Commit 76ddaa39 authored by John van Groningen's avatar John van Groningen

don't close the timer if the cancel button is pressed, we may need it to quit all the compilers,

use DQuitCompilers if the cancel button was pressed during parallel build,
in ProcessCompilerMsg yield True if the paths have changed
parent c9df392e
......@@ -6,7 +6,7 @@ import StdPSt, StdId, StdTimer, StdWindow
checkDialogExistence id io
# (st,io) = getDialogsStack io
= (isMember id st,io)
StartIntr :: !(!Id,Id) .a (.Bool -> .(.a -> .(*(PSt .b) -> *(.a,*(PSt .b))))) !*(PSt .b) -> *(PSt .b)
StartIntr (dialogId,interruptId) ls callback ps
# (exist,ps) = accPIO (checkDialogExistence dialogId) ps
......@@ -37,7 +37,6 @@ where
# ps = appPIO (disableTimer interruptId) ps
= callback False ls ps
# ps = closeWindow dialogid ps
# ps = appPIO (closeTimer interruptId) ps
= callback True ls ps
TriggerNoIntr interruptId noi (ls,ps)
......
......@@ -20,9 +20,6 @@ import PmAbcMagic,PmFileInfo,PmDirCache
import Platform
from StdLibMisc import :: Date{..}, :: Time{..}
trace_n _ g :== g
trace_n` _ g :== g
verboseInfo verbose info ps :== verbi verbose info ps
where
verbi verbose info ps
......@@ -294,18 +291,22 @@ step intr (DInit force project setproject) ps
# (fileinfo,ps) = getFICache` ps
= MakeTheProject force fileinfo libsinfo abccache project setproject ps
step True (DComp force dircache (Pers inf) rest ds) ps
# ds = {ds & ok = False}
# (paths,ds) = ds!modpaths
// compile phase finished: kill clean compiler
# (_,ps) = ExitCleanCompiler (inf,ps)
= step True (DGene paths SyncCodeGeneration ds) ps
step True (DComp force dircache compinfo rest ds) ps
// need async cocl shootdown as well..
# ds = {ds & ok = False}
# (paths,ds) = ds!modpaths
= step True (DGene paths SyncCodeGeneration ds) ps
# ds = {ds & ok = False}
# (modpaths,ds) = ds!modpaths
= case compinfo of
Pers inf
#! ds = DGene modpaths SyncCodeGeneration ds
// compile phase finished: kill clean compiler
# (_,ps) = ExitCleanCompiler (inf,ps)
-> step True ds ps
AsyncWin _ _
#! ds = DQuitCompilers modpaths compinfo ds
-> step True ds ps
_
#! ds = DGene modpaths SyncCodeGeneration ds
// need async cocl shootdown as well..
-> step True ds ps
step intr (DComp force dircache Sync Nil ds) ps
// compile phase finished: remove all modules not (indirectly) imported by main module
......@@ -347,7 +348,6 @@ step intr (DComp force dircache (Pers inf) Nil ds) ps
step intr (DComp force dircache compinfo=:(Pers _) (next :! rest) ds) ps
// compile phase: check module 'next'
# ps = trace_n ("comp step",next) ps
| StringOccurs next ds.modpaths
// if already done then skip
= step intr (DComp force dircache compinfo rest ds) ps
......@@ -387,9 +387,7 @@ step intr (DComp force dircache (AsyncWin [] {win_compiler_process_ids,win_max_n
= step intr (DGene paths (IF_MACOSX SyncCodeGeneration (ASyncCodeGenerationWin [] win_max_n_processes)) ds) ps
step intr state=:(DComp force _ (Async _ _) _ _) ps
# ps = traceInfo (Level3 ["check_completed..."]) ps
# (state, ps) = check_completed state ps
# ps = traceInfo (Level3 ["start_compilations..."]) ps
# (state, ps) = start_compilations state ps
= cont (state, ps)
where
......@@ -405,7 +403,6 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# state = DComp force dircache (Async current {max_n_processes=max_n_processes,compiler_process_ids=compiler_process_ids,unknown_finished_processors=unknown_finished_processors}) todo ds
-> check_completed state ps
(FinishedCompiler completedSlot exitcode,ps)
# ps = traceInfo (Level3 ["process_completed...",toString completedSlot,toString exitcode]) ps
#! (state,ps) = process_completed completedSlot exitcode state ps
-> check_completed state ps
check_completed state ps
......@@ -424,7 +421,6 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
# (_,ps) = SendRepeatResult process_n ps
/*
# exitcode = 1
# ps = traceInfo (Level3 ["process_completed...",toString process_n,toString exitcode]) ps
#! (state,ps) = process_completed process_n exitcode state ps
*/
= handle_completed_processes (process_n+1) state ps
......@@ -476,7 +472,6 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
= (DGene paths SyncCodeGeneration ds, ps)
= start_compilations (DComp force dircache compinfo rest ds) ps
start_compilations state ps
// # ps = traceInfo (Level3 ["start_compilations no next..."]) ps
# ps = DelayEventLoop ps
= (state, ps)
......@@ -485,9 +480,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
= or [c.iclModule == next \\ c <- current]
step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
# ps = traceInfo (Level3 ["check_completed..."]) ps
# (state, ps) = check_completed state ps
# ps = traceInfo (Level3 ["start_compilations..."]) ps
# (state, ps) = start_compilations state ps
= cont (state, ps)
where
......@@ -688,10 +681,7 @@ step intr (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes,comp
Just modinfo -> modinfo.compilerOptions
_ -> defaultCO
# timeprofile = ao.profiling && (not co.neverTimeProfile)
# free_slot = hd (removeMembers [0..max_n_processes-1] [slot \\ (slot,_,_) <- busy_processes])
// # ps = trace ("code generator started "+++toString free_slot+++"\n") ps
// # ps = trace ("s "+++toString free_slot+++" ") ps
# free_slot = hd (removeMembers [0..max_n_processes-1] [slot \\ (slot,_,_) <- busy_processes])
# (res,obj_path,compiler_process_ids,ps) = StartCodeGenerator cgen updateErrorWindow CodeGeneration abc_path free_slot timeprofile cgo proc ao startupdir compiler_process_ids ps
| not res
......@@ -1307,8 +1297,8 @@ where
// LM_Eager -> True
LM_Dynamic -> True
// ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*GeneralSt
// -> *(*GeneralSt,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String)
ProcessCompilerMsg :: !*(Maybe *CompilingInfo) !CompileOrCheckSyntax !CompilerOptions !Pathname !Pathname !CompilerMsg !FileInfoCache !*DirCache !ABCCache !Project !*GeneralSt
-> *(*(Maybe *CompilingInfo),(*GeneralSt,FileInfoCache,*DirCache,*ABCCache,Project,Bool,Bool,Pathname,List String))
ProcessCompilerMsg cstate compileOrCheckSyntax _ path abcpath (Patherror pathname) fileinfo dircache abccache project ps
# (interact, ps) = getInteract ps
| not interact
......@@ -1329,7 +1319,9 @@ ProcessCompilerMsg cstate compileOrCheckSyntax _ path abcpath (Patherror pathnam
# (pinfo,ps) = ExitCleanCompiler (pinfo, ps)
-> (Just pinfo, ps)
// RWS: this compile is still blocking...
= (cstate,CompileTheProjectModule compileOrCheckSyntax path fileinfo dircache abccache project ps)
# (ps,fileinfo,dircache,abccache,project,ok,_,abcpath,deps)
= CompileTheProjectModule compileOrCheckSyntax path fileinfo dircache abccache project ps
= (cstate,(ps,fileinfo,dircache,abccache,project,ok,True,abcpath,deps))
= (cstate,(ps,fileinfo,dircache,abccache,project,False,new,abcpath,Nil))
where
NewPathsDialog :: !String !String !Project !*GeneralSt -> *(*GeneralSt,Project,Bool)
......@@ -1566,7 +1558,7 @@ where
check date Nil files = (False,files)
check date (hd :! tl) files
# (objDate, files) = FModified hd files
| Older_Date date objDate = trace_n` ("OlderDate",hd,date,objDate) (True,files)
| Older_Date date objDate = (True,files)
= check date tl files
CheckExecOutOfDate :: !Bool !Pathname !FileInfoCache !Project !*GeneralSt -> *(Bool,*GeneralSt)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment