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/system/Basis/Implementation/Posix/posix-process.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/Posix/posix-process.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1426 - (view) (download)

1 : monnier 416 (* posix-process.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Structure for POSIX 1003.1 process submodule
6 :     *
7 :     *)
8 :    
9 :     local
10 :     structure SysWord = SysWordImp
11 :     structure Word8 = Word8Imp
12 :     structure Time = TimeImp
13 :     structure Int = IntImp
14 :     in
15 :     structure POSIX_Process =
16 :     struct
17 :    
18 :     structure Sig = POSIX_Signal
19 :    
20 :     type word = SysWord.word
21 :     type s_int = SysInt.int
22 :    
23 :     type signal = Sig.signal
24 :     datatype pid = PID of s_int
25 :     fun pidToWord (PID i) = SysWord.fromInt i
26 :     fun wordToPid w = PID (SysWord.toInt w)
27 :    
28 :     fun cfun x = CInterface.c_function "POSIX-Process" x
29 :     val osval : string -> s_int = cfun "osval"
30 :     val w_osval = SysWord.fromInt o osval
31 :    
32 :     val sysconf : string -> SysWord.word =
33 :     CInterface.c_function "POSIX-ProcEnv" "sysconf"
34 :    
35 :     val fork' : unit -> s_int = cfun "fork"
36 :     fun fork () =
37 :     case fork' () of
38 :     0 => NONE
39 :     | child_pid => SOME(PID child_pid)
40 :    
41 :     fun exec (x: string * string list) : 'a = cfun "exec" x
42 :     fun exece (x: string * string list * string list) : 'a = cfun "exece" x
43 :     fun execp (x: string * string list): 'a = cfun "execp" x
44 :    
45 :     datatype waitpid_arg
46 :     = W_ANY_CHILD
47 :     | W_CHILD of pid
48 :     | W_SAME_GROUP
49 :     | W_GROUP of pid
50 :    
51 :     datatype killpid_arg
52 :     = K_PROC of pid
53 :     | K_SAME_GROUP
54 :     | K_GROUP of pid
55 :    
56 :     datatype exit_status
57 :     = W_EXITED
58 :     | W_EXITSTATUS of Word8.word
59 :     | W_SIGNALED of signal
60 :     | W_STOPPED of signal
61 :    
62 :     (* (pid',status,status_val) = waitpid' (pid,options) *)
63 :     val waitpid' : s_int * word -> s_int * s_int * s_int = cfun "waitpid"
64 :    
65 :     fun argToInt W_ANY_CHILD = ~1
66 :     | argToInt (W_CHILD (PID pid)) = pid
67 :     | argToInt (W_SAME_GROUP) = 0
68 :     | argToInt (W_GROUP (PID pid)) = ~pid
69 :    
70 :     (* The exit status from wait is encoded as a pair of integers.
71 :     * If the first integer is 0, the child exited normally, and
72 :     * the second integer gives its exit value.
73 :     * If the first integer is 1, the child exited due to an uncaught
74 :     * signal, and the second integer gives the signal value.
75 :     * Otherwise, the child is stopped and the second integer
76 :     * gives the signal value that caused the child to stop.
77 :     *)
78 :     fun mkExitStatus (0,0) = W_EXITED
79 :     | mkExitStatus (0,v) = W_EXITSTATUS(Word8.fromInt v)
80 :     | mkExitStatus (1,s) = W_SIGNALED (Sig.SIG s)
81 :     | mkExitStatus (_,s) = W_STOPPED (Sig.SIG s)
82 :    
83 :    
84 : mblume 1426 structure W = struct
85 :     local structure W0 = BitFlagsFn ()
86 :     in
87 :     open W0
88 :     end
89 : monnier 416
90 : mblume 1426 val untraced =
91 :     fromWord ((sysconf "JOB_CONTROL"; w_osval "WUNTRACED")
92 :     handle _ => 0w0)
93 :     end
94 : monnier 416
95 : mblume 1426 val wnohang = W.fromWord (w_osval "WNOHANG")
96 : monnier 416
97 :     fun waitpid (arg,flags) = let
98 : mblume 1426 val (pid,status,sv) = waitpid'(argToInt arg, W.toWord (W.flags flags))
99 :     in
100 :     (PID pid, mkExitStatus(status,sv))
101 :     end
102 : monnier 416
103 :     fun waitpid_nh (arg,flags) =
104 : mblume 1426 case waitpid'(argToInt arg, W.toWord (W.flags (wnohang :: flags))) of
105 : monnier 416 (0,_,_) => NONE
106 :     | (pid,status,sv) => SOME(PID pid, mkExitStatus(status,sv))
107 :    
108 :     fun wait () = waitpid(W_ANY_CHILD,[])
109 :    
110 :     fun exit (x: Word8.word) : 'a = cfun "exit" x
111 :    
112 :     val kill' : s_int * s_int -> unit = cfun "kill"
113 :     fun kill (K_PROC (PID pid),Sig.SIG s) = kill'(pid, s)
114 :     | kill (K_SAME_GROUP,Sig.SIG s) = kill'(~1, s)
115 :     | kill (K_GROUP (PID pid),Sig.SIG s) = kill'(~pid, s)
116 :    
117 :     local
118 :     fun wrap f t =
119 :     Time.fromSeconds(Int.toLarge(f(Int.fromLarge(Time.toSeconds t))))
120 :     val alarm' : int -> int = cfun "alarm"
121 :     val sleep' : int -> int = cfun "sleep"
122 :     in
123 :     val alarm = wrap alarm'
124 :     val sleep = wrap sleep'
125 :     end
126 :    
127 :     val pause : unit -> unit = cfun "pause"
128 :    
129 :    
130 :     end (* structure POSIX_Process *)
131 :     end
132 :    

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