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/branches/SMLNJ/src/cml/src/Unix/unix.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/cml/src/Unix/unix.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)
Original Path: sml/trunk/src/cml/src/Unix/unix.sml

1 : monnier 2 (* unix.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * This is a CML version of the UNIX interface that is provided by SML/NJ.
6 :     *)
7 :    
8 :     structure Unix : UNIX =
9 :     struct
10 :    
11 :     structure S = Scheduler
12 :     structure PM = ProcManager
13 :    
14 :     structure PP = Posix.Process
15 :     structure PE = Posix.ProcEnv
16 :     structure PF = Posix.FileSys
17 :     structure PIO = Posix.IO
18 :     structure SS = Substring
19 :    
20 :     fun protect f x = let
21 :     val _ = Signals.maskSignals Signals.MASKALL
22 :     val y = (f x) handle ex =>
23 :     (Signals.unmaskSignals Signals.MASKALL; raise ex)
24 :     in
25 :     Signals.unmaskSignals Signals.MASKALL; y
26 :     end
27 :    
28 :     fun fdReader (name : string, fd : PIO.file_desc) =
29 :     PosixTextPrimIO.mkReader {
30 :     name = name,
31 :     fd = fd
32 :     }
33 :    
34 :     fun fdWriter (name, fd) =
35 :     PosixTextPrimIO.mkWriter {
36 :     appendMode = false,
37 :     name = name,
38 :     chunkSize=4096,
39 :     fd = fd
40 :     }
41 :    
42 :     fun openOutFD (name, fd) =
43 :     TextIO.mkOutstream (
44 :     TextIO.StreamIO.mkOutstream (
45 :     fdWriter (name, fd), IO.BLOCK_BUF))
46 :    
47 :     fun openInFD (name, fd) =
48 :     TextIO.mkInstream (
49 :     TextIO.StreamIO.mkInstream (
50 :     fdReader (name, fd), NONE))
51 :    
52 :     datatype proc = PROC of {
53 :     pid : PP.pid,
54 :     ins : TextIO.instream,
55 :     outs : TextIO.outstream
56 :     }
57 :    
58 :     fun executeInEnv (cmd, argv, env) = let
59 :     val p1 = PIO.pipe ()
60 :     val p2 = PIO.pipe ()
61 :     fun closep () = (
62 :     PIO.close (#outfd p1);
63 :     PIO.close (#infd p1);
64 :     PIO.close (#outfd p2);
65 :     PIO.close (#infd p2)
66 :     )
67 :     val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
68 :     fun startChild () = (case protect PP.fork ()
69 :     of SOME pid => pid (* parent *)
70 :     | NONE => let
71 :     val oldin = #infd p1
72 :     val newin = Posix.FileSys.wordToFD 0w0
73 :     val oldout = #outfd p2
74 :     val newout = Posix.FileSys.wordToFD 0w1
75 :     in
76 :     PIO.close (#outfd p1);
77 :     PIO.close (#infd p2);
78 :     if (oldin = newin) then ()
79 :     else (
80 :     PIO.dup2{old = oldin, new = newin};
81 :     PIO.close oldin);
82 :     if (oldout = newout) then ()
83 :     else (
84 :     PIO.dup2{old = oldout, new = newout};
85 :     PIO.close oldout);
86 :     PP.exece (cmd, base::argv, env)
87 :     end
88 :     (* end case *))
89 :     val _ = TextIO.flushOut TextIO.stdOut
90 :     val pid = (
91 :     S.stopTimer();
92 :     startChild () before
93 :     S.restartTimer())
94 :     handle ex => (S.restartTimer(); closep(); raise ex)
95 :     val ins = openInFD (base^"_exec_in", #infd p2)
96 :     val outs = openOutFD (base^"_exec_out", #outfd p1)
97 :     in
98 :     (* close the child-side fds *)
99 :     PIO.close (#outfd p2);
100 :     PIO.close (#infd p1);
101 :     (* set the fds close on exec *)
102 :     PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
103 :     PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
104 :     PROC{pid = pid, ins = ins, outs = outs}
105 :     end
106 :    
107 :     fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
108 :    
109 :     fun streamsOf (PROC{ins, outs, ...}) = (ins, outs)
110 :    
111 :     fun kill (PROC{pid, ...}, signal) = PP.kill (PP.K_PROC pid, signal)
112 :    
113 :     fun reapEvt (PROC{pid, ins, outs}) = (
114 :     S.atomicBegin(); PM.addPid pid before S.atomicEnd())
115 :    
116 :     val reap = Event.sync o reapEvt
117 :    
118 :     end (* structure Unix *)

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