Initial commit

3 files changed, 1210 insertions, 0 deletions

diff --git a/pkg/dataio/export/generic/exobands.x b/pkg/dataio/export/generic/exobands.x
new file mode 100644
index 00000000..d8a7d636
--- /dev/null
+++ b/pkg/dataio/export/generic/exobands.x
@@ -0,0 +1,489 @@
+include <error.h>
+include <mach.h>
+include <evvexpr.h>
+include <fset.h>
+include <ctype.h>
+include "../export.h"
+include "../exfcn.h"
+
+define	DEBUG	false
+define	VDEBUG	false
+
+
+# EX_EVALUATE -- Evaluate the outbands expression.
+
+pointer procedure ex_evaluate (ex, expr)
+
+pointer	ex				#i task struct pointer
+char	expr[ARB]			#i expression to be evaluated
+
+pointer	o				# operand pointer to result
+
+int     locpr()
+pointer evvexpr()
+extern  ex_getop(), ex_obfcn()
+errchk  evvexpr
+
+begin
+	if (DEBUG) { call eprintf("ex_eval: expr='%s'\n") ; call pargstr(expr) }
+
+        # Evaluate the expression.
+        iferr {
+            o = evvexpr (expr, locpr(ex_getop), ex, locpr(ex_obfcn), ex, 
+		EV_RNGCHK)
+         } then
+             call erract (EA_FATAL)
+
+	return (o)
+end
+
+
+# EX_GETOP -- Called by evvexpr to get an operand.  
+
+procedure ex_getop (ex, opname, o)
+
+pointer	ex				#i task struct pointer
+char	opname[ARB]			#i operand name to retrieve
+pointer	o				#o output operand pointer
+
+int	i, nops, found, optype, imnum
+pointer	sp, buf
+pointer	op, param, emsg
+pointer	im
+
+#int	ex_ptype()
+int	imgeti(), imgftype(), btoi(), ctoi()
+bool	streq(), imgetb()
+double	imgetd()
+
+define	getpar_		99
+
+begin
+        call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (emsg, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[buf], SZ_LINE)
+	call aclrc (Memc[param], SZ_FNAME)
+	call aclrc (Memc[emsg], SZ_LINE)
+
+	if (VDEBUG) { call eprintf ("getop: opname=%s  ");call pargstr(opname)}
+
+        # First see if it's one of the special image operands that was 
+	# referenced in an "@param" call.
+
+        if (((opname[1] != 'i' && opname[1] != 'b') && !IS_DIGIT(opname[2])) ||
+	     (opname[1] == 'i' && opname[2] == '_')) {
+	         call strcpy (opname, Memc[param], SZ_FNAME)
+                 im = IO_IMPTR(IMOP(ex,1))
+getpar_          O_LEN(o) = 0
+	         switch (imgftype (im, Memc[param])) {
+                 case TY_BOOL:
+                     O_TYPE(o) = TY_BOOL
+                     O_VALI(o) = btoi (imgetb (im, Memc[param]))
+                 case TY_CHAR:
+                     O_TYPE(o) = TY_CHAR
+                     O_LEN(o)  = SZ_LINE
+                     call malloc (O_VALP(o), SZ_LINE, TY_CHAR)
+                     call imgstr (im, Memc[param], O_VALC(o), SZ_LINE)
+                 case TY_INT:
+                     O_TYPE(o) = TY_INT
+                     O_VALI(o) = imgeti (im, Memc[param])
+                 case TY_REAL:
+                     O_TYPE(o) = TY_DOUBLE
+                     O_VALD(o) = imgetd (im, Memc[param])
+                 default:
+                     call sprintf (Memc[emsg], SZ_LINE, "param %s not found\n")
+                         call pargstr (Memc[param])
+                     call error (6, Memc[emsg])
+                 }
+
+	         call sfree (sp)
+                 return
+
+        } else if (IS_LOWER(opname[1]) && opname[3] == '.') {
+	    # This is a tag.param operand.  Break out the image tag name and
+	    # get the image pointer for it, then get the parameter
+	    if (opname[1] == 'b') {		# band of 3-D image, only 1 ptr
+                imnum = 1
+	    } else if (opname[1] == 'i') {	# image descriptor
+		i = 2
+		if (ctoi (opname, i, imnum) == 0)
+                    call error (6, "can't parse operand")
+	    } else {
+	        call sprintf (Memc[buf], SZ_LINE, 
+		    "Unknown outbands operand `%s'\n")
+	    	        call pargstr(opname) 
+	        call error (1, Memc[buf])
+	    }
+
+	    # Get the parameter value.
+            im = IO_IMPTR(IMOP(ex,imnum))
+	    call strcpy (opname[4], Memc[param], SZ_FNAME)
+	    goto getpar_
+        }
+
+	nops = EX_NIMOPS(ex)
+	found = NO
+	do i = 1, nops {
+	    # Search for operand name which matches requested value.
+	    op = IMOP(ex,i)
+            if (streq (Memc[IO_TAG(op)],opname)) {
+		found = YES
+		break
+	    }
+	}
+
+	if (VDEBUG && found == YES) {
+	    call eprintf (" tag=%s found=%d  ")
+		call pargstr(Memc[IO_TAG(op)]) ; call pargi(found)
+	    call zze_prop (op)
+	}
+
+	if (found == YES) {
+	    # Copy operand descriptor to 'o'
+	    #optype = ex_ptype (IO_TYPE(op), IO_NBYTES(op))
+	    optype = IO_TYPE(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 sprintf (Memc[buf], SZ_LINE, "Unknown outbands operand `%s'\n")
+	    	call pargstr(opname) 
+	    call error (1, Memc[buf])
+	}
+
+	call sfree (sp)
+end
+
+
+# EX_OBFCN -- Called by evvexpr to execute import outbands special functions.
+
+procedure ex_obfcn (ex, fcn, args, nargs, o)
+
+pointer	ex				#i package 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
+pointer	scaled, data
+int	i, len, v_nargs, func, nbins
+short	sz1, sz2, sb1, sb2, zero
+real	gamma, bscale, bzero, scale, pix
+real	z1, z2
+
+int	strdic()
+bool	fp_equalr(), 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 ZSCALE:
+	    v_nargs = -1
+	case BSCALE:
+	    v_nargs = 3
+	case GAMMA:
+	    v_nargs = -1
+	case BLOCK:
+	    v_nargs = 3
+	}
+        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 zze_pevop (args[i]) }
+	    call flush (STDERR)
+        }
+
+	# Evaluate the function.
+	zero = 0
+	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 ZSCALE:
+	    data = O_VALP(args[1])
+	    switch (O_TYPE(args[2])) {
+	    case TY_SHORT: 	z1 = O_VALS(args[2])
+	    case TY_INT: 	z1 = O_VALI(args[2])
+	    case TY_LONG: 	z1 = O_VALL(args[2])
+	    case TY_REAL: 	z1 = O_VALR(args[2])
+	    case TY_DOUBLE: 	z1 = O_VALD(args[2])
+	    }
+	    switch (O_TYPE(args[3])) {
+	    case TY_SHORT: 	z2 = O_VALS(args[3])
+	    case TY_INT: 	z2 = O_VALI(args[3])
+	    case TY_LONG: 	z2 = O_VALL(args[3])
+	    case TY_REAL: 	z2 = O_VALR(args[3])
+	    case TY_DOUBLE: 	z2 = O_VALD(args[3])
+	    }
+	    if (nargs < 4)
+	        nbins = 256
+	    else
+	        nbins = O_VALI(args[4])
+            len = O_LEN(args[1])
+	    O_LEN(o) = len 
+	    O_TYPE(o) = O_TYPE(args[1])
+	    call malloc (O_VALP(o), len, O_TYPE(args[1]))
+            scaled = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+		sz1 = z1
+		sz2 = z2
+		sb1 = 0
+		sb2 = nbins - 1
+		if (abs(sz2-sz1) > 1.0e-5)
+		    call amaps (Mems[data], Mems[scaled], len, sz1, sz2, 
+			sb1, sb2)
+		else
+		    call amovks (0, Mems[scaled], len)
+
+            case TY_INT:
+		if (abs(z2-z1) > 1.0e-5)
+		    call amapi (Memi[data], Memi[scaled], len, int (z1), 
+		        int(z2), int (0), int (nbins-1))
+		else
+		    call amovki (int (0), Memi[scaled], len)
+
+            case TY_LONG:
+		if (abs(z2-z1) > 1.0e-5)
+		    call amapl (Meml[data], Meml[scaled], len, long (z1), 
+		        long(z2), long (0), long (nbins-1))
+		else
+		    call amovkl (long (0), Meml[scaled], len)
+
+            case TY_REAL:
+		if (abs(z2-z1) > 1.0e-5)
+		    call amapr (Memr[data], Memr[scaled], len, real (z1), 
+		        real(z2), real (0), real (nbins-1))
+		else
+		    call amovkr (real (0), Memr[scaled], len)
+
+            case TY_DOUBLE:
+		if (abs(z2-z1) > 1.0e-5)
+		    call amapd (Memd[data], Memd[scaled], len, double (z1), 
+		        double(z2), double (0), double (nbins-1))
+		else
+		    call amovkd (double (0), Memd[scaled], len)
+
+            }
+
+	case BSCALE:
+	    data = O_VALP(args[1])
+	    bzero = O_VALR(args[2])
+	    bscale = O_VALR(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)
+            scaled = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+		if (!fp_equalr (0.0, bscale)) {
+                    do i = 0, len
+                        Memr[scaled+i] = (Mems[data+i] - bzero) / bscale
+		} else
+		    call amovks (zero, Mems[scaled], len)
+
+            case TY_INT:
+		if (!fp_equalr (0.0, bscale)) {
+                    do i = 0, len
+                        Memr[scaled+i] = (Memi[data+i] - bzero) / bscale
+		} else
+		    call amovki (int(0), Memi[scaled], len)
+
+            case TY_LONG:
+		if (!fp_equalr (0.0, bscale)) {
+                    do i = 0, len
+                        Memr[scaled+i] = (Meml[data+i] - bzero) / bscale
+		} else
+		    call amovkl (long(0), Meml[scaled], len)
+
+            case TY_REAL:
+		if (!fp_equalr (0.0, bscale)) {
+                    do i = 0, len
+                        Memr[scaled+i] = (Memr[data+i] - bzero) / bscale
+		} else
+		    call amovkr (real(0), Memr[scaled], len)
+
+            case TY_DOUBLE:
+		if (!fp_equalr (0.0, bscale)) {
+                    do i = 0, len
+                        Memr[scaled+i] = (Memd[data+i] - bzero) / bscale
+		} else
+		    call amovkd (double(0), Memd[scaled], len)
+
+            }
+
+	case GAMMA:
+	    data = O_VALP(args[1])
+	    gamma = 1.0 / O_VALR(args[2])
+	    if (nargs == 3)
+		scale = max (1.0, O_VALR(args[3]))
+	    else
+		scale = 255.0
+            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)
+            scaled = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+                do i = 0, len {
+		    pix = max (zero, Mems[data+i])
+                    Memr[scaled+i] = scale * ((pix/scale) ** gamma)
+		}
+
+            case TY_INT:
+                do i = 0, len {
+		    pix = max (int(0), Memi[data+i])
+                    Memr[scaled+i] = scale * ((pix/scale) ** gamma)
+		}
+
+            case TY_LONG:
+                do i = 0, len {
+		    pix = max (long(0), Meml[data+i])
+                    Memr[scaled+i] = scale * ((pix/scale) ** gamma)
+		}
+
+            case TY_REAL:
+                do i = 0, len {
+		    pix = max (real(0), Memr[data+i])
+                    Memr[scaled+i] = scale * ((pix/scale) ** gamma)
+		}
+
+            case TY_DOUBLE:
+                do i = 0, len {
+		    pix = max (double(0), Memd[data+i])
+                    Memr[scaled+i] = scale * ((pix/scale) ** gamma)
+		}
+
+            }
+
+        case BLOCK:
+            len = O_VALI(args[2])
+	    O_LEN(o) = len
+	    O_TYPE(o) = O_TYPE(args[1])
+	    call malloc (O_VALP(o), len, O_TYPE(args[1]))
+            scaled = O_VALP(o)
+            switch (O_TYPE(args[1])) {
+            case TY_UBYTE, TY_USHORT, TY_SHORT:
+		call amovks (O_VALS(args[1]), Mems[scaled], len)
+            case TY_INT:
+		call amovki (O_VALI(args[1]), Memi[scaled], len)
+            case TY_LONG:
+		call amovkl (O_VALL(args[1]), Meml[scaled], len)
+            case TY_REAL:
+		call amovkr (O_VALR(args[1]), Memr[scaled], len)
+            case TY_DOUBLE:
+		call amovkd (O_VALD(args[1]), Memd[scaled], len)
+            }
+
+
+	}
+
+        if (DEBUG) { call zze_pevop (o) }
+
+	call sfree (sp)
+end
diff --git a/pkg/dataio/export/generic/exraster.x b/pkg/dataio/export/generic/exraster.x
new file mode 100644
index 00000000..9838894f
--- /dev/null
+++ b/pkg/dataio/export/generic/exraster.x
@@ -0,0 +1,709 @@
+include <imhdr.h>
+include <mach.h>
+include <evvexpr.h>
+include "../export.h"
+
+define	DEBUG	false
+
+
+# EX_NO_INTERLEAVE - Write out the image with no interleaving.
+
+procedure ex_no_interleave (ex)
+
+pointer	ex				#i task struct pointer
+
+pointer	op, out
+int	i, j, k, line, percent, orow
+int	fd, outtype
+
+pointer	ex_evaluate(), ex_chtype()
+
+begin
+	if (DEBUG) { call eprintf ("ex_no_interleave:\n") 
+	    call eprintf ("NEXPR = %d  OCOLS = %d OROWS = %d\n")
+		call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex))
+		call pargi(EX_OROWS(ex))
+	}
+
+	# Loop over the number of image expressions.
+	fd = EX_FD(ex)
+	outtype = EX_OUTTYPE(ex)
+	percent = 0
+	orow = 0
+	do i = 1, EX_NEXPR(ex) {
+
+	    # Process each line in the image.
+	    do j = 1, O_HEIGHT(ex,i) {
+
+		# See if we're flipping the image.
+		if (bitset (EX_OUTFLAGS(ex), OF_FLIPY))
+		    #line = EX_NLINES(ex) - j + 1
+		    line = O_HEIGHT(ex,i) - j + 1
+		else
+		    line = j
+
+		# Get pixels from image(s).
+		call ex_getpix (ex, line)
+
+		# Evaluate expression.
+		op = ex_evaluate (ex, O_EXPR(ex,i))
+
+		# Convert to the output pixel type.
+		out = ex_chtype (ex, op, outtype)
+
+		# Write evaluated pixels.
+		if (EX_FORMAT(ex) != FMT_LIST)
+		    call ex_wpixels (fd, outtype, out, O_LEN(op))
+		else {
+		    call ex_listpix (fd, outtype, out, O_LEN(op), j, i, 
+			EX_NEXPR(ex), NO)
+		}
+
+		# Clean up the pointers.
+		if (outtype == TY_UBYTE || outtype == TY_CHAR)
+		    call mfree (out, TY_CHAR)
+		else
+		    call mfree (out, outtype)
+	 	call evvfree (op)
+		do k = 1, EX_NIMOPS(ex) {
+		    op = IMOP(ex,k)
+#		    if (IO_ISIM(op) == NO)
+			call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op)))
+		}
+
+                # Print percent done if being verbose
+	 	orow = orow + 1
+                #if (EX_VERBOSE(ex) == YES)
+		    call ex_pstat (ex, orow, percent)
+	    }
+	}
+
+	if (DEBUG) { call zze_prstruct ("Finished processing", ex) }
+end
+
+
+# EX_LN_INTERLEAVE - Write out the image with line interleaving.
+
+procedure ex_ln_interleave (ex)
+
+pointer	ex				#i task struct pointer
+
+pointer	op, out
+int	i, j, line, percent, orow
+int	fd, outtype
+
+pointer	ex_evaluate(), ex_chtype()
+
+begin
+	if (DEBUG) { call eprintf ("ex_ln_interleave:\n")
+	    call eprintf ("NEXPR = %d  OCOLS = %d OROWS = %d\n")
+		call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex))
+		call pargi(EX_OROWS(ex))
+	}
+
+	# Process each line in the image.
+	fd = EX_FD(ex)
+	outtype = EX_OUTTYPE(ex)
+	percent = 0
+	orow = 0
+	do i = 1, EX_NLINES(ex) {
+
+	    # See if we're flipping the image.
+	    if (bitset (EX_OUTFLAGS(ex), OF_FLIPY))
+		line = EX_NLINES(ex) - i + 1
+	    else
+		line = i
+
+	    # Get pixels from image(s).
+	    call ex_getpix (ex, line)
+
+	    # Loop over the number of image expressions.
+	    do j = 1, EX_NEXPR(ex) {
+
+		# Evaluate expression.
+		op = ex_evaluate (ex, O_EXPR(ex,j))
+
+		# Convert to the output pixel type.
+		out = ex_chtype (ex, op, outtype)
+
+                # Write evaluated pixels.
+		if (EX_FORMAT(ex) != FMT_LIST)
+		    call ex_wpixels (fd, outtype, out, O_LEN(op))
+		else {
+		    call ex_listpix (fd, outtype, out, O_LEN(op), i, j,
+			EX_NEXPR(ex), NO)
+		}
+
+		# Clean up the pointers.
+		if (outtype == TY_UBYTE || outtype == TY_CHAR)
+		    call mfree (out, TY_CHAR)
+		else
+		    call mfree (out, outtype)
+                call evvfree (op)
+
+                # Print percent done if being verbose
+	        orow = orow + 1
+                #if (EX_VERBOSE(ex) == YES)
+		    call ex_pstat (ex, orow, percent)
+	    }
+
+	    do j = 1, EX_NIMOPS(ex) {
+		op = IMOP(ex,j)
+#		if (IO_ISIM(op) == NO)
+		    call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op)))
+	    }
+	}
+
+	if (DEBUG) { call zze_prstruct ("Finished processing", ex) }
+end
+
+
+# EX_PX_INTERLEAVE - Write out the image with pixel interleaving.
+
+procedure ex_px_interleave (ex)
+
+pointer	ex				#i task struct pointer
+
+pointer	sp, pp, op
+pointer	o, outptr
+int	i, j, line, npix, outtype
+long	totpix
+int	fd, percent, orow
+
+pointer	ex_evaluate(), ex_chtype()
+
+begin
+	if (DEBUG) { call eprintf ("ex_px_interleave:\n")
+	    call eprintf ("NEXPR = %d  OCOLS = %d OROWS = %d\n")
+		call pargi(EX_NEXPR(ex));call pargi(EX_OCOLS(ex))
+		call pargi(EX_OROWS(ex))
+	}
+
+	call smark (sp)
+	call salloc (pp, EX_NEXPR(ex), TY_POINTER)
+
+	# Process each line in the image.
+	fd = EX_FD(ex)
+	outptr = NULL
+	outtype = EX_OUTTYPE(ex)
+	percent = 0
+	orow = 0
+	do i = 1, EX_NLINES(ex) {
+
+	    # See if we're flipping the image.
+	    if (bitset (EX_OUTFLAGS(ex), OF_FLIPY))
+	        line = EX_NLINES(ex) - i + 1
+	    else
+	        line = i
+
+	    # Get pixels from image(s).
+	    call ex_getpix (ex, line)
+
+	    # Loop over the number of image expressions.
+	    totpix = 0
+	    do j = 1, EX_NEXPR(ex) {
+
+		# Evaluate expression.
+		op = ex_evaluate (ex, O_EXPR(ex,j))
+
+		# Convert to the output pixel type.
+		o = ex_chtype (ex, op, outtype)
+		Memi[pp+j-1] = o
+
+		npix = O_LEN(op)
+		#npix = EX_OCOLS(op)
+	 	call evvfree (op)
+	    }
+
+	    # Merge pixels into a single vector.
+	    call ex_merge_pixels (Memi[pp], EX_NEXPR(ex), npix, outtype, 
+		outptr, totpix)
+		
+	    # Write vector of merged pixels.
+	    if (outtype == TY_UBYTE)
+		call achtsb (Memc[outptr], Memc[outptr], totpix)
+	    if (EX_FORMAT(ex) != FMT_LIST)
+		call ex_wpixels (fd, outtype, outptr, totpix)
+	    else {
+		call ex_listpix (fd, outtype, outptr, totpix, 
+		    i, EX_NEXPR(ex), EX_NEXPR(ex), YES)
+	    }
+
+	    if (outtype != TY_CHAR && outtype != TY_UBYTE)
+	        call mfree (outptr, outtype)
+	    else
+	        call mfree (outptr, TY_CHAR)
+	    do j = 1, EX_NIMOPS(ex) {
+		op = IMOP(ex,j)
+#		if (IO_ISIM(op) == NO)
+		    call mfree (IO_DATA(op), IM_PIXTYPE(IO_IMPTR(op)))
+	    }
+	    do j = 1, EX_NEXPR(ex) {
+	        if (outtype != TY_CHAR && outtype != TY_UBYTE)
+		    call mfree (Memi[pp+j-1], outtype)
+		else
+		    call mfree (Memi[pp+j-1], TY_CHAR)
+	    }
+
+            # Print percent done if being verbose
+	    orow = orow + 1
+            #if (EX_VERBOSE(ex) == YES)
+		call ex_pstat (ex, orow, percent)
+	}
+
+	call sfree (sp)
+
+	if (DEBUG) { call zze_prstruct ("Finished processing", ex) }
+end
+
+
+# EX_GETPIX - Get the pixels from the image and load each operand.
+
+procedure ex_getpix (ex, line)
+
+pointer	ex				#i task struct pointer
+int	line				#i current line number
+
+pointer	im, op, data
+int	nptrs, i, band
+
+pointer	imgl3s(), imgl3i(), imgl3l()
+pointer	imgl3r(), imgl3d()
+
+begin
+	# Loop over each of the image operands.
+	nptrs = EX_NIMOPS(ex)
+	do i = 1, nptrs {
+	    op = IMOP(ex,i)
+	    im = IO_IMPTR(op)
+	    band = max (1, IO_BAND(op))
+
+	    if (line > IM_LEN(im,2)) {
+	        call calloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im))
+	        IO_ISIM(op) = NO
+	        IO_NPIX(op) = IM_LEN(im,1)
+		next
+	    } else if (IO_DATA(op) == NULL)
+	        call malloc (IO_DATA(op), IM_LEN(im,1), IM_PIXTYPE(im))
+
+	    switch (IM_PIXTYPE(im)) {
+            case TY_USHORT:
+		data = imgl3s (im, line, band)
+		call amovs (Mems[data], Mems[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_SHORT
+		IO_NBYTES(op) = SZ_SHORT * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+            case TY_SHORT:
+		data = imgl3s (im, line, band)
+		call amovs (Mems[data], Mems[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_SHORT
+		    IO_NBYTES(op) = SZ_SHORT * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+            case TY_INT:
+		data = imgl3i (im, line, band)
+		call amovi (Memi[data], Memi[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_INT
+		    IO_NBYTES(op) = SZ_INT32 * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+            case TY_LONG:
+		data = imgl3l (im, line, band)
+		call amovl (Meml[data], Meml[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_LONG
+		    IO_NBYTES(op) = SZ_LONG * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+            case TY_REAL:
+		data = imgl3r (im, line, band)
+		call amovr (Memr[data], Memr[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_REAL
+		    IO_NBYTES(op) = SZ_REAL * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+            case TY_DOUBLE:
+		data = imgl3d (im, line, band)
+		call amovd (Memd[data], Memd[IO_DATA(op)], IM_LEN(im,1))
+	        IO_TYPE(op) = TY_DOUBLE
+		    IO_NBYTES(op) = SZ_DOUBLE * SZB_CHAR
+	        IO_ISIM(op) = YES
+
+	    }
+	    IO_NPIX(op) = IM_LEN(im,1)
+	}
+end
+
+
+# EX_WPIXELS - Write the pixels to the current file.
+
+procedure ex_wpixels (fd, otype, pix, npix)
+
+int	fd				#i output file descriptor
+int	otype				#i output data type
+pointer	pix				#i pointer to pixel data
+int	npix				#i number of pixels to write
+
+begin
+	# Write binary output.
+        switch (otype) {
+        case TY_UBYTE:
+            call write (fd, Mems[pix], npix / SZB_CHAR)
+        case TY_USHORT:
+            call write (fd, Mems[pix], npix * SZ_SHORT/SZ_CHAR)
+
+        case TY_SHORT:
+            call write (fd, Mems[pix], npix * SZ_SHORT/SZ_CHAR)
+
+        case TY_INT:
+	    if (SZ_INT != SZ_INT32)
+		call ipak32 (Memi[pix], Memi[pix], npix)
+            call write (fd, Memi[pix], npix * SZ_INT32/SZ_CHAR)
+
+        case TY_LONG:
+            call write (fd, Meml[pix], npix * SZ_LONG/SZ_CHAR)
+
+        case TY_REAL:
+            call write (fd, Memr[pix], npix * SZ_REAL/SZ_CHAR)
+
+        case TY_DOUBLE:
+            call write (fd, Memd[pix], npix * SZ_DOUBLE/SZ_CHAR)
+
+	}
+end
+
+
+# EX_LISTPIX - Write the pixels to the current file as ASCII text.
+
+procedure ex_listpix (fd, type, data, npix, line, band, nbands, merged)
+
+int	fd				#i output file descriptor
+int	type				#i output data type
+pointer	data				#i pointer to pixel data
+int	npix				#i number of pixels to write
+int	line				#i current output line number
+int	band				#i current output band number
+int	nbands				#i no. of output bands
+int	merged				#i are pixels interleaved?
+
+int	i, j, k
+int	val, pix, shifti(), andi()
+
+begin
+	if (merged == YES && nbands > 1) {
+	    do i = 1, npix {
+		k = 0
+	        do j = 1, nbands {
+		    call fprintf (fd, "%4d %4d %4d  ")
+		        call pargi (i)
+		        call pargi (line)
+		        call pargi (j)
+
+		    switch (type) {
+                    case TY_UBYTE:
+                        val = Memc[data+k]
+                        if (mod(i,2) == 1) {
+                            pix = shifti (val, -8)
+                        } else {
+                            pix = andi (val, 000FFX)
+                            k = k + 1
+                        }
+                        if (pix < 0)  pix = pix + 256
+                        call fprintf (fd, "%d\n")
+                            call pargi (pix)
+		    case TY_CHAR, TY_SHORT, TY_USHORT:
+		        call fprintf (fd, "%d\n")
+		            call pargs (Mems[data+((j-1)*npix+i)-1])
+        	    case TY_INT:
+		        call fprintf (fd, "%d\n")
+		            call pargi (Memi[data+((j-1)*npix+i)-1])
+        	    case TY_LONG:
+		        call fprintf (fd, "%d\n")
+		            call pargl (Meml[data+((j-1)*npix+i)-1])
+        	    case TY_REAL:
+		        call fprintf (fd, "%g\n")
+		            call pargr (Memr[data+((j-1)*npix+i)-1])
+        	    case TY_DOUBLE:
+		        call fprintf (fd, "%g\n")
+		            call pargd (Memd[data+((j-1)*npix+i)-1])
+	            }
+		}
+	    }
+	} else {
+	    j = 0
+	    do i = 1, npix {
+		if (nbands > 1) {
+		    call fprintf (fd, "%4d %4d %4d  ")
+		        call pargi (i)
+		        call pargi (line)
+		        call pargi (band)
+		} else {
+		    call fprintf (fd, "%4d %4d  ")
+		        call pargi (i)
+		        call pargi (line)
+		}
+
+		switch (type) {
+		case TY_UBYTE:
+		    val = Memc[data+j]
+		    if (mod(i,2) == 1) {
+			pix = shifti (val, -8)
+		    } else {
+			pix = andi (val, 000FFX)
+			j = j + 1
+		    }
+		    if (pix < 0)  pix = pix + 256
+		    call fprintf (fd, "%d\n")
+		        call pargi (pix)
+		case TY_CHAR, TY_SHORT, TY_USHORT:
+		    call fprintf (fd, "%d\n")
+		        call pargs (Mems[data+i-1])
+        	case TY_INT:
+		    call fprintf (fd, "%d\n")
+		        call pargi (Memi[data+i-1])
+        	case TY_LONG:
+		    call fprintf (fd, "%d\n")
+		        call pargl (Meml[data+i-1])
+        	case TY_REAL:
+		    call fprintf (fd, "%g\n")
+		        call pargr (Memr[data+i-1])
+        	case TY_DOUBLE:
+		    call fprintf (fd, "%g\n")
+		        call pargd (Memd[data+i-1])
+		}
+	    }
+	}
+end
+
+
+# EX_MERGE_PIXELS - Merge a group of pixels arrays into one array by combining
+# the elements.  Returns an allocated pointer which must be later freed and 
+# the total number of pixels.
+
+procedure ex_merge_pixels (ptrs, nptrs, npix, dtype, pix, totpix)
+
+pointer ptrs[ARB]                       #i array of pixel ptrs
+int     nptrs                           #i number of ptrs
+int     npix                            #i no. of pixels in each array
+int     dtype                           #i type of pointer to alloc
+pointer pix                             #o output pixel array ptr
+int     totpix                          #o total no. of output pixels
+
+int     i, j, ip
+
+begin
+        # Calculate the number of output pixels and allocate the pointer.
+        totpix = nptrs * npix
+	if (dtype != TY_CHAR && dtype != TY_UBYTE)
+            call realloc (pix, totpix, dtype)
+	else {
+            call realloc (pix, totpix, TY_CHAR)
+	    do i = 1, nptrs
+		call achtbs (Mems[ptrs[i]], Mems[ptrs[i]], npix)
+	}
+
+        # Fill the output array
+        ip = 0
+        for (i = 1; i<=npix; i=i+1) {
+            do j = 1, nptrs {
+                switch (dtype) {
+                case TY_UBYTE:
+                    Mems[pix+ip] = Mems[ptrs[j]+i-1]
+                case TY_USHORT:
+                    Mems[pix+ip] = Mems[ptrs[j]+i-1]
+
+                case TY_SHORT:
+                    Mems[pix+ip] = Mems[ptrs[j]+i-1]
+
+                case TY_INT:
+                    Memi[pix+ip] = Memi[ptrs[j]+i-1]
+
+                case TY_LONG:
+                    Meml[pix+ip] = Meml[ptrs[j]+i-1]
+
+                case TY_REAL:
+                    Memr[pix+ip] = Memr[ptrs[j]+i-1]
+
+                case TY_DOUBLE:
+                    Memd[pix+ip] = Memd[ptrs[j]+i-1]
+
+                }
+        
+                ip = ip + 1
+            }
+        }
+end
+
+
+# EX_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.  Any IEEE or byte-swapping
+# requests are also handled here.
+
+pointer procedure ex_chtype (ex, op, type)
+
+pointer	ex				#i task struct pointer
+pointer	op				#i evvexpr operand pointer
+int	type				#i new type of pointer
+
+pointer	out, coerce()
+int	swap, flags
+
+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)
+	}
+
+ 	# If this is a color index image subtract one from the pixel value
+ 	# to get the index.
+ 	if (bitset (flags, OF_CMAP))
+	    call ex_pix_to_index (O_VALP(op), O_TYPE(op), O_LEN(op))
+
+	# Change the pixel type.
+	flags = EX_OUTFLAGS(ex)
+	swap = EX_BSWAP(ex)
+        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)
+
+	    # Do any requested byte swapping.
+	    if (bitset (swap, S_I2) || bitset (swap, S_ALL))
+		call bswap4 (Mems[out], 1, Mems[out], 1, O_LEN(op))
+
+        case TY_INT:
+            call achti (Memi[O_VALP(op)], Memc[out], O_LEN(op), type)
+
+	    # Do any requested byte swapping.
+	    if (bitset (swap, S_I4) || bitset (swap, S_ALL))
+		call bswap4 (Memi[out], 1, Memi[out], 1, O_LEN(op))
+
+        case TY_LONG:
+            call achtl (Meml[O_VALP(op)], Memc[out], O_LEN(op), type)
+
+	    # Do any requested byte swapping.
+	    if (bitset (swap, S_I4) || bitset (swap, S_ALL))
+		call bswap4 (Meml[out], 1, Meml[out], 1, O_LEN(op))
+
+        case TY_REAL:
+            call achtr (Memr[O_VALP(op)], Memc[out], O_LEN(op), type)
+
+	    # See if we need to convert to IEEE
+	    if (bitset (flags, OF_IEEE) && IEEE_USED == NO)
+		call ieevpakr (Memr[out], Memr[out], O_LEN(op))
+
+        case TY_DOUBLE:
+            call achtd (Memd[O_VALP(op)], Memc[out], O_LEN(op), type)
+
+	    # See if we need to convert to IEEE
+	    if (bitset (flags, OF_IEEE) && IEEE_USED == NO)
+		call ieevpakd (Memd[P2D(out)], Memd[P2D(out)], O_LEN(op))
+
+	default:
+	    call error (0, "Invalid output type requested.")
+        }
+
+	if (type != TY_UBYTE && type != TY_CHAR)
+            out = coerce (out, TY_CHAR, type)
+	return (out)
+end
+
+
+# EX_PIX_TO_INDEX - Convert pixel values to color index values.  We assume
+# the colormap has at most 256 entries.
+
+procedure ex_pix_to_index (ptr, type, len)
+
+pointer	ptr				#i data ptr
+int	type				#i data type of array
+int	len				#i length of array
+
+
+short	sindx, smin, smax
+
+int	iindx, imin, imax
+
+long	lindx, lmin, lmax
+
+real	rindx, rmin, rmax
+
+double	dindx, dmin, dmax
+
+
+begin
+
+	sindx = short (1)
+	smin = short (0)
+	smax = short (255)
+
+	iindx = int (1)
+	imin = int (0)
+	imax = int (255)
+
+	lindx = long (1)
+	lmin = long (0)
+	lmax = long (255)
+
+	rindx = real (1)
+	rmin = real (0)
+	rmax = real (255)
+
+	dindx = double (1)
+	dmin = double (0)
+	dmax = double (255)
+
+
+	switch (type) {
+
+	case TY_SHORT:
+            call asubks (Mems[ptr], sindx, Mems[ptr], len)
+            call amaxks (Mems[ptr], smin, Mems[ptr], len)
+            call aminks (Mems[ptr], smax, Mems[ptr], len)
+
+	case TY_INT:
+            call asubki (Memi[ptr], iindx, Memi[ptr], len)
+            call amaxki (Memi[ptr], imin, Memi[ptr], len)
+            call aminki (Memi[ptr], imax, Memi[ptr], len)
+
+	case TY_LONG:
+            call asubkl (Meml[ptr], lindx, Meml[ptr], len)
+            call amaxkl (Meml[ptr], lmin, Meml[ptr], len)
+            call aminkl (Meml[ptr], lmax, Meml[ptr], len)
+
+	case TY_REAL:
+            call asubkr (Memr[ptr], rindx, Memr[ptr], len)
+            call amaxkr (Memr[ptr], rmin, Memr[ptr], len)
+            call aminkr (Memr[ptr], rmax, Memr[ptr], len)
+
+	case TY_DOUBLE:
+            call asubkd (Memd[ptr], dindx, Memd[ptr], len)
+            call amaxkd (Memd[ptr], dmin, Memd[ptr], len)
+            call aminkd (Memd[ptr], dmax, Memd[ptr], len)
+
+	}
+end
+
+
+# EX_PSTAT - Print information about the progress we're making.
+
+procedure ex_pstat (ex, row, percent)
+
+pointer	ex				#i task struct pointer
+int	row				#u current row
+int	percent				#u percent completed
+
+begin
+        # Print percent done if being verbose
+        if (row * 100 / EX_OROWS(ex) >= percent + 10) {
+            percent = percent + 10
+            call eprintf ("    Status: %2d%% complete\r")
+                call pargi (percent)
+            call flush (STDERR)
+        }
+end
diff --git a/pkg/dataio/export/generic/mkpkg b/pkg/dataio/export/generic/mkpkg
new file mode 100644
index 00000000..4902710d
--- /dev/null
+++ b/pkg/dataio/export/generic/mkpkg
@@ -0,0 +1,12 @@
+# Compile the generic sources.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	exobands.x	../exfcn.h ../export.h <error.h> <evvexpr.h> \
+			<fset.h> <mach.h> <ctype.h>
+	exraster.x	../export.h <evvexpr.h> <imhdr.h> <mach.h>
+	;