/*****************************************************************************
*   "Irit" - the 3d (not only polygonal) solid modeller.		     *
*									     *
* Written by:  Gershon Elber				Ver 0.2, Mar. 1990   *
******************************************************************************
*   Module to evaluate the binary tree generated by the InptPrsr module.     *
*   All the objects are handled the same but the numerical one, which is     *
* moved as a RealType and not as an object (only internally within this	     *
* module) as it is frequently used and consumes much less memory this way.   *
*   Note this module is par of InptPrsr module and was splited only because  *
* of text file sizes problems...					     *
*****************************************************************************/

#include <stdio.h>
#include <ctype.h>
#include <math.h>
#include <string.h>
#include "program.h"
#include "ctrl-brk.h"
#include "objects.h"
#include "allocate.h"
#include "inptprsg.h"
#include "inptprsl.h"
#include "windows.h"

static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld);
static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n);
static int InptEvalCountNumExpressions(ParseTree *Root);
static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
			       int DeleteSelf);

/*****************************************************************************
*   Routine to print help on the given subject HelpHeader.		     *
* Note a match is if the HelpHeader in prefix of help file line.	     *
*****************************************************************************/
void InptEvalPrintHelp(char *HelpHeader)
{
    int	i;
    char *Path, s[LINE_LEN];
    FILE *f;

    Path = searchpath(GlblHelpFileName);

    if (strlen(HelpHeader) == 0)
	HelpHeader = "Commands";	    /* Print a list of all commands. */

    if ((f = fopen(Path, "r")) == NULL) {
	sprintf(s, "Cannot open help file \"%s\".\n", GlblHelpFileName);
	WndwInputWindowPutStr(s);
	return;
    }

    for (i = 0; i < (int) strlen(HelpHeader); i++)
	if (islower(HelpHeader[i]))
	    HelpHeader[i] = toupper(HelpHeader[i]);

    while (fgets(s, LINE_LEN-1, f) != NULL) {
	if (strncmp(HelpHeader, s, strlen(HelpHeader)) == 0) {
	    /* Found match - print it. */
	    while (fgets(s, LINE_LEN-1, f) != NULL && s[0] != '$') {
		WndwInputWindowPutStr(&s[1]);		     /* Skip char 1. */
	    }
	    fclose(f);
	    return;
	}
    }

    fclose(f);

    sprintf(s, "No help on %s\n", HelpHeader);
    WndwInputWindowPutStr(s);
}

/*****************************************************************************
*   Routine to compare two objects with comparison operator as in Root.      *
*****************************************************************************/
ParseTree *InptEvalCompareObject(ParseTree *Root,
				 ParseTree *Left, ParseTree *Right,
				 InptPrsrEvalErrType *IError, char *CError)
{
    int OnlyEquality = TRUE;
    RealType
	Cmp = 0.0;

    if (Left -> PObj -> ObjType != Right -> PObj -> ObjType) {
	*IError = IE_ERR_INCOMPARABLE_TYPES;
	strcpy(CError, "");
	return NULL;
    }

    switch (Left -> PObj -> ObjType) {
	case IP_OBJ_NUMERIC:
	    Cmp = SIGN(Left -> PObj -> U.R - Right -> PObj -> U.R);
	    OnlyEquality = FALSE;
	    break;
	case IP_OBJ_POINT:
	    Cmp = PT_APX_EQ(Left -> PObj -> U.Pt,
			    Right -> PObj -> U.Pt) == 0;
	    break;
	case IP_OBJ_VECTOR:
	    Cmp = PT_APX_EQ(Left -> PObj -> U.Vec,
			    Right -> PObj -> U.Vec) == 0;
	    break;
	case IP_OBJ_PLANE:
	    Cmp =  PLANE_APX_EQ(Left -> PObj -> U.Plane,
				Right -> PObj -> U.Plane) == 0;
	    break;
	case IP_OBJ_STRING:
	    Cmp = strcmp(Left -> PObj -> U.Str, Right -> PObj -> U.Str);
	    OnlyEquality = FALSE;
	    break;
	default:
	    break;
    }

    switch (Root -> NodeKind) {
	case CMP_EQUAL:
	    Cmp = Cmp == 0.0;
	    break;
	case CMP_NOTEQUAL:
	    Cmp = Cmp != 0.0;
	    break;
	case CMP_LSEQUAL:
	case CMP_GTEQUAL:
	case CMP_LESS:
	case CMP_GREAT:
	    if (OnlyEquality) {
		*IError = IE_ERR_ONLYEQUALITY_TEST;
		strcpy(CError, "");
		return NULL;
	    }
	    else {
		switch (Root -> NodeKind) {
		    case CMP_LSEQUAL:
		        Cmp = Cmp <= 0.0;
		        break;
		    case CMP_GTEQUAL:
		        Cmp = Cmp >= 0.0;
			break;
		    case CMP_LESS:
		        Cmp = Cmp < 0.0;
			break;
		    case CMP_GREAT:
		        Cmp = Cmp > 0.0;
			break;
		}
	    }
	    break;
	default:
	    IritFatalError("A comparison operator expected.");
	    break;
    }

    Root -> PObj = GenNUMValObject(Cmp);
    return Root;
}

