/*****************************************************************************
*   "Irit" - the 3d (not only polygonal) solid modeller.		     *
*									     *
* Written by:  Gershon Elber				Ver 0.2, Mar. 1990   *
******************************************************************************
* (C) Gershon Elber, Technion, Israel Institute of Technology                *
******************************************************************************
*   Module to convert infix expression given as	ascii stream sequence into   *
* a binary tree, and evaluate it.					     *
*   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.   *
*****************************************************************************/

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

char IPGlblCharData[INPUT_LINE_LEN];	      /* Used for both parse & eval. */

static int IPGlblILastToken;			  /* Globals used by parser. */
static InptPrsrEvalErrType
    IPGlblParseError = IPE_NO_ERR;
static UserDefinedFuncDefType
    *IPGlblUserFunc = NULL;
static FileStackStruct FileStack[FILE_STACK_SIZE];    /* Include file stack. */
static int
    GlblEchoSource = TRUE,
    FileStackPtr = 0;
static char
    UnGetChar = 0;

/* Operator preceeding parser stack, and stack pointer: */
static ParseTree
    **Stack = NULL;
static int
    ParserStackSize = 0,
    ParserStackPointer = 0;

#ifdef DEBUG1
    int MaxStackPointer = 0;		  /* Measure maximum depth of stack. */
#endif /* DEBUG1 */

static ParseTree *GenInputParseTree(void);
static ParseTree *OperatorPrecedence(void);
static int TestPreceeding(int Token1, int Token2);
static char *UpdateCharErrorAux(int Token, ParseTree *Node);
static int GetToken(RealType *Data);
static int GetVarFuncToken(char *Token, RealType *Data);
static void InptPrsrUnGetC(char c);
static char InptPrsrGetC(int InString);

