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 /cml/trunk/src/Win32/proc-manager.sml
ViewVC logotype

Annotation of /cml/trunk/src/Win32/proc-manager.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2102 - (view) (download)

1 : monnier 137 (* proc-manager.sml
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
5 :     * COPYRIGHT (c) 1989-1991 John H. Reppy
6 :     *
7 :     * Win32 process management (from its Unix counterpart)
8 :     *
9 :     *)
10 :    
11 :     structure ProcManager : sig
12 :    
13 :     val addPid : Win32Process.pid -> Win32Process.exit_status Event.event
14 :    
15 :     val pollProcs : unit -> unit
16 :    
17 :     val anyWaiting : unit -> bool
18 :    
19 :     end = struct
20 :    
21 :     structure S = Scheduler
22 :     structure WP = Win32Process
23 :     structure R = Result
24 :    
25 :     datatype pid = PID of {
26 :     wait : WP.exit_status R.result,
27 :     pid : WP.pid
28 :     }
29 :    
30 :     val waiting = ref ([] : pid list)
31 :    
32 :     fun addPid pid = let
33 :     val rv = Result.result()
34 :     in
35 :     waiting := PID{wait = rv, pid = pid} :: !waiting;
36 :     Result.getEvt rv
37 :     end
38 :    
39 :     fun pollProcs () = let
40 :     (** NOTE: it would be more efficient to poll for any zombie process,
41 :     ** until there are no more.
42 :     **)
43 :     fun pollPid pid = WP.waitForSingleObject pid
44 :     fun pollItem (item as PID{wait, pid}) = (
45 :     case (pollPid pid)
46 :     of SOME(sts) => (
47 :     S.enqueueTmpThread (fn () => R.put(wait, sts));
48 :     false)
49 :     | NONE => true
50 :     (* end case *))
51 :     handle ex => (
52 :     S.enqueueTmpThread (fn () => R.putExn (wait, ex));
53 :     false)
54 :     in
55 :     waiting := List.filter pollItem (! waiting)
56 :     end
57 :    
58 :     fun anyWaiting () = (case !waiting of [] => false | _ => true)
59 :    
60 :     end
61 :    

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