Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cml/src/Win32/os-process.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/src/Win32/os-process.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 137 - (view) (download)

1 : monnier 137 (* os-process.sml
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
5 :     *
6 :     * The generic process control interface.
7 :     * Modified to work for Win32 (no reliance on Posix.Process)
8 :     *)
9 :    
10 :     structure OS_Process : OS_PROCESS =
11 :     struct
12 :    
13 :     structure S = Scheduler
14 :     structure PM = ProcManager
15 :     structure CC = SMLofNJ.Cont
16 :    
17 :     structure P = OS.Process
18 :     structure WP = Win32Process
19 :    
20 :     type status = P.status
21 :    
22 :     val success = P.success
23 :     val failure = P.failure
24 :    
25 :     (** NOTE: we probably need to disable timer signals here **)
26 :     fun system' cmd = let
27 :     val _ = S.stopTimer ()
28 :     val pid = WP.createProcess (cmd)
29 :     val _ = S.restartTimer ()
30 :     in
31 :     pid
32 :     end
33 :    
34 :     fun systemEvt cmd = let
35 :     val pid = system' cmd
36 :     val evt = (S.atomicBegin(); PM.addPid pid before S.atomicEnd())
37 :     in
38 :     Event.wrap (evt,
39 :     fn WP.SUCCESS => P.success
40 :     | _ => P.failure)
41 :     end
42 :    
43 :     val system = Event.sync o systemEvt
44 :    
45 :     fun atExit _ = raise Fail "OS.Process.atExit unimplemented"
46 :     fun exit sts = (S.atomicBegin(); CC.throw (!S.shutdownHook) (true, sts))
47 :     fun terminate sts = (S.atomicBegin(); CC.throw (!S.shutdownHook) (false, sts))
48 :    
49 :     val getEnv = P.getEnv
50 :    
51 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0