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/trunk/src/system/Basis/Implementation/Unix/unix.sml
ViewVC logotype

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

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

revision 1505, Thu Jun 17 20:41:47 2004 UTC revision 1506, Thu Jun 17 22:19:15 2004 UTC
# Line 8  Line 8 
8    struct    struct
9    
10      structure P = Posix.Process      structure P = Posix.Process
11        structure PS = POSIX_Signal
12      structure PE = Posix.ProcEnv      structure PE = Posix.ProcEnv
13      structure PF = Posix.FileSys      structure PF = Posix.FileSys
14      structure PIO = Posix.IO      structure PIO = Posix.IO
15      structure SS = Substring      structure SS = Substring
16    
17        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      fun protect f x = let      fun protect f x = let
37            val _ = Signals.maskSignals Signals.MASKALL            val _ = Signals.maskSignals Signals.MASKALL
38            val y = (f x) handle ex =>            val y = (f x) handle ex =>
# Line 21  Line 41 
41              Signals.unmaskSignals Signals.MASKALL; y              Signals.unmaskSignals Signals.MASKALL; y
42            end            end
43    
44      fun fdReader (name : string, fd : PIO.file_desc) =      fun fdTextReader (name : string, fd : PIO.file_desc) =
45            PosixTextPrimIO.mkReader {            PosixTextPrimIO.mkReader {
46                initBlkMode = true,                initBlkMode = true,
47                name = name,                name = name,
48                fd = fd                fd = fd
49              }              }
50    
51      fun fdWriter (name, fd) =      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            PosixTextPrimIO.mkWriter {            PosixTextPrimIO.mkWriter {
60                appendMode = false,                appendMode = false,
61                initBlkMode = true,                initBlkMode = true,
# Line 37  Line 64 
64                fd = fd                fd = fd
65              }              }
66    
67      fun openOutFD (name, fd) =      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            TextIO.mkOutstream (            TextIO.mkOutstream (
78              TextIO.StreamIO.mkOutstream (              TextIO.StreamIO.mkOutstream (
79                fdWriter (name, fd), IO.BLOCK_BUF))                fdTextWriter (name, fd), IO.BLOCK_BUF))
80    
81        fun openBinOutFD (name, fd) =
82              BinIO.mkOutstream (
83                BinIO.StreamIO.mkOutstream (
84                  fdBinWriter (name, fd), IO.BLOCK_BUF))
85    
86      fun openInFD (name, fd) =      fun openTextInFD (name, fd) =
87            TextIO.mkInstream (            TextIO.mkInstream (
88              TextIO.StreamIO.mkInstream (              TextIO.StreamIO.mkInstream (
89                fdReader (name, fd), ""))                fdTextReader (name, fd), ""))
90    
91      datatype proc = PROC of {      fun openBinInFD (name, fd) =
92          pid : P.pid,            BinIO.mkInstream (
93          ins : TextIO.instream,              BinIO.StreamIO.mkInstream (
94          outs : TextIO.outstream                fdBinReader (name, fd), Byte.stringToBytes ""))
95        }  
96        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) = let      fun executeInEnv (cmd, argv, env) =
114            val p1 = PIO.pipe ()          let val p1 = PIO.pipe ()
115            val p2 = PIO.pipe ()            val p2 = PIO.pipe ()
116            fun closep () = (              fun closep () =
117                  PIO.close (#outfd p1);                  (PIO.close (#outfd p1);
118                  PIO.close (#infd p1);                  PIO.close (#infd p1);
119                  PIO.close (#outfd p2);                  PIO.close (#outfd p2);
120                  PIO.close (#infd p2)                   PIO.close (#infd p2))
               )  
121            val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))            val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
122            fun startChild () = (case protect P.fork ()              fun startChild () =
123                   of SOME pid =>  pid           (* parent *)                  case protect P.fork () of
124                    | NONE => let                      SOME pid =>  pid           (* parent *)
125                        val oldin = #infd p1                    | NONE =>
126                        let val oldin = #infd p1
127                        val newin = Posix.FileSys.wordToFD 0w0                        val newin = Posix.FileSys.wordToFD 0w0
128                        val oldout = #outfd p2                        val oldout = #outfd p2
129                        val newout = Posix.FileSys.wordToFD 0w1                        val newout = Posix.FileSys.wordToFD 0w1
# Line 74  Line 131 
131                          PIO.close (#outfd p1);                          PIO.close (#outfd p1);
132                          PIO.close (#infd p2);                          PIO.close (#infd p2);
133                          if (oldin = newin) then ()                          if (oldin = newin) then ()
134                          else (                          else (PIO.dup2{old = oldin, new = newin};
                           PIO.dup2{old = oldin, new = newin};  
135                            PIO.close oldin);                            PIO.close oldin);
136                          if (oldout = newout) then ()                          if (oldout = newout) then ()
137                          else (                          else (PIO.dup2{old = oldout, new = newout};
                           PIO.dup2{old = oldout, new = newout};  
138                            PIO.close oldout);                            PIO.close oldout);
139                          P.exece (cmd, base::argv, env)                          P.exece (cmd, base::argv, env)
140                        end                        end
                 (* end case *))  
141            val _ = TextIO.flushOut TextIO.stdOut            val _ = TextIO.flushOut TextIO.stdOut
142            val pid = (startChild ()) handle ex => (closep(); raise ex)            val pid = (startChild ()) handle ex => (closep(); raise ex)
143            val ins = openInFD (base^"_exec_in", #infd p2)              val infd = #infd p2
144            val outs = openOutFD (base^"_exec_out", #outfd p1)              val outfd = #outfd p1
145            in            in
146                (* close the child-side fds *)                (* close the child-side fds *)
147              PIO.close (#outfd p2);              PIO.close (#outfd p2);
# Line 95  Line 149 
149                (* set the fds close on exec *)                (* set the fds close on exec *)
150              PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);              PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
151              PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);              PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
152              PROC {              PROC { base = base, pid = pid, infd = infd, outfd = outfd,
153                pid = pid,                     closein = ref (fn () => PIO.close infd),
154                ins = ins,                     closeout = ref (fn () => PIO.close outfd),
155                outs = outs                     exit_status = ref NONE }
             }  
156            end            end
157    
158      fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())      fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
159    
     fun streamsOf (PROC{ins,outs,...}) = (ins, outs)  
   
160      fun kill (PROC{pid,...},signal) = P.kill (P.K_PROC pid, signal)      fun kill (PROC{pid,...},signal) = P.kill (P.K_PROC pid, signal)
161    
162      fun reap (PROC{pid,ins,outs}) = let      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          (* protect is probably too much; typically, one
166           * would only mask SIGINT, SIGQUIT and SIGHUP           * would only mask SIGINT, SIGQUIT and SIGHUP
167           *)           *)
168            fun waitProc () = #2(protect P.waitpid (P.W_CHILD pid,[]))              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            in
178              TextIO.closeIn ins;              exit_status := SOME s;
179              TextIO.closeOut outs handle _ => ();              s
             waitProc ()  
180            end            end
181    
182        val exit = P.exit
183    
184    end (* structure Unix *)    end (* structure Unix *)
185    

Legend:
Removed from v.1505  
changed lines
  Added in v.1506

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