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/Unix/unix.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/Unix/unix.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1506 - (view) (download)

1 : monnier 416 (* unix.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     structure Unix : UNIX =
8 :     struct
9 :    
10 :     structure P = Posix.Process
11 : mblume 1506 structure PS = POSIX_Signal
12 : monnier 416 structure PE = Posix.ProcEnv
13 :     structure PF = Posix.FileSys
14 :     structure PIO = Posix.IO
15 :     structure SS = Substring
16 :    
17 : mblume 1506 type signal = PS.signal
18 :     datatype exit_status = datatype P.exit_status
19 :    
20 :     datatype ('a, 'b) proc =
21 :     PROC of { base: string,
22 :     pid : P.pid,
23 :     infd : PIO.file_desc,
24 :     outfd: PIO.file_desc,
25 :     (* The following two elements are a temporary
26 :     * hack until the general interface is sorted out.
27 :     * The idea is to have "reap" close the most recently
28 :     * created stream. If no stream has been created,
29 :     * then the file descriptors get closed directly. *)
30 :     closein: (unit -> unit) ref,
31 :     closeout: (unit -> unit) ref,
32 :     exit_status: OS.Process.status option ref }
33 :    
34 :     val fromStatus = P.fromStatus
35 :    
36 : monnier 416 fun protect f x = let
37 :     val _ = Signals.maskSignals Signals.MASKALL
38 :     val y = (f x) handle ex =>
39 :     (Signals.unmaskSignals Signals.MASKALL; raise ex)
40 :     in
41 :     Signals.unmaskSignals Signals.MASKALL; y
42 :     end
43 :    
44 : mblume 1506 fun fdTextReader (name : string, fd : PIO.file_desc) =
45 : monnier 416 PosixTextPrimIO.mkReader {
46 :     initBlkMode = true,
47 :     name = name,
48 :     fd = fd
49 :     }
50 :    
51 : mblume 1506 fun fdBinReader (name : string, fd : PIO.file_desc) =
52 :     PosixBinPrimIO.mkReader {
53 :     initBlkMode = true,
54 :     name = name,
55 :     fd = fd
56 :     }
57 :    
58 :     fun fdTextWriter (name, fd) =
59 : monnier 416 PosixTextPrimIO.mkWriter {
60 :     appendMode = false,
61 :     initBlkMode = true,
62 :     name = name,
63 :     chunkSize=4096,
64 :     fd = fd
65 :     }
66 :    
67 : mblume 1506 fun fdBinWriter (name, fd) =
68 :     PosixBinPrimIO.mkWriter {
69 :     appendMode = false,
70 :     initBlkMode = true,
71 :     name = name,
72 :     chunkSize=4096,
73 :     fd = fd
74 :     }
75 :    
76 :     fun openTextOutFD (name, fd) =
77 : monnier 416 TextIO.mkOutstream (
78 :     TextIO.StreamIO.mkOutstream (
79 : mblume 1506 fdTextWriter (name, fd), IO.BLOCK_BUF))
80 : monnier 416
81 : mblume 1506 fun openBinOutFD (name, fd) =
82 :     BinIO.mkOutstream (
83 :     BinIO.StreamIO.mkOutstream (
84 :     fdBinWriter (name, fd), IO.BLOCK_BUF))
85 :    
86 :     fun openTextInFD (name, fd) =
87 : monnier 416 TextIO.mkInstream (
88 :     TextIO.StreamIO.mkInstream (
89 : mblume 1506 fdTextReader (name, fd), ""))
90 : monnier 416
91 : mblume 1506 fun openBinInFD (name, fd) =
92 :     BinIO.mkInstream (
93 :     BinIO.StreamIO.mkInstream (
94 :     fdBinReader (name, fd), Byte.stringToBytes ""))
95 : monnier 416
96 : mblume 1506 fun setcloser (r, f, s) = (r := (fn () => f s); s)
97 :    
98 :     fun textInstreamOf (PROC { base, infd, closein, ... }) =
99 :     setcloser (closein, TextIO.closeIn,
100 :     openTextInFD (base ^ "_exec_txt_in", infd))
101 :     fun binInstreamOf (PROC { base, infd, closein, ... }) =
102 :     setcloser (closein, BinIO.closeIn,
103 :     openBinInFD (base ^ "_exec_bin_in", infd))
104 :     fun textOutstreamOf (PROC { base, outfd, closeout, ... }) =
105 :     setcloser (closeout, TextIO.closeOut,
106 :     openTextOutFD (base ^ "_exec_txt_out", outfd))
107 :     fun binOutstreamOf (PROC { base, outfd, closeout, ... }) =
108 :     setcloser (closeout, BinIO.closeOut,
109 :     openBinOutFD (base ^ "_exec_bin_out", outfd))
110 :    
111 :     fun streamsOf p = (textInstreamOf p, textOutstreamOf p)
112 :    
113 :     fun executeInEnv (cmd, argv, env) =
114 :     let val p1 = PIO.pipe ()
115 :     val p2 = PIO.pipe ()
116 :     fun closep () =
117 :     (PIO.close (#outfd p1);
118 :     PIO.close (#infd p1);
119 :     PIO.close (#outfd p2);
120 :     PIO.close (#infd p2))
121 :     val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
122 :     fun startChild () =
123 :     case protect P.fork () of
124 :     SOME pid => pid (* parent *)
125 :     | NONE =>
126 :     let val oldin = #infd p1
127 :     val newin = Posix.FileSys.wordToFD 0w0
128 :     val oldout = #outfd p2
129 :     val newout = Posix.FileSys.wordToFD 0w1
130 :     in
131 : monnier 416 PIO.close (#outfd p1);
132 :     PIO.close (#infd p2);
133 :     if (oldin = newin) then ()
134 : mblume 1506 else (PIO.dup2{old = oldin, new = newin};
135 :     PIO.close oldin);
136 : monnier 416 if (oldout = newout) then ()
137 : mblume 1506 else (PIO.dup2{old = oldout, new = newout};
138 :     PIO.close oldout);
139 : monnier 416 P.exece (cmd, base::argv, env)
140 : mblume 1506 end
141 :     val _ = TextIO.flushOut TextIO.stdOut
142 :     val pid = (startChild ()) handle ex => (closep(); raise ex)
143 :     val infd = #infd p2
144 :     val outfd = #outfd p1
145 :     in
146 :     (* close the child-side fds *)
147 : monnier 416 PIO.close (#outfd p2);
148 :     PIO.close (#infd p1);
149 : mblume 1506 (* set the fds close on exec *)
150 : monnier 416 PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
151 :     PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
152 : mblume 1506 PROC { base = base, pid = pid, infd = infd, outfd = outfd,
153 :     closein = ref (fn () => PIO.close infd),
154 :     closeout = ref (fn () => PIO.close outfd),
155 :     exit_status = ref NONE }
156 :     end
157 : monnier 416
158 :     fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
159 :    
160 :     fun kill (PROC{pid,...},signal) = P.kill (P.K_PROC pid, signal)
161 :    
162 : mblume 1506 fun reap (PROC { exit_status = ref (SOME s), ... }) = s
163 :     | reap (PROC { exit_status, pid, closein, closeout, ... }) =
164 :     let
165 :     (* protect is probably too much; typically, one
166 :     * would only mask SIGINT, SIGQUIT and SIGHUP
167 :     *)
168 :     fun waitProc () =
169 :     case #2(protect P.waitpid (P.W_CHILD pid,[])) of
170 :     W_EXITED => 0
171 :     | W_EXITSTATUS s => Word8Imp.toInt s
172 :     | W_SIGNALED (PS.SIG s) => 256 + s
173 :     | W_STOPPED (PS.SIG s) => (* should not happen! *) 512 + s
174 :     val _ = !closein ()
175 :     val _ = !closeout () handle _ => ()
176 :     val s = waitProc ()
177 :     in
178 :     exit_status := SOME s;
179 :     s
180 :     end
181 : monnier 416
182 : mblume 1506 val exit = P.exit
183 :    
184 : monnier 416 end (* structure Unix *)
185 :    

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