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

Parent Directory | Revision Log | Patch

	revision 651, Thu Jun 1 18:34:03 2000 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

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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