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

SCM Repository

[smlnj] Diff of /sml/branches/blume-private-devel/src/system/Basis/Implementation/Unix/unix.sml
ViewVC logotype

Diff of /sml/branches/blume-private-devel/src/system/Basis/Implementation/Unix/unix.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1516, Fri Jun 18 19:52:04 2004 UTC revision 1517, Fri Jun 18 19:52:04 2004 UTC
# Line 17  Line 17 
17      type signal = PS.signal      type signal = PS.signal
18      datatype exit_status = datatype P.exit_status      datatype exit_status = datatype P.exit_status
19    
20      datatype ('a, 'b) proc =      datatype 'stream stream =
21            UNOPENED of PIO.file_desc
22          | OPENED of { stream: 'stream, close: unit -> unit }
23    
24        datatype proc_status =
25            DEAD of OS.Process.status
26          | ALIVE of P.pid
27    
28        datatype ('instream, 'outstream) proc =
29               PROC of { base: string,               PROC of { base: string,
30                         pid  : P.pid,                    instream: 'instream stream ref,
31                         infd : PIO.file_desc,                    outstream: 'outstream stream ref,
32                         outfd: PIO.file_desc,                    status: proc_status ref }
                        (* The following two elements are a temporary  
                         * hack until the general interface is sorted out.  
                         * The idea is to have "reap" close the most recently  
                         * created stream.  If no stream has been created,  
                         * then the file descriptors get closed directly. *)  
                        closein: (unit -> unit) ref,  
                        closeout: (unit -> unit) ref,  
                        exit_status: OS.Process.status option ref }  
33    
34      val fromStatus = P.fromStatus      val fromStatus = P.fromStatus
35    
# Line 93  Line 93 
93              BinIO.StreamIO.mkInstream (              BinIO.StreamIO.mkInstream (
94                fdBinReader (name, fd), Byte.stringToBytes ""))                fdBinReader (name, fd), Byte.stringToBytes ""))
95    
96      fun setcloser (r, f, s) = (r := (fn () => f s); s)      fun streamOf (sel, sfx, opener, closer) (PROC p) =
97            case sel p of
98                ref (OPENED s) => #stream s
99              | r as ref (UNOPENED fd) =>
100                  let val s = opener (#base p ^ "_ext_" ^ sfx, fd)
101                  in
102                      r := OPENED { stream = s, close = fn () => closer s };
103                      s
104                  end
105    
106      fun textInstreamOf (PROC { base, infd, closein, ... }) =      fun textInstreamOf p =
107          setcloser (closein, TextIO.closeIn,          streamOf (#instream, "txt_in", openTextInFD, TextIO.closeIn) p
108                     openTextInFD (base ^ "_exec_txt_in", infd))      fun binInstreamOf p =
109      fun binInstreamOf (PROC { base, infd, closein, ... }) =          streamOf (#instream, "bin_in", openBinInFD, BinIO.closeIn) p
110          setcloser (closein, BinIO.closeIn,      fun textOutstreamOf p =
111                     openBinInFD (base ^ "_exec_bin_in", infd))          streamOf (#outstream, "txt_out", openTextOutFD, TextIO.closeOut) p
112      fun textOutstreamOf (PROC { base, outfd, closeout, ... }) =      fun binOutstreamOf p =
113          setcloser (closeout, TextIO.closeOut,          streamOf (#outstream, "bin_out", openBinOutFD, BinIO.closeOut) p
                    openTextOutFD (base ^ "_exec_txt_out", outfd))  
     fun binOutstreamOf (PROC { base, outfd, closeout, ... }) =  
         setcloser (closeout, BinIO.closeOut,  
                    openBinOutFD (base ^ "_exec_bin_out", outfd))  
114    
115      fun streamsOf p = (textInstreamOf p, textOutstreamOf p)      fun streamsOf p = (textInstreamOf p, textOutstreamOf p)
116    
# Line 149  Line 153 
153              (* set the fds close on exec *)              (* set the fds close on exec *)
154              PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);              PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
155              PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);              PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
156              PROC { base = base, pid = pid, infd = infd, outfd = outfd,              PROC { base = base,
157                     closein = ref (fn () => PIO.close infd),                     instream = ref (UNOPENED infd),
158                     closeout = ref (fn () => PIO.close outfd),                     outstream = ref (UNOPENED outfd),
159                     exit_status = ref NONE }                     status = ref (ALIVE pid) }
160          end          end
161    
162      fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())      fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
163    
164      fun kill (PROC{pid,...},signal) = P.kill (P.K_PROC pid, signal)      fun kill (PROC { status = ref (ALIVE pid), ... }, signal) =
165              P.kill (P.K_PROC pid, signal)
166          | kill _ = ()                     (* raise an exception here? *)
167    
168      fun reap (PROC { exit_status = ref (SOME s), ... }) = s      fun reap (PROC { status = ref (DEAD s), ... }) = s
169        | reap (PROC { exit_status, pid, closein, closeout, ... }) =        | reap (PROC { status = status as ref (ALIVE pid), instream, outstream, ... }) =
170          let          let
171              (* protect is probably too much; typically, one              (* protect is probably too much; typically, one
172               * would only mask SIGINT, SIGQUIT and SIGHUP               * would only mask SIGINT, SIGQUIT and SIGHUP
# Line 171  Line 177 
177                    | W_EXITSTATUS s => Word8Imp.toInt s                    | W_EXITSTATUS s => Word8Imp.toInt s
178                    | W_SIGNALED (PS.SIG s) => 256 + s                    | W_SIGNALED (PS.SIG s) => 256 + s
179                    | W_STOPPED (PS.SIG s) => (* should not happen! *) 512 + s                    | W_STOPPED (PS.SIG s) => (* should not happen! *) 512 + s
180              val _ = !closein ()              fun close (UNOPENED fd) = PIO.close fd
181              val _ = !closeout () handle _ => ()                | close (OPENED s) = #close s ()
182                val _ = close (!instream)
183                val _ = close (!outstream) handle _ => ()
184              val s = waitProc ()              val s = waitProc ()
185          in          in
186              exit_status := SOME s;              status := DEAD s;
187              s              s
188          end          end
189    
190      val exit = P.exit      val exit = P.exit
191    
192    end (* structure Unix *)    end (* structure Unix *)
   

Legend:
Removed from v.1516  
changed lines
  Added in v.1517

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