1 files changed, 201 insertions, 0 deletions
diff --git a/sys/etc/propcpr.x b/sys/etc/propcpr.x
new file mode 100644
index 00000000..b7b394a1
--- /dev/null
+++ b/sys/etc/propcpr.x
@@ -0,0 +1,201 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<knet.h>
+include	<config.h>
+include	<syserr.h>
+include	<fset.h>
+include	<xwhen.h>
+include	<prstat.h>
+
+# PROPCPR -- Open a connected subprocess, i.e., spawn the subprocess and
+# connect the two IPC channels to FIO file descriptors.  No i/o is done on
+# the IPC channels, hence this relatively low level command is independent
+# of the IPC protocol used.  PROPEN should be used if the standard IPC
+# protocol is followed, so that the environment and current working directory
+# may be passed to the subprocess.
+
+int procedure propcpr (process, in, out)
+
+char	process[ARB]		# filename of executable process file
+int	in			# fd of IPC input from child (output)
+int	out			# fd of IPC output to child (output)
+
+bool	first_time
+int	pr, loc_onipc
+pointer	sp, fname
+int	fopnbf()
+extern	pr_onipc(), pr_dummy_open(), pr_zclspr()
+extern	zardpr(), zawrpr(), zawtpr(), zsttpr()
+errchk	xwhen, fmapfn, syserr
+include	"prc.com"
+
+define	cleanup1_ 91
+define	cleanup2_ 92
+define	cleanup3_ 93
+data	first_time /true/
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	# Initialize the process table.  Post exception handler to recover
+	# from write to IPC with no reader.
+
+	if (first_time) {
+	    do pr = 1, MAX_CHILDPROCS
+		pr_pid[pr] = NULL
+	    pr_lastio = 1		# any legal slot number will do
+	    pr_last_exit_code = OK
+	    call zlocpr (pr_onipc, loc_onipc)
+	    call xwhen (X_IPC, loc_onipc, pr_oldipc)
+	    first_time = false
+	}
+
+	# Find empty process slot.
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if (pr_pid[pr] == NULL)
+		break
+	if (pr > MAX_CHILDPROCS)
+	    call syserr (SYS_PROVFL)
+	pr_index = pr
+
+	# Initialize the mapping of pseudofile codes to file descriptor numbers.
+	# PS codes begin at 1, corresponding to STDIN.
+
+	pr_pstofd[pr,STDIN]    = STDIN
+	pr_pstofd[pr,STDOUT]   = STDOUT
+	pr_pstofd[pr,STDERR]   = STDERR
+	pr_pstofd[pr,STDGRAPH] = STDGRAPH
+	pr_pstofd[pr,STDIMAGE] = STDIMAGE
+	pr_pstofd[pr,STDPLOT]  = STDPLOT
+
+	# Spawn process and open IPC channels.
+	call fmapfn (process, Memc[fname], SZ_PATHNAME)
+	call zopcpr (Memc[fname], pr_inchan[pr], pr_outchan[pr], pr_pid[pr])
+	if (pr_pid[pr] == ERR)
+	    goto cleanup3_
+	pr_nopen[pr] = 2
+
+	# Set up file descriptors for the two IPC channels.
+
+	call strcpy (process, Memc[fname], SZ_PATHNAME)
+	call strcat (".in", Memc[fname], SZ_PATHNAME)
+	iferr (in = fopnbf (Memc[fname], READ_ONLY,
+	    pr_dummy_open, zardpr, zawrpr, zawtpr, zsttpr, pr_zclspr))
+	    goto cleanup2_
+	pr_infd[pr] = in
+
+	call strcpy (process, Memc[fname], SZ_PATHNAME)
+	call strcat (".out", Memc[fname], SZ_PATHNAME)
+	iferr (out = fopnbf (Memc[fname], WRITE_ONLY,
+	    pr_dummy_open, zardpr, zawrpr, zawtpr, zsttpr, pr_zclspr))
+	    goto cleanup1_
+	pr_outfd[pr] = out
+
+	pr_status[pr] = P_RUNNING
+	call sfree (sp)
+	return (pr_pid[pr])
+
+cleanup1_
+	iferr (call close (out))
+	    ;
+cleanup2_
+	iferr (call close (in))
+	    ;
+cleanup3_
+	call sfree (sp)
+	pr_pid[pr] = NULL
+	call syserrs (SYS_PROPEN, process)
+end
+
+
+# PR_DUMMY_OPEN -- Dummy ZOPNPR procedure called by FIO to "open" the IPC
+# channel to a subprocess.  Our only function is to return the appropriate
+# channel code to FIO, since the channel has already been opened by ZOPCPR.
+
+procedure pr_dummy_open (osfn, mode, chan)
+
+char	osfn[ARB]		# not used
+int	mode			# used to select read or write IPC channel
+int	chan			# returned to FIO
+include	"prc.com"
+
+begin
+	if (mode == READ_ONLY)
+	    chan = pr_inchan[pr_index]
+	else
+	    chan = pr_outchan[pr_index]
+end
+
+
+# PR_ZCLSPR -- Dummy "zclspr" routine called by FIO to close an IPC channel
+# when CLOSE is called on the corresponding FIO file descriptor.  A subprocess
+# opened with PROPCPR is normally closed with PRCLCPR, but if error recovery
+# takes place CLOSE will automatically be called by the system to close both
+# file descriptors.  We decrement the count of open channels and close the
+# process and both IPC channels when the count reaches zero.  Hence, a
+# connected subprocess may be closed either by calling PRCLCPR or by closing
+# the IN and OUT file descriptors.
+
+procedure pr_zclspr (chan, status)
+
+int	chan			# either inchan or outchan of process
+int	status			# OK or ERR on output
+int	pr
+include	"prc.com"
+
+begin
+	do pr = 1, MAX_CHILDPROCS
+	    if (pr_pid[pr] != NULL)
+		if (pr_inchan[pr] == chan || pr_outchan[pr] == chan) {
+		    pr_nopen[pr] = pr_nopen[pr] - 1
+		    if (pr_nopen[pr] == 0) {
+			call zclcpr (pr_pid[pr], pr_last_exit_code)
+			pr_pid[pr] = NULL
+		    }
+		    status = OK
+		    return
+		}
+
+	status = ERR
+end
+
+
+# PR_ONIPC -- Exception handler for the X_IPC (write to IPC with no reader)
+# exception.  This exception occurs when the child process dies unexpectedly.
+# Determine what process was being written to, cancel any output (to prevent
+# a cascade of onipcs trying to flush the output buffer), and cause FIO to
+# return a file write error.  We cannot do any more than that w/o reentrancy
+# problems.
+
+procedure pr_onipc (vex, next_handler)
+
+int	vex		# virtual exception
+int	next_handler	# next handler in chain
+int	pr, fd
+int	fstati()
+include	"prc.com"
+
+begin
+	# Chain to next exception handler, if any.
+	next_handler = pr_oldipc
+
+	# Get the FD of the file being written to at the time that the
+	# exception occurred.  We assume that the write operation is still
+	# in progress when the exception takes place.
+
+	fd = fstati (0, F_LASTREFFILE)
+	for (pr=1;  pr <= MAX_CHILDPROCS;  pr=pr+1)
+	    if (pr_pid[pr] != NULL)
+		if (pr_outfd[pr] == fd)
+		    break
+	if (pr > MAX_CHILDPROCS)
+	    return
+
+	# Cancel any buffered output and remove write permission to ensure
+	# that we will not get a cascade of X_IPC exceptions.
+
+	call fseti (fd, F_CANCEL, ERR)
+	call fseti (fd, F_MODE, READ_ONLY)
+	pr_status[pr] = P_DEAD
+end