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

Annotation of /sml/trunk/src/compiler/PervEnv/Unix/unix.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 93 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/PervEnv/Unix/unix.sml

1 : monnier 16 (* 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 :     structure PE = Posix.ProcEnv
12 :     structure PF = Posix.FileSys
13 :     structure PIO = Posix.IO
14 :     structure SS = Substring
15 :    
16 :     fun protect f x = let
17 :     val _ = Signals.maskSignals Signals.MASKALL
18 :     val y = (f x) handle ex =>
19 :     (Signals.unmaskSignals Signals.MASKALL; raise ex)
20 :     in
21 :     Signals.unmaskSignals Signals.MASKALL; y
22 :     end
23 :    
24 :     fun fdReader (name : string, fd : PIO.file_desc) =
25 :     PosixTextPrimIO.mkReader {
26 :     initBlkMode = true,
27 :     name = name,
28 :     fd = fd
29 :     }
30 :    
31 :     fun fdWriter (name, fd) =
32 :     PosixTextPrimIO.mkWriter {
33 :     appendMode = false,
34 :     initBlkMode = true,
35 :     name = name,
36 :     chunkSize=4096,
37 :     fd = fd
38 :     }
39 :    
40 :     fun openOutFD (name, fd) =
41 :     TextIO.mkOutstream (
42 :     TextIO.StreamIO.mkOutstream (
43 :     fdWriter (name, fd), IO.BLOCK_BUF))
44 :    
45 :     fun openInFD (name, fd) =
46 :     TextIO.mkInstream (
47 :     TextIO.StreamIO.mkInstream (
48 :     fdReader (name, fd), NONE))
49 :    
50 :     datatype proc = PROC of {
51 :     pid : P.pid,
52 :     ins : TextIO.instream,
53 :     outs : TextIO.outstream
54 :     }
55 :    
56 :     fun executeInEnv (cmd, argv, env) = let
57 :     val p1 = PIO.pipe ()
58 :     val p2 = PIO.pipe ()
59 :     fun closep () = (
60 :     PIO.close (#outfd p1);
61 :     PIO.close (#infd p1);
62 :     PIO.close (#outfd p2);
63 :     PIO.close (#infd p2)
64 :     )
65 :     val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
66 :     fun startChild () = (case protect P.fork ()
67 :     of SOME pid => pid (* parent *)
68 :     | NONE => let
69 :     val oldin = #infd p1
70 :     val newin = Posix.FileSys.wordToFD 0w0
71 :     val oldout = #outfd p2
72 :     val newout = Posix.FileSys.wordToFD 0w1
73 :     in
74 :     PIO.close (#outfd p1);
75 :     PIO.close (#infd p2);
76 :     if (oldin = newin) then ()
77 :     else (
78 :     PIO.dup2{old = oldin, new = newin};
79 :     PIO.close oldin);
80 :     if (oldout = newout) then ()
81 :     else (
82 :     PIO.dup2{old = oldout, new = newout};
83 :     PIO.close oldout);
84 :     P.exece (cmd, base::argv, env)
85 :     end
86 :     (* end case *))
87 :     val _ = TextIO.flushOut TextIO.stdOut
88 :     val pid = (startChild ()) handle ex => (closep(); raise ex)
89 :     val ins = openInFD (base^"_exec_in", #infd p2)
90 :     val outs = openOutFD (base^"_exec_out", #outfd p1)
91 :     in
92 :     (* close the child-side fds *)
93 :     PIO.close (#outfd p2);
94 :     PIO.close (#infd p1);
95 :     (* set the fds close on exec *)
96 :     PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
97 :     PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
98 :     PROC {
99 :     pid = pid,
100 :     ins = ins,
101 :     outs = outs
102 :     }
103 :     end
104 :    
105 :     fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
106 :    
107 :     fun streamsOf (PROC{ins,outs,...}) = (ins, outs)
108 :    
109 :     fun kill (PROC{pid,...},signal) = P.kill (P.K_PROC pid, signal)
110 :    
111 :     fun reap (PROC{pid,ins,outs}) = let
112 :     (* protect is probably too much; typically, one
113 :     * would only mask SIGINT, SIGQUIT and SIGHUP
114 :     *)
115 :     fun waitProc () = #2(protect P.waitpid (P.W_CHILD pid,[]))
116 :     in
117 :     TextIO.closeIn ins;
118 :     TextIO.closeOut outs;
119 :     waitProc ()
120 :     end
121 :    
122 :     end (* structure Unix *)
123 :    
124 :     (*
125 :     * $Log: unix.sml,v $
126 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:40:00 george
127 :     * Version 110.5
128 : monnier 16 *
129 :     *)

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