/*
 * Execute a program via direct parse tree interpretation.  See 451 Notes for
 * discussion.  Note the similarity here with the type checker -- they're both
 * basically a recursive parse tree traversal.  This particular version of the
 * interpreter does not do type checking, assuming that it has already been
 * performed in a previous pass.  An interp with runtime type checking may be
 * forthcoming.
 */

#include <setjmp.h>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include "std-macros.h"
#include "parse-tree.h"
#include "tokens.h"
#include "sym.h"
#include "sym-aux.h"
#include "type-preds.h"
#include "type.h"
#include "str.h"
#include "interp.h"
#include "list.h"
#include "vlist.h"
#include "quant.h"
#include "validate.h"
#include "options.h"
#include "token-mapping.h"


/*
 * Top-level interpreter function, called with a stmt sequence to interpret.
 */
ValueStruct interp(t)
    nodep t;	/* t is a pointer to a stmtlist */
{
    ExitStatus status = OKStatus;
    Symtab *st = CurSymtab;

    /*
     * Check for the empty stmt list.
     */
    if (t == null) return;

    /*
     * Use setjmp to catch fatal runtime errors, such as nil pointer ref.
     */
    if (not (status = setjmp(RuntimeError)))
	interpStmts(t);
    if (status != OKStatus) {
	error("Execution terminated abnormally.\n");
	ReInitInterp();
    }
}


/*
 * Evaluate a stmt sequence using a typical switch.
 */
void interpStmts(t)
    nodep t;
{
    nodep s;
    ValueStruct v1, v2;

    for (s = t; s; s = s->components.stmt.next) {
	ChkBreak(s);
	switch (s->header.name) {
	    case 0:
		break;
	    case YASSMNT:
       		v1 = designator(s->components.stmt.kind.assmnt.var);
		v2 = interpExpr(s->components.stmt.kind.assmnt.expr);
		doAssmnt(v1,v2,true,s);
		break;
	    case YIF:
		doIf(s);
		break;
	}
    }
}


/*
 * Eval an expr.
 */
ValueStruct interpExpr(t)
    nodep t;
{
    ValueStruct v1,v2,v3;
    if (not t)
	return null;

    switch (t->header.kind) {
	case UNOP_NODE:
	    // copied switch t->header.name from case BINOP_NODE since
	    // lists were being IDd as UNOP_NODEs
	    // NOTE:
	    // It could be the case that the lists are not supposed to be
	    // UNOP_NODEs in the first place.
	    switch (t->header.name) {
		case '[':
		    return doDesignator(t);
		case '.':
		    return doDesignator(t);
		case '^':
		    return doDesignator(t);
		case ']':
		    return doListConstructor(t);
		case '}': /** THIS IS NEW! interpx **/
		    return doTupleConstructor(t);
	    }
	    v1 = interpExpr(t->components.expr.left_operand);
    	    switch (t->header.name) {
		case YUNYPLUS:
		    return doUnyPlus(v1);
		case YUNYMINUS:
		    return doUnyMinus(v1);
		case YNOT:
		    return doNot(v1);
		case '#':
		    return doLen(v1);
	    }
	    break;
	case BINOP_NODE:
	    switch (t->header.name) {
		case '[':
		    return doDesignator(t);
		case '.':
		    return doDesignator(t);
		case '^':
		    return doDesignator(t);
		case YISA:
		    return doUnionRef(t);
		case YCHKINSTANCE:
		    return doChkInstance(t);
		case YDOTDOT:
		    return doDotDot(t);
		case YASSMNT:
		    v1 = designator(t->components.expr.left_operand);
		    if (v1 == null) return null;
		    v2 = interpExpr(t->components.expr.right_operand);
		    if (v2 == null) return null;
		    return doAssmnt(v1, v2, false, t);
	    }
	    v1 = interpExpr(t->components.expr.left_operand);
	    if (v1 == null) return null;
	    v2 = interpExpr(t->components.expr.right_operand);
	    if (v2 == null) return null;
	    switch (t->header.name) {
		case '=':
		    return doEq(v1, v2);
		case YNEQ:
		    return doNotEq(v1, v2);
		case '<':
		    return doLess(v1, v2);
		case '>':
		    return doGreater(v1, v2);
		case YLEQ:
		    return doLessEq(v1, v2);
		case YGEQ:
		    return doGreaterEq(v1, v2);
		case '+':
		    return doPlus(v1, v2);
		case '-':
		    return doMinus(v1, v2);
		case '*':
		    return doMult(v1, v2);
		case YDIV:
		    return doDiv(v1, v2, t);
		case YMOD:
		    return doMod(v1, v2, t);
		case '/':
		    return doRealDiv(v1, v2, t);
		case YAND:
		    return doAnd(v1, v2);
		case YOR:
		    return doOr(v1, v2);
		case YXOR:
		    return doXOr(v1, v2);
		case YIMPLIES:
		    return doImplies(v1, v2);
		case YIFF:
		    return doIff(v1, v2);
		case YIN:
		    return doIn(v1, v2);
	    }

	case PROC_CALL_NODE:
	    if (t->header.name == null) {
		return doProcCall(t);
	    }
	    else {
		return doValidationCall(t);
	    }

	case ATOM_NODE:
	    switch (t->header.name) {
		SymtabEntry *sym;
		nodep t1;
		Value** vaddr;

		case Yident:
		    if (t->components.atom.next) {
			sym = QuickLookupQid(t);
			if (t->header.attachment.n1->components.atom.next)
			    return doDesignator(t->header.attachment.n1);
		    }
		    else {
			sym = Lookup(t->components.atom.val.text);
		    }

		    /*
 		     * Next check necessary in case of bogus banging at the
		     * interactive prompt.
		     */
		    if (not sym) {
			lerror(t, "%s is undefined.\n",
			    t->components.atom.val.text);
			longjmp(RuntimeError, NilPointerStatus);
		    }
			
		    switch (sym->Class) {
			case C_Var:
			case C_Parm:
			    vaddr = GetAddr(sym, t);
			    // vaddr could be null
			    if (!vaddr) {
				return null;
			    }
			    // where vaddr points could be null, i.e., in the
			    // case of an uninitialized variable.
			    else if (!(*vaddr)) {
				v1 = MakeVal(RVAL, NilType);
				return v1;
			    }
			    v1 = MakeVal(RVAL, sym->Type);
			    v1->val = (*vaddr)->val;

			    /*
			     * Important: For non-lists, copy the current
			     * value's tag.  If the current value is nil, this
			     * will perpetuate the nil tag into the new
			     * ValueStruct.
			     */
			    if (v1->tag != ListTag) {
				v1->tag = (*vaddr)->tag;
			    }

			    return v1;
			    /* Old dead code follows, to exemplify the changes
			     * made from the old to new memory models. */
			    v1 = MakeVal(RVAL, sym->Type);
			    v1->val.IntVal = 0;	/* Clear out int part so chars
						 * can be ints in for loops. */
			    if (v1->tag == StructTag)
				memcpy((char *) &(v1->val), &vaddr, v1->size);
			    else
				memcpy((char *) &(v1->val), vaddr, v1->size);
			    break;

			case C_Let_Var:
			    if ((vaddr = GetAddr(sym, t)) == null) {
				return null;
			    }
			    /*
			     * Check for uninitialized let var. If so,
			     * re-lookup in the parent scope.  The type checker
			     * ensures that a var of this name will be found in
			     * the parent scope.
			     */
			    if (*vaddr == null) {
				sym = LookupIn(t->components.atom.val.text,
				    CurSymtab->ParentTab);

				/*
				 * Now do the fetch all over again.  This chunk
				 * of code should be functionized, for use here
				 * and the preceding C_Var and C_Parm cases.
				 */
				if ((vaddr = GetAddr(sym, t)) == null) {
				    return null;
				}
				if (*vaddr == null) {
				    v1 = MakeVal(RVAL, NilType);
				    return v1;
				}
			    }
			    /*
			     * We have an non-null let var, so make its value.
			     */
			    v1 = MakeVal(RVAL, sym->Type);
			    v1->val = (*vaddr)->val;

			    /*
			     * Important: For non-lists, copy the current
			     * value's tag.  If the current value is nil, this
			     * will perpetuate the nil tag into the new
			     * ValueStruct.
			     */
			    if (v1->tag != ListTag) {
				v1->tag = (*vaddr)->tag;
			    }

			    return v1;

			case C_Obj:
			    if (isValSym(sym)) {
			        v1 = MakeVal(RVAL,
				    sym->Type ? sym->Type
					      : sym->Info.Obj.val->type);
				v1->val = sym->Info.Obj.val->val;
				v1->tag = sym->Info.Obj.val->tag;
				return v1;
			    }
			    /*
			     * Type checker should prevent this from happening,
			     * but in case it does ... .
			     */
			    else {
				lerror(t,
				    "%s is an object type, not a value.\n",
				     sym->Symbol);
				return null;
			    }

			case C_Const:
			    /* PSC 05/03/2008: problem here since constants can be
			     * more than just integers; especially for me, Bools.
			     * FYI the bool constants' values are stored as ints.
			     */
			    v1 = MakeVal(RVAL, sym->Type);
			    vaddr = (Value**) &(sym->Info.Consta.val->val.LVal);
			    /* The assignment below may not be Kosher, since we're
			     * directly assigning an IntVal to a BoolVal. This is C,
			     * though, right?
			     */
			    if (sym->Type == BoolType)
				v1->val.BoolVal = sym->Info.Consta.val->val.IntVal;
			    else
				v1->val.IntVal = 0;	/* Clear out int part so chars
							 * can be ints in for loops. */
			    if (v1->tag == StructTag)
				memcpy((char *) &(v1->val), &vaddr, v1->size);
			    else
				memcpy((char *) &(v1->val), vaddr, v1->size);
			    break;
			case C_Enum:
			    v1 = MakeVal(RVAL, sym->Type);
			    v1->val.IntVal = sym->Info.Enum.Value;
			    break;
			case C_Op:
			    v1 = MakeVal(RVAL, sym->Info.Op.OpType);
			    v1->val.ProcVal = sym;
			    break;
			case C_Proc:	/* Deprecated */
			    if (t1 = sym->Info.Proc.FType)
				v1 = MakeVal(RVAL, sym->Info.Proc.FType);
			    else {
				/*
				 * This else is the case of a built-in proc for
				 * which no FType has been built.  We can
				 * MakeVal with NilType since it doesnt matter
				 * what the type is beyond here, the reason
				 * being that we can only be calling, given
				 * that the type checker disallows using
				 * built-ins as unevaluated proc values.
				 * (Note that this comment is no where near as
				 * important as it is long.)
				 */
				v1 = MakeVal(RVAL, NilType);
			    }
			    v1->val.ProcVal = sym;
			    break;
			case C_Type:
			    v1 = MakeVal(RVAL, sym->Type);
			    v1->tag = TypeTag;
			    break;			
		    }
		    return v1;
		case Yinteger:
		    v1 = MakeVal(RVAL, IntType);
		    v1->val.IntVal = t->components.atom.val.integer;
		    return v1;
		case Yreal:
		    v1 = MakeVal(RVAL, RealType);
		    v1->val.RealVal = t->components.atom.val.real;
		    return v1;
		case Ystring:
		    v1 = MakeVal(RVAL, StringType);
		    v1->val.StringVal = NewStringQuotes(t->components.atom.val.string);
		    return v1;
	    }
	case TRINOP_NODE:
	    switch (t->header.name) {
		case YIF:
		    return doIfExpr(t);
		case '[':
		    v1 = interpExpr(t->components.trinop.left_operand);
		    v2 = interpExpr(t->components.trinop.middle_operand);
		    v3 = interpExpr(t->components.trinop.right_operand);
		    return doArraySliceRef(v1, v2, v3, t);
	    }
	case DECL_NODE:
	    switch (t->header.name) {
		case YFORALL:
		case YEXISTS:
		    return doQuant(t);
		case YLET:
		    return doLet(t);
		case YPRE:
		    return interpExpr(t->components.decl.kind.pre.expr);
		case YPOST:
		    return interpExpr(t->components.decl.kind.post.expr);
	    }
	case EXPR_LIST_NODE:
	    return doExprSeq(t);
    } // end switch (t->header.kind)
}