/*****************************************************************************
*   Routine to execute the IF structure.				     *
*****************************************************************************/
void InptEvalIfCondition(ParseTree *Cond,
			 ParseTree *CondTrue, ParseTree *CondFalse)
{
    if ((Cond = InptPrsrEvalTree(Cond, 1)) != NULL &&
	Cond -> PObj != NULL &&
	IP_IS_NUM_OBJ(Cond -> PObj)) {
	if (APX_EQ(Cond -> PObj -> U.R, 0.0)) {
	    if (CondFalse != NULL)
	      InptPrsrEvalTree(CondFalse, 1);
	}
	else {
	    if (CondTrue != NULL)
		InptPrsrEvalTree(CondTrue, 1);
	}
    }
    else {
	IPGlblEvalError = IE_ERR_IF_HAS_NO_COND;
	strcpy(IPGlblCharData, "");
    }
}

/*****************************************************************************
*   Routine to execute the FOR structure loop.				     *
*   Note that as InptPrsrEvalTree routine is destructive on its input tree,  *
* we must make a copy of the body before executing it!			     *
*   We wish we could access the loop variable directly, but the user might   *
* be stupid and free it in the loop - so me must access it by name.	     *
*****************************************************************************/
void InptEvalForLoop(ParseTree *PStart, ParseTree *PInc, ParseTree *PEnd,
							 ParseTree *PBody)
{
    int i, NumOfExpr, LoopCount;
    char
	*LoopVarName = NULL;
    RealType LoopVar, StartVal, Increment, EndVal;
    ParseTree *PTemp;
    IPObjectStruct *PLoopVar;

    /* Find the only two cases where loop variable is allowed - when then */
    /* given starting value is a parameter, or assignment to parameter... */
    if (PStart -> NodeKind == PARAMETER)
	LoopVarName = PStart -> PObj -> Name;
    else if (PStart -> NodeKind == EQUAL &&
	     PStart -> Left -> NodeKind == PARAMETER) {
	LoopVarName = PStart -> Left -> PObj -> Name;
	/* Rebind the iteration variable to body - it might be new: */
	RebindVariable(PBody, PStart -> Left -> PObj, FALSE);
	if (GetObject(LoopVarName) == NULL)		/* It is really new. */
	    PStart -> Left -> PObj -> Count++;
    }

    PStart = InptPrsrEvalTree(PStart, 1);	 /* Evaluate starting value. */
    PInc   = InptPrsrEvalTree(PInc, 1);		/* Evaluate increment value. */
    PEnd   = InptPrsrEvalTree(PEnd, 1);		      /* Evaluate end value. */
    if (IPGlblEvalError ||
	PStart == NULL || PInc == NULL || PEnd == NULL)
	return;
    StartVal = PStart -> PObj -> U.R;
    Increment = PInc -> PObj -> U.R;
    EndVal = PEnd -> PObj -> U.R;

    /* Num. of expr. in the body. */
    NumOfExpr = InptEvalCountNumExpressions(PBody);
    for (LoopVar = StartVal, LoopCount = 0;
	APX_EQ(LoopVar, EndVal) ||
	(Increment > 0 ? LoopVar <= EndVal : LoopVar >= EndVal);
	LoopVar += Increment, LoopCount++) {
	if (IPGlblEvalError || GlblFatalError)
	    return;
	if (LoopVarName != NULL) {
	    if ((PLoopVar = GetObject(LoopVarName)) != NULL &&
		IP_IS_NUM_OBJ(PLoopVar))
		PLoopVar -> U.R = LoopVar;		 /* Update loop var. */
	    else {
		IPGlblEvalError = IE_ERR_MODIF_ITER_VAR;
		strcpy(IPGlblCharData, LoopVarName);
	    }
	}

	for (i = 0; i < NumOfExpr; i++) {
	    PTemp = InptEvalFetchExpression(PBody, i, NumOfExpr);
	    if (LoopCount == 0 && InptPrsrTypeCheck(PTemp, 0) == ERROR_EXPR)
		return;
	    else {
		if (LoopVar == EndVal) {
		    /* Use the original tree. Note we must evaluate the      */
		    /* original tree at least once as ObjType's are updated. */
		    InptPrsrEvalTree(PTemp, 0);	 /* Eval as its top level... */
		}
		else {
		    PTemp = InptPrsrCopyTree(PTemp);
		    InptPrsrEvalTree(PTemp, 0);	 /* Eval as its top level... */
		    InptPrsrFreeTree(PTemp);	     /* Not needed any more. */
		}
	    }
	}
    }
}

