Initial commit

5 files changed, 2693 insertions, 0 deletions

diff --git a/pkg/dataio/import/generic/ipdb.x b/pkg/dataio/import/generic/ipdb.x
new file mode 100644
index 00000000..4dfb81c7
--- /dev/null
+++ b/pkg/dataio/import/generic/ipdb.x
@@ -0,0 +1,813 @@
+include <evvexpr.h>
+include <error.h>
+include <mach.h>
+include <imhdr.h>
+include "../import.h"
+include "../ipfcn.h"
+
+define	DEBUG	false
+
+
+# IP_EVAL_DBREC -- For each of the keywords defined in the database record,
+# evaluate the expression and load the task structure.
+
+procedure ip_eval_dbrec (ip)
+
+pointer	ip					#i task struct pointer
+
+int	ival
+pointer	sp, dims, pixtype, err
+pointer	np, stp, sym
+
+pointer	stname(), sthead(), stnext
+int	or(), ip_dbgeti()
+bool	streq()
+
+errchk	ip_dbgeti()
+
+begin
+	call smark (sp)
+	call salloc (dims, SZ_EXPR, TY_CHAR)
+	call salloc (pixtype, SZ_EXPR, TY_CHAR)
+	call salloc (err, SZ_EXPR, TY_CHAR)
+	call aclrc (Memc[dims], SZ_EXPR)
+	call aclrc (Memc[pixtype], SZ_EXPR)
+	call aclrc (Memc[err], SZ_EXPR)
+
+	# Load the defaults.
+	call ip_load_defaults (ip)
+
+	# First thing we do is get the byte swap flag so the remaining 
+	# fields will be interpreted correctly.
+	ifnoerr (ival = ip_dbgeti (ip, "bswap"))
+	    IP_SWAP(ip) = ival
+
+	# Next, we handle 'interleave', 'dims' and 'pixtype' as a special case
+	# since for band- and line-interleaved files we may need to fix up the
+	# pixtype pointers.
+	ifnoerr (ival = ip_dbgeti (ip, "interleave"))
+	    IP_INTERLEAVE(ip) = ival
+
+	ifnoerr (call ip_dbstr (ip, "dims", Memc[dims], SZ_EXPR))
+	    call ip_do_dims (ip, Memc[dims])
+
+	ifnoerr (call ip_dbstr (ip, "pixtype", Memc[pixtype], SZ_EXPR)) {
+	    if (Memc[pixtype] == '"')
+	        call fdb_strip_quote (Memc[pixtype], Memc[pixtype], SZ_EXPR)
+	    call ip_do_pixtype (ip, Memc[pixtype])
+	}
+
+	# Loop over every symbol in the table.
+	stp = IP_FSYM(ip)
+        for (sym=sthead(stp);  sym != NULL;  sym=stnext(stp,sym)) {
+	    np = stname (stp, sym)
+
+	    if (streq(Memc[np],"format") ||	# ignored or found already
+		streq(Memc[np],"alias") ||
+		streq(Memc[np],"image_id") ||
+		streq(Memc[np],"interleave") ||
+		streq(Memc[np],"dims") ||
+		streq(Memc[np],"pixtype") ||
+		streq(Memc[np],"id_string") ||
+		streq(Memc[np],"bswap")) {
+		    next
+	    } else if (streq(Memc[np],"hskip")) {
+		IP_HSKIP(ip) = ip_dbgeti (ip, "hskip")
+	    } else if (streq(Memc[np],"tskip")) {
+		IP_TSKIP(ip) = ip_dbgeti (ip, "tskip")
+	    } else if (streq(Memc[np],"bskip")) {
+		IP_BSKIP(ip) = ip_dbgeti (ip, "bskip")
+	    } else if (streq(Memc[np],"lskip")) {
+		IP_LSKIP(ip) = ip_dbgeti (ip, "lskip")
+	    } else if (streq(Memc[np],"lpad")) {
+		IP_LPAD(ip) = ip_dbgeti (ip, "lpad")
+	    } else if (streq(Memc[np],"yflip")) {
+		if (ip_dbgeti (ip, "yflip") == YES)
+		    IP_FLIP(ip) = or (IP_FLIP(ip), FLIP_Y)
+	    } else if (streq(Memc[np],"error")) {
+		if (IP_OUTPUT(ip) != IP_INFO)
+		    call ip_do_error (ip, Memc[P2C(sym)])
+	    } else if (streq(Memc[np],"comment")) {
+		call fdb_strip_quote (Memc[P2C(sym)], Memc[P2C(sym)], SZ_LINE)
+		call ip_do_comment (ip, Memc[P2C(sym)])
+	    } else {
+		call eprintf ("Warning: Unknown database keyword '%s'.\n")
+		    call pargstr (Memc[np])
+	    } 
+	}
+
+	if (DEBUG) { call zzi_prstruct ("eval dbrec:", ip) }
+	call sfree (sp)
+end
+
+
+# IP_LOAD_DEFAULTS -- Load the default input parameters to the task structure.
+
+procedure ip_load_defaults (ip)
+
+pointer	ip					#i task struct pointer
+
+begin
+        IP_SWAP(ip)       = DEF_SWAP            # type of byte swapping
+        IP_INTERLEAVE(ip) = DEF_INTERLEAVE      # type of data interleaving
+        IP_HSKIP(ip)      = DEF_HSKIP           # bytes to skip before data
+        IP_TSKIP(ip)      = DEF_TSKIP           # bytes to skip after data
+        IP_BSKIP(ip)      = DEF_BSKIP           # bytes between image bands
+        IP_LSKIP(ip)      = DEF_LSKIP           # bytes to skip at front of
+        IP_LPAD(ip)       = DEF_LPAD            # bytes to skip at end of
+
+	# zero image dimensions
+	for (IP_NDIM(ip)=IM_MAXDIM; IP_NDIM(ip) > 0; IP_NDIM(ip)=IP_NDIM(ip)-1)
+	    IP_AXLEN(ip,IP_NDIM(ip)) = 0
+end
+
+
+# IP_DBFCN -- Called by evvexpr to execute format database special functions.
+
+procedure ip_dbfcn (ip, fcn, args, nargs, o)
+
+pointer	ip					#i task struct pointer
+char	fcn[ARB]				#i function to be executed
+pointer	args[ARB]				#i argument list
+int	nargs					#i number of arguments
+pointer	o					#o operand pointer
+
+pointer	sp, buf, outstr
+int	fd, func, v_nargs
+int	i, len, nchar, ival, cur_offset, swap
+char	ch
+short	sval
+real	rval
+double	dval
+
+short	ip_getb(), ip_gets()
+int	strdic(), ip_line(), ip_locate(), ip_getu()
+int	ctoi(), ctol(), ctor(), ctod(), ctocc(), ctowrd()
+int	and(), strlen(), clgeti()
+long	ip_getl()
+real	ip_getr(), ip_getn()
+double	ip_getd(), ip_getn8()
+bool	strne(), streq()
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (outstr, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[buf], SZ_LINE)
+	call aclrc (Memc[outstr], SZ_LINE)
+
+	# Lookup function in dictionary.
+	func = strdic (fcn, Memc[buf], SZ_LINE, DB_FUNCTIONS)
+        if (func > 0 && strne(fcn,Memc[buf]))
+            func = 0
+
+        # Abort if the function is not known.
+        if (func <= 0)
+            call xev_error1 ("unknown function `%s' called", fcn)
+
+
+	# Verify the correct number of arguments, negative value means a
+	# variable number of args, handle it in the evaluation.
+	switch (func) {
+	case CTOCC, CTOD, CTOI, CTOL, CTOR, CTOWRD:
+	    v_nargs = -1
+
+	case GETSTR:
+	    v_nargs = -1
+	case GETB, GETU, GETI, GETI2, GETI4, GETR, GETR4, GETR8, 
+	     GETN, GETN4, GETN8:
+	        v_nargs = 1
+
+	case LOCATE:
+	    v_nargs = -1
+	case LINE, SKIP:
+	    v_nargs = 1
+
+	case BSWAP:
+	    v_nargs = 1
+	case PARAMETER, DEFAULT:
+	    v_nargs = 1
+	case SUBSTR:
+	    v_nargs = 3
+	case STRIDX:
+	    v_nargs = 2
+	case LSB_HOST, MSB_HOST:
+	    v_nargs = 0
+	}
+        if (v_nargs > 0 && nargs != v_nargs)
+            call xev_error2 ("function `%s' requires %d arguments",
+                fcn, v_nargs)
+        else if (v_nargs < 0 && nargs < abs(v_nargs))
+            call xev_error2 ("function `%s' requires at least %d arguments",
+                fcn, abs(v_nargs))
+
+	fd = IP_FD(ip)
+	swap = IP_SWAP(ip)
+	cur_offset = IP_OFFSET(ip)
+
+	if (DEBUG) { 
+	    call eprintf ("cur_offset=%d nargs=%d func=%s swap=%d\n")
+		call pargi(cur_offset) ; call pargi(nargs)
+		call pargstr(fcn) ; call pargi (swap)
+	    do i = 1, nargs
+	        call zzi_pevop (args[i])
+	    call eprintf ("init op =>  ") ; call zzi_pevop(o)
+
+	}
+
+	# Evaluate the function.
+	switch (func) {
+        case CTOCC:		# run the fmtio equivalents of the argument
+	    if (nargs == 1)
+	        ch = ip_getb (fd, O_VALI(args[1]))
+	    else
+	        ch = ip_getb (fd, cur_offset)
+	    len = ctocc (ch, Memc[outstr],  SZ_FNAME) + 1
+	    call ip_initop (o, len, TY_CHAR)
+	    call aclrc (O_VALC(o), len)
+	    call amovc (Memc[outstr], O_VALC(o), len)
+	    cur_offset = cur_offset + 1
+	    call ip_lseek (fd, cur_offset)
+
+        case CTOWRD:
+	    if (nargs == 1)
+	        call ip_gstr (fd, O_VALI(args[1]), SZ_FNAME, Memc[outstr])
+	    else
+	        call ip_gstr (fd, cur_offset, SZ_FNAME, Memc[outstr])
+	    nchar = ctowrd (Memc[outstr], i, Memc[outstr],  SZ_FNAME) + 1
+	    call ip_initop (o, nchar, TY_CHAR)
+	    call aclrc (O_VALC(o), nchar)
+	    call amovc (Memc[outstr], O_VALC(o), nchar)
+	    cur_offset = cur_offset + nchar + 1
+	    call ip_lseek (fd, cur_offset)
+
+        case CTOI:
+	    i = 1
+	    if (nargs == 1) {
+	        call ip_gstr (fd, O_VALI(args[i]), SZ_FNAME, Memc[outstr])
+		nchar = ctoi (Memc[outstr], i, ival)
+	        cur_offset = cur_offset + nchar - 1
+	    } else if (nargs == 2) {
+	        call ip_gstr (fd, O_VALI(args[1]), O_VALI(args[2]),Memc[outstr])
+		nchar = ctoi (Memc[outstr], i, ival)
+	        cur_offset = O_VALI(args[1]) + nchar - 1
+	    }
+	    call ip_lseek (fd, cur_offset)
+	    O_TYPE(o) = TY_INT
+
+        case CTOL:
+	    i = 1
+	    if (nargs == 1) {
+	        call ip_gstr (fd, O_VALI(args[i]), SZ_FNAME, Memc[outstr])
+		nchar = ctol (Memc[outstr], i, ival)
+	        cur_offset = cur_offset + nchar - 1
+	    } else if (nargs == 2) {
+	        call ip_gstr (fd, O_VALI(args[1]), O_VALI(args[2]),Memc[outstr])
+		nchar = ctol (Memc[outstr], i, ival)
+	        cur_offset = O_VALI(args[1]) + nchar - 1
+	    }
+	    call ip_lseek (fd, cur_offset)
+	    O_TYPE(o) = TY_LONG
+
+        case CTOR:
+	    i = 1
+	    if (nargs == 1) {
+	        call ip_gstr (fd, O_VALI(args[i]), SZ_FNAME, Memc[outstr])
+		nchar = ctor (Memc[outstr], i, rval)
+	        cur_offset = cur_offset + nchar - 1
+	    } else if (nargs == 2) {
+	        call ip_gstr (fd, O_VALI(args[1]), O_VALI(args[2]),Memc[outstr])
+		nchar = ctor (Memc[outstr], i, rval)
+	        cur_offset = O_VALI(args[1]) + nchar - 1
+	    }
+	    call ip_lseek (fd, cur_offset)
+	    O_TYPE(o) = TY_REAL
+
+        case CTOD:
+	    i = 1
+	    if (nargs == 1) {
+	        call ip_gstr (fd, O_VALI(args[i]), SZ_FNAME, Memc[outstr])
+		nchar = ctod (Memc[outstr], i, dval)
+	        cur_offset = cur_offset + nchar - 1
+	    } else if (nargs == 2) {
+	        call ip_gstr (fd, O_VALI(args[1]), O_VALI(args[2]),Memc[outstr])
+		nchar = ctod (Memc[outstr], i, dval)
+	        cur_offset = O_VALI(args[1]) + nchar - 1
+	    }
+	    call ip_lseek (fd, cur_offset)
+	    O_TYPE(o) = TY_DOUBLE
+
+        case GETSTR:
+	    if (nargs == 1) {
+		call ip_gstr (fd, cur_offset, O_VALI(args[1]), Memc[outstr])
+	        cur_offset = cur_offset + O_VALI(args[1])
+	    } else if (nargs == 2) {
+		call ip_gstr (fd, O_VALI(args[1]), O_VALI(args[2]),Memc[outstr])
+	        cur_offset = O_VALI(args[1]) + O_VALI(args[2]) - 1
+	    }
+	    if (strlen(Memc[outstr]) == 0) {
+		len = strlen ("ERR") + 1
+	        call ip_initop (o, len, TY_CHAR)
+		call aclrc (O_VALC(o), len)
+	        call strcpy ("ERR", O_VALC(o), len-1)
+	    } else {
+		len = strlen (Memc[outstr]) + 1
+	        call ip_initop (o, len, TY_CHAR)
+		call aclrc (O_VALC(o), len)
+	        call amovc (Memc[outstr], O_VALC(o), len-1)
+	    }
+
+        case GETB:
+	    if (nargs == 0) {
+		sval = ip_getb (fd, cur_offset)
+	        cur_offset = cur_offset + SZB_CHAR
+	    } else {
+		sval = ip_getb (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + SZB_CHAR
+	    }
+	    ival = sval
+	    O_TYPE(o) = TY_INT
+
+        case GETU:
+	    if (nargs == 0) {
+		sval = short (ip_getu (fd, cur_offset))
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_SHORT)
+	    } else {
+		sval = short (ip_getu (fd, O_VALI(args[1])))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_SHORT)
+	    }
+	    if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2)
+	    	call bswap2 (sval, 1, sval, 1, (SZ_SHORT*SZB_CHAR))
+	    ival = sval
+	    O_TYPE(o) = TY_INT
+
+        case GETI, GETI2:
+	    if (nargs == 0) {
+		sval = ip_gets (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_SHORT)
+	    } else {
+		sval = ip_gets (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_SHORT)
+	    }
+	    if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2) 
+		call bswap2 (sval, 1, sval, 1, (SZ_SHORT*SZB_CHAR))
+	    ival = sval
+	    O_TYPE(o) = TY_INT
+
+        case GETI4:
+	    if (nargs == 0) {
+		ival = ip_getl (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_LONG)
+	    } else {
+		ival = ip_getl (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_LONG)
+	    }
+	    if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I4)
+		call bswap4 (ival, 1, ival, 1, (SZ_INT32*SZB_CHAR))
+	    O_TYPE(o) = TY_INT
+
+        case GETR, GETR4:
+	    if (nargs == 0) {
+		rval = ip_getr (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_REAL)
+	    } else {
+		rval = ip_getr (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_REAL)
+	    }
+	    if (and(swap, S_ALL) == S_ALL)	# handle byte-swapping
+		call bswap4 (rval, 1, rval, 1, (SZ_REAL*SZB_CHAR))
+	    O_TYPE(o) = TY_REAL
+
+        case GETR8:
+	    if (nargs == 0) {
+		dval = ip_getd (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_DOUBLE)
+	    } else {
+		dval = ip_getd (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_DOUBLE)
+	    }
+	    if (and(swap, S_ALL) == S_ALL)	# handle byte-swapping
+		call bswap8 (dval, 1, dval, 1, (SZ_DOUBLE*SZB_CHAR))
+	    O_TYPE(o) = TY_DOUBLE
+
+        case GETN, GETN4:
+	    if (nargs == 0) {
+		rval = ip_getn (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_REAL)
+	    } else {
+		rval = ip_getn (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_REAL)
+	    }
+	    if (and(swap, S_ALL) == S_ALL)	# handle byte-swapping
+		call bswap4 (rval, 1, rval, 1, (SZ_REAL*SZB_CHAR))
+	    O_TYPE(o) = TY_REAL
+
+        case GETN8:
+	    if (nargs == 0) {
+		dval = ip_getn8 (fd, cur_offset)
+	        cur_offset = cur_offset + (SZB_CHAR * SZ_DOUBLE)
+	    } else {
+		dval = ip_getn8 (fd, O_VALI(args[1]))
+	        cur_offset = O_VALI(args[1]) + (SZB_CHAR * SZ_DOUBLE)
+	    }
+	    if (and(swap, S_ALL) == S_ALL)	# handle byte-swapping
+		call bswap8 (dval, 1, dval, 1, (SZ_DOUBLE*SZB_CHAR))
+	    O_TYPE(o) = TY_DOUBLE
+
+        case LOCATE: 			# locate the pattern in the file
+	    if (nargs == 1)
+	        ival = ip_locate (fd, cur_offset, O_VALC(args[1]))
+	    else if (nargs == 2)
+	        ival = ip_locate (fd, O_VALI(args[1]), O_VALC(args[2]))
+	    if (ival == ERR)
+		ival = 1
+	    O_TYPE(o) = TY_INT
+	    cur_offset = ival
+
+        case LINE: 			# locate the line no. in the file
+	    ival = ip_line (fd, O_VALI(args[1]))
+	    if (ival == ERR)
+		ival = 1
+	    O_TYPE(o) = TY_INT
+	    cur_offset = ival
+
+        case SKIP: 			# skip a certain number of bytes
+	    ival = O_VALI(args[1])
+	    O_TYPE(o) = TY_INT
+	    cur_offset = cur_offset + ival
+
+        case BSWAP: 			# byte-swap argument
+	    O_TYPE(o) = O_TYPE(args[1])
+	    switch (O_TYPE(args[1])) {
+	    case TY_SHORT:
+		call bswap2 (O_VALS(args[1]), 1, sval, 1, (SZ_SHORT*SZB_CHAR))
+	    case TY_INT:
+		call bswap4 (O_VALI(args[1]), 1, ival, 1, (SZ_INT32*SZB_CHAR))
+	    case TY_LONG:
+		call bswap4 (O_VALL(args[1]), 1, ival, 1, (SZ_LONG*SZB_CHAR))
+	    case TY_REAL:
+		call bswap4 (O_VALR(args[1]), 1, rval, 1, (SZ_REAL*SZB_CHAR))
+	    case TY_DOUBLE:
+		call bswap8 (O_VALD(args[1]), 1, dval, 1, (SZ_DOUBLE*SZB_CHAR))
+	    }
+
+        case PARAMETER: 		# return current task parameter value
+	    if (streq(O_VALC(args[1]),"dims")) {
+		call clgstr ("dims", Memc[outstr], SZ_FNAME)
+		len = strlen (Memc[outstr]) + 1
+	        call ip_initop (o, len, TY_CHAR)
+	        call strcpy (Memc[outstr], O_VALC(o), len)
+	    } else if (streq(O_VALC(args[1]),"pixtype")) {
+		call clgstr ("pixtype", Memc[outstr], SZ_FNAME)
+		len = strlen (Memc[outstr]) + 1
+	        call ip_initop (o, len, TY_CHAR)
+	        call strcpy (Memc[outstr], O_VALC(o), len)
+	    } else if (streq(O_VALC(args[1]),"interleave")) {
+		ival = clgeti ("interleave")
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"bswap")) {
+		call clgstr ("bswap", Memc[outstr], SZ_FNAME)
+		if (strne("no",Memc[outstr]) && strne("none",Memc[outstr]))
+		    ival = YES
+		else
+		    ival = NO
+		O_TYPE(o) = TY_BOOL
+	    } else if (streq(O_VALC(args[1]),"hskip")) {
+		ival = clgeti ("hskip")
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"tskip")) {
+		ival = clgeti ("tskip")
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"bskip")) {
+		ival = clgeti ("bskip")
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"lskip")) {
+		ival = clgeti ("lskip")
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"lpad")) {
+		ival = clgeti ("lpad")
+		O_TYPE(o) = TY_INT
+	    }
+
+        case DEFAULT: 			# return default task parameter value
+	    if (streq(O_VALC(args[1]),"dims")) {
+	        call ip_initop (o, 1, TY_CHAR)
+	        call strcpy ("", O_VALC(o), 1)
+	    } else if (streq(O_VALC(args[1]),"pixtype")) {
+	        call ip_initop (o, 1, TY_CHAR)
+	        call strcpy ("", O_VALC(o), 1)
+	    } else if (streq(O_VALC(args[1]),"interleave")) {
+		ival = DEF_INTERLEAVE
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"bswap")) {
+		ival = DEF_SWAP
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"hskip")) {
+		ival = DEF_HSKIP
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"tskip")) {
+		ival = DEF_TSKIP
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"bskip")) {
+		ival = DEF_BSKIP
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"lskip")) {
+		ival = DEF_LSKIP
+		O_TYPE(o) = TY_INT
+	    } else if (streq(O_VALC(args[1]),"lpad")) {
+		ival = DEF_LPAD
+		O_TYPE(o) = TY_INT
+	    }
+
+        case LSB_HOST: 			# host is an LSB byte ordered machine
+	    if (BYTE_SWAP2 == YES)
+	        ival = YES
+	    else
+	        ival = NO
+	    O_TYPE(o) = TY_BOOL
+
+        case MSB_HOST: 			# host is an MSB byte ordered machine
+	    if (BYTE_SWAP2 == NO)
+	        ival = YES
+	    else
+	        ival = NO
+	    O_TYPE(o) = TY_BOOL
+
+        case SUBSTR: 			# return a substring of the argument
+
+        case STRIDX: 			# return offset of a char w/in str
+
+	}
+
+	# Write result to output operand.
+	O_LEN(o) = 0
+	switch (O_TYPE(o)) {
+	case TY_USHORT, TY_SHORT:
+	    O_VALS(o) = sval
+	case TY_INT, TY_BOOL:
+	    O_VALI(o) = ival
+	case TY_LONG:
+	    O_VALL(o) = ival
+	case TY_REAL:
+	    O_VALR(o) = rval
+	case TY_DOUBLE:
+	    O_VALD(o) = dval
+	}
+
+	if (DEBUG) { call eprintf("ip_dbfcn: ") ; call zzi_pevop (o) }
+
+	IP_OFFSET(ip) = cur_offset
+	call sfree (sp)
+end
+
+
+# IP_DBSTR -- Get a string valued expression from the database.
+
+procedure ip_dbstr (ip, param, outstr, maxch)
+
+pointer ip                                      #i task struct pointer
+char	param[ARB]				#i parameter to evaluate
+char	outstr[ARB]				#o result string
+int	maxch					#i max length of string
+
+pointer sp, expr, o
+
+int     locpr(), strlen()
+pointer evvexpr()
+extern  ip_getop(), ip_dbfcn()
+errchk  evvexpr
+
+begin
+        call smark (sp)
+        call salloc (expr, SZ_EXPR, TY_CHAR)
+        call aclrc (Memc[expr], SZ_EXPR)
+
+        # Get the requested parameter.
+        call aclrc (outstr, SZ_EXPR)
+        call fdbgstr (IP_FSYM(ip), param, Memc[expr], SZ_EXPR)
+        if (Memc[expr] == EOS)
+            call error (1, "FDBGET: Format parameter not found")
+
+	if (DEBUG) { 
+	    call eprintf("ip_dbstr: expr='%s' len=%d ");call pargstr(Memc[expr])
+		call pargi(strlen(Memc[expr]))
+	}
+
+        # Evaluate the expression.
+        iferr {
+            o = evvexpr (Memc[expr], locpr(ip_getop), ip,
+                locpr(ip_dbfcn), ip, EV_RNGCHK)
+            if (O_TYPE(o) != TY_CHAR)
+                call error (0, "ip_dbstr: Expression must be a string valued")
+	    else
+                call amovc (O_VALC(o), outstr, (min(strlen(O_VALC(o)),maxch)))
+         } then
+             call erract (EA_WARN)
+
+	if (DEBUG) { call eprintf ("outstr=:%s:\n") ; call pargstr (outstr) }
+
+	call evvfree (o)
+        call sfree (sp)
+end
+
+
+
+# IP_DBGETI -- Get integer valued format parameter from the database.
+
+int procedure ip_dbgeti (ip, param)
+
+pointer	ip					#i task struct pointer
+char	param[ARB]				#i requested parameter
+
+int	val
+pointer	sp, expr, o
+
+int	locpr()
+pointer	evvexpr()
+extern	ip_getop(), ip_dbfcn()
+errchk	evvexpr
+
+begin
+	call smark (sp)
+	call salloc (expr, SZ_EXPR, TY_CHAR)
+
+	# Get the requested parameter.
+        call fdbgstr (IP_FSYM(ip), param, Memc[expr], SZ_EXPR)
+        if (Memc[expr] == EOS)
+	    call error (1, "IP_DBGET: Format parameter not found")
+
+	# Evaluate the expression.
+	if (DEBUG) {
+	    call eprintf ("ip_dbget: expr='%s'\n")
+		call pargstr (Memc[expr])
+	    call flush (STDERR)
+	}
+        iferr {
+            o = evvexpr (Memc[expr], locpr(ip_getop), ip, 
+		locpr(ip_dbfcn), ip, EV_RNGCHK)
+            if (O_TYPE(o) == TY_BOOL) {
+		val = O_VALI(o)
+	    } else if (O_TYPE(o) != TY_INT && O_TYPE(o) != TY_SHORT) {
+                call error (0, "Expression must be an integer")
+	    } else
+		val = O_VALI(o)
+
+	    if (DEBUG) {
+	        call eprintf ("ip_dbget: val=%d type=%d ecpr=:%s:\n")
+		    call pargi (val)
+		    call pargi (O_TYPE(o))
+		    call pargstr (Memc[expr])
+	        call flush (STDERR)
+	    }
+        } then 
+             call erract (EA_WARN)
+
+	call evvfree (o)
+	call sfree (sp)
+	return (val)
+end
+
+
+# IP_DBGETR -- Get real valued format parameter from the database.
+
+real procedure ip_dbgetr (ip, param)
+
+pointer	ip					#i task struct pointer
+char	param[ARB]				#i requested parameter
+
+real	val
+pointer	sp, expr, o
+
+int	locpr()
+pointer	evvexpr()
+extern	ip_getop(), ip_dbfcn()
+errchk	evvexpr
+
+begin
+	call smark (sp)
+	call salloc (expr, SZ_EXPR, TY_CHAR)
+
+	# Get the requested parameter.
+        call fdbgstr (IP_FSYM(ip), param, Memc[expr], SZ_EXPR)
+        if (Memc[expr] == EOS)
+	    call error (1, "IP_DBGET: Format parameter not found")
+
+	# Evaluate the expression.
+	if (DEBUG) {
+	    call eprintf ("ip_dbget: expr='%s'\n")
+		call pargstr (Memc[expr])
+	    call flush (STDERR)
+	}
+        iferr {
+            o = evvexpr (Memc[expr], locpr(ip_getop), ip, 
+		locpr(ip_dbfcn), ip, EV_RNGCHK)
+            if (O_TYPE(o) == TY_BOOL) {
+		val = O_VALI(o)
+	    } else if (O_TYPE(o) != TY_REAL) {
+                call error (0, "Expression must be a real")
+	    } else
+		val = O_VALR(o)
+
+	    if (DEBUG) {
+	        call eprintf ("ip_dbget: val=%d type=%d ecpr=:%s:\n")
+		    call pargr (val)
+		    call pargi (O_TYPE(o))
+		    call pargstr (Memc[expr])
+	        call flush (STDERR)
+	    }
+        } then 
+             call erract (EA_WARN)
+
+	call evvfree (o)
+	call sfree (sp)
+	return (val)
+end
+
+
+# IP_DO_ERROR -- Process the error parameter.
+
+procedure ip_do_error (ip, expr)
+
+pointer ip                                      #i task struct pointer
+char    expr[ARB]                               #i error string
+
+pointer o
+
+int     locpr()
+pointer evvexpr()
+extern  ip_getop(), ip_dbfcn()
+bool    strne()
+errchk  evvexpr
+
+begin
+        if (DEBUG) {call eprintf ("error expr: '%s'  ") ; call pargstr (expr)}
+
+        # Evaluate the expression.
+        iferr {
+            o = evvexpr (expr, locpr(ip_getop), ip, locpr(ip_dbfcn), ip, 
+		EV_RNGCHK)
+
+            if (DEBUG) { call eprintf("-> '%s'\n") ; call pargstr(O_VALC(o)) }
+
+            if (O_TYPE(o) != TY_CHAR)
+                call error (2, "do_error: Expression must be a string valued")
+            else {
+                if (strne("okay",O_VALC(o)))
+                    call error (2, O_VALC(o))
+            }
+            call evvfree (o)
+
+         } then
+            if (IP_OUTPUT(ip) != IP_INFO)
+                 call erract (EA_FATAL)
+end
+
+
+# IP_DO_COMMENT - Process a comment line in the format database.
+
+procedure ip_do_comment (ip, comstr)
+
+pointer	ip					#i task struct pointer
+char	comstr[ARB]				#i comment to add
+
+pointer	sp, buf
+
+begin
+	# Copy the comment line to the comment block.
+	if (IP_COMPTR(ip) == NULL)
+	    call calloc (IP_COMPTR(ip), SZ_COMMENT, TY_CHAR)
+
+	if (COMMENT(ip) == '\0') {
+	    call strcpy ("\t", COMMENT(ip), SZ_LINE)
+	    call strcat (comstr, COMMENT(ip), SZ_LINE)
+	} else { 
+	    call smark (sp)
+	    call salloc (buf, SZ_LINE, TY_CHAR)
+
+	    Memc[buf] = '\0'
+	    call strcpy ("\t", Memc[buf], SZ_LINE)
+	    call strcat (comstr, Memc[buf], SZ_LINE)
+	    call strcat ("\n", Memc[buf], SZ_LINE)
+	    call strcat (COMMENT(ip), Memc[buf], SZ_COMMENT)
+
+	    call strcpy (Memc[buf], COMMENT(ip), SZ_COMMENT)
+
+	    call sfree (sp)
+	}
+end
+
+
+# IP_INITOP - Initialize an operand pointer to the requested values
+
+procedure ip_initop (o, len, type)
+
+pointer	o				#u operand pointer
+int	len				#i length of array
+int	type				#i data type of operand
+
+begin
+	O_LEN(o) = len
+	O_TYPE(o) = type
+	if (len > 1)
+	    call calloc (O_VALP(o), len, type)
+end
diff --git a/pkg/dataio/import/generic/ipfio.x b/pkg/dataio/import/generic/ipfio.x
new file mode 100644
index 00000000..2977d8cb
--- /dev/null
+++ b/pkg/dataio/import/generic/ipfio.x
@@ -0,0 +1,569 @@
+include <mach.h>
+include <fset.h>
+include "../import.h"
+
+define	DEBUG	false
+
+
+# IP_GSTR --  Get a string of the specifed length from the given offset.
+
+procedure ip_gstr (fd, offset, len, outstr)
+
+int     fd
+int	offset
+int	len
+char    outstr[ARB]
+
+int     nstat, read()
+pointer sp, buf
+
+begin
+        call smark (sp)
+        call salloc (buf, len+2, TY_CHAR)
+	call aclrc (Memc[buf], len+2)
+	call aclrc (outstr, len+2)
+
+        call ip_lseek (fd, offset)
+        nstat = read (fd, Memc[buf], len)
+
+        if (mod(offset,2) == 0 && offset > 1)
+            call bytmov (Memc[buf], 2, Memc[buf], 1, len)
+        call chrupk (Memc[buf], 1, outstr, 1, len)
+
+	if (DEBUG) { call eprintf ("ip_gstr: :%s: len=%d\n"); 
+	    call pargstr(outstr) ; call pargi (len) }
+        call sfree (sp)
+end
+
+
+# IP_GETB --  Get a byte from the given offset.
+
+short procedure ip_getb (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+short	val
+char    buf[2]
+
+begin
+        call ip_lseek (fd, offset)
+        nstat = read (fd, buf, 2)
+
+        if (mod(offset,2) == 0)
+            call bytmov (buf, 2, buf, 1, 2)
+        call chrupk (buf, 1, buf, 1, 2)
+
+	if (DEBUG) { call eprintf ("ip_getb: %d\n"); call pargs(buf[1]) }
+	if (buf[1] < 0)
+	    val = buf[1] + 256
+	else
+	    val = buf[1]
+        return (val)
+end
+
+
+# IP_GETU --  Get a unsigned short integer from the given offset.
+
+int procedure ip_getu (fd, offset)
+
+int     fd
+int	offset
+
+int	val
+short	ip_gets()
+
+begin
+	val = ip_gets (fd, offset)
+	if (val < 0)
+	    val = val + 65536
+	return (val)
+end
+
+# IP_GET[silrd] --  Get a value of <type> from the given offset.
+
+
+
+short procedure ip_gets (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+short   val
+
+begin
+        call ip_lseek (fd, offset)
+            nstat = read (fd, val, SZ_SHORT * SZB_CHAR)
+
+	if (DEBUG) { call eprintf ("ip_get: %g\n"); call pargs(val) }
+        return (val)
+end
+
+
+int procedure ip_geti (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+int   val
+
+begin
+        call ip_lseek (fd, offset)
+            nstat = read (fd, val, SZ_INT32 * SZB_CHAR)
+	    if (SZ_INT != SZ_INT32)
+		call iupk32 (val, val, 1)
+
+	if (DEBUG) { call eprintf ("ip_get: %g\n"); call pargi(val) }
+        return (val)
+end
+
+
+long procedure ip_getl (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+long   val
+
+begin
+        call ip_lseek (fd, offset)
+            nstat = read (fd, val, SZ_INT32 * SZB_CHAR)
+	    if (SZ_INT != SZ_INT32)
+		call iupk32 (val, val, 1)
+
+	if (DEBUG) { call eprintf ("ip_get: %g\n"); call pargl(val) }
+        return (val)
+end
+
+
+real procedure ip_getr (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+real   val
+
+begin
+        call ip_lseek (fd, offset)
+            nstat = read (fd, val, SZ_REAL * SZB_CHAR)
+	call ieeupkr (val)
+
+	if (DEBUG) { call eprintf ("ip_get: %g\n"); call pargr(val) }
+        return (val)
+end
+
+
+double procedure ip_getd (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+double   val
+
+begin
+        call ip_lseek (fd, offset)
+            nstat = read (fd, val, SZ_DOUBLE * SZB_CHAR)
+	call ieeupkd (val)
+
+	if (DEBUG) { call eprintf ("ip_get: %g\n"); call pargd(val) }
+        return (val)
+end
+
+
+# IP_GETN --  Get a native floating point number from the given offset.
+
+real procedure ip_getn (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+real	rval
+
+begin
+	call ip_lseek (fd, offset)
+	nstat = read (fd, rval, SZ_REAL)
+
+	if (DEBUG) { call eprintf ("ip_getn: %g\n"); call pargr(rval) }
+	return (rval)
+end
+
+
+# IP_GETN8 --  Get a native double precision floating point number from the 
+# given offset.
+
+double procedure ip_getn8 (fd, offset)
+
+int     fd
+int	offset
+
+int     nstat, read()
+double	dval
+
+begin
+	call ip_lseek (fd, offset)
+	nstat = read (fd, dval, SZ_DOUBLE)
+
+	if (DEBUG) { call eprintf ("ip_getn8: %g\n"); call pargd(dval) }
+	return (dval)
+end
+
+
+# IP_AGETB -- Get an array of bytes from the file.  The data pointer is
+# allocated if necessary and contains the data on output.
+
+procedure ip_agetb (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+pointer sp, buf
+int     fp, nval, nstat
+int     ip_lnote(), read()
+
+begin
+        fp = ip_lnote(fd)
+        if (mod(fp,2) == 0 && fp != 1)
+	    nval = len
+	else
+	    nval = len + 1
+
+        call smark (sp)
+        call salloc (buf, nval, TY_CHAR)
+
+        if (ptr == NULL)
+            call malloc (ptr, nval * SZB_CHAR, TY_CHAR)
+        nstat = read (fd, Memc[buf], nval / SZB_CHAR + 1)
+
+        fp = ip_lnote(fd)
+        if (mod(fp,2) == 0 && fp != 1)
+            call bytmov (Memc[buf], 2, Memc[buf], 1, nval)
+        call achtbc (Memc[buf], Memc[ptr], len)
+
+        call sfree (sp)
+end
+
+
+# IP_AGETU -- Get an array of <type> from the file.  The data pointer is
+# allocated if necessary and contains the data on output.
+
+procedure ip_agetu (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+begin
+	call ip_agets (fd, ptr, len)
+	call achtsu (Mems[ptr], Mems[ptr], len)
+end
+
+
+# IP_AGET[silrd] -- Get an array of <type> from the file.  The data pointer is
+# allocated if necessary and contains the data on output.
+
+
+procedure ip_agets (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_SHORT)
+            nstat = read (fd, Mems[ptr], len * SZ_SHORT)
+end
+
+
+procedure ip_ageti (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_INT)
+            nstat = read (fd, Memi[ptr], len * SZ_INT32)
+	    if (SZ_INT != SZ_INT32)
+	        call iupk32 (Memi[ptr], Memi[ptr], len)
+end
+
+
+procedure ip_agetl (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_LONG)
+            nstat = read (fd, Meml[ptr], len * SZ_INT32)
+	    if (SZ_INT != SZ_INT32)
+	        call iupk32 (Meml[ptr], Meml[ptr], len)
+end
+
+
+procedure ip_agetr (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_REAL)
+            nstat = read (fd, Memr[ptr], len * SZ_REAL)
+	call ieevupkr (Memr[ptr], Memr[ptr], len)
+end
+
+
+procedure ip_agetd (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_DOUBLE)
+            nstat = read (fd, Memd[ptr], len * SZ_DOUBLE)
+	call ieevupkd (Memd[ptr], Memd[ptr], len)
+end
+
+
+
+# IP_AGETN -- Get an array of native floats from the file.  The data pointer is
+# allocated if necessary and contains the data on output.
+
+procedure ip_agetn (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_REAL)
+        nstat = read (fd, Memr[ptr], len * SZ_REAL)
+end
+
+
+# IP_AGETN8 -- Get an array of native doubles from the file.  The data pointer
+# is allocated if necessary and contains the data on output.
+
+procedure ip_agetn8 (fd, ptr, len)
+
+int     fd					#i file descriptor
+pointer ptr					#i data pointer
+int     len					#i length of array
+
+int     nstat
+int     read()
+
+begin
+        if (ptr == NULL)
+            call malloc (ptr, len, TY_DOUBLE)
+        nstat = read (fd, Memd[ptr], len * SZ_DOUBLE)
+end
+
+
+# -----------------------------------------------------------------
+# ------------------ UTILITY FILE I/O FUNCTIONS -------------------
+# -----------------------------------------------------------------
+
+
+define	BLKSIZE		1024
+
+# IP_LINE -- Return the offset of the start of the given line number.
+
+int procedure ip_line (fd, line)
+
+int	fd					#i input file descriptor
+int	line					#i line number to search
+
+pointer	sp, cbuf, buf
+int	nl, offset, i, nread, fsize
+
+int	read(), fstati()
+
+define	done_ 	99
+define	err_ 	98
+
+begin
+	if (line == 1) {
+	    return (1)
+	} else {
+	    call smark (sp)
+	    call salloc (buf, BLKSIZE, TY_CHAR)
+	    call salloc (cbuf, BLKSIZE, TY_CHAR)
+
+	    # Rewind file descriptor
+	    call ip_lseek (fd, BOF)
+	    nl = 1
+	    offset = 1
+	    
+	    nread = BLKSIZE / SZB_CHAR
+	    fsize = fstati (fd, F_FILESIZE)
+	    while (read (fd, Memc[buf], nread) != EOF) {
+		# Convert it to spp chars.
+	        call ip_lskip (fd, nread)
+        	call chrupk (Memc[buf], 1, Memc[cbuf], 1, BLKSIZE)
+		do i = 1, BLKSIZE {
+		    if (Memc[cbuf+i-1] == '\n') {
+		        nl = nl + 1
+		        offset = offset + 1
+		        if (nl == line)
+			    goto done_
+	 	    } else
+		        offset = offset + 1
+		    if (offset >= fsize)
+		        goto err_
+		}
+	    }
+err_	    call sfree (sp)
+	    call ip_lseek (fd, BOF)
+	    return (ERR)
+
+done_	    if (DEBUG) { call eprintf("ip_line: '%s'\n"); call pargi(offset) }
+	    call sfree (sp)
+	    call ip_lseek (fd, offset)
+	    return (offset)
+	}
+end
+
+
+# IP_LOCATE -- Return the offset of the start of the given pattern.
+
+int procedure ip_locate (fd, offset, pattern)
+
+int     fd                                      #i input file descriptor
+int	offset					#i offset to begin search
+char	pattern[ARB]                            #i pattern to locate
+
+pointer	sp, cbuf, buf
+int     fsize, nread, patlen, cur_offset, loc
+
+int     fstati(), read(), strsearch(), strlen()
+
+define	done_	99
+
+begin
+        # Rewind file descriptor
+        call ip_lseek (fd, offset)
+	cur_offset = offset
+
+	call smark (sp)
+	call salloc (buf, BLKSIZE, TY_CHAR)
+	call salloc (cbuf, BLKSIZE, TY_CHAR)
+
+	if (DEBUG) { call eprintf("ip_loc: offset %d\n"); call pargi(offset)}
+
+	nread = BLKSIZE / SZB_CHAR
+	fsize = fstati (fd, F_FILESIZE)
+	patlen = strlen (pattern)
+        while (read (fd, Memc[buf], nread) != EOF) {
+            # Convert it to spp chars.
+	    call ip_lskip (fd, nread)
+            call chrupk (Memc[buf], 1, Memc[cbuf], 1, BLKSIZE)
+	    loc = strsearch (Memc[cbuf], pattern)
+	    if (loc != 0) {
+  		cur_offset = cur_offset + loc - 1 - patlen
+        	goto done_
+            } else {
+		# Allow some overlap in case the pattern broke over the blocks.
+                cur_offset = cur_offset + BLKSIZE - 2 * patlen
+		call ip_lseek (fd, cur_offset)
+		if (cur_offset + BLKSIZE > fsize)
+		    nread = fsize - cur_offset + 1
+            }
+        }
+	call sfree (sp)
+	call ip_lseek (fd, BOF)
+        return (ERR)
+
+done_	if (DEBUG) { call eprintf("ip_loc: %d\n"); call pargi(cur_offset)}
+	call sfree (sp)
+	call ip_lseek (fd, offset)
+	return (cur_offset)
+end
+
+
+# IP_LSEEK -- Set the file position as a byte offset.
+
+procedure ip_lseek (fd, offset)
+
+int     fd					#i file descriptor
+int     offset					#i requested offset
+
+long    cur_offset, where, fsize
+int	fstati()
+common  /fiocom/ cur_offset
+
+begin
+	if (offset == BOF || offset == ERR) {
+            cur_offset = 1
+            call seek (fd, BOF)
+	} else {
+	    fsize = fstati (fd, F_FILESIZE) * SZB_CHAR
+            cur_offset = min (fsize, offset)
+	    where = min (fsize, (offset/SZB_CHAR+mod(offset,2)))
+            call seek (fd, where)
+	}
+end
+
+
+# IP_LNOTE -- Note the file position as a byte offset.
+
+int procedure ip_lnote (fd)
+
+int     fd					#i file descriptor (unused)
+
+long    cur_offset
+common  /fiocom/ cur_offset
+
+begin
+	return (cur_offset)
+end
+
+
+# IP_LSKIP -- Bump the file position by a byte offset.
+
+procedure ip_lskip (fd, skip)
+
+int     fd                                      #i file descriptor
+int     skip
+
+long    cur_offset
+common  /fiocom/ cur_offset
+
+begin
+        call ip_lseek (fd, cur_offset+skip)
+end
diff --git a/pkg/dataio/import/generic/ipobands.x b/pkg/dataio/import/generic/ipobands.x
new file mode 100644
index 00000000..65c6c1c4
--- /dev/null
+++ b/pkg/dataio/import/generic/ipobands.x
@@ -0,0 +1,375 @@
+include <error.h>
+include <mach.h>
+include <evvexpr.h>
+include <fset.h>
+include "../import.h"
+include "../ipfcn.h"
+
+define	DEBUG	false
+define	VDEBUG	false
+
+
+# IP_GETOP -- Called by evvexpr to get an operand.  
+
+procedure ip_getop (ip, opname, o)
+
+pointer	ip					#i task struct pointer
+char	opname[ARB]				#i operand name to retrieve
+pointer	o					#o output operand pointer
+
+int	i, nops, found, optype
+pointer	sp, buf
+pointer	op
+
+int	fstati(), ip_ptype(), strlen(), strncmp()
+bool	streq()
+
+begin
+	# First see if it's one of the special file operands.
+	if (opname[1] == '$') {
+	    if (strncmp(opname, "$FSIZE", 3) == 0) {
+		O_LEN(o) = 0
+		O_TYPE(o) = TY_INT
+		O_VALI(o) = fstati (IP_FD(ip), F_FILESIZE) * SZB_CHAR
+	    } else if (strncmp(opname, "$FNAME", 3) == 0) {
+	        call smark (sp)
+	        call salloc (buf, SZ_FNAME, TY_CHAR)
+
+		call fstats (IP_FD(ip), F_FILENAME, Memc[buf], SZ_FNAME)
+
+		O_TYPE(o) = TY_CHAR
+		O_LEN(o) = strlen (Memc[buf]) + 1
+		call malloc (O_VALP(o), O_LEN(o), TY_CHAR)
+		call strcpy (Memc[buf], O_VALC(o), i)
+		call sfree (sp)
+	    }
+
+	    return
+	}
+	
+	nops = IP_NPIXT(ip)
+	found = NO
+	do i = 1, nops {
+	    # Search for operand name which matches requested value.
+	    op = PTYPE(ip,i)
+            if (streq (Memc[IO_TAG(op)],opname)) {
+		found = YES
+		break
+	    }
+	}
+
+	if (VDEBUG) {
+	    call eprintf ("getop: opname=%s tag=%s found=%d  ")
+	    	call pargstr(opname) ; call pargstr(Memc[IO_TAG(op)])
+		call pargi(found)
+	    if (found == YES) call zzi_prop (op)
+	}
+
+	if (found == YES) {
+	    # Copy operand descriptor to 'o'
+	    optype = ip_ptype (IO_TYPE(op), IO_NBYTES(op))
+	    switch (optype) {
+	    case TY_UBYTE, TY_USHORT, TY_SHORT:
+                O_LEN(o) = IO_NPIX(op)
+                O_TYPE(o) = TY_SHORT
+                call malloc (O_VALP(o), IO_NPIX(op), TY_SHORT)
+		call amovs (Mems[IO_DATA(op)], Mems[O_VALP(o)], IO_NPIX(op))
+
+	    case TY_INT:
+                O_LEN(o) = IO_NPIX(op)
+                O_TYPE(o) = TY_INT
+                call malloc (O_VALP(o), IO_NPIX(op), TY_INT)
+		call amovi (Memi[IO_DATA(op)], Memi[O_VALP(o)], IO_NPIX(op))
+
+	    case TY_LONG:
+                O_LEN(o) = IO_NPIX(op)
+                O_TYPE(o) = TY_LONG
+                call malloc (O_VALP(o), IO_NPIX(op), TY_LONG)
+		call amovl (Meml[IO_DATA(op)], Meml[O_VALP(o)], IO_NPIX(op))
+
+	    case TY_REAL:
+                O_LEN(o) = IO_NPIX(op)
+                O_TYPE(o) = TY_REAL
+                call malloc (O_VALP(o), IO_NPIX(op), TY_REAL)
+		call amovr (Memr[IO_DATA(op)], Memr[O_VALP(o)], IO_NPIX(op))
+
+	    case TY_DOUBLE:
+                O_LEN(o) = IO_NPIX(op)
+                O_TYPE(o) = TY_DOUBLE
+                call malloc (O_VALP(o), IO_NPIX(op), TY_DOUBLE)
+		call amovd (Memd[IO_DATA(op)], Memd[O_VALP(o)], IO_NPIX(op))
+
+	    }
+	    
+	} else {
+	    call smark (sp)
+	    call salloc (buf, SZ_LINE, TY_CHAR)
+	    call sprintf (Memc[buf], SZ_LINE, "Unknown outbands operand `%s'\n")
+	    	call pargstr(opname) 
+	    call sfree (sp)
+	    call error (1, Memc[buf])
+	}
+end
+
+
+# IP_EVALUATE -- Evaluate the outbands expression.
+
+pointer procedure ip_evaluate (ip, expr)
+
+pointer	ip					#i task struct pointer
+char	expr[ARB]				#i expression to be evaluated
+
+pointer	o					# operand pointer to result
+
+int     locpr()
+pointer evvexpr()
+extern  ip_getop(), ip_obfcn()
+errchk  evvexpr
+
+begin
+	if (DEBUG) { call eprintf("ip_eval: expr='%s'\n") ; call pargstr(expr) }
+
+        # Evaluate the expression.
+        iferr {
+            o = evvexpr (expr, locpr(ip_getop), ip, locpr(ip_obfcn), ip, 
+		EV_RNGCHK)
+         } then
+             call erract (EA_FATAL)
+
+	return (o)
+end
+
+
+# IP_OBFCN -- Called by evvexpr to execute import outbands special functions.
+
+procedure ip_obfcn (ip, fcn, args, nargs, o)
+
+pointer ip                                      #i task struct pointer
+char    fcn[ARB]                                #i function to be executed
+pointer args[ARB]                               #i argument list
+int     nargs                                   #i number of arguments
+pointer o                                       #o operand pointer
+
+pointer	sp, buf
+pointer	r, g, b, gray, color, cmap
+int	i, len, v_nargs, func
+
+int	or(), strdic()
+bool	strne()
+
+define	setop_		99
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+        # Lookup function in dictionary.
+        func = strdic (fcn, Memc[buf], SZ_LINE, OB_FUNCTIONS)
+        if (func > 0 && strne(fcn,Memc[buf]))
+            func = 0
+
+        # Abort if the function is not known.
+        if (func <= 0)
+            call xev_error1 ("unknown function `%s' called", fcn)
+
+        # Verify the correct number of arguments, negative value means a
+        # variable number of args, handle it in the evaluation.
+	switch (func) {
+	case GRAY, GREY:
+	    v_nargs = 3
+	case FLIPX, FLIPY:
+	    v_nargs = 1
+	case RED, GREEN, BLUE:
+	    v_nargs = 1
+	}
+        if (v_nargs > 0 && nargs != v_nargs)
+            call xev_error2 ("function `%s' requires %d arguments",
+                fcn, v_nargs)
+        else if (v_nargs < 0 && nargs < abs(v_nargs))
+            call xev_error2 ("function `%s' requires at least %d arguments",
+                fcn, abs(v_nargs))
+
+        if (DEBUG) {
+            call eprintf ("obfcn: nargs=%d func=%d\n")
+		call pargi (nargs) ; call pargi (func)
+            do i = 1, nargs { call eprintf ("\t") ; call zzi_pevop (args[i]) }
+	    call flush (STDERR)
+        }
+
+	# Evaluate the function.
+	switch (func) {
+	case GRAY, GREY:
+	    # evaluate expression for NTSC grayscale.
+	    r = O_VALP(args[1])
+	    g = O_VALP(args[2])
+	    b = O_VALP(args[3])
+	    len = O_LEN(args[1]) - 1
+            O_LEN(o) = len + 1
+            O_TYPE(o) = TY_REAL
+            call malloc (O_VALP(o), len+1, TY_REAL)
+	    gray = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+	        do i = 0, len {
+		    Memr[gray+i] = R_COEFF * Mems[r+i] +
+			           G_COEFF * Mems[g+i] +
+			           B_COEFF * Mems[b+i]
+	        }
+
+            case TY_INT:
+	        do i = 0, len {
+		    Memr[gray+i] = R_COEFF * Memi[r+i] +
+			           G_COEFF * Memi[g+i] +
+			           B_COEFF * Memi[b+i]
+	        }
+
+            case TY_LONG:
+	        do i = 0, len {
+		    Memr[gray+i] = R_COEFF * Meml[r+i] +
+			           G_COEFF * Meml[g+i] +
+			           B_COEFF * Meml[b+i]
+	        }
+
+            case TY_REAL:
+	        do i = 0, len {
+		    Memr[gray+i] = R_COEFF * Memr[r+i] +
+			           G_COEFF * Memr[g+i] +
+			           B_COEFF * Memr[b+i]
+	        }
+
+            case TY_DOUBLE:
+	        do i = 0, len {
+		    Memr[gray+i] = R_COEFF * Memd[r+i] +
+			           G_COEFF * Memd[g+i] +
+			           B_COEFF * Memd[b+i]
+	        }
+
+            }
+
+	case RED:
+	    # Get the red colormap component of the image.
+	    cmap = IP_CMAP(ip)
+            if (func <= 0)
+                call xev_error1 ("No colormap in image for function `%s'", fcn)
+	    r = O_VALP(args[1])
+	    len = O_LEN(args[1]) - 1
+            O_LEN(o) = len + 1
+            O_TYPE(o) = TY_SHORT
+            call malloc (O_VALP(o), len+1, TY_SHORT)
+	    color = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_RED,Mems[r+i]+1)
+
+            case TY_INT:
+	        do i = 0, len 
+		    Mems[color+i] = CMAP(cmap,IP_RED,Memi[r+i]+1) 
+
+            case TY_LONG:
+	        do i = 0, len 
+		    Mems[color+i] = CMAP(cmap,IP_RED,Meml[r+i]+1) 
+
+            }
+
+	case GREEN:
+	    # Get the blue colormap component of the image.
+	    cmap = IP_CMAP(ip)
+            if (func <= 0)
+                call xev_error1 ("No colormap in image for function `%s'", fcn)
+	    g = O_VALP(args[1])
+	    len = O_LEN(args[1]) - 1
+            O_LEN(o) = len + 1
+            O_TYPE(o) = TY_SHORT
+            call malloc (O_VALP(o), len+1, TY_SHORT)
+	    color = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_GREEN,Mems[g+i]+1)
+
+            case TY_INT:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_GREEN,char(Memi[g+i]+1))
+
+            case TY_LONG:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_GREEN,char(Meml[g+i]+1))
+
+            }
+
+	case BLUE:
+	    # Get the blue colormap component of the image.
+	    cmap = IP_CMAP(ip)
+            if (func <= 0)
+                call xev_error1 ("No colormap in image for function `%s'", fcn)
+	    b = O_VALP(args[1])
+	    len = O_LEN(args[1]) - 1
+            O_LEN(o) = len + 1
+            O_TYPE(o) = TY_SHORT
+            call malloc (O_VALP(o), len+1, TY_SHORT)
+	    color = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_BLUE,Mems[b+i]+1)
+
+            case TY_INT:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_BLUE,char(Memi[b+i]+1))
+
+            case TY_LONG:
+	        do i = 0, len
+		    Mems[color+i] = CMAP(cmap,IP_BLUE,char(Meml[b+i]+1))
+
+            }
+
+	case FLIPX:
+	    # Set flag to reverse pixel order on output.
+	    IP_FLIP(ip) = or (IP_FLIP(ip), FLIP_X)
+	    goto setop_ 
+
+	case FLIPY:
+	    # Set flag to write image from bottom to top.
+	    IP_FLIP(ip) = or (IP_FLIP(ip), FLIP_Y)
+
+            # Copy argument operand descriptor to 'o'
+setop_      switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+                O_LEN(o) = O_LEN(args[1])
+                O_TYPE(o) = TY_SHORT
+                call malloc (O_VALP(o), O_LEN(args[1]), TY_SHORT)
+                call amovs (Mems[O_VALP(ARGS[1])], Mems[O_VALP(o)], O_LEN(o))
+
+            case TY_INT:
+                O_LEN(o) = O_LEN(args[1])
+                O_TYPE(o) = TY_INT
+                call malloc (O_VALP(o), O_LEN(args[1]), TY_INT)
+                call amovi (Memi[O_VALP(args[1])], Memi[O_VALP(o)], O_LEN(o))
+
+            case TY_LONG:
+                O_LEN(o) = O_LEN(args[1])
+                O_TYPE(o) = TY_LONG
+                call malloc (O_VALP(o), O_LEN(args[1]), TY_LONG)
+                call amovl (Meml[O_VALP(args[1])], Meml[O_VALP(o)], O_LEN(o))
+
+            case TY_REAL:
+                O_LEN(o) = O_LEN(args[1])
+                O_TYPE(o) = TY_REAL
+                call malloc (O_VALP(o), O_LEN(args[1]), TY_REAL)
+                call amovr (Memr[O_VALP(args[1])], Memr[O_VALP(o)], O_LEN(o))
+
+            case TY_DOUBLE:
+                O_LEN(o) = O_LEN(args[1])
+                O_TYPE(o) = TY_DOUBLE
+                call malloc (O_VALP(o), O_LEN(args[1]), TY_DOUBLE)
+                call amovd (Memd[O_VALP(args[1])], Memd[O_VALP(o)], O_LEN(o))
+
+            }
+
+	}
+
+        if (DEBUG) { call zzi_pevop (o) }
+
+	call sfree (sp)
+end
diff --git a/pkg/dataio/import/generic/ipproc.x b/pkg/dataio/import/generic/ipproc.x
new file mode 100644
index 00000000..def48b1c
--- /dev/null
+++ b/pkg/dataio/import/generic/ipproc.x
@@ -0,0 +1,921 @@
+include <mach.h>
+include <imhdr.h>
+include <evvexpr.h>
+include "../import.h"
+
+define	DEBUG	false
+
+
+# IP_PRBAND -- Process a band interleaved file.
+
+procedure ip_prband (ip, fd, im, cmap)
+
+pointer	ip					#i task struct pointer
+int	fd					#i inpout file descriptor
+pointer	im					#i output image pointer
+pointer	cmap					#i colormap pointer
+
+int	i, j, nlines, npix
+int	optype, nbytes_pix, percent
+int	cur_offset, band_offset, line_offset
+
+int	ip_ptype()
+long	ip_lnote()
+
+begin
+	# Rewind the file and skip header pixels.
+	call ip_lseek (fd, BOF)
+	call ip_lseek (fd, IP_HSKIP(ip)+1)
+
+	# Compute the offset between the same pixel in different bands.  This
+	# is the area of the image plus any image padding, computed as a
+	# byte offset.
+	optype = ip_ptype (IO_TYPE(PTYPE(ip,1)),IO_NBYTES(PTYPE(ip,1)))
+	switch (optype) {
+	case TY_UBYTE:			nbytes_pix = 1
+	case TY_USHORT, TY_SHORT:	nbytes_pix = SZB_CHAR * SZ_SHORT
+	case TY_INT:			nbytes_pix = SZB_CHAR * SZ_INT32
+	case TY_LONG:			nbytes_pix = SZB_CHAR * SZ_LONG
+	case TY_REAL:			nbytes_pix = SZB_CHAR * SZ_REAL
+	case TY_DOUBLE:			nbytes_pix = SZB_CHAR * SZ_DOUBLE
+	}
+	band_offset = (IP_AXLEN(ip,1) * (IP_AXLEN(ip,2)-1)) +
+		      ((IP_LSKIP(ip) + IP_LPAD(ip)) * (IP_AXLEN(ip,2)-1)) +
+		      IP_BSKIP(ip)
+	band_offset = (band_offset * nbytes_pix) #+ 1
+
+	if (DEBUG) {
+	    call eprintf ("ip_prband: band_offset=%d curpos=%d\n")
+	        call pargi(band_offset) ; call pargi(ip_lnote(fd))
+	    call zzi_prstruct ("ip_prband", ip) 
+	}
+
+	# Patch up the pixtype param if needed.
+	call ip_fix_pixtype (ip)
+
+        # See if we need to create any outbands operands if the user didn't.
+        if (IP_NBANDS(ip) == ERR)
+            call ip_fix_outbands (ip)
+
+	# Loop over the image lines.
+	nlines = IP_AXLEN(ip,2)
+	npix = IP_AXLEN(ip,1)
+	percent = 0
+	do i = 1, nlines {
+	    # Skip pixels at front of line
+	    line_offset = ip_lnote (fd)
+	    if (IP_LSKIP(ip) != 0)
+	        call ip_lskip (fd, IP_LSKIP(ip))
+
+	    # Read pixels in the line and save as operand.
+	    call ip_rdline (ip, fd, 1, npix, cmap)
+
+	    # Skip pixels at end of line.
+	    if (IP_LPAD(ip) != 0)
+	        call ip_lskip (fd, IP_LPAD(ip))
+	    cur_offset = ip_lnote (fd)
+
+	    # Loop over each of the remaining pixtypes.
+	    do j = 2, IP_NPIXT(ip) {
+		# Seek to offset of next band (i.e. line_offset + band_offset).
+	        call ip_lskip (fd, band_offset)
+		if (IP_LSKIP(ip) != 0)
+	            call ip_lskip (fd, IP_LSKIP(ip))
+	        call ip_rdline (ip, fd, j, npix, cmap) # read pixels in the line
+		if (IP_LPAD(ip) != 0)
+	            call ip_lskip (fd, IP_LPAD(ip))
+	    }
+
+	    # Evaluate and write the outbands expressions.
+	    call ip_probexpr (ip, im, npix, i)
+
+            # Print percent done if being verbose
+            #if (IP_VERBOSE(ip) == YES)
+		call ip_pstat (ip, i, percent)
+
+	    # Restore file pointer to cur_offset.
+	    call ip_lseek (fd, cur_offset)
+	}
+	do i = 1, IP_NBANDS(ip)
+	    call mfree (BUFFER(ip,i), IM_PIXTYPE(im))
+end
+
+
+# IP_PRLINE -- Process a line interleaved file.
+
+procedure ip_prline (ip, fd, im, cmap)
+
+pointer	ip					#i task struct pointer
+int	fd					#i inpout file descriptor
+pointer	im					#i output image pointer
+pointer	cmap					#i colormap pointer
+
+int	i, j, nlines, npix, percent
+
+begin
+	# Rewind the file and skip header pixels.
+	call ip_lseek (fd, BOF)
+	call ip_lseek (fd, IP_HSKIP(ip)+1)
+
+	if (DEBUG) { 
+	    call eprintf ("ip_prline:\n")
+	    call zzi_prstruct ("ip_prline", ip) 
+	}
+
+	# Patch up the pixtype param if needed.
+	call ip_fix_pixtype (ip)
+
+        # See if we need to create any outbands operands if the user didn't.
+        if (IP_NBANDS(ip) == ERR)
+            call ip_fix_outbands (ip)
+
+        # Loop over the image lines.
+        nlines = IP_AXLEN(ip,2)
+        npix = IP_AXLEN(ip,1)
+	percent = 0
+        do i = 1, nlines {
+
+            do j = 1, IP_NPIXT(ip) {
+                # Skip pixels at front of line
+                call ip_lskip (fd, IP_LSKIP(ip))
+
+                # Read pixels in the line and save as operand.
+                call ip_rdline (ip, fd, j, npix, cmap)
+
+                # Skip pixels at end of line.
+                call ip_lskip (fd, IP_LPAD(ip))
+	    }
+
+	    # Evaluate and write the outbands expressions.
+	    call ip_probexpr (ip, im, npix, i)
+
+            # Print percent done if being verbose
+            #if (IP_VERBOSE(ip) == YES)
+		call ip_pstat (ip, i, percent)
+	}
+	do i = 1, IP_NBANDS(ip)
+	    call mfree (BUFFER(ip,i), IM_PIXTYPE(im))
+end
+
+
+# IP_PRPIX -- Process a pixel interleaved file.
+
+procedure ip_prpix (ip, fd, im, cmap)
+
+pointer	ip					#i task struct pointer
+int	fd					#i inpout file descriptor
+pointer	im					#i output image pointer
+pointer	cmap					#i colormap pointer
+
+pointer	op, data
+int	i, swap, optype, nlines
+int	percent, npix, totpix
+
+int	and(), ip_ptype()
+
+begin
+	# Rewind the file and skip header pixels.
+	call ip_lseek (fd, BOF)
+	call ip_lseek (fd, IP_HSKIP(ip)+1)
+
+	if (DEBUG) { call eprintf ("ip_prpix:  ") }
+
+        # See if we need to create any outbands operands if the user didn't.
+        if (IP_NBANDS(ip) == ERR)
+            call ip_fix_outbands (ip)
+
+	# Allocate the pixtype data pointers.
+        npix = IP_AXLEN(ip,1)
+        nlines = IP_NPIXT(ip)
+	do i = 1, nlines {
+	    op = PTYPE(ip,i)
+	    optype = ip_ptype (IO_TYPE(op),IO_NBYTES(op))
+	    IO_NPIX(op) = npix
+	    if (IO_DATA(op) == NULL)
+	        if (optype == TY_UBYTE)
+		    call malloc (IO_DATA(op), npix, TY_SHORT)
+		else
+		    call malloc (IO_DATA(op), npix, optype)
+	}
+
+        # Loop over the image lines.
+        nlines = IP_AXLEN(ip,2)
+	totpix = npix * IP_NPIXT(ip)
+	swap = IP_SWAP(ip)
+	percent = 0
+	if (DEBUG) { 
+	    call zzi_prstruct ("ip_prpix", ip)
+	    call eprintf ("nl=%d np=%d tp=%d:\n") 
+		call pargi(nlines) ; call pargi(npix) ; call pargi(totpix)
+	}
+        do i = 1, nlines {
+
+            # Skip pixels at front of line
+            call ip_lskip (fd, IP_LSKIP(ip))
+
+	    # Read pixels in the line.
+	    switch (optype) {
+	    case TY_UBYTE:
+	        call ip_agetb (fd, data, totpix)
+	        call ip_lskip (fd, totpix)
+		# Apply a colormap to the bytes.  In general a pixel-interleaved
+		# file is a 24-bit True Color image, but maybe this is a
+		# 3-D color index file?
+		if (cmap != NULL && IP_USE_CMAP(ip) == YES) 		
+                    call ip_gray_cmap (Memc[data], totpix, cmap)
+
+	    case TY_USHORT:
+	        call ip_agetu (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2) {
+                    call bswap2 (Mems[data], 1, Mems[data], 1, 
+		        (totpix*(SZ_SHORT*SZB_CHAR)))
+	        }
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_SHORT)))
+
+
+	    case TY_SHORT:
+	        call ip_agets (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2) {
+                    call bswap2 (Mems[data], 1, Mems[data], 1, 
+		        (totpix*(SZ_SHORT*SZB_CHAR)))
+	        }
+
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_SHORT)))
+
+	    case TY_INT:
+	        call ip_ageti (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL || and(swap, S_I4) == S_I4) {
+		    if (SZ_INT != SZ_INT32) {
+			call ipak32 (Memi[data], Memi[data], totpix)
+                        call bswap4 (Memi[data], 1, Memi[data], 1, 
+		            (totpix*(SZ_INT32*SZB_CHAR)))
+		    } else {
+                        call bswap4 (Memi[data], 1, Memi[data], 1, 
+		            (totpix*(SZ_INT*SZB_CHAR)))
+		    }
+	        }
+
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_INT32)))
+
+	    case TY_LONG:
+	        call ip_agetl (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL || and(swap, S_I4) == S_I4) {
+		    if (SZ_INT != SZ_INT32) {
+			call ipak32 (Meml[data], Meml[data], totpix)
+                        call bswap4 (Meml[data], 1, Meml[data], 1, 
+		            (totpix*(SZ_INT32*SZB_CHAR)))
+		    } else {
+                        call bswap4 (Meml[data], 1, Meml[data], 1, 
+		            (totpix*(SZ_INT*SZB_CHAR)))
+		    }
+	        }
+
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_INT32)))
+
+	    case TY_REAL:
+	        call ip_agetr (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL) {
+                    call bswap4 (Memr[data], 1, Memr[data], 1, 
+		        (totpix*(SZ_REAL*SZB_CHAR)))
+	        }
+
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_REAL)))
+
+	    case TY_DOUBLE:
+	        call ip_agetd (fd, data, totpix)
+                if (and(swap, S_ALL) == S_ALL) {
+                    call bswap8 (Memd[data], 1, Memd[data], 1, 
+		        (totpix*(SZ_DOUBLE*SZB_CHAR)))
+	        }
+
+	        call ip_lskip (fd, (totpix * (SZB_CHAR * SZ_DOUBLE)))
+
+	    }
+
+            # Skip pixels at end of line.
+            call ip_lskip (fd, IP_LPAD(ip))
+
+	    # Separate pixels into different vectors.
+	    call ip_upkpix (ip, data, npix)
+
+	    # Evaluate and write the outbands expressions.
+	    call ip_probexpr (ip, im, npix, i)
+
+            # Print percent done if being verbose
+            #if (IP_VERBOSE(ip) == YES)
+		call ip_pstat (ip, i, percent)
+	}
+
+	if (optype == TY_UBYTE)
+	    call mfree (data, TY_SHORT)
+	else
+	    call mfree (data, optype)
+	do i = 1, IP_NBANDS(ip)
+	    call mfree (BUFFER(ip,i), IM_PIXTYPE(im))
+end
+
+
+# IP_PROBEXPR -- Process each of the outbands expressions and write the result
+# to the output image.
+
+procedure ip_probexpr (ip, im, npix, line)
+
+pointer	ip					#i task struct pointer
+pointer	im					#i output image pointer
+int	npix					#i number of output pixels
+int	line					#i line number
+
+int	i
+pointer	out, ip_evaluate()
+
+begin
+        # Loop over outbands expressions.
+        do i = 1, IP_NBANDS(ip) {
+            # Evaluate outbands expression.
+            out = ip_evaluate (ip, O_EXPR(ip,i))
+
+            # Write bands to output image
+            if (IP_OUTPUT(ip) != IP_NONE)
+                call ip_wrline (ip, im, out, npix, line, i)
+
+	    call evvfree (out)
+        }
+end
+
+
+# IP_RDLINE -- Read a line of pixels from the binary file.
+
+procedure ip_rdline (ip, fd, pnum, npix, cmap)
+
+pointer	ip					#i task struct pointer
+int	fd					#i input file descriptor
+int	pnum					#i pixtype number
+int	npix					#i number of pixels to read
+pointer	cmap					#i colormap pointer
+
+pointer	op, data
+int	swap, ptype
+
+int	and(), ip_ptype()
+
+begin
+	# Read pixels in the line and save as operand.
+	op = PTYPE(ip,pnum)
+	ptype = ip_ptype (IO_TYPE(op), IO_NBYTES(op))
+	data = IO_DATA(op)
+	swap = IP_SWAP(ip)
+	IO_NPIX(op) = npix
+
+	switch (ptype) {
+	case TY_UBYTE:
+	    call ip_agetb (fd, data, npix)
+	    call ip_lskip (fd, npix)
+	    # Apply a colormap to the bytes.  If the colormap is non-null we
+	    # assume the bytes are color indices into a colormap.
+	    if (cmap != NULL && IP_USE_CMAP(ip) == YES) 		
+                call ip_gray_cmap (Memc[data], npix, cmap)
+
+	case TY_USHORT:
+	    call ip_agetu (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2) {
+                call bswap2 (Mems[data], 1, Mems[data], 1, 
+		    (npix*(SZ_SHORT*SZB_CHAR)))
+	    }
+	    call ip_lskip (fd, (npix * (SZB_CHAR * SZ_SHORT)))
+
+	case TY_SHORT:
+	    call ip_agets (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I2) {
+                call bswap2 (Mems[data], 1, Mems[data], 1, 
+		    (npix*(SZ_SHORT*SZB_CHAR)))
+	    }
+
+	    call ip_lskip (fd, npix * (SZB_CHAR * SZ_SHORT))
+
+	case TY_INT:
+	    call ip_ageti (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I4) {
+		    if (SZ_INT != SZ_INT32) {
+			call ipak32 (Memi[data], Memi[data], npix)
+                	call bswap4 (Memi[data], 1, Memi[data], 1, 
+		    	    (npix*(SZ_INT32*SZB_CHAR)))
+		    } else {
+                	call bswap4 (Memi[data], 1, Memi[data], 1, 
+		    	    (npix*(SZ_INT*SZB_CHAR)))
+		    }
+	    }
+
+	    call ip_lskip (fd, npix * (SZB_CHAR * SZ_INT32))
+
+	case TY_LONG:
+	    call ip_agetl (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL || and(swap, S_I2) == S_I4) {
+		    if (SZ_INT != SZ_INT32) {
+			call ipak32 (Meml[data], Meml[data], npix)
+                	call bswap4 (Meml[data], 1, Meml[data], 1, 
+		    	    (npix*(SZ_INT32*SZB_CHAR)))
+		    } else {
+                	call bswap4 (Meml[data], 1, Meml[data], 1, 
+		    	    (npix*(SZ_LONG*SZB_CHAR)))
+		    }
+	    }
+
+	    call ip_lskip (fd, npix * (SZB_CHAR * SZ_INT32))
+
+	case TY_REAL:
+	    call ip_agetr (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL) {
+                call bswap4 (Memr[data], 1, Memr[data], 1, 
+		    (npix*(SZ_REAL*SZB_CHAR)))
+	    }
+
+	    call ip_lskip (fd, npix * (SZB_CHAR * SZ_REAL))
+
+	case TY_DOUBLE:
+	    call ip_agetd (fd, data, npix)
+            if (and(swap, S_ALL) == S_ALL) {
+                call bswap8 (Memd[data], 1, Memd[data], 1, 
+		    (npix*(SZ_DOUBLE*SZB_CHAR)))
+	    }
+
+	    call ip_lskip (fd, npix * (SZB_CHAR * SZ_DOUBLE))
+
+	}
+	IO_DATA(op) = data
+end
+
+
+# IP_WRLINE -- Write a line of pixels to the output image.  We handle image
+# flipping here to avoid possibly doing it several times while the outbands
+# expression is being evaluated.
+
+procedure ip_wrline (ip, im, out, npix, line, band)
+
+pointer	ip					#i task struct pointer
+pointer	im					#i output image pointer
+pointer	out					#i output operand pointer
+int	npix					#i number of pixels to read
+int	line					#i image line number
+int	band					#i image band number
+
+int	i, lnum, type
+int	nldone, blnum
+pointer	sp, dptr, data, optr
+bool	lastline
+
+int	and()
+pointer	imps3s(), imps3i(), imps3l(), imps3r(), imps3d()
+pointer	ip_chtype()
+
+data	blnum 	   /0/
+data	nldone 	   /1/
+data	lastline   /false/
+
+begin
+	call smark (sp)
+
+	# The first thing we do is change the datatype of the operand to
+	# match the output pixel type.
+	if (IP_OUTTYPE(ip) != NULL) {
+	    if (IP_OUTTYPE(ip) == O_TYPE(out))
+		optr = O_VALP(out)
+	    else
+		optr = ip_chtype (out, IP_OUTTYPE(ip))
+	}
+	type = IP_OUTTYPE(ip)
+
+	# See if we're flipping image in Y, and adjust the line number.
+	if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+	    lnum = IP_AXLEN(ip,2) - line + 1
+	    if (band == 1)
+	        blnum = IP_SZBUF(ip) - mod (line-1, IP_SZBUF(ip))
+	    lastline = (lnum == 1)
+	} else {
+	    lnum = line
+	    if (band == 1)
+	        blnum = blnum + 1
+	    lastline = (lnum == IP_AXLEN(ip,2))
+	}
+
+	# See if we're flipping image in x, and reverse the pixels.
+	if (and(IP_FLIP(ip),FLIP_X) == FLIP_X) {
+	    call salloc (dptr, npix, type)    
+	    do i = 1, npix {
+        	switch (type) {
+        	case TY_UBYTE, TY_USHORT, TY_SHORT:
+		    Mems[dptr+i-1] = Mems[optr+(npix-i)]
+
+        	case TY_INT:
+		    Memi[dptr+i-1] = Memi[optr+(npix-i)]
+
+        	case TY_LONG:
+		    Meml[dptr+i-1] = Meml[optr+(npix-i)]
+
+        	case TY_REAL:
+		    Memr[dptr+i-1] = Memr[optr+(npix-i)]
+
+        	case TY_DOUBLE:
+		    Memd[dptr+i-1] = Memd[optr+(npix-i)]
+
+        	}
+	    }
+	} else 
+	    dptr = optr
+
+	# Make sure the image pixtype is set.
+	if (IM_PIXTYPE(im) == NULL)
+	    IM_PIXTYPE(im) = type
+
+	# Allocate the buffer pointer if needed.
+	if (BUFFER(ip,band) == NULL)
+	    call calloc (BUFFER(ip,band), npix*IP_SZBUF(ip), IP_OUTTYPE(ip))
+
+	if (nldone < IP_SZBUF(ip) && !lastline) {
+	    # Copy the image line to the buffer
+	    data = BUFFER(ip,band)
+            switch (type) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+                call amovs (Mems[dptr], Mems[data+((blnum-1)*npix)], npix)
+
+            case TY_INT:
+                call amovi (Memi[dptr], Memi[data+((blnum-1)*npix)], npix)
+
+            case TY_LONG:
+                call amovl (Meml[dptr], Meml[data+((blnum-1)*npix)], npix)
+
+            case TY_REAL:
+                call amovr (Memr[dptr], Memr[data+((blnum-1)*npix)], npix)
+
+            case TY_DOUBLE:
+                call amovd (Memd[dptr], Memd[data+((blnum-1)*npix)], npix)
+
+            }
+	    if (band == IP_NBANDS(ip))
+	        nldone = nldone + 1
+
+	} else {
+	    # Write the buffer to the image as a section.
+	    data = BUFFER(ip,band)
+            switch (type) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+                call amovs (Mems[dptr], Mems[data+((blnum-1)*npix)], npix)
+		if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+                    data = imps3s (im, 1, npix, 
+		       max(1,(lnum-IP_SZBUF(ip)+1)+IP_SZBUF(ip)-1),
+		       max(1,lnum+min(nldone,IP_SZBUF(ip))-1),
+		       band, band)
+                    call amovs (Mems[BUFFER(ip,band)+(blnum-1)*npix], 
+		        Mems[data], npix*(IP_SZBUF(ip)-blnum+1))
+		} else {
+                    data = imps3s (im, 1, npix, 
+		       min(IP_AXLEN(ip,2),(lnum-blnum+1)),
+		       min(IP_AXLEN(ip,2),lnum),
+		       band, band)
+                    call amovs (Mems[BUFFER(ip,band)], Mems[data], npix*blnum)
+		}
+
+            case TY_INT:
+                call amovi (Memi[dptr], Memi[data+((blnum-1)*npix)], npix)
+		if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+                    data = imps3i (im, 1, npix, 
+		       max(1,(lnum-IP_SZBUF(ip)+1)+IP_SZBUF(ip)-1),
+		       max(1,lnum+min(nldone,IP_SZBUF(ip))-1),
+		       band, band)
+                    call amovi (Memi[BUFFER(ip,band)+(blnum-1)*npix], 
+		        Memi[data], npix*(IP_SZBUF(ip)-blnum+1))
+		} else {
+                    data = imps3i (im, 1, npix, 
+		       min(IP_AXLEN(ip,2),(lnum-blnum+1)),
+		       min(IP_AXLEN(ip,2),lnum),
+		       band, band)
+                    call amovi (Memi[BUFFER(ip,band)], Memi[data], 
+			npix*blnum)
+		}
+
+            case TY_LONG:
+                call amovl (Meml[dptr], Meml[data+((blnum-1)*npix)], npix)
+		if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+                    data = imps3l (im, 1, npix, 
+		       max(1,(lnum-IP_SZBUF(ip)+1)+IP_SZBUF(ip)-1),
+		       max(1,lnum+min(nldone,IP_SZBUF(ip))-1),
+		       band, band)
+                    call amovl (Meml[BUFFER(ip,band)+(blnum-1)*npix], 
+		        Meml[data], npix*(IP_SZBUF(ip)-blnum+1))
+		} else {
+                    data = imps3l (im, 1, npix, 
+		       min(IP_AXLEN(ip,2),(lnum-blnum+1)),
+		       min(IP_AXLEN(ip,2),lnum),
+		       band, band)
+                    call amovl (Meml[BUFFER(ip,band)], Meml[data], 
+			npix*blnum)
+		}
+
+            case TY_REAL:
+                call amovr (Memr[dptr], Memr[data+((blnum-1)*npix)], npix)
+		if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+                    data = imps3r (im, 1, npix, 
+		       max(1,(lnum-IP_SZBUF(ip)+1)+IP_SZBUF(ip)-1),
+		       max(1,lnum+min(nldone,IP_SZBUF(ip))-1),
+		       band, band)
+                    call amovr (Memr[BUFFER(ip,band)+(blnum-1)*npix], 
+		        Memr[data], npix*(IP_SZBUF(ip)-blnum+1))
+		} else {
+                    data = imps3r (im, 1, npix, 
+		       min(IP_AXLEN(ip,2),(lnum-blnum+1)),
+		       min(IP_AXLEN(ip,2),lnum),
+		       band, band)
+                    call amovr (Memr[BUFFER(ip,band)], Memr[data], 
+			npix*blnum)
+		}
+
+            case TY_DOUBLE:
+                call amovd (Memd[dptr], Memd[data+((blnum-1)*npix)], npix)
+		if (and(IP_FLIP(ip),FLIP_Y) == FLIP_Y) {
+                    data = imps3d (im, 1, npix, 
+		       max(1,(lnum-IP_SZBUF(ip)+1)+IP_SZBUF(ip)-1),
+		       max(1,lnum+min(nldone,IP_SZBUF(ip))-1),
+		       band, band)
+                    call amovd (Memd[BUFFER(ip,band)+(blnum-1)*npix], 
+		        Memd[data], npix*(IP_SZBUF(ip)-blnum+1))
+		} else {
+                    data = imps3d (im, 1, npix, 
+		       min(IP_AXLEN(ip,2),(lnum-blnum+1)),
+		       min(IP_AXLEN(ip,2),lnum),
+		       band, band)
+                    call amovd (Memd[BUFFER(ip,band)], Memd[data], 
+			npix*blnum)
+		}
+
+            }
+	    if (band == IP_NBANDS(ip)) {
+	        nldone = 1
+	        blnum = 0
+	    }
+	}
+
+	if (IP_OUTTYPE(ip) != O_TYPE(out))
+	    call mfree (optr, type)
+	call sfree (sp)
+end
+
+
+# IP_UPKPIX -- Unpack a line of pixel-interleaved pixels to the separate
+# pixtype operand arrays.
+
+procedure ip_upkpix (ip, ptr, npix)
+
+pointer	ip					#i task struct pointer
+pointer	ptr					#i pointer to pixels
+int	npix					#i number of pixels in line
+
+pointer	op[IM_MAXDIM]
+int	i, j, np, optype[IM_MAXDIM]
+
+int	ip_ptype()
+
+begin
+	np = IP_NPIXT(ip)
+	do j = 1, np {
+	    op[j] = PTYPE(ip,j)
+	    optype[j] = ip_ptype (IO_TYPE(op[j]),IO_NBYTES(op[j]))
+	}
+
+	do j = 1, np {
+
+	    do i = 0, npix-1 {
+		switch (optype[j]) {
+        	case TY_UBYTE, TY_USHORT, TY_SHORT:
+		    Mems[IO_DATA(op[j])+i] = Mems[ptr+(i*np+j)-1]
+
+        	case TY_INT:
+		    Memi[IO_DATA(op[j])+i] = Memi[ptr+(i*np+j)-1]
+
+        	case TY_LONG:
+		    Meml[IO_DATA(op[j])+i] = Meml[ptr+(i*np+j)-1]
+
+        	case TY_REAL:
+		    Memr[IO_DATA(op[j])+i] = Memr[ptr+(i*np+j)-1]
+
+        	case TY_DOUBLE:
+		    Memd[IO_DATA(op[j])+i] = Memd[ptr+(i*np+j)-1]
+
+		}
+	    }
+	}
+end
+
+
+# IP_FIX_PIXTYPE -- Create the pixtype operands for 3-D band or line-
+# interleaved files.  These weren't allocated at first since the pixtype
+# parameter or database field was atomic.
+
+procedure ip_fix_pixtype (ip)
+
+pointer	ip					#i task struct pointer
+
+pointer	op, op1
+int	i, nnp
+
+begin
+	if (DEBUG) {
+	    call eprintf ("fix_pixtype: npixt=%d ndim=%d inter=%d\n")
+	        call pargi(IP_NPIXT(ip)) ; call pargi(IP_NDIM(ip))
+	        call pargi(IP_INTERLEAVE(ip)) ; call flush (STDERR)
+	}
+
+	# See if there's anything to be fixed.
+        if (IP_NDIM(ip) < 3 || IP_NDIM(ip) < IP_NPIXT(ip))
+	    return
+	if (BAND_INTERLEAVED(ip) && (IP_NPIXT(ip) == IP_NDIM(ip)))
+	    return
+	if (LINE_INTERLEAVED(ip) && (IP_NPIXT(ip) == IP_INTERLEAVE(ip)))
+	    return
+
+	if (LINE_INTERLEAVED(ip))
+	    nnp = IP_INTERLEAVE(ip)
+	else
+	    #nnp = IP_NDIM(ip)
+	    nnp = IP_AXLEN(ip,3)
+
+	# Make the new pixtype operands.
+	op1 = PTYPE(ip,1)
+	do i = 2, nnp {
+	    call ip_alloc_operand (PTYPE(ip,i))
+	    op = PTYPE(ip,i)
+	    IO_TYPE(op) = IO_TYPE(op1)
+	    IO_NBYTES(op) = IO_NBYTES(op1)
+            call sprintf (OP_TAG(op), SZ_TAG, "b%d")
+                call pargi (i)
+	}
+	IP_NPIXT(ip) = nnp
+
+	if (DEBUG) { call zzi_prstruct ("fix_pixtype", ip) }
+end
+
+
+# IP_FIX_OUTBANDS -- Create the outbands operands if none were specified in
+# the parameter file.
+
+procedure ip_fix_outbands (ip)
+
+pointer ip                                      #i task struct pointer
+
+pointer	sp, buf
+pointer	im
+int	i, nbands
+
+define	SZ_OBSTR	2500
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	if (DEBUG) {
+	    call eprintf ("fix_outbands: npixt=%d ndim=%d inter=%d\n")
+	        call pargi(IP_NPIXT(ip)) ; call pargi(IP_NDIM(ip))
+	        call pargi(IP_INTERLEAVE(ip)) ; call flush (STDERR)
+	}
+
+	# Free up the existing outbands operands.
+	nbands = IP_NBANDS(ip)
+	do i = 1, nbands
+	    call ip_free_outbands (OBANDS(ip,i))
+
+	# Create an outbands parameter string according to the tags in the
+	# pixtype structure.  This way we preserve any user-defined tags on
+	# output.
+	nbands = IP_NPIXT(ip)
+	call aclrc (Memc[buf], SZ_FNAME)
+	do i = 1, nbands {
+	    call ip_alloc_outbands (OBANDS(ip,i))
+	    call aclrc (Memc[buf], SZ_FNAME)
+	    call sprintf (Memc[buf], SZ_FNAME, "b%d")
+		call pargi (i)
+            call strcpy (Memc[buf], O_EXPR(ip,i), SZ_EXPR)
+
+            # Load the operand struct.
+            call strcpy (Memc[buf], OP_TAG(O_OP(ip,i)), SZ_EXPR)
+	}
+	IP_NBANDS(ip) = nbands
+
+	# Fix the output image dimensions.
+	im = IP_IM(ip)
+        IM_LEN(im,3) = IP_AXLEN(ip,3)
+        if (IP_NBANDS(ip) > 1)
+            IM_NDIM(im) = 3
+        else
+            IM_NDIM(im) = IP_NDIM(ip)
+
+	call sfree (sp)
+
+	if (DEBUG) { call zzi_prstruct ("fix_outbands", ip) }
+end
+
+
+# IP_CHTYPE - Change the expression operand vector to the output datatype.
+# We allocate and return a pointer to the correct type to the converted
+# pixels, this pointer must be freed later on.
+
+pointer procedure ip_chtype (op, type)
+
+pointer	op				#i evvexpr operand pointer
+int	type				#i new type of pointer
+
+pointer	out, coerce()
+
+begin
+	# Allocate the pointer and coerce it so the routine works.
+	if (type == TY_UBYTE || type == TY_CHAR)
+            call calloc (out, O_LEN(op), TY_CHAR)
+	else {
+            call calloc (out, O_LEN(op), type)
+            out = coerce (out, type, TY_CHAR)
+	}
+
+	# Change the pixel type.
+        switch (O_TYPE(op)) {
+        case TY_CHAR:
+            call achtc (Memc[O_VALP(op)], Memc[out], O_LEN(op), type)
+        case TY_SHORT:
+            call achts (Mems[O_VALP(op)], Memc[out], O_LEN(op), type)
+        case TY_INT:
+            call achti (Memi[O_VALP(op)], Memc[out], O_LEN(op), type)
+        case TY_LONG:
+            call achtl (Meml[O_VALP(op)], Memc[out], O_LEN(op), type)
+        case TY_REAL:
+            call achtr (Memr[O_VALP(op)], Memc[out], O_LEN(op), type)
+        case TY_DOUBLE:
+            call achtd (Memd[O_VALP(op)], Memc[out], O_LEN(op), type)
+	default:
+	    call error (0, "Invalid output type requested.")
+        }
+
+        out = coerce (out, TY_CHAR, type)
+	return (out)
+end
+
+
+define	NTYPES		6
+define	NBITPIX		4
+
+# IP_PTYPE -- For a given pixtype parameter return the corresponding IRAF
+# data type.
+
+int procedure ip_ptype (type, nbytes)
+
+int	type					#i pixel type
+int	nbytes					#i number of bytes
+
+int	i, pt, pb, ptype
+int	tindex[NTYPES], bindex[NBITPIX], ttbl[NTYPES*NBITPIX]
+
+data	tindex 	/PT_BYTE, PT_UINT, PT_INT, PT_IEEE, PT_NATIVE, PT_SKIP/
+data	bindex 	/1, 2, 4, 8/
+
+data	(ttbl(i), i= 1, 4)    /TY_UBYTE,  TY_USHORT,  TY_INT,      0/      # B
+data	(ttbl(i), i= 5, 8)    /TY_UBYTE,  TY_USHORT,    0,         0/      # U
+data	(ttbl(i), i= 9,12)    /TY_UBYTE,  TY_SHORT,   TY_INT,      0/      # I
+data	(ttbl(i), i=13,16)    /   0,  	     0,	      TY_REAL, TY_DOUBLE/  # R
+data	(ttbl(i), i=17,20)    /   0,  	     0,       TY_REAL, TY_DOUBLE/  # N
+data	(ttbl(i), i=21,24)    /TY_UBYTE,  TY_USHORT,  TY_REAL, TY_DOUBLE/  # X
+
+begin
+	if (type == 0 || nbytes == 0) 		# uninitialized values
+	    return (0)
+
+	pt = NTYPES
+	do i = 1, NTYPES {
+	    if (tindex[i] == type)
+		pt = i
+	}
+	pb = NBITPIX
+	do i = 1, NBITPIX {
+	    if (bindex[i] == nbytes)
+		pb = i
+	}
+
+	ptype = ttbl[(pt-1)*NBITPIX+pb]
+	if (ptype == 0)
+	    call error (0, "Invalid pixtype specified.")
+	else
+	    return (ptype)
+end
+
+
+# IP_PSTAT - Print information about the progress we're making.
+
+procedure ip_pstat (ip, row, percent)
+
+pointer ip                              #i task struct pointer
+int     row                             #u current row
+int     percent                         #u percent completed
+
+begin
+        # Print percent done if being verbose
+        if (row * 100 / IP_AXLEN(ip,2) >= percent + 10) {
+            percent = percent + 10
+            call eprintf ("    Status: %2d%% complete\r")
+                call pargi (percent)
+            call flush (STDERR)
+        }
+end
diff --git a/pkg/dataio/import/generic/mkpkg b/pkg/dataio/import/generic/mkpkg
new file mode 100644
index 00000000..9e8721db
--- /dev/null
+++ b/pkg/dataio/import/generic/mkpkg
@@ -0,0 +1,15 @@
+# Compile the generic sources.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	ipdb.x		../import.h ../ipfcn.h \
+				<error.h> <evvexpr.h> <imhdr.h> <mach.h>
+	ipfio.x		../import.h <fset.h> <mach.h>
+	ipobands.x	../import.h ../ipfcn.h <error.h> <evvexpr.h> \
+				<fset.h> <mach.h>
+	ipproc.x	../import.h <evvexpr.h> <imhdr.h> <mach.h>
+	;