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 1506 - (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 : mblume 1506 fun fromStatus s = mkExitStatus (Int.quot (s, 256), Int.rem (s, 256))
84 : monnier 416
85 : mblume 1426 structure W = struct
86 :     local structure W0 = BitFlagsFn ()
87 :     in
88 :     open W0
89 :     end
90 : monnier 416
91 : mblume 1426 val untraced =
92 :     fromWord ((sysconf "JOB_CONTROL"; w_osval "WUNTRACED")
93 :     handle _ => 0w0)
94 :     end
95 : monnier 416
96 : mblume 1426 val wnohang = W.fromWord (w_osval "WNOHANG")
97 : monnier 416
98 :     fun waitpid (arg,flags) = let
99 : mblume 1426 val (pid,status,sv) = waitpid'(argToInt arg, W.toWord (W.flags flags))
100 :     in
101 :     (PID pid, mkExitStatus(status,sv))
102 :     end
103 : monnier 416
104 :     fun waitpid_nh (arg,flags) =
105 : mblume 1426 case waitpid'(argToInt arg, W.toWord (W.flags (wnohang :: flags))) of
106 : monnier 416 (0,_,_) => NONE
107 :     | (pid,status,sv) => SOME(PID pid, mkExitStatus(status,sv))
108 :    
109 :     fun wait () = waitpid(W_ANY_CHILD,[])
110 :    
111 :     fun exit (x: Word8.word) : 'a = cfun "exit" x
112 :    
113 :     val kill' : s_int * s_int -> unit = cfun "kill"
114 :     fun kill (K_PROC (PID pid),Sig.SIG s) = kill'(pid, s)
115 :     | kill (K_SAME_GROUP,Sig.SIG s) = kill'(~1, s)
116 :     | kill (K_GROUP (PID pid),Sig.SIG s) = kill'(~pid, s)
117 :    
118 :     local
119 :     fun wrap f t =
120 :     Time.fromSeconds(Int.toLarge(f(Int.fromLarge(Time.toSeconds t))))
121 :     val alarm' : int -> int = cfun "alarm"
122 :     val sleep' : int -> int = cfun "sleep"
123 :     in
124 :     val alarm = wrap alarm'
125 :     val sleep = wrap sleep'
126 :     end
127 :    
128 :     val pause : unit -> unit = cfun "pause"
129 :    
130 :    
131 :     end (* structure POSIX_Process *)
132 :     end
133 :    

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