/*****************************************************************************
*  Routine to rebind a variable - given a tree, scan it and update each      *
* occurance of that variable to point to PObj.				     *
*****************************************************************************/
static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld)
{
    if (Root == NULL)
	return;

    if (IS_FUNCTION(Root -> NodeKind)) {	       /* All the functions. */
	RebindVariable(Root -> Right, PObj, FreeOld);
	return;
    }

    switch (Root -> NodeKind) {
	case DIV:
	case MINUS:
	case MULT:
	case PLUS:
	case POWER:

	case COMMA:
	case COLON:
	case EQUAL:
	case CMP_EQUAL:
	case CMP_NOTEQUAL:
	case CMP_LSEQUAL:
	case CMP_GTEQUAL:
	case CMP_LESS:
	case CMP_GREAT:
	case BOOL_OR:
	case BOOL_AND:
	    RebindVariable(Root -> Right, PObj, FreeOld);
	    RebindVariable(Root -> Left, PObj, FreeOld);
	    return;

	case UNARMINUS:
	case BOOL_NOT:
	    RebindVariable(Root -> Right, PObj, FreeOld);
	    return;

	case NUMBER:
	    return;

	case PARAMETER:
	case STRING:
	    if (strcmp(Root -> PObj -> Name, PObj -> Name) == 0) {
		if (FreeOld && IP_IS_UNDEF_OBJ(Root -> PObj))
		    IPFreeObject(Root -> PObj);
		Root -> PObj = PObj;
	    }
            return;

	case TOKENSTART:
	    return;

	default:
	    IritFatalError("RebindVariable: Undefined ParseTree type, exit");
    }
}

/*****************************************************************************
*   Routine to create an OBJECT LIST object out of all parameters.	     *
*****************************************************************************/
IPObjectStruct *InptEvalGenObjectList(ParseTree *PObjParams)
{
    int i, NumOfParams;
    ParseTree *Param;
    IPObjectStruct *PObj;

    NumOfParams = InptEvalCountNumParameters(PObjParams);

    PObj = IPAllocObject("", IP_OBJ_LIST_OBJ, NULL);

    for (i = 0; i < NumOfParams; i++) {
	if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
							     NumOfParams),
				      1)) == NULL) {
	    IPFreeObject(PObj);
	    return NULL;
        }

	if (IP_IS_UNDEF_OBJ(Param -> PObj)) {
	    IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
	    strcpy(IPGlblCharData, Param -> PObj -> Name);
	    ListObjectInsert(PObj, i, NULL);
	    IPFreeObject(PObj);
	    return NULL;
	}

	ListObjectInsert(PObj, i, Param -> PObj);
	Param -> PObj -> Count++;    /* Increase number of references. */
    }

    ListObjectInsert(PObj, NumOfParams, NULL);

    return PObj;
}

