include	<mach.h>
include	"eval.h"

# Evaluation stack depth
define	STACK_DEPTH		50


# FC_EVAL[RD] - Evaluate an RPN code expression generated by the parser. This
# procedure checks for consistency in the input (although the code generated
# by the parser should be correct) and for stack underflow and overflow.
# The underflow can only happen under wrong generated code, but overflow
# can happen in complex expressions. This is not a syntactic, but related
# with the number of parenthesis used in the original source code expression.
# Illegal operations, such as division by zero, return and undefined value.

PIXEL procedure fc_eval$t (code, fptr, warnings)

pointer	code			# RPN code buffer
pointer	fptr			# file structures
bool	warnings		# print warnings ?

char	str[SZ_LINE]
int	ival, dtype
int	ip, sp			# instruction and stack pointers
int	ins			# current instruction code
PIXEL	stack[STACK_DEPTH]	# evaluation stack
real	rval
double	dval

int	fc_fdata(), fc_cgeti()
real	fc_cgetr()
PIXEL	fc_vmin$t(), fc_vmax$t()
PIXEL	fc_vavg$t(), fc_vmed$t(), fc_vmode$t(), fc_vsigma$t()
double	fc_cgetd()

begin
#call eprintf ("code=%x, fptr=%x\n")
#call pargi (code)
#call pargi (fptr)

	# Set the instruction pointer (offset from the
	# beginning) to the first instruction in the buffer
	ip = 0

	# Get first instruction from the code buffer
	ins = Memi[code + ip]

	# Reset execution stack pointer
	sp = 0

	# Loop reading instructions from the code buffer
	# until the end-of-code instruction is found
	while (ins != PEV_EOC) {

#call eprintf ("sp=%d, ip=%d, ins=%d\n")
#call pargi (sp)
#call pargi (ip)
#call pargi (ins)

	    # Branch on the instruction type
	    switch (ins) {

	    case PEV_INUMBER:
		ip = ip + 1
		sp = sp + 1
		ival = fc_cgeti (Memi[code + ip])
		if (IS_INDEFI (ival)) {
		    stack[sp] = INDEF
		    break
		} else
		    stack[sp] = PIXEL (ival)

	    case PEV_RNUMBER:
		ip = ip + 1
		sp = sp + 1
		rval = fc_cgetr (Memi[code + ip])
		if (IS_INDEFR (rval)) {
		    stack[sp] = INDEF
		    break
		} else
		    stack[sp] = PIXEL (rval)

	    case PEV_DNUMBER:
		ip = ip + 1
		sp = sp + 1
		dval = fc_cgetd (Memi[code + ip])
		if (IS_INDEFD (dval)) {
		    stack[sp] = INDEF
		    break
		} else
		    stack[sp] = PIXEL (dval)

	    case PEV_STRING:
		call error (0,
		    "fc_eval: String constants are not implemented yet")

	    case PEV_COLUMN:
		ip = ip + 2
		sp = sp + 1
		dtype = fc_fdata (fptr, Memi[code + ip - 1], Memi[code + ip],
				  warnings, ival, rval, dval, str, SZ_LINE)
		switch (dtype) {
		case TY_INT:
		    if (IS_INDEFI (ival))
		        stack[sp] = INDEF
		    else
		        stack[sp] = PIXEL (ival)
		case TY_REAL:
		    if (IS_INDEFR (rval))
		        stack[sp] = INDEF
		    else
		        stack[sp] = PIXEL (rval)
		case TY_DOUBLE:
		    if (IS_INDEFD (dval))
		        stack[sp] = INDEF
		    else
		        stack[sp] = PIXEL (dval)
		case TY_CHAR:
		    call error (0,
			"fc_eval: String columns are not implemented yet")
		default:
		    if (IS_INDEFI (dtype))
			stack[sp] = INDEF
		    else
			call error (0, "fc_eval: Unknown data type")
		}
		if (IS_INDEF (stack[sp]))
		    break


	    case PEV_UPLUS:
		# do nothing

	    case PEV_UMINUS:
		stack[sp] = - stack[sp]


	    case PEV_PLUS:
		stack[sp - 1] = stack[sp - 1] + stack[sp]
		sp = sp - 1

	    case PEV_MINUS:
		stack[sp - 1] = stack[sp - 1] - stack[sp]
		sp = sp - 1

	    case PEV_STAR:
		stack[sp - 1] = stack[sp - 1] * stack[sp]
		sp = sp - 1

	    case PEV_SLASH:
		if (abs (stack[sp]) > EPSILON$T) {
		    stack[sp - 1] = stack[sp - 1] / stack[sp]
		    sp = sp - 1
		} else {
		    stack[sp - 1] = INDEF
		    sp = sp - 1
		    break
		}

	    case PEV_EXPON:
		stack[sp - 1] = stack[sp - 1] ** stack[sp]
		sp = sp - 1

#		if (stack[sp - 1] > 0) {
#		    stack[sp - 1] = stack[sp - 1] ** stack[sp]
#		    sp = sp - 1
#		} else {
#		    stack[sp - 1] = INDEF
#		    sp = sp - 1
#		    break
#		}

	    case PEV_CONCAT:
		# Not yet implemented
		call error (0, "String concatenation is not implemented yet")


	    case PEV_ACOS:
		if (abs (stack[sp]) - PIXEL (1) < EPSILON$T)
		    stack[sp] = acos (stack[sp])
		else {
		    stack[sp] = INDEF
		    break
		}

	    case PEV_ASIN:
		if (abs (stack[sp]) - PIXEL (1) < EPSILON$T)
		    stack[sp] = asin (stack[sp])
		else {
		    stack[sp] = INDEF
		    break
		}

	    case PEV_ATAN:
		stack[sp] = atan (stack[sp])

	    case PEV_ATAN2:
		if (abs (stack[sp]) > EPSILON$T) {
		    stack[sp - 1] = atan2 (stack[sp - 1], stack[sp])
		    sp = sp - 1
		} else {
		    stack[sp] = INDEF
		    sp = sp - 1
		    break
		}

	    case PEV_COS:
		stack[sp] = cos (stack[sp])

	    case PEV_SIN:
		stack[sp] = sin (stack[sp])

	    case PEV_TAN:
		stack[sp] = tan (stack[sp])


	    case PEV_EXP:
		stack[sp] = exp (stack[sp])

	    case PEV_LOG:
		if (stack[sp] > EPSILON$T)
		    stack[sp] = log (stack[sp])
		else {
		    stack[sp] = INDEF
		    break
		}

	    case PEV_LOG10:
		if (stack[sp] > EPSILON$T)
		    stack[sp] = log10 (stack[sp])
		else {
		    stack[sp] = INDEF
		    break
		}

	    case PEV_SQRT:
		if (stack[sp] > EPSILON$T)
		    stack[sp] = sqrt (stack[sp])
		else {
		    stack[sp] = INDEF
		    break
		}

	    case PEV_ABS:
		stack[sp] = abs (stack[sp])

	    case PEV_INT:
		stack[sp] = int (stack[sp])


	    case PEV_MIN:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vmin$t (stack[sp], Memi[code + ip])

	    case PEV_MAX:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vmax$t (stack[sp], Memi[code + ip])


	    case PEV_AVG:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vavg$t (stack[sp], Memi[code + ip])

	    case PEV_MEDIAN:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vmed$t (stack[sp], Memi[code + ip])

	    case PEV_MODE:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vmode$t (stack[sp], Memi[code + ip])

	    case PEV_SIGMA:
		ip = ip + 1
		sp = sp - Memi[code + ip] + 1
		stack[sp] = fc_vsigma$t (stack[sp], Memi[code + ip])


	    case PEV_COLMIN:
		# Not yet implemented
		call error (0, "Minimum of column is not implemented yet")

	    case PEV_COLMAX:
		# Not yet implemented
		call error (0, "Maximum of column is not implemented yet")


	    case PEV_COLAVG:
		# Not yet implemented
		call error (0, "Average of column is not implemented yet")

	    case PEV_COLMEDIAN:
		# Not yet implemented
		call error (0, "Median of column is not implemented yet")

	    case PEV_COLMODE:
		# Not yet implemented
		call error (0, "Mode of column is not implemented yet")

	    case PEV_COLSIGMA:
		# Not yet implemented
		call error (0, "Sigma of column is not implemented yet")


	    case PEV_STR:
		# Not yet implemented
		call error (0, "Conversion to string is not implemented yet")


	    default:	# (just in case)
		call sprintf (str, SZ_LINE,
		"fc_eval: Evaluation code error (code=%d ip=%d ins=%d sp=%d)")
		    call pargi (code)
		    call pargi (ip)
		    call pargi (ins)
		    call pargi (sp)
		call error (0, str)
	    }

	    # Check for stack overflow. This is the only check that's
	    # really needed.
	    if (sp >= STACK_DEPTH) {
		call sprintf (str, SZ_LINE,
		"fc_eval: Evaluation stack overflow (code=%d ip=%d ins=%d sp=%d)")
		    call pargi (code)
		    call pargi (ip)
		    call pargi (ins)
		    call pargi (sp)
		call error (0, str)
	    }

	    # Check for stack underflow (just in case)
	    if (sp < 1) {
		call sprintf (str, SZ_LINE,
		"fc_eval: Evaluation stack underflow (code=%d ip=%d ins=%d sp=%d)")
		    call pargi (code)
		    call pargi (ip)
		    call pargi (ins)
		    call pargi (sp)
		call error (0, str)
	    }

	    # Get next instruction
	    ip = ip + 1
	    ins = Memi[code + ip]
	}

	# Return expression value
	return (stack[sp])
end