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 8 - (view) (download)

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 : monnier 8
59 : monnier 2 fun executeInEnv (cmd, argv, env) = let
60 :     val p1 = PIO.pipe ()
61 :     val p2 = PIO.pipe ()
62 :     fun closep () = (
63 :     PIO.close (#outfd p1);
64 :     PIO.close (#infd p1);
65 :     PIO.close (#outfd p2);
66 :     PIO.close (#infd p2)
67 :     )
68 :     val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
69 :     fun startChild () = (case protect PP.fork ()
70 :     of SOME pid => pid (* parent *)
71 :     | NONE => let
72 :     val oldin = #infd p1
73 :     val newin = Posix.FileSys.wordToFD 0w0
74 :     val oldout = #outfd p2
75 :     val newout = Posix.FileSys.wordToFD 0w1
76 :     in
77 :     PIO.close (#outfd p1);
78 :     PIO.close (#infd p2);
79 :     if (oldin = newin) then ()
80 :     else (
81 :     PIO.dup2{old = oldin, new = newin};
82 :     PIO.close oldin);
83 :     if (oldout = newout) then ()
84 :     else (
85 :     PIO.dup2{old = oldout, new = newout};
86 :     PIO.close oldout);
87 :     PP.exece (cmd, base::argv, env)
88 :     end
89 :     (* end case *))
90 :     val _ = TextIO.flushOut TextIO.stdOut
91 :     val pid = (
92 :     S.stopTimer();
93 :     startChild () before
94 :     S.restartTimer())
95 :     handle ex => (S.restartTimer(); closep(); raise ex)
96 :     val ins = openInFD (base^"_exec_in", #infd p2)
97 :     val outs = openOutFD (base^"_exec_out", #outfd p1)
98 :     in
99 :     (* close the child-side fds *)
100 :     PIO.close (#outfd p2);
101 :     PIO.close (#infd p1);
102 :     (* set the fds close on exec *)
103 :     PIO.setfd (#infd p2, PIO.FD.flags [PIO.FD.cloexec]);
104 :     PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
105 :     PROC{pid = pid, ins = ins, outs = outs}
106 :     end
107 :    
108 :     fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
109 :    
110 :     fun streamsOf (PROC{ins, outs, ...}) = (ins, outs)
111 :    
112 :     fun kill (PROC{pid, ...}, signal) = PP.kill (PP.K_PROC pid, signal)
113 :    
114 :     fun reapEvt (PROC{pid, ins, outs}) = (
115 :     S.atomicBegin(); PM.addPid pid before S.atomicEnd())
116 :    
117 :     val reap = Event.sync o reapEvt
118 :    
119 :     end (* structure Unix *)

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