/***
 *** Individual evaluation routines for each kind of tree node that requires
 *** evaluation.
 ***/

/*
 * Interpret an expr sequence of the form
 *
 *    ( e<1>; e<2>; ..., e<n> )
 *
 * Note that although each expression in an expression sequence will be
 * interpreted, the Value of an expression sequence is equal to the value
 * of the last expression in the sequence.
 *
 * The evaluation entails entering the expr sequence scope, as is done for
 * operation execution.  Viz., an act rec is pushed onto the stack and the
 * scope's symtab is entered.  Upon completion of execution, the scope is
 * exited, by popping the stack and ascending up to the parent symtab scope.
 *
 * A very important piece of additional work is performed here, in contrast
 * what is done for operation execution.  Here in doExprSeq, all of the entries
 * in the act record are initialized explicitly to null, to indicate their
 * unbound status.  This is done so that the semantics of let vars can be
 * properly implemented.  See C_Let_Var case for Yident for further discussion.
 */
ValueStruct doExprSeq(t)
    nodep t;
{
    nodep el;
    ValueStruct v;
    Symtab* st;
    int o, so;
    Value** saveftos;

    if (not t)
	return null;

    /*
     * Enter expr sequence scope.  There must always be one, since the type
     * checker always allocates a symtab, even if there are no lets in the expr
     * sequence.
     */
    st = t->components.exprlist.symtab;
    PushSymtab();
    MoveToSymtab(st);

    /*
     * Push expr sequence act rec.  The size of this is the size of all the
     * distinct let-vars declared herein.  I.e., storage for let-vars is within
     * the act rec for the enclosing expr sequence scope.  By the current
     * syntax and semantics of SpecL, the only scope in which lets can appear
     * is an expr sequence.
     *
     * Note the use of PushActRecCleared, instead of PushActRec.  The former
     * initializes all act rec ValueStructs to null.  See the C_Let_Var case
     * of Yident for how this is utilized.
     */
    saveftos = GetFTos();
    PushActRecCleared(o = st->Offset);

    /*
     * Save the current display pointer.  See doProcCall comments for
     * further discussion.
     */
    SaveDisplay(st->Level, so = (o - 1));

    /*
     * Do the work of executing each expr in the sequence.
     */
    for (el=t; el; el=el->components.exprlist.next) {
	v = interpExpr(el->components.exprlist.expr);
    }

    /*
     * If a scope was entered, leave it.
     */
    if (st) {
	/*
	 * Restore the display.
	 */
	RestoreDisplay(st->Level, so);

	/*
	 * Pop act rec by restoring entering ftos; restore calling symtab
	 * context.
	 */
	SetFTos(saveftos);
	PopSymtab();
    }

    return v;
} // end ValueStruct doExprSeq

/*
 * Evaluate an assignemnt by assigning the given rval to the memory location
 * pointed to by the given lval.  In the uniform memory model based on Value
 * pointers, the LVal field of a Value points to a memory segement consisting
 * of other Values.  That is, all memory segments are uniformly blocks of
 * Value pointers.
 *
 * The remaining two paragraphs refer to the old memory model, based on raw
 * char* blocks.  These comments are left as an historical reference, and
 * should be deleted in due course.
 *
 * Evaluate an assignment statement via bcopy.  Note the difference in handling
 * of structured vs. non-structured values.  For structured values, we must
 * deref the r-value and l-value pointers to get to the bytes we need.  Note
 * the lack of check for null lval.  A null pointer will have been detected and
 * long jumped from before we get here.
 *
 * Note finally the special treament of string literals on the RHS.  In such
 * cases, type checking guarantees the the LHS will be an array of the form
 * "array[0..n] of char" and that n > strlen(RHS).  What we do with the literal
 * is strcpy it into the LHS array, including the null termination.
 */
ValueStruct doAssmnt(lval, rval, freeflag, t)
    ValueStruct lval;
    ValueStruct rval;
    bool freeflag;		/* If true, free lval and rval on exit. */
    nodep t;			/* Source tree for stmt for line number only */
{
    /*
     * Check for null LVal pointer, which happens when we're mutating a
     * not-yet-initialized tuple field.  Issue an error in this case, meaning
     * that tuple vars must be initialized en masse, not field-by-field.
     */
    if (lval->val.LVal == null) {
	lerror(t->components.expr.left_operand,
	   "Designated tuple field is uninitialized, and so cannot be set.\n");
	return TheNilValue;
    }

    /* 
     * in this case we want to copy the type and tag good stuff over, too? 
     * might have been initialized as nil!
     */
    if (*(lval->val.LVal)) {
	(*(lval->val.LVal))->val = rval->val;
	(*(lval->val.LVal))->type = rval->type;
	(*(lval->val.LVal))->tag = rval->tag;
	(*(lval->val.LVal))->size = rval->size;
    }
    else {
	*(lval->val.LVal) = rval;
    }

    /*
     * Free the value structs if the caller says it's OK.  Otherwise, we'll
     * assume that the caller does the freeing.  An example of when it's not OK
     * to free here is in the call from doFor, where the lvalue needs to be
     * retained until for processing is done.
     */
    if (freeflag) {
	free(lval);
	free(rval);
    }

    return rval;

    /*
     * From here to end is old, now dead, code.
     */

    /*
     * Do the bcopy, noting whether we have a structured, non-structured, or
     * string value
     */
    switch (rval->tag) {
	case StructTag:
	    memcpy(lval->val.LVal, (char *) rval->val.StructVal, 
		rval->type->header.attachment.count);
/*	    bcopy((char *) rval->val.StructVal, lval->val.LVal,
		rval->type->header.attachment.count);*/
	    break;
/* 1feb09 gfisher: separate case for String should not be necessary, given now
 * String representation.  Not certain about, but testing should confirm.
 *
	case StringTag:
	    strcpy(lval->val.LVal, rval->val.StringVal);
	    break;
 */
	default:
	    memcpy(lval->val.LVal, (char *) &(rval->val), rval->size);
/*	    bcopy((char *) &(rval->val), lval->val.LVal, rval->size);*/
    }

}


/*
 * Evaluate a proc call:
 *     (1) push an activation record onto the stack, saving current display
 *	   entry at level of this proc
 *     (2) recursively evaluate each actual parm
 *     (3) store the value of each acutal in the location of the corresponding
 *	   formal in the act rec
 *     (4) move the symbol table context to the called proc
 *     (4) recursively execute the proc body
 *     (5) pop the act rec; restore the symbol table context to what it was on
 *	   entry; restore display entry, and return the return value of the
 *	   proc, if any
 */
ValueStruct doProcCall(t)
    nodep t;			/* Parse tree proc call */
{
    SymtabEntry *p, *fp;
    nodep ap, d;
    ValueStruct v1, v2;
    int i, o, so;
    Value** saveftos;
    jmp_buf **jbp;

    /*
     * Evaluate proc designator.
     */
    v1 = interpExpr(d = t->components.proccall.desig);

    /*
     * Bail if null comes back from the designator eval.  Assume that an error
     * message has already but output.
     */
    if (v1 == null) {
	return null;
    }

    /*
     * Check first if we have a cast, in which case we'll handle not as a proc
     * call at all.
     */
    if (v1->tag == TypeTag) {
	return doCast(v1, t->components.proccall.actuals);
    }

    /*
     * Check next for a non-null procedure.  Type checking handles everything
     * else but this.
     */
    if (not (p = v1->val.ProcVal)) {
	lerror(t, "Attempt to call a null procedure.\n");
	longjmp(RuntimeError, NilProcStatus);
    }

    /*
     * Check if special proc, and if so, call immediately.
     */
    if (ChkSymFlag(p, specialProc))
	return p->Info.Proc.Code.Func(t->components.proccall.actuals);

    /*
     * Push storage for act rec, based on size of parm and local storage.
     * Before pushing, we save the entering formals stack pointer so that it
     * can be restored upon exit.  Note that we're using two top-of-stack
     * pointers here: the one in the current display entry and ftos.  The "f"
     * in ftos stands for "formals" tos, since it points to the top of the
     * stack where the formals for the called proc are being bound.
     * 
     * During parm binding, the display points to the top of stack in the
     * callING environment, while ftos points to the top of stack in the callED
     * environment.  Once binding is accomplished, the display is moved up to
     * ftos, and ftos is no longer needed.
     */
    saveftos = GetFTos();
    PushActRec(o = p->Info.Op.Symtab->Offset);

    /*
     * Evaluate each actual and store value in corresponding formal.
     */
    for (ap = t->components.proccall.actuals,
	 fp = p->Info.Op.InParms,
	 i=1;
           ap && fp;
	     ap = ap->components.exprlist.next,
	     fp = fp->Info.Parm.Link,
	     i++) {

	/*
	 * Compute address of formal, in callED environment.  The callED stack
	 * environment is pointed to by ftos.  We havent yet moved into the
	 * callED symtab environment, but we get there through the threaded
	 * parm chain.
	 */
	v1 = MakeVal(LVAL, fp->Type);
	v1->val.LVal = GetFormalAddr(fp);

	/*
	 * Recursively eval actual in the callING environment.  The callING
	 * stack environment is pointed to by the current display entry, which
	 * the recursive call to inerpExpr will use via GetAddr.  And as noted
	 * above, we havent yet moved into the callED symtab environment.
	 *
	 * Note the different handling of call-by-val vs call-by-var parms.
	 * For the former, we compute an r-value, for the latter an l-value.
	 */
	if (ChkSymFlag(fp, varParm))
	    v2 = designator(ap->components.exprlist.expr);
	else
	    v2 = interpExpr(ap->components.exprlist.expr);

	/*
	 * Bind per the parm discipline -- call-by-value, call-by-var, call-by
	 * array.
	 */
	Bind(fp, v1, v2);
    }

    /*
     * Move the Symtab context into the called proc.
     */
    PushSymtab();
    MoveToSymtab(p->Info.Op.Symtab);
    
    /*
     * Save the current display entry for this proc's level and update the
     * entry at this level.  Note that the display save slot in the act rec is
     * just "above" that bottommost formal, where above is calculated by
     * subtracting 1.  This value of 1 represents one stack element element of
     * size Value*.
     */
    SaveDisplay(p->Level, so = (o - 1));

    /*
     * NOPE.
     * Set the normal (i.e., not-during-binding) tos pointer.  This will be
     * used by folks who need to use the stack as a utility storage area, such
     * as doLoop and printf_, q.q.v.
    SetTos(p->Level);
     */

    /*
     * Recursively execute the body of the proc.  Note use of setjmp here.  The
     * jmp_buf is put in the act rec, to be used subsequently by the longjmp in
     * the return stmt code, q.v.  We need to put jmp_bufs on the stack, since
     * each recursive proc invocation needs its own copy.  And we can't put jmp
     * bufs in a local (C) var, since the return stmt code wouldn't be able to
     * see it there
     */
    if (ChkSymFlag(p, compiledProc))
	v1 = p->Info.Op.Code.Func(t);
    else {
#ifdef Sparc
	jmp_buf *jbp1 = (jmp_buf *) malloc(sizeof(jmp_buf));

	jbp = (jmp_buf **) StackAddr(p->Info.Op.Offset);
	memcpy((char *) jbp, (char *) &jbp1, sizeof (char *));
/*	bcopy((char *) &jbp1, (char *) jbp, sizeof (char *));*/
	if (not (v1 = ((ValueStruct) setjmp(*jbp1))))
	    interpStmts(p->Info.Op.Code.Tree);
	free(jbp1);
#else
	jbp = (jmp_buf **) StackAddr(p->Info.Op.Offset);
	*jbp = (jmp_buf *) malloc(sizeof(jmp_buf));
	if (not (v1 = ((ValueStruct) setjmp(**jbp))))
	    v1 = interpExpr(p->Info.Op.Code.Tree);
/* 3/3/2009 PSC
	free(*jbp);
*/
#endif
    }

    /*
     * Restore display.
     */
    RestoreDisplay(p->Level, so);

    /*
     * Pop act rec by restoring entering ftos; restore calling symtab context.
     */
    SetFTos(saveftos);
    PopSymtab();

    /*
     * If the return val is nil and the return type is any kind of list, then
     * make the return value an empty list of the return type.
     */
    if (v1 and (v1->tag == NilTag) and isListType(p->Type)) {
	v1 = MakeVal(RVAL, p->Type);
	v1->val.ListVal = NewList();
    }
    return v1;
}


