1 files changed, 392 insertions, 0 deletions
diff --git a/sys/qpoe/qpioopen.x b/sys/qpoe/qpioopen.x
new file mode 100644
index 00000000..4ed8a711
--- /dev/null
+++ b/sys/qpoe/qpioopen.x
@@ -0,0 +1,392 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+include	<mach.h>
+include	<fset.h>
+include	<plset.h>
+include	"qpoe.h"
+include	"qpex.h"
+include	"qpio.h"
+
+# QPIO_OPEN -- Open the named event list parameter for event i/o.  Since event
+# lists can only be read and written sequentially, there are only two useful
+# i/o modes, namely, READ_ONLY and NEW_FILE.  Filtering is permitted only
+# when reading an event list; when writing to a new event list, the events
+# are merely copied out as they are received.
+
+pointer procedure qpio_open (qp, paramex, mode)
+
+pointer	qp			#I QPOE descriptor
+char	paramex[ARB]		#I event-list parameter plus expression list
+int	mode			#I access mode
+
+bool	newlist
+pointer	sp, io, dd, eh, op, oo, flist, deffilt, defmask, maskname
+pointer	param, expr, filter, filter_text, mask, umask, psym, dsym, name
+int	sz_filter, szb_page, nwords, nchars, junk, fd, ip, i, j
+
+pointer	qp_gpsym(), qpex_open(), stname(), strefstab()
+int	qp_popen(), qp_lenf(), read(), pl_l2pi(), fstati()
+int	qp_geti(), qp_gstr(), qp_parsefl(), qpio_parse(), qpex_modfilter()
+
+errchk	qp_bind, qp_geti, qpio_parse, qp_gpsym, qp_addf, qp_gstr
+errchk	qp_parsefl, qp_popen, qpex_open, qpio_loadmask, qpex_modfilter
+errchk	stname, calloc, malloc, realloc, read, syserrs
+string	s_deffilt DEF_FILTER
+string	s_defmask DEF_MASK
+define	done_ 91
+
+begin
+	call smark (sp)
+	call salloc (deffilt, SZ_FNAME, TY_CHAR)
+	call salloc (defmask, SZ_FNAME, TY_CHAR)
+	call salloc (maskname, SZ_FNAME, TY_CHAR)
+	call salloc (umask, SZ_FNAME, TY_CHAR)
+
+	if (QP_ACTIVE(qp) == NO)
+	    call qp_bind (qp)
+
+	newlist = (mode == NEW_FILE || mode == APPEND)
+
+	if (QP_DEBUG(qp) > 0) {
+	    call eprintf ("qpio_open (%xX, `%s', %d)\n")
+		call pargi (qp)
+		call pargstr (paramex)
+		call pargi (mode)
+	}
+
+	# Allocate and initialize the QPIO descriptor.
+	call calloc (io, LEN_IODES, TY_STRUCT)
+
+	call calloc (IO_DD(io), LEN_DDDES, TY_STRUCT)
+	call calloc (IO_PARAM(io), SZ_FNAME, TY_CHAR)
+	call calloc (IO_MASK(io), SZ_FNAME, TY_CHAR)
+
+	IO_QP(io) = qp
+	IO_MODE(io) = mode
+	IO_DEBUG(io) = QP_DEBUG(qp)
+	IO_XBLOCK(io) = QP_XBLOCK(qp)
+	IO_YBLOCK(io) = QP_YBLOCK(qp)
+	IO_NODEFFILT(io) = QP_NODEFFILT(qp)
+	IO_NODEFMASK(io) = QP_NODEFMASK(qp)
+	IO_OPTBUFSIZE(io) = QP_OPTBUFSIZE(qp)
+	IO_ACTIVE(io) = NO
+
+	dd 	= IO_DD(io)
+	param 	= IO_PARAM(io)
+	mask 	= IO_MASK(io)
+	filter 	= NULL
+
+iferr {
+	# Get the image dimensions.
+	IO_NCOLS(io)	= qp_geti (qp, "axlen[1]")
+	IO_NLINES(io)	= qp_geti (qp, "axlen[2]")
+
+	# Parse the parameter expression into the parameter name and
+	# expression qualifier fields.  Possible variations on the input
+	# syntax are "" (null string, default everything), "param" (parameter
+	# name only), "param[expr]" (parameter name plus expression), and
+	# "[expr]" or "expr" (expression only), where the parameter name may
+	# be specified as in "[param=value,...]", i.e., as a term in the
+	# expression (allowing it to be input by the user to override the
+	# default).
+
+	op = param
+	for (ip=1;  paramex[ip] != EOS && paramex[ip] != '[';  ip=ip+1) {
+	    Memc[op] = paramex[ip]
+	    op = op + 1
+	}
+	expr = ip
+
+	# Parse the expression qualifier field to set the i/o parameters,
+	# e.g., region mask, event attribute filter, blocking factor,
+	# coordinate system, etc.  All QPIO parameters are removed, returning
+	# the filter expression (if any) to be passed on to QPEX for event
+	# attribute filtering.  The `filter' buffer is passed by pointer so
+	# that it may be reallocated if more space is needed.
+
+	sz_filter = DEF_SZEXPRBUF
+	call malloc (filter, sz_filter, TY_CHAR)
+	if (qpio_parse (io, paramex[expr],
+	    filter, sz_filter, Memc[mask], SZ_FNAME) == ERR)
+	    call eprintf ("QPIO warning: error parsing options expression\n")
+
+	# If no event list parameter was named, use the default.
+	if (Memc[param] == EOS)
+	    call strcpy (DEF_EVENTPARAM, Memc[param], SZ_FNAME)
+
+	# Verify the parameter's type if it already exists, or create a new
+	# parameter of the default type if the mode is newfile or append.
+
+	psym = qp_gpsym (qp, Memc[param])
+	if (psym != NULL) {
+	    if (S_DTYPE(psym) != TY_USER || S_DSYM(psym) == NULL)
+		call syserrs (SYS_QPNEVPAR, Memc[param])
+	    else if (newlist && S_NELEM(psym) > 0)
+		call syserrs (SYS_QPCLOBBER, Memc[param])
+	} else if (mode == READ_ONLY) {
+	    call syserrs (SYS_QPUKNPAR, Memc[param])
+	} else {
+	    call qp_addf (qp, Memc[param], DEF_EVENTTYPE, 0, "", 0)
+	    psym = qp_gpsym (qp, Memc[param])
+	}
+
+	# Get the field list for the user defined event structure.  This
+	# defines the size of an event struct, lists the offset and type
+	# of each field, and indicates which fields are to be used for X
+	# and Y in positional accesses (unless already set in the paramex).
+
+	dsym = strefstab (QP_ST(qp), S_DSYM(psym))
+	nchars = S_NELEM(dsym)
+	name = stname (QP_ST(qp), dsym)
+
+	call salloc (flist, nchars, TY_CHAR)
+	if (qp_gstr (qp, Memc[name], Memc[flist], nchars) < nchars)
+	    call syserrs (SYS_QPBADVAL, Memc[name])
+
+	if (qp_parsefl (qp, Memc[flist], IO_DD(io)) <= 0)
+	    call syserrs (SYS_QPINVDD, Memc[name])
+	else if (IO_EVXOFF(io) == NULL && IO_EVYOFF(io) == NULL) {
+	    i = DD_XFIELD(dd)
+	    j = DD_YFIELD(dd)
+	    if (i == 0 || j == 0)
+		call syserrs (SYS_QPNOXYF, Memc[name])
+
+	    switch (DD_FTYPE(dd,i)) {
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		IO_EVXTYPE(io) = DD_FTYPE(dd,i)
+	    default:
+		call syserrs (SYS_QPXYFNS, Memc[name])
+	    }
+
+	    switch (DD_FTYPE(dd,j)) {
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		IO_EVYTYPE(io) = DD_FTYPE(dd,j)
+	    default:
+		call syserrs (SYS_QPXYFNS, Memc[name])
+	    }
+
+	    IO_EVXOFF(io) = DD_FOFFSET(dd,i)
+	    IO_EVYOFF(io) = DD_FOFFSET(dd,j)
+	}
+
+	IO_EVENTLEN(io) = DD_STRUCTLEN(dd) * SZ_STRUCT / SZ_SHORT
+
+	# Open the lfile used to store the event list.
+	IO_FD(io) = qp_popen (qp, Memc[param], mode, BINARY_FILE)
+	IO_LF(io) = S_LFILE(psym)
+	IO_CHAN(io) = fstati (IO_FD(io), F_CHANNEL)
+	IO_PSYM(io) = psym
+
+	# The rest of the initialization is performed in the first call to
+	# qpio_putev if we are writing a new event list.
+
+	if (newlist) 			# EXIT if new event list
+	    goto done_			# -----------------------
+
+	fd = IO_FD(io)
+	szb_page = QP_FMPAGESIZE(qp)
+	nchars = szb_page / SZB_CHAR
+	call salloc (eh, szb_page / (SZ_STRUCT*SZB_CHAR), TY_STRUCT)
+	call aclri (Memi[eh], szb_page / (SZ_STRUCT*SZB_CHAR))
+
+	# Read event list header.
+	if (read (fd, Memi[eh], nchars) < nchars)
+	    call syserrs (SYS_QPNOEH, Memc[param])
+
+	IO_NEVENTS(io)	= EH_NEVENTS(eh)
+	IO_EVENTLEN(io)	= EH_EVENTLEN(eh)
+	IO_SZBBUCKET(io)= EH_SZBBUCKET(eh)
+	IO_BUCKETLEN(io)= EH_BUCKETLEN(eh)
+	IO_FBOFF(io)	= EH_FBOFF(eh)
+	IO_EVMINOFF(io)	= EH_EVMINOFF(eh)
+	IO_EVMAXOFF(io)	= EH_EVMAXOFF(eh)
+	IO_INDEXLEN(io)	= EH_INDEXLEN(eh)
+	IO_YOFFVOFF(io) = EH_YOFFVOFF(eh)
+	IO_YOFFVLEN(io) = EH_YOFFVLEN(eh)
+	IO_YLENVOFF(io) = EH_YLENVOFF(eh)
+	IO_YLENVLEN(io) = EH_YLENVLEN(eh)
+	IO_IXXOFF(io)	= EH_IXXOFF(eh)
+	IO_IXYOFF(io)	= EH_IXYOFF(eh)
+	IO_IXXTYPE(io)	= EH_IXXTYPE(eh)
+	IO_IXYTYPE(io)	= EH_IXYTYPE(eh)
+
+	# Copy the MINEVL event struct into the QPIO descriptor.
+	nwords = IO_EVENTLEN(io)
+	call malloc (IO_MINEVL(io), nwords, TY_SHORT)
+	call amovs (Memi[eh+EH_MINEVLOFF(eh)], Mems[IO_MINEVL(io)],
+	    IO_EVENTLEN(io))
+
+	# Copy the MAXEVL event struct into the QPIO descriptor.
+	call malloc (IO_MAXEVL(io), nwords, TY_SHORT)
+	call amovs (Memi[eh+EH_MAXEVLOFF(eh)], Mems[IO_MAXEVL(io)],
+	    IO_EVENTLEN(io))
+
+	if (IO_DEBUG(io) > 0) {
+	    call eprintf ("%s: nev=%d, szbk=%d, bklen=%d+2, ixlen=%d\n")
+		call pargstr (Memc[param])
+		call pargi (IO_NEVENTS(io))
+		call pargi (IO_SZBBUCKET(io))
+		call pargi (IO_BUCKETLEN(io))
+		call pargi (IO_INDEXLEN(io))
+	}
+
+	# Get compressed event list index, if any.
+	if (IO_INDEXLEN(io) > 0) {
+	    call salloc (oo, IO_INDEXLEN(io) * 2, TY_SHORT)
+	    call malloc (IO_YOFFVP(io), IO_INDEXLEN(io), TY_INT)
+	    call malloc (IO_YLENVP(io), IO_INDEXLEN(io), TY_INT)
+
+	    nchars = IO_YOFFVLEN(io) * SZ_SHORT
+	    call seek (fd, IO_YOFFVOFF(io))
+	    if (read (fd, Mems[oo], nchars) < nchars)
+		call syserrs (SYS_QPBADIX, Memc[param])
+	    junk = pl_l2pi (Mems[oo], 1, Memi[IO_YOFFVP(io)], IO_INDEXLEN(io))
+
+	    nchars = IO_YLENVLEN(io) * SZ_SHORT
+	    call seek (fd, IO_YLENVOFF(io))
+	    if (read (fd, Mems[oo], nchars) < nchars)
+		call syserrs (SYS_QPBADIX, Memc[param])
+	    junk = pl_l2pi (Mems[oo], 1, Memi[IO_YLENVP(io)], IO_INDEXLEN(io))
+	}
+
+	# We won't need the file buffer any more, so free it.
+	call fseti (fd, F_BUFSIZE, 0)
+
+	# Compile the event attribute filter (EAF).  Always open the default
+	# filter if one is provided with the datafile.  If the user has also
+	# specified a filter, this will modify the default filter.
+
+	if (IO_NODEFFILT(io) != YES) {
+	    # Check for "deffilt.<evl>" first, then "deffilt".
+	    call sprintf (Memc[deffilt], SZ_FNAME, "%s.%s")
+		call pargstr (s_deffilt)
+		call pargstr (Memc[param])
+	    nchars = qp_lenf (qp, Memc[deffilt])
+	    if (nchars <= 0) {
+		call strcpy (s_deffilt, Memc[deffilt], SZ_FNAME)
+		nchars = qp_lenf (qp, Memc[deffilt])
+	    }
+
+	    # Open the default filter if one was found.
+	    if (nchars > 0) {
+		call salloc (filter_text, nchars, TY_CHAR)
+		if (qp_gstr(qp,Memc[deffilt],Memc[filter_text],nchars) < nchars)
+		    call syserrs (SYS_QPBADVAL, Memc[deffilt])
+		IO_EX(io) = qpex_open (qp, Memc[filter_text])
+		IO_EXCLOSE(io) = YES
+	    }
+	}
+
+	# Fold in the user specified filter if one was given.
+	if (Memc[filter] != EOS) {
+	    if (IO_EX(io) != NULL) {
+		if (qpex_modfilter (IO_EX(io), Memc[filter]) == ERR)
+		    call fprintf (STDERR,
+			"Warning: error compiling QPIO filter\n")
+	    } else {
+		IO_EX(io) = qpex_open (qp, Memc[filter])
+		IO_EXCLOSE(io) = YES
+	    }
+
+	    if (IO_DEBUG(io) > 0) {
+		call eprintf ("event attribute filter: %s\n")
+		    call pargstr (Memc[filter])
+	    }
+	}
+
+	# Open the region mask.  This may be specified (named) in the parameter
+	# expression, else we try to open a default mask.  If a mask is named,
+	# the name may be the name of a header parameter containing the mask
+	# as the stored array value (TY_OPAQUE parameter), the name of a header
+	# parameter containing the name of the mask (TY_CHAR), or the name of
+	# a mask storage file (.pl extension).
+
+	# Make a copy of the user mask name, as qpio_loadmask will clobber it.
+	call strcpy (Memc[mask], Memc[umask], SZ_FNAME)
+
+	if (IO_NODEFMASK(io) != YES) {
+	    # Check for "defmask.<evl>" first, then "defmask".
+	    call sprintf (Memc[defmask], SZ_FNAME, "%s.%s")
+		call pargstr (s_defmask)
+		call pargstr (Memc[param])
+	    nchars = qp_lenf (qp, Memc[defmask])
+	    if (nchars <= 0) {
+		call strcpy (s_defmask, Memc[defmask], SZ_FNAME)
+		nchars = qp_lenf (qp, Memc[defmask])
+	    }
+
+	    if (nchars > 0)
+		if (qp_gstr (qp, Memc[defmask], Memc[maskname], SZ_FNAME) > 0)
+		    call qpio_loadmask (io, Memc[maskname], NO)
+	}
+
+	# Load user specified mask.
+	if (Memc[umask] != EOS)
+	    call qpio_loadmask (io, Memc[umask], YES)
+	else if (IO_INDEXLEN(io) > 0)
+	    call malloc (IO_RL(io), RL_LENELEM*2, TY_INT)
+
+	# Allocate the bucket buffer.
+	call malloc (IO_BP(io), IO_SZBBUCKET(io)/SZB_CHAR/SZ_SHORT, TY_SHORT)
+done_
+	# If no default rect was specified, set default bounding box for
+	# reading to be the entire image.
+
+	if (IO_BBUSED(io) == NO) {
+	    IO_VSDEF(io,1) = 1;			IO_VSDEF(io,2) = 1
+	    IO_VEDEF(io,1) = IO_NCOLS(io);	IO_VEDEF(io,2) = IO_NLINES(io)
+	}
+
+	# Initialize the active BB to the default.
+	call amovi (IO_VSDEF(io,1), IO_VS(io,1), NDIM)
+	call amovi (IO_VEDEF(io,1), IO_VE(io,1), NDIM)
+
+} then {
+	# We branch here if any nasty errors occur above.  Cleanup and free
+	# the partially opened descriptor and pass the error on to whoever
+	# called us.
+
+	if (IO_BP(io) != NULL)
+	    call mfree (IO_BP(io), TY_SHORT)
+	if (IO_RL(io) != NULL)
+	    call mfree (IO_RL(io), TY_INT)
+	if (IO_PL(io) != NULL && IO_PLCLOSE(io) == YES)
+	    call pl_close (IO_PL(io))
+	if (IO_EX(io) != NULL)
+	    call qpex_close (IO_EX(io))
+
+	if (IO_YLENVP(io) != NULL)
+	    call mfree (IO_YLENVP(io), TY_INT)
+	if (IO_YOFFVP(io) != NULL)
+	    call mfree (IO_YOFFVP(io), TY_INT)
+	if (IO_MINEVL(io) != NULL)
+	    call mfree (IO_MINEVL(io), TY_SHORT)
+	if (IO_MAXEVL(io) != NULL)
+	    call mfree (IO_MAXEVL(io), TY_SHORT)
+	if (IO_FD(io) != NULL)
+	    call close (IO_FD(io))
+
+	if (IO_MASK(io) != NULL)
+	    call mfree (IO_MASK(io), TY_CHAR)
+	if (IO_PARAM(io) != NULL)
+	    call mfree (IO_PARAM(io), TY_CHAR)
+	if (IO_DD(io) != NULL)
+	    call mfree (IO_DD(io), TY_STRUCT)
+
+	if (filter != NULL)
+	    call mfree (filter, TY_CHAR)
+	if (io != NULL)
+	    call mfree (io, TY_STRUCT)
+
+	call erract (EA_ERROR)
+}
+
+	# The filter can be regenerated, so don't keep the input expr around.
+	call mfree (filter, TY_CHAR)
+
+	# Normal exit for read-only access.
+	call sfree (sp)
+	return (io)
+end