/*****************************************************************************
*   Routine to create an Control Point Object out of all parameters.	     *
*****************************************************************************/
IPObjectStruct *InptEvalCtlPtFromParams(ParseTree *PObjParams)
{
    int i, NumPts, NumOfParams, PtType;
    ParseTree *Param;
    IPObjectStruct *PObj;

    NumOfParams = InptEvalCountNumParameters(PObjParams);

    PObj = IPAllocObject("", IP_OBJ_CTLPT, NULL);

    for (i = 0; i < NumOfParams; i++) {
	int CoordCount;

	if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
							     NumOfParams),
				      1)) == NULL) {
	    IPFreeObject(PObj);
	    return NULL;
        }
        if (!IP_IS_NUM_OBJ(Param -> PObj)) {
	    IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
	    strcpy(IPGlblCharData, "Numeric data expected");
	    IPFreeObject(PObj);
	    return NULL;
        }

	if (i == 0) {
	    PtType = PObj -> U.CtlPt.PtType =
	        (CagdPointType) Param -> PObj -> U.R;
	    switch (PtType) {
		case CAGD_PT_E1_TYPE:
		case CAGD_PT_E2_TYPE:
		case CAGD_PT_E3_TYPE:
		case CAGD_PT_E4_TYPE:
		case CAGD_PT_E5_TYPE:
		    NumPts = CAGD_NUM_OF_PT_COORD(PtType);
		    CoordCount = 1;
		    break;
		case CAGD_PT_P1_TYPE:
		case CAGD_PT_P2_TYPE:
		case CAGD_PT_P3_TYPE:
		case CAGD_PT_P4_TYPE:
		case CAGD_PT_P5_TYPE:
		    NumPts = CAGD_NUM_OF_PT_COORD(PtType) + 1;
		    CoordCount = 0;
		    break;
		default:
		    IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
		    strcpy(IPGlblCharData,
			   "E{1-5} or P{1-5} point type expected");
		    IPFreeObject(PObj);
		    return NULL;
	    }
	    if (NumOfParams - 1 != NumPts) {
		IPGlblEvalError = IE_ERR_NUM_PRM_MISMATCH;
		sprintf(IPGlblCharData, "%d expected", NumPts);
		IPFreeObject(PObj);
		return NULL;
	    }
	}
        else
	    PObj -> U.CtlPt.Coords[CoordCount++] = Param -> PObj -> U.R;
    }

    return PObj;
}

/*****************************************************************************
*   Routine to fetch the i expression out of a tree represent n expressions  *
* (0 <= i < n) seperated by colonc. Similar to InptEvalFetchParameter rtn.   *
*****************************************************************************/
static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n)
{
    int j;

    for (j = 0; j < i; j++)
	Root = Root -> Right;

    if (i == n - 1)
        return Root;
    else
	return Root -> Left;
}

/*****************************************************************************
*   Routine to count number of expressions seperated by a COLON are given    *
* in the tree ROOT. This routine is similar to InptEvalCountNumParameters.   *
*****************************************************************************/
static int InptEvalCountNumExpressions(ParseTree *Root)
{
    int i = 1;

    while (Root -> NodeKind == COLON) {
	i++;
	Root = Root -> Right;
    }
    return i;
}