/*****************************************************************************
* DESCRIPTION:                                                               M
* Main module routine - generate parse tree and then tries to evaluate it.   M
*   Returns TRUE if succesfull, otherwise check IPGlblParseError/EvalError.  M
*                                                                            *
* PARAMETERS:                                                                M
*   None                                                                     M
*                                                                            *
* RETURN VALUE:                                                              M
*   int:         TRUE if successful, FALSE otherwise.                        M
*                                                                            *
* KEYWORDS:                                                                  M
*   InputParser                                                              M
*****************************************************************************/
int InputParser(void)
{
    ParseTree *PTree;

    if (GlblFatalError) {
	GlblFatalError = FALSE;
	FlushToEndOfExpr(FALSE);	  /* Close all include files if any. */
	return TRUE;
    }

    if (Stack == NULL) {				      /* First time. */
	ParserStackSize = INIT_PARSER_STACK;
	Stack = IritMalloc(ParserStackSize * sizeof(ParseTree *));
    }

    PTree = GenInputParseTree();		     /* Generate parse tree. */

    if (IPGlblParseError == IPE_NO_ERR) {
#	ifdef DEBUG1
	    fprintf(stderr, "\nInput generated Parse tree (Max stack = %d)\n",
							MaxStackPointer);
	    InptPrsrPrintTree(PTree, NULL);
	    fprintf(stderr, "\n");
#	endif /* DEBUG1 */
	if (InptPrsrTypeCheck(PTree, 0) == ERROR_EXPR) {   /* Type checking. */
	    InptPrsrFreeTree(PTree);		     /* Not needed any more. */
	    FlushToEndOfExpr(TRUE);/* Close all include files, & flush stdin.*/
	    return FALSE;
	}

	InptPrsrEvalTree(PTree, 0);			     /* Evaluate it. */
	if (IPGlblEvalError != IPE_NO_ERR) {
	    FlushToEndOfExpr(TRUE); /* Close include files, and flush stdin. */
	    return FALSE;
	}
    }
    else {
	FlushToEndOfExpr(TRUE); /* Close all include files, and flush stdin. */
	return FALSE;
    }

    InptPrsrFreeTree(PTree);			     /* Not needed any more. */

    return !(IPGlblParseError || IPGlblEvalError);
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to convert the expression from stream f into a binary tree.        *
*   Algorithm: Using operator precedence with the following grammer:         *
* EXPR    ::= EXPR    |  EXPR + EXPR    |  EXPR - EXPR                       *
* EXPR    ::= EXPR    |  EXPR * EXPR    |  EXPR / EXPR                       *
* EXPR    ::= EXPR    |  EXPR ^ EXPR                                         *
* EXPR    ::= EXPR    |  EXPR , EXPR    |  EXPR = EXPR                       *
* EXPR    ::= NUMBER  |  -EXPR          |  (EXPR)        |  FUNCTION         *
* FUCTION ::= FUNC(EXPR , EXPR , ...)					     *
*   Where FUNC might be function like arithmetics (SIN, COS etc.).	     *
*   Note that FUNC might have more than one operand, seperated by ','.	     *
*                                                                            *
*   Note the stream is terminated by semicolon character ';'.		     *
*                                                                            *
*   Left associativity for +, -, *, /, ^.                                    *
*   Precedence of operators is as usual:                                     *
*     <Highest> {unar minus}   {^}   {*, /}   {+, -} <Lowest>		     *
*                                                                            *
*   Returns NULL if an error was found, and error is in IPGlblParseError     *
*                                                                            *
* PARAMETERS:                                                                *
*   None                                                                     *
*                                                                            *
* RETURN VALUE:                                                              *
*   ParseTree *:   Constructed parsed tree.                                  *
*****************************************************************************/
static ParseTree *GenInputParseTree(void)
{
    ParseTree *Root;
    int i;

    IPGlblILastToken = 0;	/* Used to hold last token read from stream. */
    IPGlblParseError = IPE_NO_ERR;		     /* No errors so far ... */

    Root = OperatorPrecedence();

    if (IPGlblParseError) {
	/* Free partialy allocated tree. */
	for (i = 0; i <= ParserStackPointer; i++)
	    InptPrsrFreeTree(Stack[i]);
    	return NULL;						  /* Error ! */
    }
    else
	return Root;
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to allocate new ParseTree expression node.			     M
*                                                                            *
* PARAMETERS:                                                                M
*   None                                                                     M
*                                                                            *
* RETURN VALUE:                                                              M
*   ParseTree *:   Allocate a ParseTree node.                                M
*                                                                            *
* KEYWORDS:                                                                  M
*   ExprMalloc                                                               M
*****************************************************************************/
ParseTree *ExprMalloc(void)
{
    ParseTree *p;

    p = (ParseTree *) IritMalloc(sizeof(ParseTree));
    p -> Right = p -> Left = NULL;
    p -> NodeKind = IP_OBJ_UNDEF;
    p -> PObj = NULL;
    p -> UserFunc = NULL;
    return p;
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to free one expression node.					     M
*                                                                            *
* PARAMETERS:                                                                M
*   Ptr:       ParseTree to free.                                            M
*                                                                            *
* RETURN VALUE:                                                              M
*   void                                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   ExprFree                                                                 M
*****************************************************************************/
void ExprFree(ParseTree *Ptr)
{
    IritFree((VoidPtr) Ptr);
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to actually parse using operator precedence.                       *
* Few Notes:                                                                 *
* 1. Parse the input with the help of GetToken routine. Input is redirected  *
*    using the FileStack.						     *
* 2. All tokens must be in the range of 0..999 as we use the numbers above   *
*    it (adding 1000) to deactivate them in the handle searching (i.e. when  *
*    they were reduced to sub.-expression).                                  *
* 3. Returns NULL pointer in case of an error.				     *
* 4. See "Compilers - principles, techniques and tools" by Aho, Sethi &      *
*    Ullman,   pages 207-210.                                                *
*                                                                            *
* PARAMETERS:                                                                *
*   None                                                                     *
*                                                                            *
* RETURN VALUE:                                                              *
*   ParseTree *:   Returned parsed tree.                                     *
*****************************************************************************/
static ParseTree *OperatorPrecedence(void)
{
    int Token, LowHandle, Temp1, Temp2;
    RealType Data;

#   ifdef DEBUG1
	MaxStackPointer = 0;
#   endif /* DEBUG1 */

    ParserStackPointer = 0;

    /* Push the start symbol on stack (node pointer points on tos): */
    Stack[ParserStackPointer] = ExprMalloc();
    Stack[ParserStackPointer] -> NodeKind = TOKENSTART;
    Stack[ParserStackPointer] -> Right =
	Stack[ParserStackPointer] -> Left = NULL;

    Token = GetToken(&Data);      /* Get one look ahead token to start with. */

    while (TRUE) {
        if (IPGlblParseError)
	    return NULL;

        Temp1 = ParserStackPointer;	   /* Find top active token (<1000). */
        while (Stack[Temp1] -> NodeKind >= 1000)
	    Temp1--;
        /* Now test to see if the new token completes an handle: */
        if (TestPreceeding(Stack[Temp1] -> NodeKind, Token)) {
            switch (Token) {
		case CLOSPARA:
                    if (Stack[Temp1] -> NodeKind == OPENPARA) {
			ExprFree(Stack[Temp1]);		 /* Free open paran. */
			Stack[Temp1] = NULL;
			/* If a parameter is introduced instead of function  */
			/* it will be reduced already against "(" and it     */
			/* probably was missspelled function...		     */
                        if (Stack[Temp1 - 1] -> NodeKind == PARAMETER + 1000) {
			    strcpy(IPGlblCharData,
				    Stack[Temp1 - 1] -> PObj -> Name);
			    IPGlblParseError = IP_ERR_UNDEF_FUNC;
			    return NULL;
			}

			if (IS_USER_FUNCTION(Stack[Temp1 - 1] -> NodeKind)) {
			    if (ParserStackPointer - Temp1 == 1) {
				Stack[ParserStackPointer] -> NodeKind -= 1000;
				Stack[Temp1 - 1] -> NodeKind += 1000;
				Stack[Temp1 - 1] -> Right =
				    Stack[ParserStackPointer];
				ParserStackPointer -= 2;
			    }
			    else {
				Stack[Temp1 - 1] -> NodeKind += 1000;
				Stack[Temp1 - 1] -> Right = NULL;
				ParserStackPointer--;
			    }
			}
                        else if (IS_NO_PARAM_FUNC(Stack[Temp1 - 1] -> NodeKind)) {
			    if (ParserStackPointer - Temp1 == 1) {
			        UpdateCharError("",
						Stack[Temp1 - 1] -> NodeKind,
						Stack[Temp1 - 1]);
				IPGlblParseError = IP_ERR_NO_PARAM_FUNC;
				return NULL;
			    }
			    Stack[Temp1 - 1] -> NodeKind += 1000;
			    Stack[Temp1 - 1] -> Right = NULL;
			    ParserStackPointer--;
                        }
                        else if (IS_FUNCTION(Stack[Temp1 - 1] -> NodeKind)) {
			    if (ParserStackPointer - Temp1 != 1) {
			        UpdateCharError("",
						Stack[Temp1 - 1] -> NodeKind,
						Stack[Temp1 - 1]);
			        IPGlblParseError = IP_ERR_PARAM_FUNC;
			        return NULL;
			    }
			    Stack[ParserStackPointer] -> NodeKind -= 1000;
			    Stack[Temp1 - 1] -> NodeKind += 1000;
			    Stack[Temp1 - 1] -> Right =
					Stack[ParserStackPointer];
			    ParserStackPointer -= 2;
	                }
                        else {
			    if (ParserStackPointer - Temp1 != 1) {
			        IPGlblParseError = IP_ERR_PARAM_MATCH;
			        return NULL;
			    }
                            Stack[Temp1] = Stack[ParserStackPointer--];
			}
                        Token = GetToken(&Data);       /* Get another token. */
                        continue;
		    }
		    else if (Stack[Temp1] -> NodeKind == TOKENSTART) {
			/* No match for this one! */
                        IPGlblParseError = IP_ERR_PARAM_MATCH;
			return NULL;
		    }
		    break;
                case TOKENEND:
                    if (Stack[Temp1] -> NodeKind == TOKENSTART) {
                        if (ParserStackPointer != 1) {
                            IPGlblParseError = IP_ERR_WRONG_SYNTAX;
			    return NULL;
			}
			InptPrsrFreeTree(Stack[Temp1]);	  /* The TOKENSTART. */
			Stack[1] -> NodeKind -= 1000;
			return Stack[1];
		    }
		}

            Temp2 = Temp1 - 1;		  /* Find the lower bound of handle. */
            while (Temp2 >= 0 && Stack[Temp2] -> NodeKind >= 1000)
		Temp2--;
            LowHandle = Temp2 + 1;
            if (LowHandle < 1) {                  /* No low bound was found. */
                IPGlblParseError = IP_ERR_WRONG_SYNTAX;
	        return NULL;			 /* We ignore data till now. */
            }
	    switch (ParserStackPointer - LowHandle + 1) {
		case 1: /* Its a scalar one - mark it as used (add 1000). */
		    switch (Stack[ParserStackPointer] -> NodeKind) {
			case NUMBER:
			case PARAMETER:
			case STRING:
		            Stack[ParserStackPointer] -> NodeKind += 1000;
			    break;
			default:
			    UpdateCharError("Found ",
					 Stack[ParserStackPointer] -> NodeKind,
					 Stack[ParserStackPointer]);
			    IPGlblParseError = IP_ERR_PARAM_EXPECT;
			    return NULL;
		    }
		    break;
		case 2: /* Its a monadic operator - create the subtree. */
		    switch (Stack[ParserStackPointer - 1] -> NodeKind) {
		        case BOOL_NOT:
		        case UNARMINUS:
		            Stack[ParserStackPointer - 1] -> Right =
						Stack[ParserStackPointer];
		            Stack[ParserStackPointer] -> NodeKind -= 1000;
		            Stack[ParserStackPointer - 1] -> NodeKind += 1000;
		            ParserStackPointer--;
		            break;
		        case OPENPARA:
			    IPGlblParseError = IP_ERR_PARAM_MATCH;
			    return NULL;
		        default:
			    if (IS_AN_OPERATOR(Stack[ParserStackPointer] ->
					                            NodeKind))
				UpdateCharError("Found ",
					Stack[ParserStackPointer] -> NodeKind,
				        Stack[ParserStackPointer]);
			    else
				UpdateCharError("Found ",
				    Stack[ParserStackPointer - 1] -> NodeKind,
				    Stack[ParserStackPointer - 1]);

			    IPGlblParseError = IP_ERR_ONE_OPERAND;
			    return NULL;
		    }
		    break;
		case 3: /* Its a diadic operator - create the subtree. */
		    switch (Stack[ParserStackPointer - 1] -> NodeKind) {
		        case PLUS:
		        case MINUS:
		        case MULT:
		        case DIV:
		        case POWER:
		        case COMMA:
		        case EQUAL:
		        case CMP_EQUAL:
		        case CMP_NOTEQUAL:
		        case CMP_LSEQUAL:
		        case CMP_GTEQUAL:
		        case CMP_LESS:
		        case CMP_GREAT:
		        case BOOL_AND:
		        case BOOL_OR:
		        case COLON:
		            Stack[ParserStackPointer - 1] -> Right =
                                  Stack[ParserStackPointer];
                            Stack[ParserStackPointer - 1] -> Left =
                                  Stack[ParserStackPointer - 2];
		            Stack[ParserStackPointer - 2] -> NodeKind -= 1000;
		            Stack[ParserStackPointer] -> NodeKind -= 1000;
		            Stack[ParserStackPointer - 1] -> NodeKind += 1000;
		            Stack[ParserStackPointer - 2] =
						Stack[ParserStackPointer - 1];
		            ParserStackPointer -= 2;
                            break;
                        default:
			    UpdateCharError("Found Operator ",
				    Stack[ParserStackPointer - 1] -> NodeKind,
				    Stack[ParserStackPointer - 1]);
			    IPGlblParseError = IP_ERR_TWO_OPERAND;
			    return NULL;
		    }
		    break;
		default:
		    IPGlblParseError = IP_ERR_WRONG_SYNTAX;
		    return NULL;
	    }
        }
        else {		 /* Push that token on stack - it is not handle yet. */
	    Stack[++ParserStackPointer] = ExprMalloc();

#	    ifdef DEBUG1
		if (MaxStackPointer < ParserStackPointer)
		    MaxStackPointer = ParserStackPointer;
#	    endif /* DEBUG1 */

            if (ParserStackPointer >= ParserStackSize - 10) {
		/* Reallocate the stack. */
		ParserStackSize *= 2;
		Stack = IritRealloc(Stack,
				    ParserStackSize * sizeof(ParseTree *));
	    }
            if ((Stack[ParserStackPointer] -> NodeKind = Token) == USERINSTDEF)
		Stack[ParserStackPointer] -> UserFunc = IPGlblUserFunc;
            Stack[ParserStackPointer] -> PObj = NULL;
	    Stack[ParserStackPointer] -> Right =
	    Stack[ParserStackPointer] -> Left = NULL;
	    if (Token == NUMBER) {
		Stack[ParserStackPointer] -> PObj = GenNUMValObject(Data);
		Stack[ParserStackPointer] -> PObj -> Count++;
	    }
	    else if (Token == PARAMETER) {
		if ((Stack[ParserStackPointer] -> PObj =
				GetObject(IPGlblCharData)) == NULL) {
		    /*   Its new one - allocate memory for it. Create a      */
		    /* numeric object as a reasonable default.		     */
		    Stack[ParserStackPointer] -> PObj =
			IPAllocObject(IPGlblCharData, IP_OBJ_UNDEF, NULL);
		    InsertObject(Stack[ParserStackPointer] -> PObj);
		}
		Stack[ParserStackPointer] -> PObj -> Count++;
	    }
	    else if (Token == STRING) {
		Stack[ParserStackPointer] -> PObj =
		    IPAllocObject("", IP_OBJ_STRING, NULL);
		strcpy(Stack[ParserStackPointer] -> PObj -> U.Str,
		       IPGlblCharData);
		Stack[ParserStackPointer] -> PObj -> Count++;
	    }
            Token = GetToken(&Data);	   /* And get new token from stream. */
	}
    }
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to test precedence of two tokens. returns 0, <0 or >0 according to *
* comparison results.                                                        *
*                                                                            *
* PARAMETERS:                                                                *
*   Token1, Token2:   Tokens to compare.                                     *
*                                                                            *
* RETURN VALUE:                                                              *
*   int:         <0, 0, >0 comparison's result.                              *
*****************************************************************************/
static int TestPreceeding(int Token1, int Token2)
{
    int Preced1 = 0,
	Preced2 = 0;

    if ((Token1 >= 1000) || (Token2 >= 1000))
	return FALSE;					 /* Ignore sub-expr. */

    if (IS_FUNCTION(Token1))
	Preced1 = 160;
    else {
    	switch (Token1) {
	    case TOKENSTART:
	    case TOKENEND:
	        Preced1 = 10;
    		break;
	    case OPENPARA:
    		Preced1 = 20;
    		break;
    	    case COMMA:
	        Preced1 = 30;
    		break;
    	    case COLON:
	        Preced1 = 40;
    		break;
	    case BOOL_AND:
	    case BOOL_OR:
		Preced1 = 50;
		break;
    	    case EQUAL:
	    case CMP_EQUAL:
	    case CMP_NOTEQUAL:
	    case CMP_LSEQUAL:
	    case CMP_GTEQUAL:
	    case CMP_LESS:
	    case CMP_GREAT:
	        Preced1 = 55;
    		break;
	    case PLUS:
	    case MINUS:
    		Preced1 = 80;
    		break;
	    case MULT:
	    case DIV:
    		Preced1 = 100;
    		break;
	    case POWER:
    		Preced1 = 120;
    		break;
	    case UNARMINUS:
	    case BOOL_NOT:
    		Preced1 = 125;
    		break;
    	    case NUMBER:
    	    case PARAMETER:
    	    case STRING:
	    case CLOSPARA:
    		Preced1 = 180;
    		break;

    	}
    }

    if (IS_FUNCTION(Token2))
	Preced2 = 150;
    else {
    	switch (Token2) {
	    case TOKENSTART:
	    case TOKENEND:
    		Preced2 = 0;
    		break;
	    case CLOSPARA:
    		Preced2 = 15;
    		break;
	    case COMMA:
    		Preced2 = 30;
    		break;
	    case COLON:
    		Preced2 = 40;
    		break;
	    case BOOL_AND:
	    case BOOL_OR:
		Preced2 = 50;
		break;
	    case EQUAL:
	    case CMP_EQUAL:
	    case CMP_NOTEQUAL:
	    case CMP_LSEQUAL:
	    case CMP_GTEQUAL:
	    case CMP_LESS:
	    case CMP_GREAT:
    		Preced2 = 55;
    		break;
	    case PLUS:
	    case MINUS:
    		Preced2 = 70;
    		break;
	    case MULT:
	    case DIV:
    		Preced2 = 90;
    		break;
	    case POWER:
    		Preced2 = 110;
    		break;
	    case UNARMINUS:
	    case BOOL_NOT:
    		Preced2 = 130;
    		break;
	    case NUMBER:
	    case PARAMETER:
	    case STRING:
	    case OPENPARA:
    		Preced2 = 170;
    		break;

    	}
    }

    return Preced1 - Preced2 > 0;
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to provide a description, gievn Token and optionally a Node.       *
*                                                                            *
* PARAMETERS:                                                                *
*   Token:      With the fault.                                              *
*   Node:       Optional node at fault.                                      *
*                                                                            *
* RETURN VALUE:                                                              *
*   char *:     Description of error.                                        *
*****************************************************************************/
static char *UpdateCharErrorAux(int Token, ParseTree *Node)
{
    static char TmpStr[LINE_LEN];
    char *TokenChar = NULL;

    if (Token > 1000)
	Token -= 1000;

    if (IS_NUM_FUNCTION(Token))
	TokenChar = NumFuncTable[Token - NUM_FUNC_OFFSET].FuncName;
    else if (IS_OBJ_FUNCTION(Token))
	TokenChar = ObjFuncTable[Token - OBJ_FUNC_OFFSET].FuncName;
    else if (IS_GEN_FUNCTION(Token))
	TokenChar = GenFuncTable[Token - GEN_FUNC_OFFSET].FuncName;
    else {
    	switch (Token) {
    	    case PLUS:
    		TokenChar = "+";
    		break;
    	    case MINUS:
    		TokenChar = "-";
    		break;
	    case MULT:
    		TokenChar = "*";
    		break;
	    case DIV:
    		TokenChar = "/";
    		break;
	    case POWER:
    		TokenChar = "^";
    		break;
	    case UNARMINUS:
    		TokenChar = "(Unary) -";
    		break;
	    case EQUAL:
    		TokenChar = "=";
    		break;
	    case COMMA:
    		TokenChar = ",";
    		break;
	    case COLON:
    		TokenChar = ":";
    		break;
	    case SEMICOLON:
    		TokenChar = ";";
    		break;
	    case CMP_EQUAL:
    		TokenChar = "==";
    		break;
	    case CMP_NOTEQUAL:
    		TokenChar = "!=";
    		break;
	    case CMP_LSEQUAL:
    		TokenChar = "<=";
    		break;
	    case CMP_GTEQUAL:
    		TokenChar = ">=";
    		break;
	    case CMP_LESS:
    		TokenChar = "<";
    		break;
	    case CMP_GREAT:
    		TokenChar = ">";
    		break;
	    case BOOL_AND:
    		TokenChar = "&&";
		break;
	    case BOOL_OR:
    		TokenChar = "||";
		break;
	    case BOOL_NOT:
    		TokenChar = "!";
		break;
	    case OPENPARA:
		TokenChar = "(";
		break;
	    case CLOSPARA:
		TokenChar = ")";
		break;
	    case NUMBER:
		if (Node && Node -> PObj && IP_IS_NUM_OBJ(Node -> PObj)) {
		    sprintf(TmpStr, "%g", Node -> PObj -> U.R);
		    TokenChar = TmpStr;
		}
		else
		    TokenChar = "Numeric";
		break;
	    case PARAMETER:
		if (Node && Node -> PObj && strlen(Node -> PObj -> Name) > 0)
		    TokenChar = Node -> PObj -> Name;
		else
		    TokenChar = "Parameter";
		break;
	    case STRING:
		if (Node && Node -> PObj && IP_IS_STR_OBJ(Node -> PObj)) {
		    TokenChar = Node -> PObj -> U.Str;
		}
		else
		    TokenChar = "String";
		break;
	    case USERINSTDEF:
	    case USERFUNCDEF:
	    case USERPROCDEF:
		TokenChar = "UserFunc";
		break;
	    default:
    		sprintf(TmpStr, "Token %d\n", Token);
		TokenChar = TmpStr;
		break;
    	}
    }

    return TokenChar;
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to update the character error message according to StrMsg & Token  M
*   Node is optional and if not NULL, will be used to get better details.    M
*                                                                            *
* PARAMETERS:                                                                M
*   StrMsg:   Some description of error.                                     M
*   Token:    Token at fault.                                                M
*   Node:     Optional Node at fault.                                        M
*                                                                            *
* RETURN VALUE:                                                              M
*   void                                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   UpdateCharError                                                          M
*****************************************************************************/
void UpdateCharError(char *StrMsg, int Token, ParseTree *Node)
{
    char
	*TokenChar = UpdateCharErrorAux(Token, Node);
	    
    sprintf(IPGlblCharData, "%s\"%s\"", StrMsg, TokenChar);
    if (IS_AN_OPERATOR(Token) && Node) {
	if (Node -> Left) {
	    char *StrType =
		InptPrsrTypeToStr(InptPrsrTypeCheck(Node -> Left, 1));

	    sprintf(&IPGlblCharData[strlen(IPGlblCharData)],
		    "\n\tLeft Operand: \"%s\" (%s type)",
		    UpdateCharErrorAux(Node -> Left -> NodeKind,
				       Node -> Left),
		    StrType);
	}
	if (Node -> Right) {
	    char *StrType =
		InptPrsrTypeToStr(InptPrsrTypeCheck(Node -> Right, 1));

	    sprintf(&IPGlblCharData[strlen(IPGlblCharData)],
		    "\n\tRight Operand: \"%s\" (%s type)",
		    UpdateCharErrorAux(Node -> Right -> NodeKind,
				       Node -> Right),
		    StrType);
	}
    }
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to get the next token out of the expression.                       *
*   Returns next token found and sets Data to the returned value (if any).   *
*                                                                            *
* PARAMETERS:                                                                *
*   Data:      Real numbers will be saved herein.                            *
*                                                                            *
* RETURN VALUE:                                                              *
*   int:       Numeric value of next token.                                  *
*****************************************************************************/
static int GetToken(RealType *Data)
{
    int i,
	RetVal = TOKEN_NONE;
    char c;

    while (isspace(c = InptPrsrGetC(FALSE)));	       /* Skip white blanks. */

    if (c == '"') {		  /* Its a string token - read up to next ". */
	i = 0;
	while ((IPGlblCharData[i] = InptPrsrGetC(TRUE)) != '"') {
	    if (IPGlblCharData[i] == '\\') /* Its escape char. for next one: */
		IPGlblCharData[i] = InptPrsrGetC(TRUE);
	    if (IPGlblCharData[i] < ' ' || i > INPUT_LINE_LEN - 2) {
		RetVal = TOKENERROR;
		IPGlblCharData[i] = 0;
		IPGlblParseError = IP_ERR_STR_TOO_LONG;
		break;
	    }
	    i++;
	}
	if (RetVal != TOKENERROR) {
	    IPGlblCharData[i] = 0;
	    RetVal = STRING;
	}
    }
    else if (isalpha(c)) {		  /* Is it a variable/function name? */
	if (islower(c))
	    IPGlblCharData[i = 0] = toupper(c);
	else
	    IPGlblCharData[i = 0] = c;

	while (isalpha(c = InptPrsrGetC(FALSE)) || isdigit(c) || c == '_')
	    if (islower(c))
		IPGlblCharData[++i] = toupper(c);
	    else
		IPGlblCharData[++i] = c;
	IPGlblCharData[++i] = 0;
	InptPrsrUnGetC(c);

	if ((int) strlen(IPGlblCharData) >= OBJ_NAME_LEN) {
	    RetVal = TOKENERROR;
	    IPGlblParseError = IP_ERR_NAME_TOO_LONG;
	}
	else {
	    RetVal = GetVarFuncToken(IPGlblCharData, Data);
	}
    }
    else if (isdigit(c) || (c == '.')) {	      /* Is it numeric data? */
	IPGlblCharData[i=0] = c;

	while (isdigit(c = InptPrsrGetC(FALSE)) || (c == '.') ||
					(c == 'e') || (c == 'E') || (c == 'e'))
	    IPGlblCharData[++i] = c;
	/* Handle the special case of negative exponent ("111.111E-22"). */
	if (c == '-' && (IPGlblCharData[i] == 'e' ||
			 IPGlblCharData[i] == 'E')) {
	    IPGlblCharData[++i] = c;
	    while (isdigit(c = InptPrsrGetC(FALSE)) || (c == '.'))
		IPGlblCharData[++i] = c;
	}
	IPGlblCharData[++i] = 0;

	InptPrsrUnGetC(c);

#	ifdef IRIT_DOUBLE
	    sscanf(IPGlblCharData, "%lf", Data);
#	else
	    sscanf(IPGlblCharData, "%f", Data);
#	endif /* IRIT_DOUBLE */

        RetVal = NUMBER;
    }
    else
	switch (c) {
	    case '+':
		RetVal = PLUS;
		break;
	    case '-':
		switch (IPGlblILastToken) {
		    case 0:	      /* If first token (no last token yet). */
		    case PLUS:
		    case MINUS:
		    case MULT:
		    case DIV:
		    case POWER:
		    case COMMA:
		    case EQUAL:
		    case CMP_EQUAL:
		    case CMP_NOTEQUAL:
		    case CMP_LSEQUAL:
		    case CMP_GTEQUAL:
		    case CMP_LESS:
		    case CMP_GREAT:
		    case BOOL_AND:
		    case BOOL_OR:
		    case BOOL_NOT:
		    case COLON:
		    case UNARMINUS:
		    case OPENPARA:
			RetVal = UNARMINUS;
			break;
		    default:
                        RetVal = MINUS;
	    		break;
		}
		break;
	    case '*':
		RetVal = MULT; break;
	    case '/':
		RetVal = DIV;
		break;
	    case '^':
		RetVal = POWER;
		break;
	    case '(':
		RetVal = OPENPARA;
		break;
	    case ')':
		RetVal = CLOSPARA;
		break;
	    case '=':
		switch (c = InptPrsrGetC(FALSE)) {
		    case '=':
		        RetVal = CMP_EQUAL;
			break;
		    default:
			InptPrsrUnGetC(c);
			RetVal = EQUAL;
			break;
		}
		break;
	    case '<':
		switch (c = InptPrsrGetC(FALSE)) {
		    case '=':
		        RetVal = CMP_LSEQUAL;
			break;
		    default:
			InptPrsrUnGetC(c);
			RetVal = CMP_LESS;
			break;
		}
		break;
	    case '>':
		switch (c = InptPrsrGetC(FALSE)) {
		    case '=':
		        RetVal = CMP_GTEQUAL;
			break;
		    default:
			InptPrsrUnGetC(c);
			RetVal = CMP_GREAT;
			break;
		}
		break;
	    case '&':
		if ((c = InptPrsrGetC(FALSE)) == '&') {
		    RetVal = BOOL_AND;
		    break;
		}
		else {
		    RetVal = TOKENERROR;
		    IPGlblCharData[0] = '&';
		    IPGlblCharData[1] = c;
		    IPGlblCharData[2] = 0;
		    IPGlblParseError = IP_ERR_UNDEF_TOKEN;
		    break;
		}
	    case '|':
		if ((c = InptPrsrGetC(FALSE)) == '|') {
		    RetVal = BOOL_OR;
		    break;
		}
		else {
		    RetVal = TOKENERROR;
		    IPGlblCharData[0] = '|';
		    IPGlblCharData[1] = c;
		    IPGlblCharData[2] = 0;
		    IPGlblParseError = IP_ERR_UNDEF_TOKEN;
		    break;
		}
	    case ',':
		RetVal = COMMA;
		break;
	    case ':':
		RetVal = COLON;
		break;
	    case ';':
		RetVal = TOKENEND;
		break;	       /* End of expression! */
	    case '!':
		if ((c = InptPrsrGetC(FALSE)) == '=') {
		    RetVal = CMP_NOTEQUAL;
		}
		else {
		    InptPrsrUnGetC(c);
		    RetVal = BOOL_NOT;
		}
		break;
	    default:
		RetVal = TOKENERROR;
		IPGlblCharData[0] = c;
		IPGlblCharData[1] = 0;
		IPGlblParseError = IP_ERR_UNDEF_TOKEN;
		break;
    }

    IPGlblILastToken = RetVal;

    return RetVal;
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to test alpha Token for match with one of the defined functions    *
* and returns that Token function if found one.				     *
*   Otherwise it is assumed to be a user defined function or a variable.     *
*                                                                            *
* PARAMETERS:                                                                *
*   Token:     Token to search, in string function.                          *
*   Data:      Real numbers will be saved herein.                            *
*                                                                            *
* RETURN VALUE:                                                              *
*   int:       Token number                                                  *
*****************************************************************************/
static int GetVarFuncToken(char *Token, RealType *Data)
{
    int i;
    char c;
    UserDefinedFuncDefType *UserFunc;

    if (strcmp("COMMENT", Token) == 0) {
	/* Get first nonspace char after the COMMENT key word: */
	while (isspace(c = InptPrsrGetC(FALSE)));
	/* And read the input until this char appear again (end of comment): */
	while (c != InptPrsrGetC(FALSE));

	return GetToken(Data);		       /* Return next token instead. */
    }

    for (UserFunc = UserDefinedFuncList;
	 UserFunc != NULL;
	 UserFunc = UserFunc -> Pnext)
	if (strcmp(UserFunc -> FuncName, Token) == 0) {
	    while (isspace(c = InptPrsrGetC(FALSE)));  /* Skip white blanks. */
	    InptPrsrUnGetC(c);
	    if (c == '(') {
		IPGlblUserFunc = UserFunc;
		return USERINSTDEF;
	    }
	    else
		break;
	}
    for (i = 0; i < NumFuncTableSize; i++)        /* Is it Numeric function? */
	if (strcmp(NumFuncTable[i].FuncName, Token) == 0)
	    return NumFuncTable[i].FuncToken;
    for (i = 0; i < ObjFuncTableSize; i++)	   /* Is it Object function? */
	if (strcmp(ObjFuncTable[i].FuncName, Token) == 0)
	    return ObjFuncTable[i].FuncToken;
    for (i = 0; i < GenFuncTableSize; i++)	  /* Is it General function? */
	if (strcmp(GenFuncTable[i].FuncName, Token) == 0)
	    return GenFuncTable[i].FuncToken;

    if (strcmp("FUNCTION", Token) == 0)
	return USERFUNCDEF;
    if (strcmp("PROCEDURE", Token) == 0)
	return USERPROCDEF;
	
    for (i = 0; i < ConstantTableSize; i++)/* Replace constant by its value. */
	if (strcmp(ConstantTable[i].FuncName, Token) == 0) {
	    sprintf(Token, "%g", ConstantTable[i].Value);
	    *Data = ConstantTable[i].Value;
	    return NUMBER;
	}

    return PARAMETER;   /* If not a function - it is assumed to be variable. */
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Sets echo level of source irt files.                                       M
*                                                                            *
* PARAMETERS:                                                                M
*   EchoSource:  TRUE for echo, FALSE for no echo.                           M
*                                                                            *
* RETURN VALUE:                                                              M
*   void                                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   InptPrsrEchoSource                                                       M
*****************************************************************************/
void InptPrsrEchoSource(int EchoSource)
{
    GlblEchoSource = EchoSource;
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to control all getchar in this module and echo it if requested     *
*   Note it handles the FileStack and decrease it if end of file was found.  *
*                                                                            *
* PARAMETERS:                                                                *
*   InString:   TRUE if now we read between two double quotes (a string).    *
*                                                                            *
* RETURN VALUE:                                                              *
*   char:       Next character in input stream.                              *
*****************************************************************************/
static char InptPrsrGetC(int InString)
{
    static char *p,
	Line[INPUT_LINE_LEN] = "",
	TLine[INPUT_LINE_LEN] = "";
    static int
	LineLength = 0,
	LineCount = 0;
    char c;
    int i;

    if (UnGetChar == 0) {		       /* One level of unget char... */
	if (LineCount < LineLength) {	 /* Is there anything in local Line? */
	}
	else
	    do {
	        if (FileStackPtr == 0) {
		    WndwInputWindowGetStr(Line, INPUT_LINE_LEN);
		    LineCount = 0;
	        }
	        else {
		    sprintf(Line, "%s > ", FileStack[FileStackPtr - 1].Name);
		    LineCount = strlen(Line);
		    if (fgets(TLine, INPUT_LINE_LEN,
			      FileStack[FileStackPtr - 1].f) == NULL) {
		        /* Its end of file - close it and update stack. */
			TLine[0] = 0;
		        fclose(FileStack[--FileStackPtr].f);
		    }

		    /* Strip off CR/LF/TAB.  */
		    for (i = LineCount, p = TLine; *p != 0; p++) {
			if (*p == 0x09)
			    do {
				Line[i++] = ' ';
			    }
		            while ((i - LineCount) % 8 != 0);
			else if (*p < ' ' || *p > '~')
			    break;
			else
			    Line[i++] = *p;
		    }
		    Line[i] = 0;
	        }

		if (GlblEchoSource)
#ifdef DJGCC
		    WndwInputWindowPutStr(Line);
#else
		    if (FileStackPtr != 0)	 /* Input was from keyboard? */
			WndwInputWindowPutStr(Line);
#endif /* DJGCC */

	        LineLength = strlen(Line);
	    } while (LineCount >= LineLength);

	c = Line[LineCount++];
	if (c == '#' && !InString) {	  /* Its a comment - skip that line. */
            c = ' ';				   /* Must return something. */
            LineCount = LineLength;    /* Force next time to fetch new line. */
	}
#	ifdef DEBUG1
	    fprintf(stderr, "%c", c);
#	endif /* DEBUG1 */
    }
    else {
	c = UnGetChar;
	UnGetChar = 0;
    }

    return c;
}

/*****************************************************************************
* DESCRIPTION:                                                               *
* Routine to unget one char						     *
*                                                                            *
* PARAMETERS:                                                                *
*   c:        Character to unget.                                            *
*                                                                            *
* RETURN VALUE:                                                              *
*   void                                                                     *
*****************************************************************************/
static void InptPrsrUnGetC(char c)
{
    UnGetChar = c;
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to quit reading until next ';'. If reading from files, they are    M
* all closed as well.							     M
*                                                                            *
* PARAMETERS:                                                                M
*   FlushStdin:   If not reading from a file, should we skip to next ';'?    M
*                                                                            *
* RETURN VALUE:                                                              M
*   void                                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   FlushToEndOfExpr                                                         M
*****************************************************************************/
void FlushToEndOfExpr(int FlushStdin)
{
    if (FileStackPtr > 0)	/* Close all the open files - back to stdin. */
	while (FileStackPtr)
	    fclose(FileStack[--FileStackPtr].f);
    else if (FlushStdin && IPGlblILastToken != TOKENEND)
	while (InptPrsrGetC(FALSE) != ';');
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to push new file to read on the FileStack from INCLUDE command:    M
*                                                                            *
* PARAMETERS:                                                                M
*   PrmFileName:  Name of file to start to read from.                        M
*                                                                            *
* RETURN VALUE:                                                              M
*   void                                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   FileInclude                                                              M
*****************************************************************************/
void FileInclude(char *PrmFileName)
{
    int i;
    FILE *f;
    char s[LINE_LEN], FileName[LINE_LEN], c;

    if (FileStackPtr < FILE_STACK_SIZE) {
	strcpy(FileName, PrmFileName);

  	if (strstr(FileName, ".irt") == NULL)
	    strcat(FileName, ".irt");

	if ((f = fopen(FileName, "r")) != NULL) {
	    FileStack[FileStackPtr].f = f;
	    for (i = strlen(FileName) - 1;	   /* Isolate the file name. */
		 i > 0 && (c = FileName[i]) != '\\' && c != '/' && c != ':';
		 i--);
	    if (i > 0)
		i++;
	    strncpy(FileStack[FileStackPtr].Name, &FileName[i],
							FILE_NAME_LEN - 1);
	    FileStackPtr++;		 /* Now next char is from that file! */
	}
	else {
	    sprintf(s, "Cannt open file %s - ignored", FileName);
	    WndwInputWindowPutStr(s);
	}
    }
    else
	WndwInputWindowPutStr("File nesting too deep - ignored");
}

/*****************************************************************************
* DESCRIPTION:                                                               M
* Routine to return parsing error if happen one, zero return value otherwise.M
*                                                                            *
* PARAMETERS:                                                                M
*   Message:                                                                 M
*                                                                            *
* RETURN VALUE:                                                              M
*   InptPrsrEvalErrType:                                                     M
*                                                                            *
* KEYWORDS:                                                                  M
*   InptPrsrParseError                                                       M
*****************************************************************************/
InptPrsrEvalErrType InptPrsrParseError(char **Message)
{
    InptPrsrEvalErrType Temp;

    *Message = IPGlblCharData;
    Temp = IPGlblParseError;
    IPGlblParseError = IPE_NO_ERR;
    return Temp;
}