Initial commit

1 files changed, 2680 insertions, 0 deletions

diff --git a/sys/fmtio/evvexpr.gy b/sys/fmtio/evvexpr.gy
new file mode 100644
index 00000000..32a91153
--- /dev/null
+++ b/sys/fmtio/evvexpr.gy
@@ -0,0 +1,2680 @@
+%{
+include	<lexnum.h>
+include	<ctype.h>
+include	<mach.h>
+include	<math.h>
+include	<evvexpr.h>
+
+.help evvexpr
+.nf --------------------------------------------------------------------------
+EVVEXPR.GY -- Generic XYacc source for a general vector expression evaluator.
+
+	    o = evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+		evvfree (o)
+
+Client callbacks:
+
+	          getop (client_data, opname, out)
+	           ufcn (client_data, fcn, args, nargs, out)
+
+here "out" is the output operand returned to EVVEXPR.  Client_data is any
+arbitrary integer or pointer value passed in to EVVEXPR when by the client
+when the callback was registered.  "args" is an array of operand structs,
+the arguments for the user function being called.  If the operand or
+function call cannot be completed normally an error exit may be made (call
+error) or an invalid operand may be returned (O_TYPE set to 0).  The client
+should not free the "args" input operands, this will be handled by EVVEXPR.
+
+Operand struct (lib$evvexpr.h):
+
+	struct operand {
+		int	O_TYPE			# operand type (bcsilrd)
+		int	O_LEN			# operand length (0=scalar)
+		int	O_FLAGS			# O_FREEVAL, O_FREEOP
+		union {
+			char*	O_VALC		# string
+			short	O_VALS
+			int	O_VALI		# int or bool
+			long	O_VALL
+			real	O_VALR
+			double	O_VALD
+			pointer	O_VALP		# vector data
+		}
+	}
+
+The macro O_VALC references the string value of a TY_CHAR operand.  The
+flags are O_FREEVAL and O_FREEOP, which tell EVVEXPR and EVVFREE whether or
+not to free any vector operand array or the operand struct when the operand
+is freed.  The client should set these flags on operands returned to EVVEXPR
+if it wants EVVEXPR to free any operand storage.
+
+Supported types are bool, char (string), and SILRD.  Bool is indicated as
+TY_BOOL in the O_TYPE field of the operand struct, but is stored internally
+as an integer and the value field of a boolean operand is given by O_VALI.
+
+Operands may be either scalars or vectors.  A vector is indicated by a O_LEN
+value greater than zero.  For vector operands O_VALP points to the data array.
+A special case is TY_CHAR (string), in which case O_LEN is the allocated
+length of the EOS-terminated string.  A string is logically a scalar value
+even though it is physically stored in the operand as a character vector.
+
+The trig functions operate upon angles in units of radians.  The intrinsic
+functions RAD and DEG are available for converting between radians and
+degrees.  A string can be coerced to a binary value and vice versa, using
+the INT, STR, etc. intrinsic functions.
+
+This is a generalization of the older EVEXPR routine, adding additional
+datatypes, support for vector operands, and numerous minor enhancements.
+.endhelp ---------------------------------------------------------------------
+
+define	YYMAXDEPTH	64		# parser stack length
+define	MAX_ARGS	17		# max args in a function call
+define	yyparse		xvv_parse
+
+# Arglist structure.
+define	LEN_ARGSTRUCT	(1+MAX_ARGS+(MAX_ARGS*LEN_OPERAND))
+define	A_NARGS		Memi[$1]	# number of arguments
+define	A_ARGP		Memi[$1+$2]	# array of pointers to operand structs
+define	A_OPS		($1+MAX_ARGS+1)	# offset to operand storage area
+
+# Intrinsic functions.
+
+define	LEN_STAB	300		# for symbol table
+define	LEN_SBUF	256
+define	LEN_INDEX	97
+
+define	LEN_SYM		1		# symbol data
+define	SYM_CODE	Memi[$1]
+
+define	KEYWORDS	"|abs|acos|asin|atan|atan2|bool|cos|cosh|deg|double|\
+			 |exp|hiv|int|len|log|log10|long|lov|max|mean|median|\
+			 |min|mod|nint|rad|real|repl|stddev|shift|short|sin|\
+			 |sinh|sort|sqrt|str|sum|tan|tanh|"
+
+define	F_ABS		01		# function codes
+define	F_ACOS		02
+define	F_ASIN		03
+define	F_ATAN		04
+define	F_ATAN2		05
+define	F_BOOL		06
+define	F_COS		07
+define	F_COSH		08
+define	F_DEG		09		# radians to degrees
+define	F_DOUBLE	10
+	# newline	11
+define	F_EXP		12
+define	F_HIV		13		# high value
+define	F_INT		14
+define	F_LEN		15		# vector length
+define	F_LOG		16
+define	F_LOG10		17
+define	F_LONG		18
+define	F_LOV		19		# low value
+define	F_MAX		20
+define	F_MEAN		21
+define	F_MEDIAN	22
+	# newline	23
+define	F_MIN		24
+define	F_MOD		25
+define	F_NINT		26
+define	F_RAD		27		# degrees to radians
+define	F_REAL		28
+define	F_REPL		29		# replicate
+define	F_STDDEV	30		# standard deviation
+define	F_SHIFT		31
+define	F_SHORT		32
+define	F_SIN		33
+	# newline	34
+define	F_SINH		35
+define	F_SORT		36		# sort
+define	F_SQRT		37		# square root
+define	F_STR		38
+define	F_SUM		39
+define	F_TAN 		40
+define	F_TANH 		41
+
+define	T_B		TY_BOOL
+define	T_C		TY_CHAR
+define	T_S		TY_SHORT
+define	T_I		TY_INT
+define	T_L		TY_LONG
+define	T_R		TY_REAL
+define	T_D		TY_DOUBLE
+
+
+# EVVEXPR -- Evaluate a general mixed type vector expression.  Input consists
+# of the expression to be evaluated (a string) and, optionally, user
+# procedures for fetching external operands and executing external functions.
+# Output is a pointer to an operand structure containing the computed value of
+# the expression.  The output operand structure is dynamically allocated by
+# EVVEXPR and must be freed by the user.
+# 
+# NOTE: this is not intended to be an especially efficient procedure.  Rather,
+# this is a high level, easy to use procedure, intended to provide greater
+# flexibility in the parameterization of applications programs.  The main
+# inefficiency is that, since compilation and execution are not broken out as
+# separate steps, when the routine is repeatedly called to evaluate the same
+# expression with different data, all the compile time computation (parsing
+# etc.) has to be repeated.
+
+pointer procedure evvexpr (expr, getop, getop_data, ufcn, ufcn_data, flags)
+
+char	expr[ARB]		#I expression to be evaluated
+int	getop			#I user supplied get operand procedure
+int	getop_data		#I client data for above function
+int	ufcn			#I user supplied function call procedure
+int	ufcn_data		#I client data for above function
+int	flags			#I flag bits
+
+int	junk
+pointer	sp, ip
+bool	debug, first_time
+int	strlen(), xvv_parse()
+pointer	xvv_loadsymbols()
+extern	xvv_gettok()
+
+errchk	xvv_parse, calloc
+include	"evvexpr.com"
+data	debug /false/
+data	first_time /true/
+
+begin
+	call smark (sp)
+
+	if (first_time) {
+	    # This creates data which remains for the life of the process.
+	    ev_st = xvv_loadsymbols (KEYWORDS)
+	    first_time = false
+	}
+
+	# Set user function entry point addresses.
+	ev_getop = getop
+	ev_getop_data = getop_data
+	ev_ufcn = ufcn
+	ev_ufcn_data = ufcn_data
+	ev_flags = flags
+
+	# Allocate an operand struct for the expression value.
+	call calloc (ev_oval, LEN_OPERAND, TY_STRUCT)
+
+	# Make a local copy of the input string.
+	call salloc (ip, strlen(expr), TY_CHAR)
+	call strcpy (expr, Memc[ip], ARB)
+
+	# Evaluate the expression.  The expression value is copied into the
+	# output operand structure by XVV_PARSE, given the operand pointer
+	# passed in common.  A common must be used since the standard parser
+	# subroutine has a fixed calling sequence.
+
+	junk = xvv_parse (ip, debug, xvv_gettok)
+	O_FLAGS(ev_oval) = or (O_FLAGS(ev_oval), O_FREEOP)
+
+	call sfree (sp)
+	return (ev_oval)
+end
+
+
+# EVVFREE -- Free an operand struct such as is returned by EVVEXPR.
+
+procedure evvfree (o)
+
+pointer	o			# operand struct
+
+begin
+	call xvv_freeop (o)
+end
+
+%L
+# XVV_PARSE -- SPP/Yacc parser for the evaluation of an expression passed as
+# a text string.  Expression evaluation is carried out as the expression is
+# parsed, rather than being broken into separate compile and execute stages.
+# There is only one statement in this grammar, the expression.  Our function
+# is to reduce an expression to a single value of type bool, string, int,
+# or real.
+
+pointer	ap
+bool	streq()
+errchk	zcall3, xvv_error1, xvv_unop, xvv_binop, xvv_boolop
+errchk	xvv_quest, xvv_callfcn, xvv_addarg
+include	"evvexpr.com"
+
+%}
+
+# The $/ following causes the generic preprocessor to pass this block of code
+# through unchanged.
+
+$/
+
+%token		CONSTANT IDENTIFIER NEWLINE YYEOS
+%token		PLUS MINUS STAR SLASH EXPON CONCAT QUEST COLON
+%token		LT GT LE GT EQ NE SE LAND LOR LNOT BAND BOR BXOR BNOT AT
+
+%nonassoc	QUEST
+%left		LAND LOR
+%left		BAND BOR BXOR
+%nonassoc	EQ NE SE
+%nonassoc	LT GT LE GE
+%left		CONCAT
+%left		PLUS MINUS
+%left		STAR SLASH
+%right		UMINUS LNOT BNOT
+%left		EXPON
+%right		AT
+
+%%
+
+stmt	:	exprlist YYEOS {
+			# Normal exit.  Move the final expression value operand
+			# into the operand structure pointed to by the global
+			# variable ev_oval.
+
+			YYMOVE ($1, ev_oval)
+			call sfree (yysp)
+			return (OK)
+		}
+	|	error {
+			call error (1, "syntax error")
+		}
+	;
+
+exprlist:	expr {
+			YYMOVE ($1, $$)
+		}
+	|	exprlist ',' opnl expr {
+			YYMOVE ($4, $$)
+			call xvv_freeop ($1)
+		}
+
+
+expr	:	CONSTANT {
+			# Numeric constant.
+			YYMOVE ($1, $$)
+		    }
+	|	IDENTIFIER {
+			# The boolean constants "yes" and "no" are implemented
+			# as reserved operands.
+
+			call xvv_initop ($$, 0, TY_BOOL)
+			if (streq (O_VALC($1), "yes")) {
+			    O_VALI($$) = YES
+			} else if (streq (O_VALC($1), "no")) {
+			    O_VALI($$) = NO
+			} else if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($1), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($1))
+			call xvv_freeop ($1)
+		    }
+	|	AT CONSTANT {
+			# e.g., @"param"
+			if (ev_getop != NULL) {
+			    call zcall3 (ev_getop,ev_getop_data, O_VALC($2), $$)
+			    if (O_TYPE($$) <= 0)
+				call xvv_error1 ("unknown operand `%s'",
+				    O_VALC($1))
+			} else
+			    call xvv_error1 ("illegal operand `%s'", O_VALC($2))
+			call xvv_freeop ($2)
+		    }
+	|	MINUS expr %prec UMINUS {
+			# Unary arithmetic minus.
+			call xvv_unop (MINUS, $2, $$)
+		    }
+	|	LNOT expr {
+			# Logical not.
+			call xvv_unop (LNOT, $2, $$)
+		    }
+	|	BNOT expr {
+			# Boolean not.
+			call xvv_unop (BNOT, $2, $$)
+		    }
+	|	expr PLUS opnl expr {
+			# Addition.
+			call xvv_binop (PLUS, $1, $4, $$)
+		    }
+	|	expr MINUS opnl expr {
+			# Subtraction.
+			call xvv_binop (MINUS, $1, $4, $$)
+		    }
+	| 	expr STAR opnl expr {
+			# Multiplication.
+			call xvv_binop (STAR, $1, $4, $$)
+		    }
+	|	expr SLASH opnl expr {
+			# Division.
+			call xvv_binop (SLASH, $1, $4, $$)
+		    }
+	|	expr EXPON opnl expr {
+			# Exponentiation.
+			call xvv_binop (EXPON, $1, $4, $$)
+		    }
+	|	expr CONCAT opnl expr {
+			# Concatenate two operands.
+			call xvv_binop (CONCAT, $1, $4, $$)
+		    }
+	|	expr LAND opnl expr {
+			# Logical and.
+			call xvv_boolop (LAND, $1, $4, $$)
+		    }
+	|	expr LOR opnl expr {
+			# Logical or.
+			call xvv_boolop (LOR, $1, $4, $$)
+		    }
+	|	expr BAND opnl expr {
+			# Boolean and.
+			call xvv_binop (BAND, $1, $4, $$)
+		    }
+	|	expr BOR opnl expr {
+			# Boolean or.
+			call xvv_binop (BOR, $1, $4, $$)
+		    }
+	|	expr BXOR opnl expr {
+			# Boolean xor.
+			call xvv_binop (BXOR, $1, $4, $$)
+		    }
+	|	expr LT opnl expr {
+			# Boolean less than.
+			call xvv_boolop (LT, $1, $4, $$)
+		    }
+	|	expr GT opnl expr {
+			# Boolean greater than.
+			call xvv_boolop (GT, $1, $4, $$)
+		    }
+	|	expr LE opnl expr {
+			# Boolean less than or equal.
+			call xvv_boolop (LE, $1, $4, $$)
+		    }
+	|	expr GE opnl expr {
+			# Boolean greater than or equal.
+			call xvv_boolop (GE, $1, $4, $$)
+		    }
+	|	expr EQ opnl expr {
+			# Boolean equal.
+			call xvv_boolop (EQ, $1, $4, $$)
+		    }
+	|	expr SE opnl expr {
+			# String pattern-equal.
+			call xvv_boolop (SE, $1, $4, $$)
+		    }
+	|	expr NE opnl expr {
+			# Boolean not equal.
+			call xvv_boolop (NE, $1, $4, $$)
+		    }
+	|	expr QUEST opnl expr COLON opnl expr {
+			# Conditional expression.
+			call xvv_quest ($1, $4, $7, $$)
+		    }
+	|	funct '(' arglist ')' {
+			# Call an intrinsic or external function.
+			ap = O_VALP($3)
+			call xvv_callfcn (O_VALC($1),
+			    A_ARGP(ap,1), A_NARGS(ap), $$)
+			call xvv_freeop ($1)
+			call xvv_freeop ($3)
+		    }
+	|	'(' expr ')' {
+			YYMOVE ($2, $$)
+		    }
+	;
+
+
+funct	:	IDENTIFIER {
+			YYMOVE ($1, $$)
+		    }
+	|	CONSTANT {
+			if (O_TYPE($1) != TY_CHAR)
+			    call error (1, "illegal function name")
+			YYMOVE ($1, $$)
+		    }
+	;
+
+
+arglist	:	{
+			# Empty.
+			call xvv_startarglist (NULL, $$)
+		    }
+	|	expr {
+			# First arg; start a nonnull list.
+			call xvv_startarglist ($1, $$)
+		    }
+	|	arglist ',' opnl expr {
+			# Add an argument to an existing list.
+			call xvv_addarg ($4, $1, $$)
+		    }
+	;
+
+
+opnl	:	# Empty.
+	|	opnl NEWLINE
+	;
+
+%%
+
+# End generic preprocessor escape.
+/
+
+
+# XVV_UNOP -- Unary operation.  Perform the indicated unary operation on the
+# input operand, returning the result as the output operand.
+
+procedure xvv_unop (opcode, in, out)
+
+int	opcode			#I operation to be performed
+pointer	in			#I input operand
+pointer	out			#I output operand
+
+short	val_s
+long	val_l
+int	val_i, nelem
+errchk	xvv_error, xvv_initop
+string	s_badswitch "unop: bad switch"
+
+begin
+	nelem = O_LEN(in)
+
+	switch (opcode) {
+	case MINUS:
+	    # Unary negation.
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR:
+		call xvv_error ("negation of a nonarithmetic operand")
+$for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call aneg$t (Mem$t[O_VALP(in)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = -O_VAL$T(in)
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case LNOT:
+	    # Logical NOT.
+
+	    call xvv_initop (out, nelem, TY_BOOL)
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL:
+		if (nelem > 0)
+		    call abeqki (Memi[O_VALP(in)], NO, Memi[O_VALP(out)], nelem)
+		else {
+		    if (O_VALI(in) == NO)
+			O_VALI(out) = YES
+		    else
+			O_VALI(out) = NO
+		}
+$for (sil)
+	    case TY_PIXEL:
+		if (nelem > 0) {
+		    val_$t = NO
+		    call abeqk$t (Mem$t[O_VALP(in)], val_$t, Memi[O_VALP(out)],
+			nelem)
+		} else {
+		    if (O_VAL$T(in) == NO)
+			O_VAL$T(out) = YES
+		    else
+			O_VAL$T(out) = NO
+		}
+$endfor
+	    case TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("not of a nonlogical")
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	case BNOT:
+	    # Bitwise boolean NOT.
+
+	    call xvv_initop (out, nelem, O_TYPE(in))
+	    switch (O_TYPE(in)) {
+	    case TY_BOOL, TY_CHAR, TY_REAL, TY_DOUBLE:
+		call xvv_error ("boolean not of a noninteger operand")
+$for (sil)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call anot$t (Mem$t[O_VALP(in)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = not(O_VAL$T(in))
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+
+	default:
+	    call xvv_error (s_badswitch)
+	}
+
+	call xvv_freeop (in)
+end
+
+
+# XVV_BINOP -- Binary operation.  Perform the indicated arithmetic binary
+# operation on the two input operands, returning the result as the output
+# operand.
+
+procedure xvv_binop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+$for (silrd)
+PIXEL	v_$t
+PIXEL	xvv_null$t()
+extern	xvv_null$t()
+$endfor
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+include	"evvexpr.com"
+
+int	xvv_newtype(), strlen()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badswitch "binop: bad case in switch"
+string	s_boolop "binop: bitwise boolean operands must be an integer type"
+define	done_ 91
+
+begin
+	# Set the datatype of the output operand, taking an error action if
+	# the operands have incompatible datatypes.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	switch (dtype) {
+	case TY_BOOL:
+	    call xvv_error ("binop: operation illegal for boolean operands")
+	case TY_CHAR:
+	    nelem = strlen (O_VALC(in1)) + strlen (O_VALC(in2))
+	default:
+	    if (opcode == CONCAT)
+		nelem = max (1, O_LEN(in1)) + max (1, O_LEN(in2))
+	    else {
+		if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		    nelem = min (O_LEN(in1), O_LEN(in2))
+		else if (O_LEN(in1) > 0)
+		    nelem = O_LEN(in1)
+		else if (O_LEN(in2) > 0)
+		    nelem = O_LEN(in2)
+		else
+		    nelem = 0
+	    }
+	}
+
+	# Convert input operands to desired type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case PLUS:
+		# Swap operands.
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+	    case CONCAT:
+		; # Do nothing
+
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    v_$t = O_VAL$T(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovk$t (v_$t, Mem$t[O_VALP(in1)], nelem)
+		$endfor
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, dtype)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# The bitwise boolean binary operators a special case since only the
+	# integer datatypes are permitted.  Otherwise the bitwise booleans
+	# are just like arithmetic booleans.
+
+	if (opcode == BAND || opcode == BOR || opcode == BXOR) {
+	    switch (dtype) {
+$for (sil)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case BAND:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = and (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call aandk$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call aand$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		case BOR:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = or (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call abork$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call abor$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		case BXOR:
+		    if (len1 <= 0) {
+			O_VAL$T(out) = xor (O_VAL$T(in1), O_VAL$T(in2))
+		    } else if (len2 <= 0) {
+			call axork$t (Mem$t[p1], O_VAL$T(in2),
+			    Mem$t[po], nelem)
+		    } else {
+			call axor$t (Mem$t[p1], Mem$t[p2],
+			    Mem$t[po], nelem)
+		    }
+		}
+$endfor
+	    default:
+		call xvv_error (s_boolop)
+	    }
+
+	    goto done_
+	}
+
+	# Perform an arithmetic binary operation.
+	switch (dtype) {
+	case TY_CHAR:
+	    switch (opcode) {
+	    case CONCAT:
+		call strcpy (O_VALC(in1), O_VALC(out), ARB)
+		call strcat (O_VALC(in2), O_VALC(out), ARB)
+	    default:
+		call xvv_error ("binop: operation illegal for string operands")
+	    }
+$for (silrd)
+	case TY_PIXEL:
+	    switch (opcode) {
+	    case PLUS:
+		if (len1 <= 0) {
+		    O_VAL$T(out) = O_VAL$T(in1) + O_VAL$T(in2)
+		} else if (len2 <= 0) {
+		    call aaddk$t (Mem$t[p1], O_VAL$T(in2),
+			Mem$t[po], nelem)
+		} else {
+		    call aadd$t (Mem$t[p1], Mem$t[p2],
+			Mem$t[po], nelem)
+		}
+	    case MINUS:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) - O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call asubk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call asub$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case STAR:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) * O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call amulk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call amul$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case SLASH:
+		if (and (ev_flags, EV_RNGCHK) == 0) {
+		    # No range checking.
+		    if (len1 <= 0)
+			O_VAL$T(out) = O_VAL$T(in1) / O_VAL$T(in2)
+		    else if (len2 <= 0)
+			call adivk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		    else
+			call adiv$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+		} else {
+		    # Check for divide by zero.
+		    if (len1 <= 0) {
+			if (O_VAL$T(in2) == 0$f)
+			    O_VAL$T(out) = xvv_null$t(0$f)
+			else
+			    O_VAL$T(out) = O_VAL$T(in1) / O_VAL$T(in2)
+		    } else if (len2 <= 0) {
+			if (O_VAL$T(in2) == 0$f)
+			    call amovk$t (xvv_null$t(0$f), Mem$t[po], nelem)
+			else {
+			    call adivk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po],
+				nelem)
+			}
+		    } else {
+			call advz$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem,
+			    xvv_null$t)
+		    }
+		}
+	    case EXPON:
+		if (len1 <= 0)
+		    O_VAL$T(out) = O_VAL$T(in1) ** O_VAL$T(in2)
+		else if (len2 <= 0)
+		    call aexpk$t (Mem$t[p1], O_VAL$T(in2), Mem$t[po], nelem)
+		else
+		    call aexp$t (Mem$t[p1], Mem$t[p2], Mem$t[po], nelem)
+
+	    case CONCAT:
+		# Concatenate two numeric operands.
+		if (len1 <= 0) {
+		    Mem$t[po] = O_VAL$T(in1)
+		    po = po + 1
+		} else {
+		    call amov$t (Mem$t[p1], Mem$t[po], len1)
+		    po = po + len1
+		}
+		if (len2 <= 0)
+		    Mem$t[po] = O_VAL$T(in2)
+		else
+		    call amov$t (Mem$t[p2], Mem$t[po], len2)
+
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+$endfor
+	default:
+	    call xvv_error (s_badswitch)
+	}
+done_
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_BOOLOP -- Boolean (actually logical) binary operations.  Perform the
+# indicated logical operation on the two input operands, returning the result
+# as the output operand.  The opcodes implemented by this routine are
+# characterized by the fact that they all return a logical result (YES or NO
+# physically expressed as an integer).
+
+procedure xvv_boolop (opcode, in1, in2, out)
+
+int	opcode			#I operation to be performed
+pointer	in1, in2		#I input operands
+pointer	out			#I output operand
+
+$for (silrd)
+PIXEL	v_$t
+$endfor
+pointer	sp, otemp, p1, p2, po
+int	dtype, nelem, len1, len2
+int	xvv_newtype(), xvv_patmatch(), strncmp(), btoi()
+errchk	xvv_newtype, xvv_initop, xvv_chtype, xvv_error
+string	s_badop "boolop: illegal operation"
+string	s_badswitch "boolop: illegal switch"
+
+begin
+	# Boolean operands are treated as integer within this routine.
+	if (O_TYPE(in1) == TY_BOOL)
+	    O_TYPE(in1) = TY_INT
+	if (O_TYPE(in2) == TY_BOOL)
+	    O_TYPE(in2) = TY_INT
+
+	# Determine the computation type for the operation, i.e., the type
+	# both input operands must have.  This is not the same as the type
+	# of the output operand, which is always boolean for the operations
+	# implemented by this routine.
+
+	dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	# Compute the size of the output operand.  If both input operands are
+	# vectors the length of the output vector is the shorter of the two.
+
+	if (dtype == TY_CHAR)
+	    nelem = 0
+	else {
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+	    else
+		nelem = 0
+	}
+
+	# Convert input operands to desired computation type.
+	if (O_TYPE(in1) != dtype)
+	    call xvv_chtype (in1, in1, dtype)
+	if (O_TYPE(in2) != dtype)
+	    call xvv_chtype (in2, in2, dtype)
+
+	# If this is a scalar/vector operation make sure the vector is the
+	# first operand.
+
+	len1 = O_LEN(in1)
+	len2 = O_LEN(in2)
+
+	if (len1 == 0 && len2 > 0) {
+	    switch (opcode) {
+	    case EQ, NE:
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+	    default:
+		# Promote operand to a constant vector.  Inefficient, but
+		# better than aborting.
+
+		switch (dtype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    v_$t = O_VAL$T(in1)
+		    call xvv_initop (in1, nelem, dtype)
+		    call amovk$t (v_$t, Mem$t[O_VALP(in1)], nelem)
+		$endfor
+		}
+	    }
+
+	    len1 = O_LEN(in1)
+	    len2 = O_LEN(in2)
+	}
+
+	# Initialize the output operand.
+	call xvv_initop (out, nelem, TY_BOOL)
+
+	p1 = O_VALP(in1)
+	p2 = O_VALP(in2)
+	po = O_VALP(out)
+
+	# Perform the operation.
+	if (dtype == TY_CHAR) {
+	    # Character data is a special case.
+
+	    switch (opcode) {
+	    case SE:
+		O_VALI(out) = btoi(xvv_patmatch (O_VALC(in1), O_VALC(in2)) > 0)
+	    case LT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) < 0)
+	    case LE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) <= 0)
+	    case GT:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) > 0)
+	    case GE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) >= 0)
+	    case EQ:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) == 0)
+	    case NE:
+		O_VALI(out) = btoi(strncmp (O_VALC(in1), O_VALC(in2), ARB) != 0)
+	    default:
+		call xvv_error (s_badop)
+	    }
+
+	} else if (opcode == LAND || opcode == LOR) {
+	    # Operations supporting only the integer types.
+
+	    switch (dtype) {
+$for (sil)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case LAND:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VAL$T(in1) != 0 && O_VAL$T(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alank$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    } else
+			call alan$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+		case LOR:
+		    if (len1 <= 0) {
+			O_VALI(out) =
+			    btoi (O_VAL$T(in1) != 0 || O_VAL$T(in2) != 0)
+		    } else if (len2 <= 0) {
+			call alork$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    } else
+			call alor$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+		default:
+		    call xvv_error (s_badop)
+		}
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	} else {
+	    # Operations supporting any arithmetic type.
+
+	    switch (dtype) {
+$for (silrd)
+	    case TY_PIXEL:
+		switch (opcode) {
+		case LT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) < O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abltk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call ablt$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case LE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) <= O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call ablek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call able$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case GT:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) > O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abgtk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abgt$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case GE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) >= O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abgek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abge$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case EQ:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) == O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abeqk$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abeq$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		case NE:
+		    if (len1 <= 0)
+			O_VALI(out) = btoi (O_VAL$T(in1) != O_VAL$T(in2))
+		    else if (len2 <= 0)
+			call abnek$t (Mem$t[p1], O_VAL$T(in2), Memi[po], nelem)
+		    else
+			call abne$t (Mem$t[p1], Mem$t[p2], Memi[po], nelem)
+
+		default:
+		    call xvv_error (s_badop)
+		}
+$endfor
+	    default:
+		call xvv_error (s_badswitch)
+	    }
+	}
+
+	# Free any storage in input operands.
+	call xvv_freeop (in1)
+	call xvv_freeop (in2)
+end
+
+
+# XVV_PATMATCH -- Match a string against a pattern, returning the patmatch
+# index if the string matches.  The pattern may contain any of the conventional
+# pattern matching metacharacters.  Closure (i.e., "*") is mapped to "?*".
+
+int procedure xvv_patmatch (str, pat)
+
+char	str[ARB]		#I operand string
+char	pat[ARB]		#I pattern
+
+int	junk, ip, index
+pointer	sp, patstr, patbuf, op
+int	patmake(), patmatch()
+
+begin
+	call smark (sp)
+	call salloc (patstr, SZ_FNAME, TY_CHAR)
+	call salloc (patbuf, SZ_LINE,  TY_CHAR)
+	call aclrc (Memc[patstr], SZ_FNAME)
+	call aclrc (Memc[patbuf], SZ_LINE)
+
+	# Map pattern, changing '*' into '?*'.
+	op = patstr
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == '*') {
+		Memc[op] = '?'
+		op = op + 1
+	    }
+	    Memc[op] = pat[ip]
+	    op = op + 1
+	}
+
+	# Encode pattern.
+	junk = patmake (Memc[patstr], Memc[patbuf], SZ_LINE)
+
+	# Perform the pattern matching operation.
+	index = patmatch (str, Memc[patbuf])
+
+	call sfree (sp)
+	return (index)
+end
+
+
+# XVV_NEWTYPE -- Get the datatype of a binary operation, given the datatypes
+# of the two input operands.  An error action is taken if the datatypes are
+# incompatible, e.g., boolean and anything else or string and anything else.
+
+int procedure xvv_newtype (type1, type2)
+
+int	type1			#I datatype of first operand
+int	type2			#I datatype of second operand
+
+int	newtype, p, q, i
+int	tyindex[NTYPES], ttbl[NTYPES*NTYPES]
+data	tyindex	/T_B, T_C, T_S, T_I, T_L, T_R, T_D/
+
+data	(ttbl(i),i= 1, 7)	/T_B,    0,    0,    0,    0,    0,    0/
+data	(ttbl(i),i= 8,14)	/  0,  T_C,    0,    0,    0,    0,    0/
+data	(ttbl(i),i=15,21)	/  0,    0,  T_S,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=22,28)	/  0,    0,  T_I,  T_I,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=29,35)	/  0,    0,  T_L,  T_L,  T_L,  T_R,  T_D/
+data	(ttbl(i),i=36,42)	/  0,    0,  T_R,  T_R,  T_R,  T_R,  T_D/
+data	(ttbl(i),i=43,49)	/  0,    0,  T_D,  T_D,  T_D,  T_D,  T_D/
+
+begin
+	do i = 1, NTYPES {
+	    if (tyindex[i] == type1)
+		p = i
+	    if (tyindex[i] == type2)
+		q = i
+	}
+
+	newtype = ttbl[(p-1)*NTYPES+q]
+	if (newtype == 0)
+	    call xvv_error ("operands have incompatible types")
+	else
+	    return (newtype)
+end
+
+
+# XVV_QUEST -- Conditional expression.  If the condition operand is true
+# return the first (true) operand, else return the second (false) operand.
+
+procedure xvv_quest (cond, in1, in2, out)
+
+pointer	cond			#I pointer to condition operand
+pointer	in1, in2		#I pointer to true,false operands
+pointer	out			#I pointer to output operand
+
+int	dtype, nelem, i
+pointer	sp, otemp, ip1, ip2, op, sel
+errchk	xvv_error, xvv_newtype, xvv_initop, xvv_chtype
+int	xvv_newtype(), btoi()
+
+begin
+	switch (O_TYPE(cond)) {
+	case TY_BOOL, TY_INT:
+	    ;
+	case TY_SHORT, TY_LONG:
+	    call xvv_chtype (cond, cond, TY_BOOL)
+	default:
+	    call xvv_error ("evvexpr: nonboolean condition operand")
+	}
+
+	if (O_LEN(cond) <= 0 &&
+	    (O_LEN(in1) <= 0 || O_TYPE(in1) == TY_CHAR) &&
+	    (O_LEN(in2) <= 0 || O_TYPE(in2) == TY_CHAR)) {
+
+	    # Both operands and the conditional are scalars; the expression
+	    # type is the type of the selected operand.
+
+	    if (O_VALI(cond) != 0) {
+		YYMOVE (in1, out)
+		call xvv_freeop (in2)
+	    } else {
+		YYMOVE (in2, out)
+		call xvv_freeop (in1)
+	    }
+
+	} else if (O_TYPE(in1) == TY_CHAR || O_TYPE(in2) == TY_CHAR) {
+	    # This combination is not legal.
+	    call xvv_error ("evvexpr: character and vector in cond expr")
+
+	} else {
+	    # Vector/scalar or vector/vector operation.  Both operands must
+	    # be of the same type.
+
+	    dtype = xvv_newtype (O_TYPE(in1), O_TYPE(in2))
+
+	    # Compute the size of the output operand.  If both input operands
+	    # are vectors the length of the output vector is the shorter of
+	    # the two.  The condition operand contributes to the dimension of
+	    # the expression result, although not to the datatype.
+
+	    nelem = 0
+	    if (O_LEN(in1) > 0 && O_LEN(in2) > 0)
+		nelem = min (O_LEN(in1), O_LEN(in2))
+	    else if (O_LEN(in1) > 0)
+		nelem = O_LEN(in1)
+	    else if (O_LEN(in2) > 0)
+		nelem = O_LEN(in2)
+
+	    if (O_LEN(cond) > 0 && nelem > 0)
+		nelem = min (O_LEN(cond), nelem)
+	    else if (O_LEN(cond) > 0)
+		nelem = O_LEN(cond)
+
+	    # If this is a scalar/vector operation make sure the vector is the
+	    # first operand.
+
+	    if (O_LEN(in1) == 0 && O_LEN(in2) > 0) {
+		call smark (sp)
+		call salloc (otemp, LEN_OPERAND, TY_STRUCT)
+		YYMOVE (in1, otemp)
+		YYMOVE (in2, in1)
+		YYMOVE (otemp, in2)
+		call sfree (sp)
+
+		# Since we are swapping arguments we need to negate the cond.
+		if (O_LEN(cond) <= 0)
+		    O_VALI(cond) = btoi (O_VALI(cond) == 0)
+		else {
+		    call abeqki (Memi[O_VALP(cond)], NO, Memi[O_VALP(cond)],
+			nelem)
+		}
+	    }
+
+	    # Initialize the output operand.
+	    call xvv_initop (out, nelem, dtype)
+
+	    # Convert input operands to desired computation type.
+	    if (O_TYPE(in1) != dtype)
+		call xvv_chtype (in1, in1, dtype)
+	    if (O_TYPE(in2) != dtype)
+		call xvv_chtype (in2, in2, dtype)
+
+	    ip1 = O_VALP(in1)
+	    ip2 = O_VALP(in2)
+	    op  = O_VALP(out)
+	    sel = O_VALP(cond)
+
+	    # Perform the operation.
+	    switch (dtype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(in1) <= 0 && O_LEN(in2) <= 0) {
+		    # Vector conditional, both operands are scalars.
+		    do i = 1, nelem
+			if (Memi[sel+i-1] != 0)
+			    Mem$t[op+i-1] = O_VAL$T(in1)
+			else
+			    Mem$t[op+i-1] = O_VAL$T(in2)
+
+		} else if (O_LEN(in2) <= 0) {
+		    # Operand 1 is a vector, operand 2 is a scalar.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amov$t (Mem$t[ip1], Mem$t[op], nelem)
+			else
+			    call amovk$t (O_VAL$T(in2), Mem$t[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call aselk$t (Mem$t[ip1], O_VAL$T(in2), Mem$t[op],
+			    Memi[sel], nelem)
+		    }
+		} else {
+		    # Both operands are vectors.
+		    if (O_LEN(cond) <= 0) {
+			# Conditional is a scalar.
+			if (O_VALI(cond) != 0)
+			    call amov$t (Mem$t[ip1], Mem$t[op], nelem)
+			else
+			    call amov$t (Mem$t[ip2], Mem$t[op], nelem)
+		    } else {
+			# Conditional is a vector.
+			call asel$t (Mem$t[ip1], Mem$t[ip2], Mem$t[op],
+			    Memi[sel], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error ("evvexpr: bad datatype in cond expr")
+	    }
+
+	    call xvv_freeop (in1)
+	    call xvv_freeop (in2)
+	}
+
+	call xvv_freeop (cond)
+end
+
+
+# XVV_CALLFCN -- Call an intrinsic function.  If the function named is not
+# one of the standard intrinsic functions, call an external user function
+# if a function call procedure was supplied.
+
+procedure xvv_callfcn (fcn, args, nargs, out)
+
+char	fcn[ARB]		#I function to be called
+pointer	args[ARB]		#I pointer to arglist descriptor
+int	nargs			#I number of arguments
+pointer	out			#I output operand (function value)
+
+$for (silrd)
+PIXEL	v_$t
+PIXEL	ahiv$t(), alov$t()
+PIXEL	amed$t()
+int	arav$t()
+$endfor
+
+real	mean_r, sigma_r
+double	mean_d, sigma_d
+real	asums(), asumi(), asumr()
+double	asuml(), asumd()
+
+bool	rangecheck
+int	optype, opcode
+int	chunk, repl, nelem, v_nargs, ch, shift, i, j
+pointer	sp, sym, buf, ap, ip, op, in1, in2
+include	"evvexpr.com"
+
+pointer	stfind()
+int	xvv_newtype(), strlen(), gctod(), btoi()
+errchk	xvv_chtype, xvv_initop, xvv_newtype, xvv_error1, xvv_error2
+errchk	zcall5, malloc
+
+string	s_badtype "%s: illegal operand type"
+define	free_ 91
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_FNAME, TY_CHAR)
+
+	# Lookup the function name in the symbol table.
+	sym = stfind (ev_st, fcn)
+	if (sym != NULL)
+	    opcode = SYM_CODE(sym)
+	else
+	    opcode = 0
+
+	# If the function named is not a standard one and the user has supplied
+	# the entry point of an external function evaluation procedure, call
+	# the user procedure to evaluate the function, otherwise abort.
+
+	if (opcode <= 0)
+	    if (ev_ufcn != NULL) {
+		call zcall5 (ev_ufcn, ev_ufcn_data, fcn, args, nargs, out)
+		if (O_TYPE(out) <= 0)
+		    call xvv_error1 ("unrecognized macro or function `%s'", fcn)
+		goto free_
+	    } else
+		call xvv_error1 ("unknown function `%s' called", fcn)
+
+	# Range checking on functions that need it?
+	rangecheck = (and (ev_flags, EV_RNGCHK) != 0)
+
+	# Verify correct number of arguments.
+	switch (opcode) {
+	case F_MOD, F_REPL, F_SHIFT:
+	    v_nargs = 2
+	case F_MAX, F_MIN, F_ATAN, F_ATAN2, F_MEAN, F_STDDEV, F_MEDIAN:
+	    v_nargs = -1
+	default:
+	    v_nargs = 1
+	}
+	if (v_nargs > 0 && nargs != v_nargs)
+	    call xvv_error2 ("function `%s' requires %d arguments",
+		fcn, v_nargs)
+	else if (v_nargs < 0 && nargs < abs(v_nargs))
+	    call xvv_error2 ("function `%s' requires at least %d arguments",
+		fcn, abs(v_nargs))
+
+	# Some functions require that the input operand be a certain type,
+	# e.g. floating.  Handle the simple cases, converting input operands
+	# to the desired type.
+
+	switch (opcode) {
+	case F_ACOS, F_ASIN, F_ATAN, F_ATAN2, F_COS, F_COSH, F_DEG, F_EXP,
+	     F_LOG, F_LOG10, F_RAD, F_SIN, F_SINH, F_SQRT, F_TAN, F_TANH:
+
+	    # These functions want a floating point input operand.
+	    optype = TY_REAL
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) == TY_DOUBLE || O_TYPE(args[i]) == TY_LONG)
+		    optype = TY_DOUBLE
+	    }
+	    do i = 1, nargs {
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+	    }
+	    call xvv_initop (out, O_LEN(args[1]), optype)
+
+	case F_MOD, F_MIN, F_MAX, F_MEDIAN:
+	    # These functions may have multiple arguments, all of which
+	    # should be the same type.
+
+	    optype = O_TYPE(args[1])
+	    nelem = O_LEN(args[1])
+	    do i = 2, nargs {
+		optype = xvv_newtype (optype, args[i])
+		if (O_LEN(args[i]) > 0)
+		    if (nelem > 0)
+			nelem = min (nelem, O_LEN(args[i]))
+		    else if (nelem == 0)
+			nelem = O_LEN(args[i])
+	    }
+
+	    do i = 1, nargs
+		if (O_TYPE(args[i]) != optype)
+		    call xvv_chtype (args[i], args[i], optype)
+
+	    if (nargs == 1 && opcode == F_MEDIAN)
+		nelem = 0
+	    call xvv_initop (out, nelem, optype)
+
+	case F_LEN:
+	    # This function always returns an integer scalar value.
+	    nelem = 0
+	    optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_HIV, F_LOV:
+	    # These functions return a scalar value.
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    call xvv_initop (out, nelem, optype)
+
+	case F_SUM, F_MEAN, F_STDDEV:
+	    # These functions require a vector argument and return a scalar
+	    # value.
+
+	    nelem = 0
+	    optype = O_TYPE(args[1])
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+	    
+	    if (optype == TY_DOUBLE)
+		call xvv_initop (out, nelem, TY_DOUBLE)
+	    else
+		call xvv_initop (out, nelem, TY_REAL)
+
+	case F_SORT, F_SHIFT:
+	    # Vector to vector, no type conversions.
+	    nelem = O_LEN(args[1])
+	    optype = O_TYPE(args[1])
+	    call xvv_initop (out, nelem, optype)
+
+	default:
+	    optype = 0
+	}
+
+	# Evaluate the function.
+	ap = args[1]
+
+	switch (opcode) {
+	case F_ABS:
+	    call xvv_initop (out, O_LEN(ap), O_TYPE(ap))
+	    switch (O_TYPE(ap)) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0) {
+		    call aabs$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)],
+			O_LEN(ap))
+		} else
+		    O_VAL$T(out) = abs(O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ACOS:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = acos (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = acos (O_VAL$T(ap))
+	    $endfor
+	case F_ASIN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = asin (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = asin (O_VAL$T(ap))
+	    $endfor
+	case F_COS:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = cos (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = cos (O_VAL$T(ap))
+	    $endfor
+	case F_COSH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = cosh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = cosh (O_VAL$T(ap))
+	    $endfor
+	case F_DEG:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = RADTODEG(Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = RADTODEG (O_VAL$T(ap))
+	    $endfor
+	case F_EXP:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = exp (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = exp (O_VAL$T(ap))
+	    $endfor
+	case F_LOG:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t <= 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = log (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = log (v_$t)
+		}
+	    $endfor
+	case F_LOG10:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t <= 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = log10 (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = log10 (v_$t)
+		}
+	    $endfor
+	case F_RAD:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = DEGTORAD(Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = DEGTORAD (O_VAL$T(ap))
+	    $endfor
+	case F_SIN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = sin (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = sin (O_VAL$T(ap))
+	    $endfor
+	case F_SINH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = sinh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = sinh (O_VAL$T(ap))
+	    $endfor
+	case F_SQRT:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    op = O_VALP(out)
+		    do i = 1, O_LEN(ap) {
+			v_$t = Mem$t[O_VALP(ap)+i-1]
+			if (rangecheck && v_$t < 0)
+			    Mem$t[op] = 0
+			else
+			    Mem$t[op] = sqrt (v_$t)
+			op = op + 1
+		    }
+		} else {
+		    v_$t = O_VAL$T(ap)
+		    if (rangecheck && v_$t <= 0)
+			O_VAL$T(out) = 0
+		    else
+			O_VAL$T(out) = sqrt (v_$t)
+		}
+	    $endfor
+	case F_TAN:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = tan (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = tan (O_VAL$T(ap))
+	    $endfor
+	case F_TANH:
+	    $for (rd)
+	    if (optype == TY_PIXEL) 
+		if (O_LEN(ap) > 0) {
+		    do i = 1, O_LEN(ap)
+			Mem$t[O_VALP(out)+i-1] = tanh (Mem$t[O_VALP(ap)+i-1])
+		} else
+		    O_VAL$T(out) = tanh (O_VAL$T(ap))
+	    $endfor
+
+	case F_LEN:
+	    # Vector length.
+	    O_VALI(out) = O_LEN(ap)
+
+	case F_HIV:
+	    # High value.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    O_VAL$T(out) = ahiv$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VAL$T(out) = O_VAL$T(ap)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+	case F_LOV:
+	    # Low value.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    O_VAL$T(out) = alov$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    O_VAL$T(out) = O_VAL$T(ap)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SUM:
+	    # Vector sum.
+	    switch (optype) {
+	    $for (silr)
+	    case TY_PIXEL:
+		if (O_LEN(ap) > 0)
+		    v_r = asum$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_r = O_VAL$T(ap)
+	    $endfor
+	    case TY_DOUBLE:
+		if (O_LEN(ap) > 0)
+		    v_d = asumd (Memd[O_VALP(ap)], O_LEN(ap))
+		else
+		    v_d = O_VALD(ap)
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (optype == TY_DOUBLE)
+		O_VALD(out) = v_d
+	    else
+		O_VALR(out) = v_r
+
+	case F_MEAN, F_STDDEV:
+	    # Compute the mean or standard deviation of a vector.  An optional
+	    # second argument may be supplied to compute a K-sigma rejection
+	    # mean and sigma.
+
+	    if (nargs == 2) {
+		if (O_LEN(args[2]) > 0)
+		    call xvv_error1 ("%s: ksigma arg must be a scalar" , fcn)
+
+		switch (O_TYPE(args[2])) {
+		case TY_REAL:
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		case TY_DOUBLE:
+		    v_d = O_VALD(args[2])
+		    v_r = v_d
+		default:
+		    call xvv_chtype (args[2], args[2], TY_REAL)
+		    v_r = O_VALR(args[2])
+		    v_d = v_r
+		}
+	    } else {
+		v_r = 0.0
+		v_d = 0.0
+	    }
+
+	    switch (optype) {
+	    $for (sir)
+	    case TY_PIXEL:
+		v_i = arav$t (Mem$t[O_VALP(ap)], O_LEN(ap), mean_r,sigma_r,v_r)
+	    $endfor
+	    $for (ld)
+	    case TY_PIXEL:
+		v_i = arav$t (Mem$t[O_VALP(ap)], O_LEN(ap), mean_d,sigma_d,v_d)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	    if (opcode == F_MEAN) {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = mean_r
+		else
+		    O_VALD(out) = mean_d
+	    } else {
+		if (O_TYPE(out) == TY_REAL)
+		    O_VALR(out) = sigma_r
+		else
+		    O_VALD(out) = sigma_d
+	    }
+
+	case F_MEDIAN:
+	    # Compute the median value of a vector, or the vector median
+	    # of 3 or more vectors.
+
+	    switch (nargs) {
+	    case 1:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    O_VAL$T(out) = amed$t (Mem$t[O_VALP(ap)], O_LEN(ap))
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 3:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed3$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 4:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed4$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(args[4])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    case 5:
+		switch (optype) {
+		$for (silrd)
+		case TY_PIXEL:
+		    call amed5$t (Mem$t[O_VALP(args[1])],
+				  Mem$t[O_VALP(args[2])],
+				  Mem$t[O_VALP(args[3])],
+				  Mem$t[O_VALP(args[4])],
+				  Mem$t[O_VALP(args[5])],
+				  Mem$t[O_VALP(out)], nelem)
+		$endfor
+		default:
+		    call xvv_error1 (s_badtype, fcn)
+		}
+	    default:
+		call xvv_error1 ("%s: wrong number of arguments", fcn)
+	    }
+
+	case F_REPL:
+	    # Replicate an item to make a longer vector.
+
+	    chunk = O_LEN(ap)
+	    optype = O_TYPE(ap)
+	    if (optype == TY_BOOL)
+		optype = TY_INT
+
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: replication factor must be a scalar", fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    repl = max (1, O_VALI(args[2]))
+
+	    if (chunk <= 0)
+		nelem = repl
+	    else
+		nelem = chunk * repl
+	    call xvv_initop (out, nelem, optype)
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (chunk > 0) {
+		    ip = O_VALP(ap)
+		    op = O_VALP(out)
+		    do i = 1, repl {
+			call amov$t (Mem$t[ip], Mem$t[op], chunk)
+			op = op + chunk
+		    }
+		} else
+		    call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHIFT:
+	    # Vector shift.
+	    if (O_LEN(args[2]) > 0)
+		call xvv_error1 ("%s: shift arg must be a scalar" , fcn)
+	    if (O_TYPE(args[2]) != TY_INT)
+		call xvv_chtype (args[2], args[2], TY_INT)
+	    shift = O_VALI(args[2])
+
+	    if (abs(shift) > nelem) {
+		if (shift > 0)
+		    shift = nelem
+		else
+		    shift = -nelem
+	    }
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0) {
+		    do i = 1, nelem {
+			j = i - shift
+			if (j < 1)
+			    j = j + nelem
+			else if (j > nelem)
+			    j = j - nelem
+			Mem$t[O_VALP(out)+i-1] = Mem$t[O_VALP(ap)+j-1]
+		    }
+		} else
+		    O_VAL$T(out) = (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SORT:
+	    # Sort a vector.
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (nelem > 0)
+		    call asrt$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+		else
+		    O_VAL$T(out) = (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_ATAN, F_ATAN2:
+	    $for (rd)
+	    if (optype == TY_PIXEL) {
+		if (nargs == 1) {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Mem$t[O_VALP(out)+i-1] =
+				atan (Mem$t[O_VALP(ap)+i-1])
+		    } else
+			O_VAL$T(out) = atan (O_VAL$T(ap))
+		} else {
+		    if (O_LEN(ap) > 0) {
+			do i = 1, O_LEN(ap)
+			    Mem$t[O_VALP(out)+i-1] =
+				atan2 (Mem$t[O_VALP(args[1])+i-1],
+				       Mem$t[O_VALP(args[2])+i-1])
+		    } else
+			O_VAL$T(out) = atan2(O_VAL$T(args[1]), O_VAL$T(args[2]))
+		}
+	    }
+	    $endfor
+
+	case F_MOD:
+	    in1 = args[1]
+	    in2 = args[2]
+
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(in1) <= 0) {
+		    O_VAL$T(out) = mod (O_VAL$T(in1), O_VAL$T(in2))
+		} else if (O_LEN(in2) <= 0) {
+		    call amodk$t (Mem$t[O_VALP(in1)], O_VAL$T(in2),
+			Mem$t[O_VALP(out)], nelem)
+		} else {
+		    call amod$t (Mem$t[O_VALP(in1)], Mem$t[O_VALP(in2)],
+			Mem$t[O_VALP(out)], nelem)
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MAX:
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+		    else
+			O_VAL$T(out) = O_VAL$T(ap)
+		} else
+		    call amov$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VAL$T(out) = max (O_VAL$T(ap), O_VAL$T(out))
+			else {
+			    call amaxk$t (Mem$t[O_VALP(out)], O_VAL$T(ap),
+				Mem$t[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amax$t (Mem$t[O_VALP(out)], Mem$t[O_VALP(ap)],
+			    Mem$t[O_VALP(out)], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_MIN:
+	    switch (optype) {
+	    $for (silrd)
+	    case TY_PIXEL:
+		# Copy the first argument.
+		ap = args[1]
+		if (O_LEN(ap) <= 0) {
+		    if (O_LEN(out) > 0)
+			call amovk$t (O_VAL$T(ap), Mem$t[O_VALP(out)], nelem)
+		    else
+			O_VAL$T(out) = O_VAL$T(ap)
+		} else
+		    call amov$t (Mem$t[O_VALP(ap)], Mem$t[O_VALP(out)], nelem)
+
+		# Process the second and remaining arguments.
+		do i = 2, nargs {
+		    ap = args[i]
+		    if (O_LEN(ap) <= 0) {
+			if (O_LEN(out) <= 0)
+			    O_VAL$T(out) = min (O_VAL$T(ap), O_VAL$T(out))
+			else {
+			    call amink$t (Mem$t[O_VALP(out)], O_VAL$T(ap),
+				Mem$t[O_VALP(out)], nelem)
+			}
+		    } else {
+			call amin$t (Mem$t[O_VALP(out)], Mem$t[O_VALP(ap)],
+			    Mem$t[O_VALP(out)], nelem)
+		    }
+		}
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_BOOL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_BOOL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ch = O_VALC(ap)
+		O_VALI(out) = btoi (ch == 'y' || ch == 'Y')
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = btoi (O_VAL$T(ap) != 0$f)
+		else {
+		    v_$t = 0$f
+		    call abnek$t (Mem$t[O_VALP(ap)], v_$t, Memi[O_VALP(out)],
+			nelem)
+		}
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_SHORT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_SHORT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VALI(ap)
+		else
+		    call achtis (Memi[O_VALP(ap)], Mems[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALS(out) = 0
+		else
+		    O_VALS(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALS(out) = O_VAL$T(ap)
+		else
+		    call acht$ts (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_INT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VAL$T(ap)
+		else
+		    call acht$ti (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_LONG:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_LONG)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Meml[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALL(out) = 0
+		else
+		    O_VALL(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALL(out) = O_VAL$T(ap)
+		else
+		    call acht$tl (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_NINT:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_INT)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VALI(ap)
+		else
+		    call amovi (Memi[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALI(out) = 0
+		else
+		    O_VALI(out) = nint (v_d)
+
+	    $for (sil)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = O_VAL$T(ap)
+		else
+		    call acht$ti (Mem$t[O_VALP(ap)], Memi[O_VALP(out)], nelem)
+	    $endfor
+
+	    $for (rd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALI(out) = nint (O_VAL$T(ap))
+		else {
+		    do i = 1, nelem
+			Memi[O_VALP(out)+i-1] = nint (Mem$t[O_VALP(ap)+i-1])
+		}
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_REAL:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_REAL)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VALI(ap)
+		else
+		    call achtir (Memi[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALR(out) = 0
+		else
+		    O_VALR(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALR(out) = O_VAL$T(ap)
+		else
+		    call acht$tr (Mem$t[O_VALP(ap)], Memr[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_DOUBLE:
+	    nelem = 0
+	    if (O_LEN(ap) > 0 && O_TYPE(ap) != TY_CHAR)
+		nelem = O_LEN(ap)
+	    call xvv_initop (out, nelem, TY_DOUBLE)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VALI(ap)
+		else
+		    call achtid (Memi[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+
+	    case TY_CHAR:
+		ip = O_VALP(ap)
+		if (gctod (Memc, ip, v_d) <= 0)
+		    O_VALD(out) = 0
+		else
+		    O_VALD(out) = v_d
+
+	    $for (silrd)
+	    case TY_PIXEL:
+		if (O_LEN(ap) <= 0)
+		    O_VALD(out) = O_VAL$T(ap)
+		else
+		    call acht$td (Mem$t[O_VALP(ap)], Memd[O_VALP(out)], nelem)
+	    $endfor
+
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	case F_STR:
+	    optype = TY_CHAR
+	    if (O_TYPE(ap) == TY_CHAR)
+		nelem = strlen (O_VALC(ap))
+	    else
+		nelem = MAX_DIGITS
+	    call xvv_initop (out, nelem, TY_CHAR)
+
+	    switch (O_TYPE(ap)) {
+	    case TY_BOOL:
+		call sprintf (O_VALC(out), nelem, "%b")
+		    call pargi (O_VALI(ap))
+	    case TY_CHAR:
+		call sprintf (O_VALC(out), nelem, "%s")
+		    call pargstr (O_VALC(ap))
+	    $for (sil)
+	    case TY_PIXEL:
+		call sprintf (O_VALC(out), nelem, "%d")
+		    call parg$t (O_VAL$T(ap))
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		call sprintf (O_VALC(out), nelem, "%g")
+		    call parg$t (O_VAL$T(ap))
+	    $endfor
+	    default:
+		call xvv_error1 (s_badtype, fcn)
+	    }
+
+	default:
+	    call xvv_error ("callfcn: unknown function type")
+	}
+
+free_
+	# Free any storage used by the argument list operands.
+	do i = 1, nargs
+	    call xvv_freeop (args[i])
+
+	call sfree (sp)
+end
+
+
+# XVV_STARTARGLIST -- Allocate an argument list descriptor to receive
+# arguments as a function call is parsed.  We are called with either
+# zero or one arguments.  The argument list descriptor is pointed to by
+# a ficticious operand.  The descriptor itself contains a count of the
+# number of arguments, an array of pointers to the operand structures,
+# as well as storage for the operand structures.  The operands must be
+# stored locally since the parser will discard its copy of the operand
+# structure for each argument as the associated grammar rule is reduced.
+
+procedure xvv_startarglist (arg, out)
+
+pointer	arg			#I pointer to first argument, or NULL
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap
+errchk	xvv_initop
+
+begin
+	call xvv_initop (out, LEN_ARGSTRUCT, TY_STRUCT)
+	ap = O_VALP(out)
+
+	if (arg == NULL)
+	    A_NARGS(ap) = 0
+	else {
+	    A_NARGS(ap) = 1
+	    A_ARGP(ap,1) = A_OPS(ap)
+	    YYMOVE (arg, A_OPS(ap))
+	}
+end
+
+
+# XVV_ADDARG -- Add an argument to the argument list for a function call.
+
+procedure xvv_addarg (arg, arglist, out)
+
+pointer	arg			#I pointer to argument to be added
+pointer	arglist			#I pointer to operand pointing to arglist
+pointer	out			#I output operand pointing to arg descriptor
+
+pointer	ap, o
+int	nargs
+
+begin
+	ap = O_VALP(arglist)
+
+	nargs = A_NARGS(ap) + 1
+	A_NARGS(ap) = nargs
+	if (nargs > MAX_ARGS)
+	    call xvv_error ("too many function arguments")
+
+	o = A_OPS(ap) + ((nargs - 1) * LEN_OPERAND)
+	A_ARGP(ap,nargs) = o
+	YYMOVE (arg, o)
+
+	YYMOVE (arglist, out)
+end
+
+
+# XVV_ERROR1 -- Take an error action, formatting an error message with one
+# format string plus one string argument.
+
+procedure xvv_error1 (fmt, arg)
+
+char	fmt[ARB]		#I printf format string
+char	arg[ARB]		#I string argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR2 -- Take an error action, formatting an error message with one
+# format string plus one string argument and one integer argument.
+
+procedure xvv_error2 (fmt, arg1, arg2)
+
+char	fmt[ARB]		#I printf format string
+char	arg1[ARB]		#I string argument
+int	arg2			#I integer argument
+
+pointer	sp, buf
+
+begin
+	call smark (sp)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+
+	call sprintf (Memc[buf], SZ_LINE, fmt)
+	    call pargstr (arg1)
+	    call pargi (arg2)
+
+	call xvv_error (Memc[buf])
+	call sfree (sp)
+end
+
+
+# XVV_ERROR -- Take an error action, given an error message string as the
+# sole argument.
+
+procedure xvv_error (errmsg)
+
+char	errmsg[ARB]			#I error message
+
+begin
+	call error (1, errmsg)
+end
+
+
+# XVV_CHTYPE -- Change the datatype of an operand.  The input and output
+# operands may be the same.
+
+procedure xvv_chtype (o1, o2, dtype)
+
+pointer	o1		#I input operand
+pointer	o2		#I output operand
+int	dtype		#I new datatype
+
+short	v_s
+int	v_i
+long	v_l
+real	v_r
+double	v_d
+pointer	vp, ip, op
+bool	float, freeval
+int	old_type, nelem, ch
+
+pointer	coerce()
+int	sizeof(), btoi(), gctod()
+string	s_badtype "chtype: invalid operand type"
+
+begin
+	old_type = O_TYPE(o1)
+	nelem = O_LEN(o1)
+
+	# No type conversion needed?
+	if (old_type == dtype) {
+	    if (o1 != o2) {
+		if (nelem <= 0)
+		    YYMOVE (o1, o2)
+		else {
+		    call xvv_initop (o2, nelem, old_type)
+		    call amovc (O_VALC(o1), O_VALC(o2), nelem * sizeof(dtype))
+		}
+	    }
+	    return
+	}
+
+	if (nelem <= 0) {
+	    # Scalar input operand.
+
+	    O_TYPE(o2) = dtype
+	    O_LEN(o2) = 0
+	    float = false
+
+	    # Read the old value into a local variable of type long or double.
+	    switch (old_type) {
+	    case TY_BOOL:
+		v_l = O_VALI(o1)
+	    case TY_CHAR:
+		v_l = 0  # null string?
+	    $for (sil)
+	    case TY_PIXEL:
+		v_l = O_VAL$T(o1)
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		v_d = O_VAL$T(o1)
+		float = true
+	    $endfor
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Set the value of the output operand.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (float)
+		    O_VALI(o2) = btoi (v_d != 0)
+		else
+		    O_VALI(o2) = btoi (v_l != 0)
+	    case TY_CHAR:
+		call xvv_initop (o2, MAX_DIGITS, TY_CHAR)
+		if (float) {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%g")
+			call pargd (v_d)
+		} else {
+		    call sprintf (O_VALC(o2), MAX_DIGITS, "%d")
+			call pargl (v_l)
+		}
+	    $for (sil)
+	    case TY_PIXEL:
+		if (float)
+		    O_VAL$T(o2) = v_d
+		else
+		    O_VAL$T(o2) = v_l
+	    $endfor
+	    $for (rd)
+	    case TY_PIXEL:
+		if (float)
+		    O_VAL$T(o2) = v_d
+		else
+		    O_VAL$T(o2) = v_l
+	    $endfor
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	} else {
+	    # Vector input operand.
+
+	    # Save a pointer to the input operand data vector, to avoid it
+	    # getting clobbered if O1 and O2 are the same operand.
+
+	    vp = O_VALP(o1)
+
+	    # If we have a char string input operand the output numeric
+	    # operand can only be a scalar.  If we have a char string output
+	    # operand nelem is the length of the string.
+
+	    if (old_type == TY_CHAR)
+		nelem = 0
+	    else if (dtype == TY_CHAR)
+		nelem = MAX_DIGITS
+
+	    # Initialize the output operand O2.  The freeval flag is cleared
+	    # cleared to keep the initop from freeing the input operand array,
+	    # inherited when the input operand is copied (or when the input
+	    # and output operands are the same).  We free the old operand
+	    # array manually below.
+
+	    if (o1 != o2)
+		YYMOVE (o1, o2)
+	    freeval = (and (O_FLAGS(o1), O_FREEVAL) != 0)
+	    O_FLAGS(o2) = and (O_FLAGS(o2), not(O_FREEVAL))
+	    call xvv_initop (o2, nelem, dtype)
+
+	    # Write output value.
+	    switch (dtype) {
+	    case TY_BOOL:
+		if (old_type == TY_CHAR) {
+		    ch = Memc[vp]
+		    O_VALI(o2) = btoi (ch == 'y' || ch == 'Y')
+		} else {
+		    switch (old_type) {
+		    $for (silrd)
+		    case TY_PIXEL:
+			v_$t = 0$f
+			call abnek$t (Mem$t[vp], v_$t, Memi[O_VALP(o2)], nelem)
+		    $endfor
+		    default:
+			call xvv_error (s_badtype)
+		    }
+		}
+
+	    case TY_CHAR:
+		call xvv_error (s_badtype)
+
+	    case TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE:
+		switch (old_type) {
+		case TY_BOOL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call achti (Memi[vp], Memc[op], nelem, dtype)
+		case TY_CHAR:
+		    ip = vp
+		    if (gctod (Memc, ip, v_d) <= 0)
+			v_d = 0
+		    switch (dtype) {
+		    $for (silrd)
+		    case TY_PIXEL:
+			O_VAL$T(o2) = v_d
+		    $endfor
+		    }
+		$for (silrd)
+		case TY_PIXEL:
+		    op = coerce (O_VALP(o2), O_TYPE(o2), TY_CHAR)
+		    call acht$t (Mem$t[vp], Memc[op], nelem, dtype)
+		$endfor
+		default:
+		    call xvv_error (s_badtype)
+		}
+	    default:
+		call xvv_error (s_badtype)
+	    }
+
+	    # Free old operand value.
+	    if (freeval)
+		call mfree (vp, old_type)
+	}
+end
+
+
+# XVV_INITOP -- Initialize an operand, providing storage for an operand value
+# of the given size and type.
+
+procedure xvv_initop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+begin
+	O_LEN(o) = 0
+	call xvv_makeop (o, o_len, o_type)
+end
+
+
+# XVV_MAKEOP -- Set up the operand structure.  If the operand structure has
+# already been initialized and array storage allocated, free the old array.
+
+procedure xvv_makeop (o, o_len, o_type)
+
+pointer	o		#I pointer to operand structure
+int	o_len		#I length of operand (zero if scalar)
+int	o_type		#I datatype of operand
+
+errchk	malloc
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Set new operand type.
+	O_TYPE(o) = o_type
+
+	# Allocate array storage if nonscalar operand.
+	if (o_len > 0) {
+	    if (o_type == TY_BOOL)
+		call malloc (O_VALP(o), o_len, TY_INT)
+	    else
+		call malloc (O_VALP(o), o_len, o_type)
+	    O_LEN(o) = o_len
+	}
+
+	O_FLAGS(o) = O_FREEVAL
+end
+
+
+# XVV_FREEOP -- Reinitialize an operand structure, i.e., free any associated
+# array storage and clear the operand datatype field, but do not free the
+# operand structure itself (which may be only a segment of an array and not
+# a separately allocated structure).
+
+procedure xvv_freeop (o)
+
+pointer	o		#I pointer to operand structure
+
+begin
+	# Free old array storage if any.
+	if (O_TYPE(o) != 0 && O_LEN(o) > 0)
+	    if (and (O_FLAGS(o), O_FREEVAL) != 0) {
+		if (O_TYPE(o) == TY_BOOL)
+		    call mfree (O_VALP(o), TY_INT)
+		else
+		    call mfree (O_VALP(o), O_TYPE(o))
+		O_LEN(o) = 0
+	    }
+
+	# Either free operand struct or clear the operand type to mark
+	# operand invalid.
+
+	if (and (O_FLAGS(o), O_FREEOP) != 0)
+	    call mfree (o, TY_STRUCT)
+	else
+	    O_TYPE(o) = 0
+end
+
+
+# XVV_LOADSYMBOLS -- Load a list of symbol names into a symbol table.  Each
+# symbol is tagged with an integer code corresponding to its sequence number
+# in the symbol list.
+
+pointer procedure xvv_loadsymbols (s)
+
+char	s[ARB]			#I symbol list "|sym1|sym2|...|"
+
+int	delim, symnum, ip
+pointer	sp, symname, st, sym, op
+pointer	stopen(), stenter()
+
+begin
+	call smark (sp)
+	call salloc (symname, SZ_FNAME, TY_CHAR)
+
+	st = stopen ("evvexpr", LEN_INDEX, LEN_STAB, LEN_SBUF)
+	delim = s[1]
+	symnum = 0
+
+	for (ip=2;  s[ip] != EOS;  ip=ip+1) {
+	    op = symname
+	    while (s[ip] != delim && s[ip] != EOS) {
+		Memc[op] = s[ip]
+		op = op + 1
+		ip = ip + 1
+	    }
+	    Memc[op] = EOS
+	    symnum = symnum + 1
+
+	    if (op > symname && IS_ALPHA(Memc[symname])) {
+		sym = stenter (st, Memc[symname], LEN_SYM)
+		SYM_CODE(sym) = symnum
+	    }
+	}
+
+	call sfree (sp)
+	return (st)
+end
+
+
+# XVV_NULL -- Return a null value to be used when a computation cannot be
+# performed and range checking is enabled.  Perhaps we should permit a user
+# specified value here, however this doesn't really work in an expression
+# evaluator since the value generated may be used in subsequent calculations
+# and hence may change.  If more careful treatment of out of range values
+# is needed a conditional expression can be used in which case the value
+# we return here is ignored (but still needed to avoid a hardware exception
+# when computing a vector).
+
+$for (silrd)
+PIXEL procedure xvv_null$t (ignore)
+PIXEL	ignore			#I ignored
+begin
+	return (0$f)
+end
+$endfor