/*****************************************************************************
*   Handle a user defined function or procedure.			     *
*   A user defined function or proecdure is of the sepcial form:	     *
*									     *
* FuncName = {function | procedure}(Param1, Param2, ... , ParamN):	     *
*	LocalVar1: LocalVar2: ... LocalVarN:				     *
*	BodyExpr1: BodyExpr2: ... BodYExprN;				     *
*									     *
* This special form is decomposed into the following sections:		     *
* + Parameter list as a list of IPObjectStructs.			     *
* + Local variable list as a list of IPObjectStructs.			     *
* + Body expression list as a Parsing tree.				     *
* All the information is saved in 					     *
*									     *
*****************************************************************************/
void InptEvalDefineFunc(ParseTree *FuncDef)
{
    int NewFunc;
    char
	*Name = FuncDef -> Left -> Left -> PObj -> Name;
    ParseTree *Body, *PTmp;
    UserDefinedFuncDefType *UserFunc;
    IPObjectStruct *PObjTail, *PObj, *PObjTmp;

    for (UserFunc = UserDefinedFuncList;
	 UserFunc != NULL;
	 UserFunc = UserFunc -> Pnext) {
	if (strcmp(UserFunc -> FuncName, Name) == 0) {
	    InptEvalDeleteFunc(UserFunc, FALSE);
	    break;
	}
    }
    if (UserFunc == NULL) {
	UserFunc = (UserDefinedFuncDefType *)
	    IritMalloc(sizeof(UserDefinedFuncDefType));
	UserFunc -> Params = UserFunc -> LocalVars = NULL;
	UserFunc -> Body = NULL;
	UserFunc -> NumParams = 0;
	NewFunc = TRUE;
    }
    else {
	InptEvalDeleteFunc(UserFunc, FALSE);
	NewFunc = FALSE;
    }

    /* Mark it as a function or procedure. */
    UserFunc -> IsFunction =
	FuncDef -> Left -> Right -> NodeKind == USERFUNCDEF;

    /* Get the function name. */
    PTmp = FuncDef -> Left -> Left;
    strncpy(UserFunc -> FuncName, Name, FUNC_NAME_LEN - 1);
    if (PTmp -> PObj -> ObjType == IP_OBJ_UNDEF) {
	/* Free it since not such object exists. */
	IPFreeObject(PTmp -> PObj);
	PTmp -> PObj = NULL;
    }

    /* Remove the object with the function name if it is undefined and was   */
    /* created because of the parsing of the function.			     */
    if ((PObj = GetObject(Name)) != NULL && PObj -> ObjType == IP_OBJ_UNDEF)
	DeleteObject(PObj, TRUE);

    /* Save the list of parameters. */
    for (PTmp = FuncDef -> Left -> Right -> Right, PObjTail = NULL;
	 PTmp != NULL && PTmp -> NodeKind == COMMA;
	 PTmp = PTmp -> Right) {
	if (PTmp -> Left -> NodeKind == PARAMETER) {
	    Name = PTmp -> Left -> PObj -> Name;

	    /* Make sure we do not have duplicated names in param. list. */
	    for (PObjTmp = UserFunc -> Params;
		 PObjTmp != NULL;
		 PObjTmp = PObjTmp -> Pnext) {
		if (strcmp(Name, PObjTmp -> Name) == 0) {
		    IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
		    sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
			    UserFunc -> FuncName, Name);
		    InptEvalDeleteFunc(UserFunc, TRUE);
		    return;
		}
	    }

	    /* Create a new object with same name but undefined type. */
	    if (UserFunc -> Params == NULL)
		UserFunc -> Params = PObjTail = 
		    IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
	    else {
		PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
		PObjTail = PObjTail -> Pnext;
	    }

	    /* Make sure there is no undefined object by that name in global */
	    /* list from the parsing stage. If so - remove it.		     */
	    if ((PObj = GetObject(Name)) != NULL &&
		PObj -> ObjType == IP_OBJ_UNDEF)
		DeleteObject(PObj, TRUE);
	}
	UserFunc -> NumParams++;
    }
    if (PTmp != NULL && PTmp  -> NodeKind == PARAMETER) {
	Name = PTmp -> PObj -> Name;

	/* Make sure we do not have duplicated names in param. list. */
	for (PObjTmp = UserFunc -> Params;
	     PObjTmp != NULL;
	     PObjTmp = PObjTmp -> Pnext) {
	    if (strcmp(Name, PObjTmp -> Name) == 0) {
		IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
		sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
			UserFunc -> FuncName, Name);
		InptEvalDeleteFunc(UserFunc, TRUE);
		return;
	    }
	}

	/* Create a new object with same name but undefined type. */
	if (UserFunc -> Params == NULL)
	    UserFunc -> Params = PObjTail = 
		IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
	else {
	    PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
	    PObjTail = PObjTail -> Pnext;
	}

	/* Make sure there is no undefined object by that name in global     */
	/* list from the parsing stage. If so - remove it.		     */
	if ((PObj = GetObject(Name)) != NULL && PObj -> ObjType == IP_OBJ_UNDEF)
	    DeleteObject(PObj, TRUE);

	UserFunc -> NumParams++;
    }

    /* Allocate a "return" variable. */
    UserFunc -> LocalVars = IPAllocObject("RETURN", IP_OBJ_UNDEF, NULL);

    /* Isolate the body of the function while saving the list of local vars. */
    for (Body = FuncDef -> Right, PTmp = FuncDef;
	 Body -> NodeKind == COLON && Body -> Left -> NodeKind == PARAMETER;
	 PTmp = Body, Body = Body -> Right) {
	Name = Body -> Left -> PObj -> Name;
		
	/* Make sure we do not have duplicated names in local vars list. */
	for (PObjTmp = UserFunc -> Params;
	     PObjTmp != NULL;
	     PObjTmp = PObjTmp -> Pnext) {
	    if (strcmp(Name, PObjTmp -> Name) == 0) {
		IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
		sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
			UserFunc -> FuncName, Name);
		InptEvalDeleteFunc(UserFunc, TRUE);
		return;
	    }
	}
	for (PObjTmp = UserFunc -> LocalVars;
	     PObjTmp != NULL;
	     PObjTmp = PObjTmp -> Pnext) {
	    if (strcmp(Name, PObjTmp -> Name) == 0) {
		IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
		sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
			UserFunc -> FuncName, Name);
		InptEvalDeleteFunc(UserFunc, TRUE);
		return;
	    }
	}

	/* We found a local variable decl. Copy it to local variable list.  */
	/* Create a new object with same name but undefined type.           */
	UserFunc -> LocalVars =
	    IPAllocObject(Name, IP_OBJ_UNDEF, UserFunc -> LocalVars);

	/* Make sure there is no undefined object by that name in global     */
	/* list from the parsing stage. If so - remove it.		     */
	if ((PObj = GetObject(Name)) != NULL && PObj -> ObjType == IP_OBJ_UNDEF)
	    DeleteObject(PObj, TRUE);
    }

    /* Disconnect body of the function and save it in function definition.  */
    PTmp -> Right = NULL;
    UserFunc -> Body = Body;

    if (NewFunc) {
	UserFunc -> Pnext = UserDefinedFuncList;
	UserDefinedFuncList = UserFunc;
    }
}

/*****************************************************************************
*   Delete/clear a user defined function structure.			     *
*****************************************************************************/
static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
			       int DeleteSelf)
{
    if (UserFunc -> Params != NULL)
	IPFreeObject(UserFunc -> Params);
    if (UserFunc -> LocalVars != NULL)
	IPFreeObject(UserFunc -> LocalVars);
    if (UserFunc -> Body != NULL)
	InptPrsrFreeTree(UserFunc -> Body);

    if (DeleteSelf)
	IritFree((VoidPtr) UserFunc);
    else {
	UserFunc -> Params = UserFunc -> LocalVars = NULL;
	UserFunc -> Body = NULL;
	UserFunc -> NumParams = 0;
    }
}

/*****************************************************************************
*   Invoke evaluation of a user function. The following steps are perfomred: *
* + A copy is made of parameter variables and local variables.		     *
* + Binding of given parameters to function parameters.			     *
* + The local variables and parameters are added to global variable list.    *
*****************************************************************************/
ParseTree *InptEvalUserFunc(ParseTree *Root, ParseTree *InputParams[])
{
    char
	*IritDebugFuncs = getenv("IRIT_DEBUG_FUNC");
    int i,
	DebugFunc = IritDebugFuncs != NULL ? atoi(IritDebugFuncs) : 0;
    UserDefinedFuncDefType
	*UserFunc = Root -> UserFunc;
    IPObjectStruct *PObj,
	*RetVal = NULL,
	*LastNewObj = NULL,
	*Params = CopyObjectList(UserFunc -> Params, TRUE),
	*ParamsLast = IritPrsrGetLastObj(Params),
	*LocalVars = CopyObjectList(UserFunc -> LocalVars, TRUE),
	*LocalVarsLast = IritPrsrGetLastObj(LocalVars),
	*EntryGlblObjList = GlblObjList;
    ParseTree
	*Body = InptPrsrCopyTree(UserFunc -> Body);

    if (DebugFunc > 0) {
	char s[LINE_LEN];

	sprintf(s, "***** FUNCDEBUG: invoking \"%s\"\n", UserFunc -> FuncName);
	WndwInputWindowPutStr(s);
    }

    if (LocalVars) {
	/* Rebind local variables. */
	for (PObj = LocalVars, i = 0; PObj != NULL; PObj = PObj -> Pnext) {
	    RebindVariable(Body, PObj, TRUE);
	}

	/* Chain the local variables into the global variable list. */
	LastNewObj = LocalVarsLast;
	LocalVarsLast -> Pnext = GlblObjList;
	GlblObjList = LocalVars;
    }

    if (Params) {
	/* Copy the parameter data into the parameters and rebind. */
	for (PObj = Params, i = 0; PObj != NULL; PObj = PObj -> Pnext, i++) {
	    if (InputParams[i] -> PObj -> ObjType == IP_OBJ_UNDEF) {
		IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
		strcpy(IPGlblCharData, PObj -> Name);
		return NULL;
	    }
	    CopyObject(PObj, InputParams[i] -> PObj, FALSE);
	    RebindVariable(Body, PObj, TRUE);

	    if (DebugFunc > 2) {
		char s[LINE_LEN];

		sprintf(s, "***** FUNCDEBUG: parameter %d =\n", i);
		WndwInputWindowPutStr(s);
		PrintObject(PObj);	    
	    }
	}

	/* Chain the parameters into the global variable list. */
	if (LastNewObj == NULL)
	    LastNewObj = ParamsLast;
	ParamsLast -> Pnext = GlblObjList;
	GlblObjList = Params;
    }

    if (DebugFunc > 4) {
	WndwInputWindowPutStr("***** FUNCDEBUG: global variable list =\n");
	PrintObjectList(GlblObjList);	    
    }

    /* Invoke the body of the function/procedure. */
    InptPrsrEvalTree(Body, 1);

    if (strcmp(LocalVarsLast -> Name, "RETURN") != 0)
	IritFatalError("Must have return value as last local\n");
    if (UserFunc -> IsFunction) {
	if (LocalVarsLast -> ObjType == IP_OBJ_UNDEF) {
	    IPGlblEvalError = IE_ERR_USER_FUNC_NO_RETVAL;
	    strcpy(IPGlblCharData, UserFunc -> FuncName);
	}
	else {
	    RetVal = CopyObject(NULL, LocalVarsLast, FALSE);

	    if (DebugFunc > 2) {
		WndwInputWindowPutStr("***** FUNCDEBUG: return value =\n");
		PrintObject(RetVal);	    
	    }
	}
    }
    else {
	if (DebugFunc > 0) {
	    char s[LINE_LEN];

	    sprintf(s, "***** FUNCDEBUG: leaving \"%s\"\n",
		    UserFunc -> FuncName);
	    WndwInputWindowPutStr(s);
	}
    }

    /* Restore previous state of global var list, and free the local       */
    /* variables, parameters, and body.					   */
    LastNewObj ->Pnext = NULL;
    IPFreeObject(GlblObjList);
    GlblObjList = EntryGlblObjList;
    InptPrsrFreeTree(Body);

    if (RetVal == NULL)
	return NULL;
    else {
	Root -> PObj = RetVal;
	return Root;
    }
}