/*
 * Bind the given actual value to the given formal.  This is a non-mutating
 * version of doAssmnt.  Note in particular that calling doAssmnt from here
 * will NOT work correctly.  This is because doAssmnt determines if a mutation
 * is to be performed by checking for a non-null value in *(fv->val.LVal).
 * This won't work here for parm binding, since *(fv->val.LVal) could point to
 * a non-null stack value that is simply left over from a previous call.
 *
 * Hence, Bind unconditionally reassigns the rvalue to the lvalue.  This is, in
 * fact, the fundamental meaning of functional binding.
 */
Bind(fp, fv, av)
    SymtabEntry *fp;
    ValueStruct fv, av;
{
    *(fv->val.LVal) = av;
    if (av) {
	/*
	 * if we have a struct (or list) here, gotta grab the resolved name
	 * info from the LHS, otherwise just pass the RHS junk.
	 */
	switch (av->tag) {
	    case StructTag:
	    case ListTag:
		UniverseAddValue1(fv->type->components.type.resolvedname, av);
		break;
	    default:
		UniverseAddValue(av);
		break;
	} // end switch
    } // end if
    
}


/*
 * Evaluate a cast.
 */
ValueStruct doCast(v, actuals)
    ValueStruct v;
    nodep actuals;
{
    ValueStruct v1;

    /*
     * Next line should not happen, but somehow it does at times.  Case in
     * point, a C-style decl, such as integer i, which somehow gets by the
     * parser as a syntactically legal cast.  FIX THIS.
     */
    if (not actuals)
	return null;
    v1 = interpExpr(actuals->components.exprlist.expr);
    v1->type = v->type;
    v1->tag = v->tag;
    return v1;
}

/*
 * Evaluate a let of the form
 *
 * 


/*
 * Evaluate an if.
 */
doIf(t)
    nodep t;
{
    ValueStruct v1;
    nodep elsif;

    /*
     * Eval the if expr and do the then if true.
     */
    v1 = interpExpr(t->components.stmt.kind.ifstmt.expr);
    if (v1 and v1->val.BoolVal) {
	interpStmts(t->components.stmt.kind.ifstmt.thenpart);
	free(v1);
	return;
    }

    /*
     * Do the first elsif that's true, if any.
     */
    for (elsif = t->components.stmt.kind.ifstmt.elsifparts; elsif;
	    elsif = elsif->components.stmt.next) {
	v1 = interpExpr(t->components.stmt.kind.elsif.expr);
	if (v1 and v1->val.BoolVal) {
	    interpStmts(t->components.stmt.kind.elsif.thenpart);
	    free(v1);
	    return;
	}
    }

    /*
     * Try the else if all else has failed.
     */
    if (t->components.stmt.kind.ifstmt.elsepart)
	interpStmts(t->components.stmt.kind.ifstmt.elsepart);
}


/*
 * Evaluate a while.
 */
doWhile(t)
    nodep t;
{
    ValueStruct v1;

    while ((v1 = interpExpr(
		    t->components.stmt.kind.whilestmt.expr))->val.BoolVal) {
	free(v1);
	interpStmts(t->components.stmt.kind.whilestmt.body);
    }
}


/*
 * Evaluate a repeat.
 */
doRepeat(t)
    nodep t;
{
    ValueStruct v1;
    nodep b;

    interpStmts(b = t->components.stmt.kind.repeatstmt.body);

    while (not ((v1 = interpExpr(
		    t->components.stmt.kind.repeatstmt.expr))->val.BoolVal)) {
	free(v1);
	interpStmts(b);
    }
}


/*
 * Evaluate a loop.  Push a one-word eval blip on the stack to hold jmp_buf
 * that subsequent exit stmt will longjmp through.  Cf. doProcCall for the
 * similar use of setjmp.
 */
doLoop(t)
    nodep t;
{
    jmp_buf *jbp;

    /*
     * Malloc the jmp_buf and stick it on the stack.
     */
    jbp = (jmp_buf *) malloc(sizeof(jmp_buf));
    push(&jbp, sizeof (jmp_buf *));

    /*
     * Do the setjmp and recursively eval the loop body.
     */
    if (not(setjmp(*jbp))) 
	while (true)
	    interpStmts(t->components.stmt.kind.loopstmt.body);

    /*
     * The exit stmt, if executed, will longjmp back to here.  Note that if we
     * dont do an exit at some point, the program is in a (possibly legitimate)
     * infinite loop, since the only way out of a loop is an exit.
     */
    pop(sizeof (jmp_buf *));
    free(jbp);
}


/*
 * Evaluate a for.
 */
doFor(t)
    nodep t;
{
    ValueStruct v1,v2,v3=null;
    nodep byt;
    int byval, endval;

    v1 = designator(t->components.stmt.kind.forstmt.var);
    v2 = interpExpr(t->components.stmt.kind.forstmt.startexpr);
    endval = Integerize(interpExpr(t->components.stmt.kind.forstmt.endexpr));
    byval = (byt = t->components.stmt.kind.forstmt.byexpr) ?
	Integerize(v3 = interpExpr(byt)) : 1;

    for (doAssmnt(v1,v2,false);
	    IntegerizeL(v1) <= endval; doForIncr(v1, byval))
	interpStmts(t->components.stmt.kind.forstmt.body);
    free(v1); free(v2); if (v3) free(v3);
}


/*
 * Incr a for var appropriately.
 */
doForIncr(forvar, byval)
    ValueStruct forvar;
    int byval;
{
    int i;
    memcpy(&i, forvar->val.LVal, TypeSize(forvar->type));
    /*bcopy(forvar->val.LVal, &i, TypeSize(forvar->type));*/
    i += byval;
    memcpy(&i, forvar->val.LVal, TypeSize(forvar->type));
    /*bcopy(&i, forvar->val.LVal, TypeSize(forvar->type));*/

    /*
     * We'd like to do the following, which would be faster, but it causes BUS
     * (alignment error) on the Sparc, at least:
     *
	switch (forvar->tag) {
	    case LIntTag:
	    case IntTag:
		*((int *)forvar->val.LVal) += byval;
		return;
	    case CharTag:
		*((char *)forvar->val.LVal) += byval;
		return;
	    case BoolTag:
		*((bool *)forvar->val.LVal) += byval;
		return;
	}
     *
     */
}


/*
 * Evaluate an exit by longjmping out to the setjmp of enclosing loop.
 * Typechecking gaurantees there's an enclosing loop.  Cf. doReturn just below.
 * Note that we extract jump_buf pointer here via top.  We then longjump back
 * to doLoop, which does the stack pop (and also frees *jbp).
 */
doExit(t)
    nodep t;
{
    jmp_buf *jbp;

    memcpy(&jbp, top(), sizeof(jmp_buf *));
    /*bcopy(top(), &jbp, sizeof(jmp_buf *));*/
    longjmp(*jbp, null);
}


/*
 * Evaluate a return.  The sweet trick is a longjmp via a jmp_buf stored in the
 * act rec of the currently active proc.  See the corresponding setjmp in
 * doProcCall.  Very nice.
 */
doReturn(t)
    nodep t;
{
    ValueStruct v1;
    jmp_buf **jbp = (jmp_buf **) StackAddr(
	CurSymtab->ParentEntry->Info.Proc.Offset);

    v1 = interpExpr(t->components.stmt.kind.returnstmt);
    longjmp(**jbp, (int) v1);

    /*
     * Not:
    return interpExpr(t->components.stmt.kind.returnstmt);
     */
}


/*
 * Evaluate a designator as an r-value.  To do this, just call designator,
 * which produces an l-value, and deref it.  Note the difference in handling
 * structured vs. non-structured vals.  For structured values, we only copy the
 * pointer, not the entire value.  This is safe at this point, since we have an
 * r-value that will not be mutated anywhere above us.  This is in contrast to
 * binding structured values as actual parms, where we must in fact make a new
 * copy of the struct.
 */
ValueStruct doDesignator(t)
    nodep t;
{
    ValueStruct v1,v2;
    v1 = designator(t);

    if (isNilValue(v1)) {
	return v1;
    }

    if (v1->tag == StructTag) {
	v2 = MakeTupleVal(RVAL, v1->type);
	v2->val = (*(v1->val.LVal))->val;
//	memcpy((char *) &(v2->val), (char *) &(v1->val), sizeof(char *));
    }
    else if (v1->tag == ListTag) {
	v2 = MakeVal(RVAL, v1->type);
	v2->val = (*(v1->val.LVal))->val;
//    	memcpy((char *) &(v2->val), (char *) &(v1->val), sizeof(char *));
	/*bcopy((char *) &(v1->val), (char *) &(v2->val), sizeof(char *));*/
    }
    else {
	if (*(v1->val.LVal)) {
	    v2 = MakeVal(RVAL, v1->type);
	    v2->val = (*(v1->val.LVal))->val;
	}
	/*
	 * uninitialized variable?
	 */
	else {
	    return null;
	}
//	memcpy(&(v2->val), &(v1->val), v1->size);
	/*bcopy(v1->val.LVal, &(v2->val), v1->size);*/
    }

    return v1 == null ? null : v2;
}


