Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
981f599c
Commit
981f599c
authored
Apr 29, 2004
by
John van Groningen
Browse files
implement async compilation with module caching on windows
parent
4450ea5d
Changes
5
Hide whitespace changes
Inline
Side-by-side
Pm/PmDriver.icl
View file @
981f599c
...
...
@@ -118,10 +118,15 @@ GenAsmProjectModule path project setproject ps
::
*
DriverCompilingInfo
=
Sync
|
AsyncWin
!
Int
![
CurrentlyCompiled
]
|
AsyncWin
![
CurrentlyCompiled
]
!
AsyncWinCompilingInfo
|
Async
![
CurrentlyCompiled
]
!
AsyncCompilingInfo
|
Pers
!*
CompilingInfo
::
AsyncWinCompilingInfo
=
{
win_max_n_processes
::
!
Int
,
win_compiler_process_ids
::
!
CompilerProcessIds
};
::
AsyncCompilingInfo
=
{
max_n_processes
::
!
Int
,
compiler_process_ids
::
!
CompilerProcessIds
,
...
...
@@ -219,7 +224,7 @@ MakeTheProject force fileinfo libsinfo abccache project continue ps
#
(
compinfo
,
ps
)
=
case
method
of
CompileSync
->
(
Sync
,
ps
)
(
CompileAsync
cmax
)
->
PlatformDependant
(
AsyncWin
cmax
[]
,
ps
)
// win
(
AsyncWin
[]
{
win_max_n_processes
=
cmax
,
win_compiler_process_ids
=
NoCompilerProcessIds
}
,
ps
)
// win
(
let
(
compiler_process_ids
,
ps2
)
=
getCompilerProcessIds
ps
in
(
Async
[]
{
max_n_processes
=
cmax
,
compiler_process_ids
=
compiler_process_ids
,
unknown_finished_processors
=
NoUnknownFinishedProcessors
},
ps2
)
// mac
)
...
...
@@ -375,17 +380,17 @@ step intr (DComp force dircache (Async [] async_compiling_info=:{max_n_processes
#
ps
=
showInfo
(
Level1
"Generating..."
)
ps
#
(
paths
,
ds
)
=
ds
!
modpaths
=
step
intr
(
DGene
paths
(
ASyncCodeGeneration
[]
async_compiling_info
)
ds
)
ps
step
intr
(
DComp
force
dircache
(
AsyncWin
_
[])
Nil
ds
)
ps
step
intr
(
DComp
force
dircache
(
AsyncWin
[]
{
win_compiler_process_ids
})
Nil
ds
)
ps
// compile phase finished: remove all modules not (indirectly) imported by main module
#
project
=
PR_SetBuilt
ds
.
modpaths
ds
.
project
// removes unused modules
#
(
modpaths
,
project
)
=
PR_GetModulenames
True
IclMod
project
#
ds
=
{
ds
&
modpaths
=
modpaths
,
project
=
project
}
//
#
(os_error,ps) =
Clea
r
Compiler
Caches
compiler_process_ids ps;
#
ps
=
Quit
Clea
n
Compiler
True
win_
compiler_process_ids
ps
;
#
ps
=
showInfo
(
Level1
"Generating..."
)
ps
#
(
paths
,
ds
)
=
ds
!
modpaths
=
step
intr
(
DGene
paths
SyncCodeGeneration
ds
)
ps
step
intr
state
=:(
DComp
force
_
(
Async
_
_)
_
_)
ps
#
ps
=
traceInfo
(
Level3
[
"check_completed..."
])
ps
#
(
state
,
ps
)
=
check_completed
state
ps
...
...
@@ -437,7 +442,7 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
#
(
completed
,
current
)
=
removeFromCurrent
completedSlot
current
#
unknown_finished_processors
=
remove_from_unknown_finished_processors
completedSlot
unknown_finished_processors
#
(
startupdir
,
ps
)
=
getStup
ps
typewin
=
updateTypeWindow
True
(
GetModuleName
completed
.
iclModule
)
[
typeWinKeyboard
,
typeWinMouse
]
#
typewin
=
updateTypeWindow
True
(
GetModuleName
completed
.
iclModule
)
[
typeWinKeyboard
,
typeWinMouse
]
#
ccstring
=
"dummy ccstring for now.."
#
(
abcpath
,
res
,
ps
)
=
CompileHandleExitCode
exitcode
ccstring
startupdir
completedSlot
updateErrorWindow
typewin
completed
.
iclModule
completed
.
options
.
listTypes
ps
// types param
...
...
@@ -493,7 +498,6 @@ step intr state=:(DComp force _ (Async _ _) _ _) ps
currently_compiled
next
current
=
or
[
c
.
iclModule
==
next
\\
c
<-
current
]
/*XXX
step
intr
state
=:(
DComp
force
dircache
compinfo
=:(
AsyncWin
_
_)
rest
ds
)
ps
#
ps
=
traceInfo
(
Level3
[
"check_completed..."
])
ps
#
(
state
,
ps
)
=
check_completed
state
ps
...
...
@@ -501,8 +505,8 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
#
(
state
,
ps
)
=
start_compilations
state
ps
=
cont
(
state
,
ps
)
where
check_completed :: !*DriverState !*(PSt General) ->
!
(!*DriverState,!*PSt General)
check_completed state=:(DComp _ _ (AsyncWin
cmax
current=:[_:_]) _ _) ps
check_completed
::
!*
DriverState
!*(
PSt
General
)
->
(!*
DriverState
,!*
PSt
General
)
check_completed
state
=:(
DComp
_
_
(
AsyncWin
current
=:[_:_]
_
)
_
_)
ps
=
case
(
CompilePollCompleted
ps
)
of
(
NoFinishedCompiler
,
ps
)
->
(
state
,
ps
)
...
...
@@ -514,22 +518,23 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
check_completed
state
ps
=
(
state
,
ps
)
process_completed :: !Int !Int !*DriverState !*(PSt General) ->
!
(!*DriverState,!*PSt General)
process_completed completedSlot exitcode (DComp force dircache (AsyncWin c
max c
urrent) todo ds) ps
process_completed
::
!
Int
!
Int
!*
DriverState
!*(
PSt
General
)
->
(!*
DriverState
,!*
PSt
General
)
process_completed
completedSlot
exitcode
(
DComp
force
dircache
(
AsyncWin
current
{
win_max_n_processes
,
win_compiler_process_ids
}
)
todo
ds
)
ps
#
(
completed
,
current
)
=
removeFromCurrent
completedSlot
current
#
(
startupdir
,
ps
)
=
getStup
ps
typewin = updateTypeWindow (GetModuleName completed.iclModule) [typeWinKeyboard, typeWinMouse]
#
typewin
=
updateTypeWindow
True
(
GetModuleName
completed
.
iclModule
)
[
typeWinKeyboard
,
typeWinMouse
]
#
ccstring
=
"dummy ccstring for now.."
# (
ps,
abcpath,res) = CompileHandleExitCode exitcode ccstring startupdir completedSlot updateErrorWindow typewin
#
(
abcpath
,
res
,
ps
)
=
CompileHandleExitCode
exitcode
ccstring
startupdir
completedSlot
updateErrorWindow
typewin
completed
.
iclModule
completed
.
options
.
listTypes
ps
// types param
# (ps,fileinfo,dircache,abccache,project,ok,newpaths`,_,deps)
= ProcessCompilerMsg Compilation completed.options completed.iclModule abcpath res ds.fileinfo dircache ds.abccache ds.project ps
#
(_,
(
ps
,
fileinfo
,
dircache
,
abccache
,
project
,
ok
,
newpaths`
,_,
deps
)
)
=
ProcessCompilerMsg
Nothing
Compilation
completed
.
options
completed
.
iclModule
abcpath
res
ds
.
fileinfo
dircache
ds
.
abccache
ds
.
project
ps
#
ds
=
{
ds
&
newpaths
=
ds
.
newpaths
||
newpaths`
,
fileinfo
=
fileinfo
,
abccache
=
abccache
,
project
=
project
,
ok
=
ok
}
|
ok
# ds
= {ds & modpaths = completed.iclModule :! ds.modpaths}
= (DComp force dircache (AsyncWin c
max c
urrent) (Concat deps todo) ds, ps)
#
ds
=
{
ds
&
modpaths
=
icl_to_dcl_file_name
completed
.
iclModule
:!
ds
.
modpaths
}
=
(
DComp
force
dircache
(
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
}
)
(
Concat
deps
todo
)
ds
,
ps
)
// not ok
#
(
paths
,
ds
)
=
ds
!
modpaths
#
ps
=
QuitCleanCompiler
True
win_compiler_process_ids
ps
;
=
(
DGene
paths
SyncCodeGeneration
ds
,
ps
)
where
removeFromCurrent
::
Int
[
CurrentlyCompiled
]
->
(
CurrentlyCompiled
,
[
CurrentlyCompiled
])
...
...
@@ -543,30 +548,36 @@ step intr state=:(DComp force dircache compinfo=:(AsyncWin _ _) rest ds) ps
=
(
completed
,
[
current
:
rest
])
start_compilations
::
!*
DriverState
!*(
PSt
General
)
->
(!*
DriverState
,!*
PSt
General
)
start_compilations state=:(DComp force dircache (AsyncWin cmax current) (next :! rest) ds) ps
| length current >= cmax
start_compilations
state
=:(
DComp
force
dircache
(
AsyncWin
current
{
win_max_n_processes
,
win_compiler_process_ids
})
(
next
:!
rest
)
ds
)
ps
|
length
current
>=
win_max_n_processes
#
ps
=
DelayEventLoop
ps
;
=
(
state
,
ps
)
// compile phase: check module 'next'
| StringOccurs next ds.modpaths || currently_compiled next current
= start_compilations (DComp force dircache (AsyncWin cmax current) rest ds) ps
#
next_icl
=
dcl_to_icl_file_name
next
;
|
StringOccurs
next
ds
.
modpaths
||
currently_compiled
next_icl
current
=
start_compilations
(
DComp
force
dircache
(
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
})
rest
ds
)
ps
#
modname
=
GetModuleName
next
|
isProjLibraryModule
modname
ds
.
libsinfo
// instead of testing explicitly put libmodules in done <= conflicts with other administration
= (DComp force dircache (AsyncWin c
max c
urrent) rest ds, ps)
=
(
DComp
force
dircache
(
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
}
)
rest
ds
,
ps
)
#
(
ps
,
dircache
,
ok
,_,
rest
,
compinfo
,
ds
,_)
= UpdateDependencies force next rest (AsyncWin c
max c
urrent) dircache ds ps
=
UpdateDependencies
force
next
rest
(
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
}
)
dircache
ds
ps
#
ds
=
{
ds
&
ok
=
ok
}
|
not
ok
#!
(
paths
,
ds
)
=
ds
!
modpaths
#
ps
=
QuitCleanCompiler
True
win_compiler_process_ids
ps
;
=
(
DGene
paths
SyncCodeGeneration
ds
,
ps
)
=
start_compilations
(
DComp
force
dircache
compinfo
rest
ds
)
ps
start_compilations
state
=:(
DComp
force
dircache
(
AsyncWin
[]
_)
Nil
ds
)
ps
=
(
state
,
ps
)
start_compilations
state
ps
#
ps
=
DelayEventLoop
ps
;
=
(
state
,
ps
)
currently_compiled
::
String
[
CurrentlyCompiled
]
->
Bool
currently_compiled
next
current
=
or
[
c
.
iclModule
==
next
\\
c
<-
current
]
*/
step
intr
(
DGene
Nil
SyncCodeGeneration
ds
)
ps
#!
ps
=
showInfo
(
Level1
"Linking..."
)
ps
=
step
intr
(
DLink
ds
)
ps
...
...
@@ -968,10 +979,8 @@ remove_from_unknown_finished_processors completedSlot unknown_finished_processor
=
unknown_finished_processors
compiling_info
::
!
DriverCompilingInfo
->
(
String
,
DriverCompilingInfo
)
/*
compiling_info info=:(AsyncWin _ current)
compiling_info
info
=:(
AsyncWin
current
_)
=
(
compiling_info_async
current
,
info
)
*/
compiling_info
info
=:(
Async
current
_)
=
(
compiling_info_async
current
,
info
);
compiling_info
info
...
...
@@ -1003,7 +1012,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
=
case
compinfo
of
Sync
->
UpdateSyncDependencies
rest
impname
co
dircache
ds
ps
(
Async
current
async_compiling_info
)
->
UpdateAsyncDependencies
current
async_compiling_info
rest
impname
co
dircache
ds
ps
//
async=:
(AsyncWin
_ _
)-> UpdateAsyncDependencies
async
rest impname co dircache ds ps
(
AsyncWin
current
win_compiling_info
)->
UpdateAsyncDependencies
Win
current
win_compiling_info
rest
impname
co
dircache
ds
ps
(
Pers
info
)
->
UpdatePersDependencies
info
rest
impname
co
dircache
ds
ps
|
info
.
sys
// system module
#
wrongVersion
=
info
.
version
<>
version
...
...
@@ -1069,7 +1078,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
=
case
compinfo
of
Sync
->
UpdateSyncDependencies
rest
impname
co
dircache
ds
ps
(
Async
current
async_compiling_info
)
->
UpdateAsyncDependencies
current
async_compiling_info
rest
impname
co
dircache
ds
ps
//
async=:
(AsyncWin
_ _)
-> UpdateAsyncDependencies
async
rest impname co dircache ds ps
(
AsyncWin
cmax
current
)
->
UpdateAsyncDependencies
Win
cmax
current
rest
impname
co
dircache
ds
ps
(
Pers
info
)
->
UpdatePersDependencies
info
rest
impname
co
dircache
ds
ps
#
((
ok
,
mods
,
xxx_md
,
xxx_dd
,
objs
,
libs
,
abccache
),
ps
)
=
accFiles
(
ParseABCDependencies`
info
.
abcpath
info
.
abcdate
ds
.
abccache
)
ps
...
...
@@ -1097,7 +1106,7 @@ UpdateDependencies force next rest compinfo dircache ds ps`
=
case
compinfo
of
Sync
->
UpdateSyncDependencies
rest
impname
co
dircache
ds
ps
(
Async
current
compiling_info
)
->
UpdateAsyncDependencies
current
compiling_info
rest
impname
co
dircache
ds
ps
// async=:(AsyncWin _ _ )-> UpdateAsyncDependencies async
rest impname co dircache ds ps
(
AsyncWin
current
win_compiling_info
)->
UpdateAsyncDependenciesWin
current
win_compiling_info
rest
impname
co
dircache
ds
ps
(
Pers
info
)
->
UpdatePersDependencies
info
rest
impname
co
dircache
ds
ps
where
(
prefs
,
ps
)
=
getPrefs
ps`
// lift to DriverState
...
...
@@ -1123,28 +1132,27 @@ where
co
=
case
modinfo
of
Just
modinfo
->
modinfo
.
compilerOptions
_
->
defaultCO
/*
UpdateAsyncDependencies
(AsyncWin cmax current)
rest impname co dircache ds ps
UpdateAsyncDependencies
Win
current
{
win_max_n_processes
,
win_compiler_process_ids
}
rest
impname
co
dircache
ds
ps
#
free_slot
=
get_free_slot
current
# (compileStarted, fileinfo, dircache, abccache,
ps)
= CompileTheProjectModuleStart Compilation impname free_slot ds.fileinfo dircache ds.abccache ds.project ps
#
(
compileStarted
,
fileinfo
,
dircache
,
abccache
,
win_compiler_process_ids
,
ps
)
=
CompileTheProjectModuleStart
Compilation
impname
free_slot
ds
.
fileinfo
dircache
ds
.
abccache
ds
.
project
win_compiler_process_ids
ps
;
#
ds
=
{
ds
&
fileinfo
=
fileinfo
,
abccache
=
abccache
}
|
compileStarted
#
current
=
[{
iclModule
=
impname
,
options
=
co
,
slot
=
free_slot
}
:
current
]
#
cinf
=
compiling_info_async
current
#
ps
=
showInfo
(
Level2
cinf
)
ps
# async = AsyncWin c
max c
urrent
#
async
=
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
}
=
(
ps
,
dircache
,
True
,
False
,
rest
,
async
,
ds
,
True
)
// not compileStarted
#
cinf
=
compiling_info_async
current
#
ps
=
showInfo
(
Level2
cinf
)
ps
# async = AsyncWin c
max c
urrent
#
async
=
AsyncWin
current
{
win_max_n_processes
=
win_max_n_processes
,
win_compiler_process_ids
=
win_compiler_process_ids
}
=
(
ps
,
dircache
,
False
,
False
,
rest
,
async
,
ds
,
False
)
where
get_free_slot
::
[
CurrentlyCompiled
]
->
Int
get_free_slot
current
=
hd
(
removeMembers
[
0
..]
[
slot
\\
{
slot
}
<-
current
])
*/
UpdateAsyncDependencies
current
{
max_n_processes
,
compiler_process_ids
,
unknown_finished_processors
}
rest
impname
co
dircache
ds
ps
#
free_slot
=
get_free_slot
current
...
...
Win/Clean System Files/thread_message.obj
View file @
981f599c
No preview for this file type
Win/PmCleanSystem.dcl
View file @
981f599c
...
...
@@ -19,7 +19,7 @@ NoCompilerProcessIds :: CompilerProcessIds
ClearCompilerCache
::
!
String
!
String
!.
a
->
(!
Int
,!.
a
)
ClearCompilerCaches
::
!
CompilerProcessIds
!.
a
->
(!
Int
,!.
a
)
QuitCleanCompiler
::
!
Bool
!
CompilerProcessIds
!
*(
IOSt
.
l
)
->
*(
IOSt
.
l
)
QuitCleanCompiler
::
!
Bool
!
CompilerProcessIds
!
.
env
->
.
env
//:: CompileClearCache = ClearCache | Don`tClearCache
//instance == CompileClearCache
...
...
Win/PmCleanSystem.icl
View file @
981f599c
...
...
@@ -16,7 +16,7 @@ from clCCall_12 import winLaunchApp, winLaunchApp2, winCallProcess, winMakeCStri
from
linkargs
import
ReadLinkErrors
,
WriteLinkOpts
,::
LinkInfo`
(..),::
LPathname
import
thread_message
import
lib
import
asynclaunch
//
import asynclaunch
import
UtilIO
...
...
@@ -62,7 +62,13 @@ getLib lib files
#
slibs
=
map
RemoveSuffix
slibs
=
(
errs
,
slibs
,
files
)
::
CompilerProcessIds
:==
[
Int
]
// not used for windows, always []
::
CompilerProcessHandlesAndId
=
{
compiler_thread_id
::
!
Int
,
compiler_thread_handle
::
!
Int
,
compiler_process_handle
::
!
Int
}
::
CompilerProcessIds
:==
[
CompilerProcessHandlesAndId
]
NoCompilerProcessIds
::
CompilerProcessIds
NoCompilerProcessIds
=
[]
...
...
@@ -73,8 +79,19 @@ ClearCompilerCache _ _ ps = (0,ps)
ClearCompilerCaches
::
!
CompilerProcessIds
!.
a
->
(!
Int
,!.
a
)
ClearCompilerCaches
_
ps
=
(
0
,
ps
)
QuitCleanCompiler
::
!
Bool
!
CompilerProcessIds
!*(
IOSt
.
l
)
->
*(
IOSt
.
l
)
QuitCleanCompiler
_
_
io
=
io
QuitCleanCompiler
::
!
Bool
!
CompilerProcessIds
!.
env
->
.
env
QuitCleanCompiler
async
compiler_process_ids
io
|
async
=
quit_compilers
compiler_process_ids
io
;
with
quit_compilers
[{
compiler_thread_id
,
compiler_process_handle
}:
compiler_process_ids
]
io
#
wm_number
=
get_message_number
;
#
r
=
send_string_to_thread
compiler_thread_id
compiler_process_handle
wm_number
(
"exit
\0
"
)
|
r
==
r
=
quit_compilers
compiler_process_ids
io
;
quit_compilers
[]
io
=
io
;
=
io
;
ExitCleanCompiler
::
!*(!*
CompilingInfo
,*
env
)
->
*(!*
CompilingInfo
,*
env
)
ExitCleanCompiler
prog
=:(
CompilingInfo
(
CompilerProcess
compiler_thread_id
compiler_thread_handle
compiler_process_handle
),
ps
)
...
...
@@ -149,6 +166,7 @@ Compile
cocl`
use_compiler_process_ids
write_module_times
errwin
typewin
compileOrCheckSyntax
path
paths
projectMemoryProfiling
projectTimeProfiling
projectEagerOrDynamic
co
=:{
CompilerOptions
|
listTypes
}
startupdir
compiler_process_ids
ps
#
(
cocl_ok
,
cocl
,
cocldir
)
=
mangleCompiler
cocl`
startupdir
// platform dependant mangling...
|
not
cocl_ok
#
ps
=
errwin
[
cocl
]
ps
=
(
""
,
SyntaxError
,
compiler_process_ids
,
ps
)
...
...
@@ -167,7 +185,6 @@ Compile
where
dummy_slot
=
0
write_module_times_string
=
if
write_module_times
" -wmt "
" "
(
cocl_ok
,
cocl
,
cocldir
)
=
mangleCompiler
cocl`
startupdir
// platform dependant mangling...
mangleCompiler
ccstring`
startupdir
#
(
ccstring`
,
rem
)
=
splitOptions
ccstring`
...
...
@@ -198,10 +215,12 @@ mangleCompiler2 ccstring` startupdir
::
ExitCode
:==
Int
/*
CompileStartCommand :: !String !Bool !(WindowFun *env) !CompileOrCheckSyntax !Pathname !(List Pathname) !Int !Bool !Bool !Bool
!CompilerOptions !Pathname !CompilerProcessIds !*env -> (!Bool,!CompilerProcessIds,!*env) | FileEnv env
CompileStartCommand cocl` write_module_times errwin compileOrCheckSyntax path paths slot projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic
co startupdir compiler_process_ids ps
# (cocl_ok,cocl,cocldir) = mangleCompiler cocl` startupdir // platform dependant mangling...
| not cocl_ok
# ps = errwin [cocl] ps
= (False,compiler_process_ids,ps)
...
...
@@ -218,19 +237,76 @@ CompileStartCommand cocl` write_module_times errwin compileOrCheckSyntax path pa
= (True,compiler_process_ids,ps)
where
write_module_times_string = if write_module_times " -wmt " " "
(
cocl_ok
,
cocl
,
cocldir
)
=
mangleCompiler
cocl`
startupdir
// platform dependant mangling...
*/
::
CompilePollCompletedResult
=
NoFinishedCompiler
|
UnknownFinishedCompiler
|
FinishedCompiler
!
Int
!
Int
CompileStartCommand
::
!
String
!
Bool
!(
WindowFun
*
env
)
!
CompileOrCheckSyntax
!
Pathname
!(
List
Pathname
)
!
Int
!
Bool
!
Bool
!
Bool
!
CompilerOptions
!
Pathname
!
CompilerProcessIds
!*
env
->
(!
Bool
,!
CompilerProcessIds
,!*
env
)
|
FileEnv
env
CompileStartCommand
cocl`
write_module_times
errwin
compileOrCheckSyntax
path
paths
slot
projectMemoryProfiling
projectTimeProfiling
projectEagerOrDynamic
co
startupdir
compiler_process_ids
ps
#
(
cocl_ok
,
cocl
,
cocl_dir
,
cocl_startup
,
options
)
=
mangleCompiler2
cocl`
startupdir
// platform dependant mangling...
|
not
cocl_ok
#
ps
=
errwin
[
cocl
]
ps
=
(
False
,
compiler_process_ids
,
ps
)
#
out_file_name
=
out_file_path
tooltempdir
slot
#
errors_file_name
=
errors_file_path
tooltempdir
slot
#
cocl_arguments
=
" -id "
+++
toString
slot
+++
" "
+++
options
+++
write_module_times_string
+++.
CompileBuildCommand
out_file_name
errors_file_name
compileOrCheckSyntax
path
paths
projectMemoryProfiling
projectTimeProfiling
projectEagerOrDynamic
co
#
(
compile_ok
,
compiler_process_ids
,
ps
)
=
start_compile_with_cache
cocl
slot
cocl_dir
cocl_startup
cocl_arguments
compiler_process_ids
ps
;
|
not
compile_ok
#
ps
=
errwin
[
"Error: Unable to run compiler: "
+++
cocl
]
ps
=
(
False
,
compiler_process_ids
,
ps
)
=
(
True
,
compiler_process_ids
,
ps
)
where
write_module_times_string
=
if
write_module_times
" -wmt "
" "
CompilePollCompleted
::
!*
env
->
(!
CompilePollCompletedResult
,
!*
env
)
|
FileEnv
env
start_compile_with_cache
::
String
Int
String
String
String
CompilerProcessIds
*
env
->
(!
Bool
,!
CompilerProcessIds
,!*
env
)
start_compile_with_cache
path
slot
directory
startup_arguments
arguments
compiler_process_ids
ps
|
slot
<
length
compiler_process_ids
#
compiler_handles_and_id
=
compiler_process_ids
!!
slot
=
start_compile_with_cache2
path
compiler_handles_and_id
directory
arguments
compiler_process_ids
ps
#
thread_id
=
get_current_thread_id
;
#
begin_arguments
=
startup_arguments
+++
" -ide "
+++
int_to_hex
thread_id
;
#
(
r
,
compiler_thread_id
,
compiler_thread_handle
,
compiler_process_handle
)
=
start_compiler_process
(
path
+++
"
\0
"
)
(
directory
+++
"
\0
"
)
(
path
+++
" "
+++
begin_arguments
+++
"
\0
"
);
|
r
==
0
=
(
False
,
compiler_process_ids
,
ps
)
#
compiler_handles_and_id
=
{
compiler_thread_id
=
compiler_thread_id
,
compiler_thread_handle
=
compiler_thread_handle
,
compiler_process_handle
=
compiler_process_handle
}
#
compiler_process_ids
=
compiler_process_ids
++[
compiler_handles_and_id
]
=
start_compile_with_cache2
path
compiler_handles_and_id
directory
arguments
compiler_process_ids
ps
start_compile_with_cache2
::
{#.
Char
}
CompilerProcessHandlesAndId
{#.
Char
}
{#.
Char
}
CompilerProcessIds
*
env
->
(!
Bool
,!
CompilerProcessIds
,!*
env
)
start_compile_with_cache2
path
{
compiler_thread_id
,
compiler_thread_handle
,
compiler_process_handle
}
directory
arguments
compiler_process_ids
ps
#
wm_number
=
get_message_number
#
r
=
send_string_to_thread
compiler_thread_id
compiler_process_handle
wm_number
(
"cocl "
+++
arguments
+++
"
\0
"
)
|
r
==
0
=
(
False
,
compiler_process_ids
,
ps
)
=
(
True
,
compiler_process_ids
,
ps
)
::
CompilePollCompletedResult
=
NoFinishedCompiler
|
UnknownFinishedCompiler
|
FinishedCompiler
!
Int
!
Int
/*
CompilePollCompleted ps
# (ok, exitCode, slot, os)
= AsyncPollCompleted 99
// | trace_n ("CompilePollCompleted ok=" +++ toString ok +++ " slot/r=" +++ toString slot) ok
| ok
=
wait
100
(
FinishedCompiler
slot
exitCode
,
ps
)
= //wait 100
(FinishedCompiler slot exitCode, ps)
// not ok
= (NoFinishedCompiler, ps)
*/
CompilePollCompleted
::
!*
env
->
(!
CompilePollCompletedResult
,
!*
env
)
|
FileEnv
env
CompilePollCompleted
ps
#
(
compiler_id
,
exit_code
)
=
get_finished_compiler_id_and_exit_code
|
compiler_id
<
0
=
(
NoFinishedCompiler
,
ps
)
=
(
FinishedCompiler
compiler_id
exit_code
,
ps
);
get_finished_compiler_id_and_exit_code
::
(!
Int
/*compiler_id*/
,!
Int
/*exit_code*/
);
get_finished_compiler_id_and_exit_code
=
code {
ccall
get_finished_compiler_id_and_exit_code
":II"
}
//-- Persistent compilation stuff...synchronous for now...
...
...
@@ -285,10 +361,10 @@ CompileBuildCommand out_file_name errors_file_name compileOrCheckSyntax path pat
CompileHandleExitCode
::
!
Int
!
String
!
String
!
Int
!(
WindowFun
*
env
)
!(
WindowFun
*
env
)
!
Pathname
!
ListTypes
!*
env
->
(!
Pathname
,!
CompilerMsg
,!*
env
)
|
FileEnv
env
CompileHandleExitCode
exitcode
cocl
tooltem
pdir
slot
errwin
typewin
path
CompileHandleExitCode
exitcode
cocl
startu
pdir
slot
errwin
typewin
path
listTypes
ps
#
out_file_name
=
out_file_path
tooltempdir
0
errors_file_name
=
errors_file_path
tooltempdir
0
#
out_file_name
=
out_file_path
tooltempdir
slot
errors_file_name
=
errors_file_path
tooltempdir
slot
#
((
type_text_not_empty
,
type_text
),
ps
)
=
accFiles
(
ReadTypesInfo
(
listTypes
<>
NoTypes
)
out_file_name
)
ps
((
errors
,
errors_and_messages_not_empty
,
errors_and_messages
),
ps
)
...
...
@@ -759,7 +835,6 @@ compile_with_cache path directory startup_arguments arguments prog=:(NotCompilin
compile_with_cache2
::
{#.
Char
}
{#.
Char
}
{#.
Char
}
Int
Int
Int
->
(!
Bool
,!
Int
)
compile_with_cache2
path
directory
arguments
compiler_thread_id
compiler_thread_handle
compiler_process_handle
#
wm_number
=
get_message_number
// # r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
#
r
=
send_string_to_thread
compiler_thread_id
compiler_process_handle
wm_number
(
"cocl "
+++
arguments
+++
"
\0
"
)
#
r
=
trace_n
(
"Compile"
,
"cocl "
+++
arguments
)
r
|
r
==
0
...
...
@@ -776,4 +851,11 @@ SendRepeatResult :: !Int !.a -> (!Int,!.a)
SendRepeatResult
_
_
=
undef
DelayEventLoop
::
!.
ps
->
.
ps
DelayEventLoop
ps
=
ps
// only used on the Mac
DelayEventLoop
ps
|
wait_message
0
==
0
=
ps
wait_message
::
!
Int
->
Int
;
wait_message
r
=
code {
ccall
WaitMessage@0
"P:V:I"
}
\ No newline at end of file
Win/thread_message.c
View file @
981f599c
...
...
@@ -4,6 +4,8 @@
#include
"Clean.h"
#include
"thread_message.h"
static
int
CleanCompiler_message_nunber
;
int
get_message_number
(
void
)
{
return
RegisterWindowMessage
(
"CleanCompiler"
);
...
...
@@ -14,6 +16,36 @@ int get_current_thread_id (void)
return
GetCurrentThreadId
();
}
int
compiler_result_handler_installed
=
0
;
extern
void
(
*
dispatch_null_message_hook
)
(
MSG
*
);
#define MAX_N_COMPILERS 32
int
compiler_finished
[
MAX_N_COMPILERS
];
int
compiler_exit_codes
[
MAX_N_COMPILERS
];
void
compiler_result_handler
(
MSG
*
msg
)
{
if
(
msg
->
message
==
CleanCompiler_message_nunber
){
unsigned
int
compiler_n
;
compiler_n
=
msg
->
wParam
;
if
(
compiler_n
<
MAX_N_COMPILERS
){
compiler_exit_codes
[
compiler_n
]
=
msg
->
lParam
;
compiler_finished
[
compiler_n
]
=
1
;
}
}
}
void
install_compiler_result_handler
(
void
)
{
CleanCompiler_message_nunber
=
get_message_number
();
dispatch_null_message_hook
=
&
compiler_result_handler
;
}
int
start_compiler_process
(
CleanString
compiler_path
,
CleanString
compiler_directory
,
CleanString
command
,
int
*
compiler_thread_id_p
,
int
*
compiler_thread_handle_p
,
int
*
compiler_process_handle_p
)
{
...
...
@@ -22,6 +54,11 @@ int start_compiler_process (CleanString compiler_path,CleanString compiler_direc
PROCESS_INFORMATION
pi
;
int
r
;
if
(
!
compiler_result_handler_installed
){
install_compiler_result_handler
();
compiler_result_handler_installed
=
1
;
}
application_name
=
CleanStringCharacters
(
compiler_path
);
dir
=
CleanStringCharacters
(
compiler_directory
);
command_line
=
CleanStringCharacters
(
command
);
...
...
@@ -185,3 +222,31 @@ int send_integers_to_thread (int thread_id,int wm_number,int i1,int i2)
return
r
;
}
int
compiler_id
=-
1
;
int
set_compiler_id
(
int
compiler_id_p
)
{
compiler_id
=
compiler_id_p
;
return
compiler_id_p
;
}
int
get_compiler_id
(
void
)
{
return
compiler_id
;
}
int
get_finished_compiler_id_and_exit_code
(
int
*
exit_code_p
)
{
int
compiler_n
;
for
(
compiler_n
=
0
;
compiler_n
<
MAX_N_COMPILERS
;
++
compiler_n
)
if
(
compiler_finished
[
compiler_n
]){
*
exit_code_p
=
compiler_exit_codes
[
compiler_n
];
compiler_finished
[
compiler_n
]
=
0
;
return
compiler_n
;
}
*
exit_code_p
=
0
;
return
-
1
;
}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment