Repatch (from linux) of OSX IRAF

1 files changed, 149 insertions, 0 deletions

diff --git a/sys/qpoe/qpparsefl.x b/sys/qpoe/qpparsefl.x
new file mode 100644
index 00000000..566274fb
--- /dev/null
+++ b/sys/qpoe/qpparsefl.x
@@ -0,0 +1,149 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"qpoe.h"
+include	"qpex.h"
+
+# QP_PARSEFL -- Parse the field list, or declarations string for a user
+# defined datatype (structure or domain).
+#
+# Syntax:	{ type1, type2, ..., typeN }
+#
+# e.g.,		{d,s:x,s:y,s,s,s,s}	(Rosat/PROS event structure)
+#
+# where the TYPEi are primitive types, e.g., "r" or "real", "i" or "int",
+# etc.  Selected fields may have ":x" or ":y" appended to indicate that these
+# are the default coordinate fields to be used for position based extraction.
+# Fields will be automatically aligned as necessary, and the computed structure
+# size will be forced to be an integral multiple of the largest datatype
+# within the structure, to ensure proper alignment in arrays of the structures.
+
+int procedure qp_parsefl (qp, fieldlist, dd)
+
+pointer	qp			#I QPOE descriptor
+char	fieldlist[ARB]		#I field list defining new datatype (domain)
+pointer	dd			#U pointer to domain descriptor
+
+pointer	sp, tokbuf, dsym, in
+int	nfields, offset, maxsize, xfield, yfield, token, dtype, fsize
+
+pointer	qp_opentext()
+int	qp_gettok(), qp_nexttok(), sizeof(), qp_dtype()
+errchk	qp_gettok, qp_opentext, qp_nexttok
+string	qperr "QPOE structdef"
+define	nextfield_ 91
+
+begin
+	call smark (sp)
+	call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
+
+	# Open declarations string for non macro expanded token input.
+	in = qp_opentext (NULL, fieldlist)
+
+	# Advance to structure terms list.
+	while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
+	    if (Memc[tokbuf] == '{')
+		break
+
+	nfields = 0
+	offset  = 0
+	maxsize = 0
+	xfield  = 0
+	yfield  = 0
+
+	# Process the structure terms list.
+	repeat {
+	    token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+
+	    switch (token) {		# {
+	    case EOF, '}':
+		break
+
+	    case TOK_IDENTIFIER:
+		# Get field datatype and size.
+		dtype = qp_dtype (qp, Memc[tokbuf], dsym)
+		if (dtype < TY_BOOL || dtype > TY_COMPLEX) {
+		    call eprintf ("%s: bad field type `%s'\n")
+			call pargstr (qperr)
+			call pargstr (Memc[tokbuf])
+		    goto nextfield_
+		} else
+		    fsize = sizeof (dtype)
+
+		# Output field descriptor.
+		nfields = nfields + 1
+		if (nfields > MAX_FIELDS) {
+		    call eprintf ("%s: too many fields `%s'\n")
+			call pargstr (qperr)
+			call pargstr (Memc[tokbuf])
+		    break
+		}
+		DD_FOFFSET(dd,nfields) = (offset + fsize-1) / fsize
+		DD_FTYPE(dd,nfields)   = dtype
+
+		# Update structure size parameters.
+		offset = (DD_FOFFSET(dd,nfields) * fsize) + fsize
+		maxsize = max (maxsize, fsize)
+
+		# Process any :[XY] field modifiers.
+		if (qp_nexttok(in) == ':') {
+		    repeat {
+			token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
+			switch (Memc[tokbuf]) {
+			case ':':
+			    next
+			case 'x':
+			    if (xfield != 0) {
+				call eprintf ("%s: duplicate X field `%s'\n")
+				    call pargstr (qperr)
+				    call pargstr (Memc[tokbuf])
+			    }
+			    xfield = nfields
+			    break
+			case 'y':
+			    if (yfield != 0) {
+				call eprintf ("%s: duplicate Y field `%s'\n")
+				    call pargstr (qperr)
+				    call pargstr (Memc[tokbuf])
+			    }
+			    yfield = nfields
+			    break
+			default:
+			    call eprintf ("%s: unknown : field modifier `%s'\n")
+				call pargstr (qperr)
+				call pargstr (Memc[tokbuf])
+			}
+		    }
+		    goto nextfield_
+		}
+	    case ',':
+		next
+	    default:
+		call eprintf ("%s: unexpected token `%s'\n")
+		    call pargstr (qperr)
+		    call pargstr (Memc[tokbuf])
+	    }
+
+nextfield_
+	    # Read and discard tokens until we get to the next field.
+	    while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
+		if (Memc[tokbuf] == ',')
+		    break
+	}
+
+	# Complete the domain descriptor initialization.
+	DD_NFIELDS(dd) = nfields
+	DD_XFIELD(dd)  = xfield
+	DD_YFIELD(dd)  = yfield
+
+	# Pad the struct size to an integral multiple of the max field size.
+	if (nfields > 0) {
+	    maxsize = max (SZ_STRUCT, maxsize)
+	    DD_STRUCTLEN(dd) = (offset+maxsize-1)/maxsize*maxsize / SZ_STRUCT
+	} else
+	    DD_STRUCTLEN(dd) = 0
+
+	call qp_closetext (in)
+	call sfree (sp)
+
+	return (nfields)
+end