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