/**
 ** The operator evaluation functions that follow are largely clones.  They
 ** each just apply the C operation that is the equivalent of the corresponding
 ** operation in the parse tree, with a Modula-2 nuiance here and there.
 **
 ** Note that even though type checking has already been done, we still need to
 ** do some type analysis here in order to make sure that values are computed
 ** properly.  Strong typing sucks.
 **
 **/

/*
 * Eval '*'
 */
ValueStruct doMult(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, and longreal.
     */
    switch (v1->tag) {
	case IntTag:
	    if (v2->tag == RealTag) {
		v1->val.RealVal = v1->val.IntVal * v2->val.RealVal;
		v1->tag = RealTag;
	    }
	    else {
		v1->val.IntVal = v1->val.IntVal * v2->val.IntVal;
	    }

	    free(v2);
	    return v1;
	case LIntTag:
	    v1->val.LIntVal = v1->val.LIntVal * v2->val.LIntVal;
	    free(v2);
	    return v1;
	case RealTag:
	    if (v2->tag == IntTag)
		v1->val.RealVal = v1->val.RealVal * v2->val.IntVal;
	    else
		v1->val.RealVal = v1->val.RealVal * v2->val.RealVal;

	    free(v2);
	    return v1;
	case LRealTag:
	    v1->val.LRealVal = v1->val.LRealVal * v2->val.LRealVal;
	    free(v2);
	    return v1;
    }
}
    
/*
 * Eval '+'
 */
ValueStruct doPlus(v1,v2)
    ValueStruct v1,v2;
{
    ValueStruct val;
    List* l;
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, and longreal.
     */
    switch (v1->tag) {
	case StringTag:
	    // could be a list?
	    if (v2->tag != ListTag) {
		val = MakeVal(RVAL, StringType);
		val->val.StringVal = (String *)StringConcat(v1->val.StringVal, v2->val.StringVal);
		return val;
	    }
	    break;
	case IntTag:
	    if (v2->tag == RealTag) {
		v1->val.RealVal = v1->val.IntVal + v2->val.RealVal;
		v1->tag = RealTag;
		return v1;
	    }
	    // could be a list?
	    if (v2->tag != ListTag) {
		v1->val.IntVal = v1->val.IntVal + v2->val.IntVal;
		free(v2);
		return v1;
	    }
	    break;
	case LIntTag:
	    // could be a list?
	    if (v2->tag != ListTag) {
		v1->val.LIntVal = v1->val.LIntVal + v2->val.LIntVal;
		free(v2);
		return v1;
	    }
	    break;
	case RealTag:
	    if (v2->tag == IntTag) {
		v1->val.RealVal = v1->val.RealVal + v2->val.IntVal;
		return v1;
	    }
	    // could be a list?
	    if (v2->tag != ListTag) {
		v1->val.RealVal = v1->val.RealVal + v2->val.RealVal;
		free(v2);
		return v1;
	    }
	    break;
	case LRealTag:
	    // could be a list?
	    if (v2->tag != ListTag) {
		v1->val.LRealVal = v1->val.LRealVal + v2->val.LRealVal;
		free(v2);
		return v1;
	    }
	    break;
	case NilTag:
	    return TheNilValue;
	    break;
    }
    // if we get down this far, we might have some lists to deal with
    if ((v1->tag == ListTag) && (v2->tag == ListTag)) {
	val = MakeVal(RVAL, v1->type);
	val->val.ListVal = (List *)ConcatLists(v1->val.ListVal, v2->val.ListVal);
	return val;
    }
   // v1 is a list then v2 must be an element, thanks to Mr. TC
    else if (v1->tag == ListTag) {
	val = MakeVal(RVAL, v1->type);
	l = NewList1((ListElemData*)v2);
	val->val.ListVal = (List *)ConcatLists(v1->val.ListVal, l);
	return val;
    }
    // v2 is a list then v1 must be an element, thanks to Mr. TC
    else if (v2->tag == ListTag) {
	val = MakeVal(RVAL, v2->type);
	l = NewList1((ListElemData*)v1);
	val->val.ListVal = (List *)ConcatLists(l, v2->val.ListVal);
	return val;
    }

} // end function doPlus

ValueStruct doDiv(ValueStruct v1,ValueStruct v2, nodep t)
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The only possibility is int.
     */
    if (v2->val.IntVal == 0) {
	free(v2);
	lerror(t, "Divide by zero.\n");
	return null;
	longjmp(RuntimeError, DivideByZeroStatus);
    }

    v1->val.IntVal = v1->val.IntVal / v2->val.IntVal;
    free(v2);
    return v1;
}


ValueStruct doMod(ValueStruct v1, ValueStruct v2, nodep t)
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The only possibility is int.
     */
    if (v2->val.IntVal == 0) {
	free(v2);
	lerror(t, "Modulus by zero.\n");
	return null;
	longjmp(RuntimeError, DivideByZeroStatus);
    }

    v1->val.IntVal = v1->val.IntVal % v2->val.IntVal;
    free(v2);
    return v1;
}

ValueStruct doRealDiv(ValueStruct v1, ValueStruct v2, nodep t)
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are only real and longreal.
     */
    switch (v1->tag) {
	case RealTag:
	    if (v2->tag == IntTag) {
		if (v2->val.IntVal == 0) {
		    free(v2);
		    lerror(t, "Divide by zero.\n");
		    return null;
		    /* Formerly:
			longjmp(RuntimeError, DivideByZeroStatus);
		     */
	        }
	        v1->val.RealVal = v1->val.RealVal / v2->val.IntVal;
	    }
	    else {
		if (v2->val.RealVal == 0) {
		    free(v2);
		    lerror(t, "Divide by zero.\n");
		    return null;
		    longjmp(RuntimeError, DivideByZeroStatus);
	        }
	        v1->val.RealVal = v1->val.RealVal / v2->val.RealVal;
	    }
	    free(v2);
	    return v1;
	case IntTag:
	    if (v2->tag == RealTag) {
		if (v2->val.RealVal == 0) {
		    free(v2);
		    lerror(t, "Divide by zero.\n");
		    return null;
		    longjmp(RuntimeError, DivideByZeroStatus);
	        }
	        v1->val.RealVal = v1->val.IntVal / v2->val.RealVal;
		v1->tag = RealTag;
	    }
	    else {
		if (v2->val.IntVal == 0) {
		    free(v2);
		    lerror(t, "Divide by zero.\n");
		    return null;
		    longjmp(RuntimeError, DivideByZeroStatus);
	        }
	        v1->val.IntVal = v1->val.IntVal / v2->val.IntVal;
	    }
	    free(v2);
	    return v1;
    }
}

ValueStruct doMinus(v1,v2)
    ValueStruct v1,v2;
{
    ValueStruct v;
    int pos;
    List* firstHalf,
	* lastHalf;

    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, and longreal.
     */
    switch (v1->tag) {
	case IntTag:
	    if (v2->tag == RealTag) {
		v1->val.RealVal = v1->val.IntVal - v2->val.RealVal;
		v1->tag = RealTag;
	    }
	    else {
		v1->val.IntVal = v1->val.IntVal - v2->val.IntVal;
	    }

	    free(v2);
	    return v1;
	case LIntTag:
	    v1->val.LIntVal = v1->val.LIntVal - v2->val.LIntVal;
	    free(v2);
	    return v1;
	case RealTag:
	    if (v2->tag == IntTag)
		v1->val.RealVal = v1->val.RealVal - v2->val.IntVal;
	    else
		v1->val.RealVal = v1->val.RealVal - v2->val.RealVal;

	    free(v2);
	    return v1;
	case LRealTag:
	    v1->val.LRealVal = v1->val.LRealVal - v2->val.LRealVal;
	    free(v2);
	    return v1;
	case ListTag:
	    pos = InListWithFunction(v1->val.ListVal, v2, ValueListEquals);
	    if (pos > 0)
	    {
		// if the list size is 1 and we found a match, we've now got
		// an empty list... => nil
		if (ListLen(v1->val.ListVal) == 1) {
		    v = MakeVal(RVAL, NilType);
		}
		else {
		    v = MakeVal(RVAL, v1->type);
		    firstHalf = SubList(v1->val.ListVal, 1, pos - 1);
		    lastHalf = SubList(v1->val.ListVal, pos + 1, ListLen(v1->val.ListVal));
		    if (firstHalf && lastHalf)
			v->val.ListVal = (List *)ConcatLists(firstHalf, lastHalf);
		    else if (firstHalf)
			v->val.ListVal = firstHalf;
		    else if (lastHalf)
			v->val.ListVal = lastHalf;
		}
		return v;
	    }
	    // if we got this far, return v1 since that means v2 wasn't contained within v1
	    return v1;
    } // end switch
} // end doMinus

ValueStruct doUnyPlus(v1)
    ValueStruct v1;
{
    return v1;
}


ValueStruct doUnyMinus(v1)
    ValueStruct v1;
{
    /*
     * Propagate null value if operand is null.
     */
    if (isNilValue(v1))
	return null;

    /*
     * The possibilities here are int, real, longint, and longreal.
     */
    switch (v1->tag) {
	case IntTag:
	    v1->val.IntVal = -v1->val.IntVal;
	    return v1;
	case LIntTag:
	    v1->val.LIntVal = -v1->val.LIntVal;
	    return v1;
	case RealTag:
	    v1->val.RealVal = -v1->val.RealVal;
	    return v1;
	case LRealTag:
	    v1->val.LRealVal = -v1->val.LRealVal;
	    return v1;
    }
}

ValueStruct doAnd(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = v1->val.BoolVal and v2->val.BoolVal;
//    free(v2);
    return v1;
}

ValueStruct doOr(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = v1->val.BoolVal or v2->val.BoolVal;
    return v1;
}

ValueStruct doXOr(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = v1->val.BoolVal neq v2->val.BoolVal;
    return v1;
}

ValueStruct doImplies(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = not v1->val.BoolVal or v2->val.BoolVal;
    return v1;
}

ValueStruct doIfExpr(nodep t) {
    ValueStruct v1, v2;
    TypeStruct t1;

    /*
     * Eval test expr. 
     */
    v1 = interpExpr(t->components.trinop.left_operand);

    /*
     * Propagate null if test fails.
     */
    if (isNilValue(v1)) {
	return null;
    }

    /*
     * Eval the then or else part as appropriate.
     */
    if (v1->val.BoolVal) {
	return interpExpr(t->components.trinop.middle_operand);
    }

    if (t->components.trinop.right_operand) {
	return interpExpr(t->components.trinop.right_operand);
    }

    t1 = chkExpr(t->components.trinop.middle_operand, true, null);
    if (t1 and isBool(t1)) {
	v1->val.BoolVal = true;
	return v1;
    }

    return TheNilValue;
}

ValueStruct doIff(v1,v2)
    ValueStruct v1,v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = (v1->val.BoolVal == v2->val.BoolVal);
    return v1;
}

ValueStruct doNot(v1)
    ValueStruct v1;
{
    /*
     * Propagate null value if either is operand is null.
     */
    if (isNilValue(v1))
	return null;

    /*
     * Only possibility here is bool.
     */
    v1->val.BoolVal = not v1->val.BoolVal;
    return v1;
}


/*
 * Do equality.  As with assignment, eq is fully polymorphic. so we must
 * distingish between struct and non-struct vals, and handle accrordingly.
 */
ValueStruct doEq(v1,v2)
    ValueStruct v1, v2;
{
    /*
     * Handle nil as its own case.
     */
    if (isNilValue(v1) and isNilValue(v2)) {
	v1->val.BoolVal = true;
	v1->tag = BoolTag;
	v1->type = BoolType;
	v1->size = TypeSize(BoolType);
	return v1;
    }
    else if (isNilValue(v1) or isNilValue(v2)) {
	v1->val.BoolVal = false;
	v1->tag = BoolTag;
	v1->type = BoolType;
	v1->size = TypeSize(BoolType);
	return v1;
    }

    /*
     * PSC 5/13/2008: changed bcmp calls to memcmp.
     * Bcmp here lets us compare any two types, so that = is fully polymorphic.
     * Note the chk for struct type.  For these, we must chase the pointer to
     * the actual stored value.  Cf doAssmnt.
     * 
     * TODO - verify that StructTag works, and make a similar change in vlist.c (if needed)
     */
    switch (v1->tag) {
	case StructTag:
	    /* Since tuples are very much like lists, try this out */
	    v1->val.BoolVal = ListEqualsWithFunction(v1->val.StructVal, v2->val.StructVal, ValueListEquals);
/* old code
	    v1->val.BoolVal = not memcmp(v1->val.StructVal, v2->val.StructVal,
						v1->size);
*/
	    break;
	case ListTag:
	    v1->val.BoolVal = ListEqualsWithFunction(v1->val.ListVal, v2->val.ListVal, ValueListEquals);
	    break;
	case StringTag:
	    v1->val.BoolVal = StringEqual(v1->val.StringVal, v2->val.StringVal);
	    break;
	case IntTag:
	    v1->val.BoolVal = (v1->val.IntVal == v2->val.IntVal);
	    break;
	default:
	    v1->val.BoolVal = not memcmp(&(v1->val), &(v2->val), v1->size);
	    break;
    } // end switch v1->tag
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
//    free(v2);
    return v1;
}

ValueStruct doNotEq(v1,v2)
    ValueStruct v1, v2;
{
    /*v1->val.BoolVal = bcmp(&(v1->val), &(v2->val), v1->size)*/
    /*    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
    free(v2);*/
    v1 = doEq(v1, v2);
    v1->val.BoolVal = !(v1->val.BoolVal);
    return v1;
}


/*
 * The four rel ops that follow are a bit of a pain given all the types that
 * are comparable.  We just have to sort them all out.
 */
ValueStruct doLess(v1,v2)
    ValueStruct v1, v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, longreal, bool, or char.
     */
    switch (v1->tag) {
	case IntTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.IntVal < v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.IntVal < v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LIntTag:
	    v1->val.BoolVal = v1->val.LIntVal < v2->val.LIntVal;
	    break;
	case RealTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.RealVal < v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.RealVal < v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LRealTag:
	    v1->val.BoolVal = v1->val.LRealVal < v2->val.LRealVal;
	    break;
	case BoolTag:
	    v1->val.BoolVal = v1->val.BoolVal < v2->val.BoolVal;
	    break;
	case CharTag:
	    v1->val.BoolVal = v1->val.CharVal < v2->val.CharVal;
	    break;
	case StringTag:
	    v1->val.BoolVal = (StringCompare(v1->val.StringVal, v2->val.StringVal) < 0);
	    break;
    }
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
    free(v2);
    return v1;
}

ValueStruct doGreater(v1,v2)
    ValueStruct v1, v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, longreal, bool, or char.
     */
    switch (v1->tag) {
	case IntTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.IntVal > v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.IntVal > v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LIntTag:
	    v1->val.BoolVal = v1->val.LIntVal > v2->val.LIntVal;
	    break;
	case RealTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.RealVal > v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.RealVal > v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LRealTag:
	    v1->val.BoolVal = v1->val.LRealVal > v2->val.LRealVal;
	    break;
	case BoolTag:
	    v1->val.BoolVal = v1->val.BoolVal > v2->val.BoolVal;
	    break;
	case CharTag:
	    v1->val.BoolVal = v1->val.CharVal > v2->val.CharVal;
	    break;
	case StringTag:
	    v1->val.BoolVal = (StringCompare(v1->val.StringVal, v2->val.StringVal) > 0);
	    break;
    }
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
    free(v2);
    return v1;
}

ValueStruct doLessEq(v1,v2)
    ValueStruct v1, v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, longreal, bool, char, or
     * set.
     */
    switch (v1->tag) {
	case IntTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.IntVal <= v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.IntVal <= v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LIntTag:
	    v1->val.BoolVal = v1->val.LIntVal <= v2->val.LIntVal;
	    break;
	case RealTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.RealVal <= v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.RealVal <= v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LRealTag:
	    v1->val.BoolVal = v1->val.LRealVal <= v2->val.LRealVal;
	    break;
	case BoolTag:
	    v1->val.BoolVal = v1->val.BoolVal <= v2->val.BoolVal;
	    break;
	case CharTag:
	    v1->val.BoolVal = v1->val.CharVal <= v2->val.CharVal;
	    break;
	case SetTag:
	    v1->val.BoolVal = SetContains(v1, v2);
	    break;
	case StringTag:
	    v1->val.BoolVal = (StringCompare(v1->val.StringVal, v2->val.StringVal) <= 0);
	    break;
    }
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
    free(v2);
    return v1;
}

ValueStruct doGreaterEq(v1,v2)
    ValueStruct v1, v2;
{
    /*
     * Propagate null value if either is operand is nil.
     */
    if (isNilValue(v1) or isNilValue(v2))
	return null;

    /*
     * The possibilities here are int, real, longint, longreal, bool, char, or
     * set.
     */
    switch (v1->tag) {
	case IntTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.IntVal >= v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.IntVal >= v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;
	case LIntTag:
	    v1->val.LIntVal = v1->val.LIntVal >= v2->val.LIntVal;
	    break;
	case RealTag:
	    switch(v2->tag) {
		case IntTag: 
		    v1->val.BoolVal = v1->val.RealVal >= v2->val.IntVal;
		    break;
		case RealTag: 
		    v1->val.BoolVal = v1->val.RealVal >= v2->val.RealVal;
		    break;
	    } // end switch v2->tag
	    break;	case LRealTag:
	    v1->val.LRealVal = v1->val.LRealVal >= v2->val.LRealVal;
	    break;
	case BoolTag:
	    v1->val.BoolVal = v1->val.BoolVal >= v2->val.BoolVal;
	    break;
	case CharTag:
	    v1->val.CharVal = v1->val.CharVal >= v2->val.CharVal;
	    break;
	case StringTag:
	    v1->val.BoolVal = (StringCompare(v1->val.StringVal, v2->val.StringVal) >= 0);
	    break;
	case SetTag:
	    v1->val.BoolVal = SetContains(v2, v1);
	    break;
    }
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
    free(v2);
    return v1;
}

/*
 * Set containment predicate.  Implement by comparing bits.  Viz., each bit on
 * in v1 must also be on in v2.  v2 may have other bits on.
 */
bool SetContains(v1, v2)
    ValueStruct v1, v2;    
{
    return (((v1->val.SetVal | v2->val.SetVal) ^ v2->val.SetVal) == 0);
}

/*
 * Set membership.  Implement by bit comparison.  Viz., v1'th bit must be on in
 * v2.
 */
ValueStruct doIn(v1,v2)
    ValueStruct v1, v2;    
{
    if (v2->tag == ListTag) {
	v1->val.BoolVal = (InListWithFunction(v2->val.ListVal, v1, ValueListEquals) > 0);
    }
    else if ((v1->tag == StringTag) && (v2->tag == StringTag)) {
	v1->val.BoolVal = StringContains(v2->val.StringVal, v1->val.StringVal);
    }
    else {
	v1->val.BoolVal = (1 << SetNormalize(v1->val.IntVal, v2->type))
	    and v2->val.SetVal;
    } // not a list
    v1->tag = BoolTag;
    v1->type = BoolType;
    v1->size = TypeSize(BoolType);
//    free(v2);

    return v1;
}


/*
 * Length operator.  Returns length list, string, or integer.  For the latter,
 * it's the number of digits.  The type checker ensures that it's one of these
 * three types.
 */
ValueStruct doLen(ValueStruct v1) {
    ValueStruct v;
    int len = 0;

    if (v1 == null) {
	return v1;
    }

    v = MakeVal(RVAL, IntType);

    switch (v1->tag) {
        case NilTag:
	    len = 0;
	    break;
	case ListTag:
	    len = ListLen(v1->val.ListVal);
	    break;
	case StringTag:
	    len = StringLen(v1->val.StringVal);
	    break;
	case IntTag:
	    len = (int) log10(v1->val.IntVal) + 1;
    }
    v->val.IntVal = len;
    return v;
}

/*
 * Evaluate a let by binding the expression value to each of the let vars.
 * Note that no scope entry/exit happens here.  Let's are required to be
 * within an expr seq scope, and hence are local to it.  The let itself does
 * not declare a scope, but rather uses the parent expr seq scope.
 */
ValueStruct doLet(nodep t) {
    nodep n;
    ValueStruct lval, rval;
    SymtabEntry* sym;

    /*
     * Eval the let expr.
     */
    rval = interpExpr(t->components.decl.kind.let.expr);
    if (rval == null) {
	return null;
    }

    /*
     * Bind the expr value to each name.
     */
    for (n = t->components.decl.kind.let.names; n != null;
	     n = n->components.atom.next) {

        /*
         * The new chunk of code is QidRef, without its traversal of the
         * atom.next chain.  The subtle problem here is that a qid, e.g.,
         * x.y.z, is reperesented as a tree with an atom.next chain.  But the
         * let name list is also represented this way.  Hence, the tree for
         * x.y.z looks just like the tree for let x,y,z ... .  So, we'll do
         * here what QidRef does, but not traverse the rest of the atom chain
         * as if it's a qid.  Bad tree design, but whatever.
         */
        sym = QuickLookupQid(n);
        lval = MakeVal(LVAL, sym->Type);
        lval->val.LVal = GetAddr(sym, n);

        /*
         * Do the rval binding.
         */
	Bind(sym, lval, rval);
    }

    /*
     * Return the expr value.
     */
    return rval;
}

/*
 * Evaluate an array constructor by alloc'ing a properly sized block of storage
 * and assigning each elem to the sucessive operand values.
 */
ValueStruct doListConstructor(t)
    nodep t;
{
    TypeStruct type             /* Type of the array, courtesy of typechker */
	= t->header.attachment.n2;
    TypeStruct basetype 	/* Base type of the list. */
	= type ? type->components.type.kind.arraytype.basetype : null;
    ValueStruct rtn,            /* Return val temp */
           rval;                /* Value of each elem expr */
    //ListElemData* newData;	/* working new data pointer */
    nodep e;                    /* Working expr pointer */

    /*
     * If we arrive here and type is undefined, return nil now.
     */
    if (!type)
    {
	rtn = MakeVal(RVAL, NilType);
	return rtn;
    }

    rtn = MakeVal(RVAL, type);
    rtn->val.ListVal = NewList();

    for (e = t->components.expr.left_operand; e;
                e = e->components.exprlist.next) {

	// Evaluate the value expressions along the way and assign to a memory slot
        rval = interpExpr(e->components.exprlist.expr);
	PutList(rtn->val.ListVal, (ListElemData*)rval);

	/*
	 * As a special case, add constructed list elements to the universe of
	 * list's base type, when that base is an ident type.  This is also
	 * done in doDotDot, which handles list construction from a value
	 * range.
	 */
        if (isIdentType(basetype)) {
	    UniverseAddValue1(
		basetype->components.type.kind.ident.type->
		    components.atom.val.text, rval);
	}
    }

    return rtn;
}

/*
 * Evaluate an tuple constructor
 */
ValueStruct doTupleConstructor(t)
    nodep t;
{
    ValueStruct rtn,            /* Return val temp */
	rval;
    nodep e,
	expr;
    TypeStruct f,
	tupleType,
	fieldType;
    int numFields,
	i;
    /*
     * Implementation Notes:
     *
     * Your pseudo code for how to do things is the correct approach, except
     * for the use of the tuple symbol table.  In this context, the symbol
     * table is actually useless, because the type checker could only construct
     * a table with anonymous tuple values.  E.g., the symtab for {1, 2, 3} has
     * three entrees, but no field names to lookup with.
     *
     * The only way fields in a constructed tuple can be lookedup via symtab is
     * when the value gets bound to a variable with a matching tuple type.
     * E.g.,
     *
     *     obj T = i:integer and j:integer and k:integer;
     *     var t:T;
     *     > t = {1,2,3};
     *     > t.k;
     *
     * The typechecker makes sure that you can only bind compatible tuple
     * values to variables like t, so that t.k accesses the correct value.  But
     * it's the object type T that has the useable symtab, not the raw tuple
     * value {1,2,3}.
     *
     * What you do need are types for each field, to put in the constructed
     * Values.  The following is the record type that has this info:
     *
     *     t->components.unop.operand->
     *         components.exprlist.type->
     *             components.type.kind.record
     *
     * The way to access each field is through the .numfields and .fields
     * components.  E.g., if
     *
     *  rt =
     *     t->components.unop.operand->
     *         components.exprlist.type->
     *             components.type.kind.record;
     * 
     * then rt.numfields is the int value of how many fields there are and
     * rt.fields is a list of tree nodes for the fields.  See the
     * EnterTupleField function in typechk.c for the way the field list is
     * created.
     */

    if (!t->components.unop.operand)
    {
	rtn = MakeVal(RVAL, NilType);
	return rtn;
    }

    /** return nil since this isn't working **/
    tupleType = t->components.unop.operand->components.exprlist.type;
    rtn = MakeTupleVal(RVAL, tupleType);

    // numFields = tupleType->components.type.kind.record.numfields; // don't need this any more?
    rtn->val.StructVal = NewList();
    for (e = t->components.unop.operand;
		e;
		e = e->components.exprlist.next) {
        rval = interpExpr(e->components.exprlist.expr);
	PutList(rtn->val.StructVal, (ListElemData*)rval);
    }

    /**
     * Approach Idea
     * - assign to rtn the result of MakeVal(RVAL, type of tuple within t) 
     * - grab from the type structure...
     *   => the # of tuple components
     *   => the starting address of the symtab
     * - foreach expression in the tuple type structure
     *   => interpExpr the expression
     *   => assign the address of the resulting ValueStruct to symtab[] at the proper index
     * - return rtn
     * - success!
     */
    return rtn;
}

/*
 * Evaluate a union tag query of the form
 *
 *     u ?. f
 *
 * where u is a union and f is one of its fields.  Return true if f is the
 * current field, false otherwise.
 */
ValueStruct doUnionRef(nodep t) {
    return null;
    /* TODO: Finish this. */
}

/*
 * Evaluate an instance checking expr of the form
 *
 *	desig '?<' name
 *
 * where desig must be a class type, and name must be the name of one of its
 * instances.  Return true if name is the type of desig, false otherwise.
 */
ValueStruct doChkInstance(nodep t) {
    return null;
    /* TODO: Finish this. */
}

/*
 * Evaluate an array constructor of integers when a range is provided.
 * For example, this function turns [ 1 .. 4 ] into a list of
 * [ 1, 2, 3, 4 ].
 */
ValueStruct doDotDot(t)
    nodep t;
{
    TypeStruct type             /* Type of the array, courtesy of typechker */
              = t->header.attachment.n2;
    TypeStruct rtype;		/* Temp var to hold ResolveIdentType(type) */
    ValueStruct rtn,            /* Return val temp */
		lower,		/* lower bounds expression */
		upper,		/* upper bounds expression */
		rval;           /* Value of each elem expr */
    nodep e;                    /* Working expr pointer */
    int i;

    // if we arrive here and type is undefined, return nil now
    if (!type)
    {
	rtn = MakeVal(RVAL, NilType);
	return rtn;
    }

    // plan of attack: evaluate the lower and upper bounds. Assume will evaluate
    // properly since typechecker already did some dirty work.
    lower = interpExpr(t->components.binop.left_operand);
    upper = interpExpr(t->components.binop.right_operand);

    rtn = MakeVal(RVAL, type);
    rtn->val.ListVal = NewList();

    for (i = lower->val.IntVal; i <= upper->val.IntVal; i++) {
        rval = MakeVal(RVAL, IntType);
	rval->val.IntVal = i;
	PutList(rtn->val.ListVal, (ListElemData*)rval);

	/*
	 * As a special case, add constructed list elements to the universe of
	 * list's base type.  This is also done in doListConstructor, which
	 * handles list construction from a discrete list of values.  Note that
	 * here, the type of value is unconditionally integer, as opposed to
	 * doListConstructor, where the list base type is arbitrary.
	 */
	UniverseAddValue(rval);
    } // end for lower .. upper

    return rtn;
} // end function doDotDot

/*
 * Normalize a set member to its bit position within the set.  If the set
 * element is an enum ident, there's nothing to do.  If its a subrange value,
 * then subtract off the lower bound.
 */
int SetNormalize(v1, t)
    ValueStruct v1;
    TypeStruct t;
{
    if (isSubrange(t))
	return v1->val.IntVal - t->components.type.kind.subrange.lowerval;
    else
	return v1->val.IntVal;
}


/*
 * Compute the storage location designated by a designator, returning an
 * l-value.  doDesignator above returns a designator r-value.
 */
ValueStruct designator(t)
    nodep t;
{
    ValueStruct v1,
	lval,
	tuple;
    TypeStruct type;
    SymtabEntry *sym;
    int i;

    /*
     * Switch on one of the three forms of designator operator (array, record,
     * or pointer), or the base case of a qualident.
     */
    // pcdebug: parse-tree.h indicates that EXPR_NODE is deprecated.
    //          should this change to UNOP_NODE or BINOP_NODE?
    if (t->header.kind == BINOP_NODE) {
	switch (t->header.name) {
	    case '[':
		v1 = interpExpr(t->components.binop.left_operand);
		return doArrayRef(v1, t->components.binop.right_operand);
	    case '.':
		v1 = interpExpr(t->components.expr.left_operand);
		return RecordRef(v1, t->components.expr.right_operand);
	    case '^':
		v1 = designator(t->components.expr.left_operand);
		return PointerRef(v1, t);
	}
   }
   else {
	/*
	 * if we have an uninitialized structured val -- union or tuple --
	 * then do some initializing here.
	 */
	sym = QuickLookupQid(t);
	if (t->header.attachment.n1->components.atom.next) {
	    type = ResolveIdentType(sym->Type, null, false);
	    lval = MakeVal(LVAL, type);
	    lval->val.LVal = GetAddr(sym, t);
	    if (!(lval->val.LVal) || !(*(lval->val.LVal))) {
		// dotupleconstructor... but then what with the result?
		tuple = MakeTupleVal(RVAL, type);
		tuple->val.StructVal = NewList();
		/*
		 * Initialize these elements to nil
		 */
	        for (i = 1; i <= type->components.type.kind.record.numfields; i++) {
		    PutList(tuple->val.StructVal, MakeVal(RVAL, NilType));
		}

		*(lval->val.LVal) = tuple;
	    }
	} // end if structured union / tuple

	return QidRef(t);
   } // not a binop node
}

/*
 * Returns a ValueStruct that points to the value within list desig at index.
 */
ValueStruct doArrayRef(desig, index)
    ValueStruct desig;	/* L-value for the left operand. */
    nodep index;	/* Expr list for the right operand. */
{
    ValueStruct vIndex,
		result,
		newDesig;
    bool isList = true;
    int index_val;

    /*
     * Deal with nil desig, i.e., just return it as is.
     */
    if (isNilValue(desig)) {
	return desig;
    }

    // figure out the index
    vIndex = interpExpr(index);
    if (desig->tag == ListTag) {
	result = (ValueStruct)GetListNth(desig->val.ListVal,
	    index_val = vIndex->val.IntVal);
    }
    else if (desig->tag == StringTag) {
	result = MakeVal(RVAL, StringType);
	result->val.StringVal = GetNthStringCharAsString(desig->val.StringVal,
	    index_val = vIndex->val.IntVal);
	isList = false;
    }

    /*
     * Handle null return value from list or string access, which we assume
     * means index out of bounds.
     *
     * TODO: Make sure there's no other reason the access fucntions could fail
     * here.
     */
    if (result == null) {
	lerror(index, "%s index value of %d is out of bounds.\n",
	    isList ? "List" : "String", index_val);
	/* 
	 * Update: don't long jump here, just return a nil value.
	 *
	longjmp(RuntimeError, ArrayBndStatus);
	 */
	return null;
    }

    /*
     * Index is OK -- make the return value.
     */
    newDesig = MakeVal(LVAL,
	isList ? desig->type->components.type.kind.arraytype.basetype
	       : result->type);
//  newDesig = MakeVal(LVAL, result->type);
    newDesig->val.LVal = (ValueStruct *) malloc(sizeof(Value **));
    *(newDesig->val.LVal) = result;
//  newDesig->type = result->type;
    newDesig->tag = result->tag;
    newDesig->size = result->size;

    return newDesig;
} // end function doArrayRef

/*
 * Nominally returns a list of components from v1, at elements v2 .. v3.
 * v1 represents the list
 * v2 represents the lower bounds
 * v3 represents the upper bounds
 */
ValueStruct doArraySliceRef(ValueStruct v1, ValueStruct v2, ValueStruct v3,
        nodep t) {
    ValueStruct result;
    int i, lower, upper, len;
    bool isList;
    bool err = false;

    /*
     * Return null if one or more args is null
     */
    if (isNilValue(v1) or isNilValue(v2) or isNilValue(v3)) {
	return null;
    }

    /*
     * Do bounds checks.
     */
    lower = v2->val.IntVal;
    upper = v3->val.IntVal;
    if (v1->tag == StringTag) {
	len = StringLen(v1->val.StringVal);
	isList = false;
    }
    else {
	len = ListLen(v1->val.ListVal);
	isList = true;
    }

    if (((lower <= 0) or (lower > len)) and (lower <= upper)) {
	lerror(t->components.trinop.middle_operand,
	    "%s index value of %d is out of bounds.\n",
	        isList ? "List" : "String", lower);
	err = true;
    }
	
    if (((upper <= 0) or (upper > len)) and (upper >= lower)) {
	lerror(t->components.trinop.right_operand,
	    "%s index value of %d is out of bounds.\n",
	        isList ? "List" : "String", upper);
	err = true;
    }

    if (err) return null;

    /*
     * NOTE: the following check is disabled, which means that this function
     * quietly returns the empty list or string when lower > upper.  This gives
     * the Lisp-like behavior of cdr quietly returning nil when it so returns.
     *
    if (lower > upper) {
	lerror(t->components.trinop.middle_operand,
	    "%s lower index value of %d is greater than upper index value of %d\n",
	        isList ? "List" : "String", lower, upper);
    }	
     */

    /*
     * Build the new list or string.  The type checker ensures that the left
     * operand is one of these two types.
     */
    result = MakeVal(RVAL, v1->type);
    if (isList) {
	result->val.ListVal = NewList();

	// loop through from lower .. upper and add the elements to result
	for (i = v2->val.IntVal; i <= v3->val.IntVal; i++) {
	    PutList(result->val.ListVal, GetListNth(v1->val.ListVal, i));
	}
    }
    else if (v1->tag == StringTag) {
	result->val.StringVal = (String *)SubString(v1->val.StringVal, v2->val.IntVal, v3->val.IntVal);
    }

    return result;
}

/*
 * Bounds check an array index.  Fatal error if out of bounds.
 */
ChkBound(i, lbv, type, t)
    int i;
    int lbv;
    TypeStruct type;
    nodep t;
{
    if ((i < 0) or
	    (i > type->components.type.kind.arraytype.normalizedubval)) {
	lerror(t, "Array index value %d out of bounds.\n", i+lbv);
	longjmp(RuntimeError, ArrayBndStatus);
    }
}


/*
 * Compute the location designated by a record ref.  Since the type checker
 * built record symtabs, field offset computation is just a simple lookup.
 */
ValueStruct RecordRef(desig, field)
    ValueStruct desig;	/* L-value for the left operand. */
    nodep field;	/* Ident for the right operand. */
{
    ValueStruct valueField,
	tuple,
	newDesig;
    SymtabEntry *f;
    int n;
    TypeStruct type = ResolveIdentType(desig->type, null, false),
	fieldType;

    /*
     * Deal with nil desig, i.e., just return it as is.
     */
    if (isNilValue(desig)) {
	return desig;
    }

    /*
     * coming in, desig->LVal should point to the ValueStruct of the struct
     */
    if (field->header.name == Yident) {
	f = LookupIn(field->components.atom.val.text,
			type->components.type.kind.record.fieldstab);
	fieldType = ResolveIdentType(f->Type, null, false);
    }
    else {
	f = null;
	n = field->components.atom.val.integer;
	fieldType = ResolveIdentType(
	    GetNthField(type->components.type.kind.record.fields, n)->
		components.decl.kind.field.type, null, false);
    }

    if (desig->LorR == LVAL) {
	tuple = (ValueStruct)*(desig->val.LVal);
    }
    else {
	tuple = desig;
    }

    /* Note: Lists are 1-indexed */
    valueField = (ValueStruct)GetListNth(tuple->val.StructVal,
	f ? f->Info.Var.Offset + 1 : n);
    /*
     * if we have valueField filled in, use its type... otherwise use the fieldType
     */
    if (!valueField) {
	newDesig = MakeVal(LVAL, fieldType);
    }
    else {
	newDesig = MakeVal(LVAL, valueField->type);
    }
    newDesig->val.LVal = (ValueStruct *) malloc(sizeof(Value **));
    *(newDesig->val.LVal) = valueField;

    return newDesig;
}

/*
 * Get the nth field in the given records fields list, which is a decl list of
 * field decls.  The type checker has made sure that there are enough fields.
 */
nodep GetNthField(nodep fields, int n) {
    int i;
    nodep fp;

    for (i = 1, fp = fields;
	i < n;
	    i++, fp = fp->components.decl.next) {
	;
    }
    return fp;
}

/*
 * Compute the location designated by a pointer ref.  We'd like it to be just a
 * simple deref of the C pointer, viz.:
 *	desig->val.LVal = *((char **) desig->val.LVal)
 * However, as noted elsewhere in the interp (e.g., doForIncr, IntegerizeL),
 * alignment problems arise with such casts.  Hence we do the bcopy.
 *
 * Note the handling of nil pointer value.  The error message is issued and a
 * longjmp performed.  The longjmp is used since nil pointer referencing is
 * quite fatal, and we need to get all the back way out to the top-level of
 * interp.
 */
ValueStruct PointerRef(desig, t)
    ValueStruct desig;
    nodep t;		/* Only used in nil pointer error message. */
{
    memcpy(&(desig->val.LVal), desig->val.LVal, TypeSize(desig->type));
    /*bcopy(desig->val.LVal, &(desig->val.LVal), TypeSize(desig->type));*/

    /*
     * Check for a nil pointer value.  It's an error if we're not at the
     * top-level of the designator.
     */
    if (not desig->val.LVal) {
	lerror(t, "Attempt to reference through a nil pointer.\n");
	longjmp(RuntimeError, NilPointerStatus);
    }

    desig->type = desig->type->components.type.kind.ref.basetype;
    desig->tag = desig->type->components.type.tag;
    desig->size = TypeSize(desig->type);

    return desig;
}


/*
 * Eval a qid ref as an l-value.  This is where we have to handle the syntactic
 * nuisance of a record ref that looks like a qid.  This is an artifact of the
 * shift-reduce error on qid.  Viz., there's no way to distinguish a qid from a
 * designator, so the parser picks qid.  We could avoid this by having the type
 * checker convert qid record refs into desig trees, but it's not really that
 * important.
 *
 * What we're dealing with is the leading part of a designator that has '.'
 * operators, before we get to the '[' and '^' operators, after which we'll see
 * '.'s in expr nodes above in designator.  Hence, we interate through the
 * field refs rather than recurse.
 */
ValueStruct QidRef(qid)
    nodep qid;
{
    nodep id, ft;
    ValueStruct desig;
    SymtabEntry *sym;

    /*
     * Lookup the first (only) qid component.  QuickLookupQid has already moved
     * us past any leading module name components in the qid, so all we're left
     * with is a single ident, or a record ref.
     *
     * 27oct93 bugfix: QuickLookupQid HAS NOT yet been called.  Not quite sure
     * why I thought it had been. Anyway, it needs to be called here and now.
     */
    sym = QuickLookupQid(qid);

    /*
     * Make the initial base lval for a designator.
     */
    desig = MakeVal(LVAL, sym->Type);
    desig->val.LVal = GetAddr(sym, qid);

    /*
     * Cruise through any fields, using RecordRef for each.  This does
     * iteratively what is done recursively when '.'s are parsed as exprs.
     * Note user of header.attachment.n1 field, set to the first non-module
     * component of the qid, courtesy (uglyly) of QuickLookupQid.
     */
    for (ft = qid->header.attachment.n1->components.atom.next;
	    ft; ft = ft->components.atom.next) {
	desig = RecordRef(desig, ft);
    }

    return desig;
}


/*
 * Lookup a qualident through all leading modules.  This is a "quick" version
 * of sym-aux.c:LookupQid in that this version does not need to do any legality
 * checks.
 *
 * A bit of a hack is used to inform the caller where the end of the leading
 * module qualifiers is.  Viz., the header.attachment.n1 field is used to point
 * to the first non-module-name component of the qid sent in.
 */
SymtabEntry *QuickLookupQid(qid)
    nodep qid;
{
    nodep ql, qr;
    SymtabEntry *syml, *symr;
    char *nl, *nr;

    /*
     * Lookup first qid component.
     */
    syml = Lookup(nl = qid->components.atom.val.text);

    /*
     * Prepare to move into new symtab(s) by saving CurSymtab.
     */
    PushSymtab();
    
    /* 
     * Move through each qid component up to the first non-module component.
     */
    for (ql = qid, qr = qid->components.atom.next;
	     qr; ql = qr, qr = qr->components.atom.next, syml = symr) {

	/*
	 * Quit on first non-module.
	 */
	if (syml->Class != C_Module)
	    break;

	/*
	 * Move into the scope of the left operand.
	 */
	MoveToSymtab(syml->Info.Module.Symtab);

	/*
	 * Lookup right oprnd.
	 */
	symr = Lookup(nr = qr->components.atom.val.text);
    }

    /*
     * Return the Lookup of the last qid component, threading n1 as described
     * above, and restoring the entering symtab.
     */
    qid->header.attachment.n1 = ql;
    PopSymtab();
    return syml;
}


/*
 * Compute the address of the storage bound to a variable, value, or parameter.
 * Return a pointer to the location.
 */
Value** GetAddr(SymtabEntry *sym, nodep t)
{
    Value **addr1, **addr2;

    if ((sym->Class == C_Var) or (sym->Class == C_Let_Var)) {
	return Display[sym->Level] + sym->Info.Var.Offset;
    }
    else if (sym->Class == C_Obj) {
	if (isValSym(sym)) {
	    return &(sym->Info.Obj.val);
	}
	/*
	 * Type checker should prevent this from happening, but in case it does
	 * ... .
	 */
	else {
	    lerror(t,
		"%s is an object type, not a value.\n",
		 sym->Symbol);
	    return &TheNilValue;
	}
    }
    else {
	return Display[sym->Level] + sym->Info.Parm.Offset;
    }
}


/*
 * Compute the static address of a global variable, given its offset.
 * NOTE: this is vestigial from a non-display version of the interp, but left
 * around for possible future use.
 */
Value** StaticAddr(offset)
    int offset;
{
    return &(StaticPool[offset]);
}


/*
 * Return the address of the stack at a given offset from the current tos.
 */
Value** StackAddr(offset)
    int offset;
{
    return &(Display[CurSymtab->Level][offset]);
}


/*
 * Compute the address of a formal parm during binding.
 */
Value** GetFormalAddr(sym)
    SymtabEntry *sym;
{
    return &(ftos[sym->Info.Parm.Offset]);
}


/*
 * Make a new value struct.  Notice the distinction in the size for structured
 * vs non-structured values.  For the former, we set the size only to the size
 * of the pointer to the value, not to the actual TypeSize of the value itself.
 * This means that we need to treat structured vals differently in accessing
 * and assignment.
 */
ValueStruct MakeVal(LorR, type)
    ValType LorR;
    TypeStruct type;
{
    ValueStruct v;

    v = (ValueStruct) malloc(sizeof(Value));
    v->LorR = LorR;
    v->type = (TypeStruct)ResolveIdentType(type, null, false);
    v->tag = ValueTag(v->type);
    if (v->tag == ListTag) {
        v->size = sizeof(char *);
    }
    else
    {
        v->size = TypeSize(type);
    }

    return v;
}

/*
 * Make a new value struct specifically for Tuples. Other comments / code
 * are left-over. psc 2/6/09.
 *
 * Notice the distinction in the size for structured
 * vs non-structured values.  For the former, we set the size only to the size
 * of the pointer to the value, not to the actual TypeSize of the value itself.
 * This means that we need to treat structured vals differently in accessing
 * and assignment.
 */
ValueStruct MakeTupleVal(LorR, type)
    ValType LorR;
    TypeStruct type;
{
    ValueStruct v;

    v = (ValueStruct) malloc(sizeof(Value));
    v->LorR = LorR;
    v->type = type;
    v->tag = ValueTag(v->type);
    v->size = sizeof(char *);

    return v;
}

/*
 * Compute one of the possible tag types from a TypeStruct.
 */
ValTag ValueTag(t)
    TypeStruct t;
{
    if (isNil(t))
	return NilTag;
    if (isInt(t))
	return IntTag;
    if (isReal(t))
	return RealTag;
    if (isBool(t))
	return BoolTag;
    if (isString(t))
	return StringTag;
    if (isSymlitType(t))
	return SymLitTag;
    if (isTuple(t))
	return StructTag;
    if (isArray(t))
	return ListTag;
    if (isProc(t))
	return ProcTag;

    /*
     * 5feb09 gfisher@calpoly.edu: This needs to be finished to return BoolTag,
     * StringTag, StructTag, ListTag, and ProcTag.
     */


    return NilTag;  /* The current default */
}


/*
 * Push an act rec by incrementing ftos by the given size.
 */
void PushActRec(size)
    int size;
{
    ftos -= size;
}

/*
 * As PushActRec, then set all ValueStructs to null.
 */
void PushActRecCleared(size)
    int size;
{
    Value** tos = ftos-1;

    ftos -= size;

    for (; tos > ftos; tos--) {
	*tos = null;
    }
}

/*
 * Get the current ftos.
 */
Value** GetFTos()
{
    return ftos;
}


/*
 * Set the current ftos.
 */
void SetFTos(newtos)
    Value** newtos;
{
    ftos = newtos;
}

/*
 * Incr ftos by given size in bytes.
 */
IncrFTos(size)
    int size;
{
    ftos -= size;
}

/*
 * Decr ftos by given size in bytes.
 */
DecrFTos(size)
    int size;
{
    ftos += size;
}

/*
 * Set the normal (i.e., not-during-binding) tos pointer.  This will be used by
 * folks who need to use the stack as a utility storage area, such as doLoop
 * and printf_, q.q.v.
SetTos(level)
    int level;
{
    tos = &Display[level];
}
 */

/*
 * Push something onto the stack, NOT during binding.  Used by doLoop, e.g.
 */
void push(data, size)
    char *data;
    int size;
{
    ftos -= size;
    memcpy(ftos, data, size);
    /*bcopy(data, ftos, size)*/;
}

/*
 * Pop something off the stack, NOT during binding.
 */
Value** pop(size)
    int size;
{
    Value** rtnval = ftos;
    ftos += size;
    return rtnval;
}

/*
 * Return pointer to tos, NOT during binding.  Used by doExit, e.g.
 */
Value** top()
{
    return ftos;
}


/*
 * Save Display[level] in current act rec at given offset and set
 * Display[level] = ftos.
 */
SaveDisplay(level, offset)
    int level, offset;
{
    ftos[offset] = (Value*) Display[level];
    /*memcpy(&(ftos[offset]), (char *) &(Display[level]), sizeof(char *));*/
    /*bcopy((char *) &(Display[level]), &(ftos[offset]), sizeof(char *));*/
    Display[level] = ftos;
}

/*
 * Restore Display[level] from Display[level][offset].
 */
RestoreDisplay(level, offset)
{
    Display[level] = (Value**) Display[level][offset];
    /*memcpy(&(Display[level]), &(Display[level][offset]), sizeof (char *));*/
    /*bcopy(&(Display[level][offset]), &(Display[level]), sizeof (char *));*/

    /* 
     * Familiar alignment problems with this:
     *
    Display[level]= (char *) Display[level][offset];
     */
}


/*
 * Coerce an allowably numeric value struct into a plain C integer.  Caveat
 * caller: it must be called with an integerizable type: int, card, longint,
 * char, bool, subrange, enum.  These are the "caseable" types.
 */
intptr_t Integerize(v)
    ValueStruct v;
{
    switch (v->tag) {
	case IntTag:
	case LIntTag:
	case NilTag:
	    return v->val.IntVal;
	case CharTag:
	    return (intptr_t) v->val.CharVal;
	case BoolTag:
	    return (intptr_t) v->val.BoolVal;
    }
}


/*
 * Same as Integerize, but for an l-value.
 */
int IntegerizeL(v)
    ValueStruct v;
{
    switch (v->tag) {
	case IntTag: {
	    int i;
	    memcpy(&i, v->val.LVal, sizeof(int));
	    /*bcopy(v->val.LVal, &i, sizeof(int));*/
	    return i;
	    /*
	     * We'd like to use the following here and in the three case's
	     * below, but it causes BUS (alignment error) on the Sparc, at
	     * least:
	     *
		return (int) (*((int *)v->val.LVal));
	     *
	     */
	}
	case LIntTag: {
	    long i;
	    memcpy(&i, v->val.LVal, sizeof(int));
	    /*bcopy(v->val.LVal, &i, sizeof(int))*/;
	    return (int) i;
	}
	case CharTag: {
	    int i = 0;
	    memcpy(&i, v->val.LVal, sizeof(char));
	    /*bcopy(v->val.LVal, &i, sizeof(char))*/;
	    return i;
	}
	case BoolTag: {
	    int i = 0;
	    memcpy(&i, v->val.LVal, sizeof(bool));
	    /*bcopy(v->val.LVal, &i, sizeof(bool))*/;
	    return i;
	}
    }
}


/*
 * Return true if the given ValueStruct is null or TheNilValue.
 */
bool isNilValue(ValueStruct v) {
    return (v == null) or (v->tag == NilTag);
}


/*
 * Intialize the interpreter by allocating the static storage pool and runtime
 * stack.  The given nodep is the parse tree of module we're about to
 * execute.
 */
bool InitInterp(nodep ptree) {
    SymtabEntry* sym;

    /*
     * Enter the scope of the module we're now going to execute.
     */
    if (ptree) {
	char *name;
	name = ptree->components.module.name->components.atom.val.text;
	sym = LookupString(name);

	/*
	 * This is to prevent nested modules from executing.  TODO: fix this.
	 */
	if (not sym) {
	    return false;
	}
	MoveToSymtab(LookupString(name)->Info.Module.Symtab);
    }
    else {
	MoveToSymtab(MainSymtab);
    }
    InitPools();
    InitVals();

    return true;
}

/*
 * Init the memory pools.
 */
void InitPools() {
    EnvirPool = (Value**) calloc(ENVIRSIZE, sizeof(Value*));
    StaticPool = (Value**) calloc(STATICSIZE, sizeof(Value*));
    Stack = (Value**) calloc(STACKSIZE, sizeof(Value*));
    Display = (Value***) calloc(DISPLAYSIZE, sizeof(Value**));
    Display[0] = EnvirPool;
    Display[1] = StaticPool;
    ftos = &(Stack[STACKSIZE]);

    /*
     * Note that stack will grow *up* to make act rec offset computation easy.
     * Also, while we could compute display size by high-water mark of nesting
     * level, life gets difficult if the interp loads a module at runtime with
     * a greater nest max than before.  Hence, we'll pick a safe size for the
     * display (50) and complain if nesting ever gets below that.
     */
}

/*
 * Build one-time-init interpreter constants.
 */
void InitVals() {
    TheNilValue = MakeVal(RVAL, NilType);
}

/*
 * Reinit interp after runtime error, in case we're running interactively and
 * need things cleaned up.
 */
ReInitInterp()
{
    int i;

    ftos = &(Stack[STACKSIZE]);
    for (i = 2; i <= DISPLAYSIZE; i++)
	Display[i] = null;
    MoveToSymtab(CurProgSymtab);
}

/*
 * If all checking succeeds, run the spec by tracking down all of its top-level
 * executable exprs.  The code follows the typechk.c:chkSpec, q.v.
 *
 * 17feb09 NOTE I moved these puppies. PSC
 *
 * 20oct08 NOTE from gfisher@calpoly.edu: All of the "run" prefixed functions
 * that follow belong in interp.c.  They're here at present to avoid conflicts
 * with interp.c check-in.  The functions should be moved when conflict
 * avoidence has been cleared.
 */
void runSpec() {
    Symtab *Tab;

    MoveToSymtab(MainSymtab);
    runModule(CurSymtab->Tree);
    MoveToSymtab(Level0Symtab);
    for (Tab = (Symtab *) EnumCppList(ModuleList); Tab;
				Tab = (Symtab *) EnumCppList(ModuleList)) {
	MoveToSymtab(Tab);
	runModule(CurSymtab->Tree);
	Level0Symtab->Offset = CurStaticOffset;
    }
    if (DumpUniverseOn()) {
	PrintUniverse();
    }
}

/*
 * Execution analog of typechk.c:chkModule, q.v.
 */
void runModule(nodep t) {
    /*
     * Run the body parts.
     */ 
    if (t->header.name == YOBJ) {
	runSpecBody(t->components.module.body);
    }
    else
	runBlock(t->components.module.body);
}

void runSpecBody(nodep t) { 
    nodep n;
    void chkObj(nodep t);
    void chkOp(nodep t);
    ExitStatus status = OKStatus;
    ValueStruct v;

    /*
     * Cruise the parse tree entities list, executing any expr lists, but
     * ignoring all of the decls.  Do the setjmp at this level, so that runtime
     * errors abort a single top-level expr at a time.
     */
    if (InitInterp(CurSymtab->Tree)) {
	for (n=t->components.spec.entities;
		     n; n=n->components.decl.next) {
	    if (n->header.name == '>') {
		if (not (status = setjmp(RuntimeError))) {
		    DoPrint = true;
		    v = interpExpr(n->components.decl.kind.expr);
		    if (DoPrint) {
			PpValue(v, true);
			printf("\n");
			fflush(stdout);
		    }
		}
	    }
	}
    }
}

void runBlock(nodep t) {
    printf("Cannot run blocks at present.\n");
}