/*****************************************************************************
*   "Irit" - the 3d polygonal solid modeller.				     *
*									     *
* Written by:  Gershon Elber				Ver 0.2, Mar. 1990   *
******************************************************************************
*   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.   *
*****************************************************************************/

#ifdef __MSDOS__
#include <alloc.h>
#include <graphics.h>
#endif /* __MSDOS__ */

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

#ifndef __MSDOS__
#include "xgraphic.h"
#endif /* __MSDOS__ */


static int IPGlblILastToken, IPGlblParseError;    /* Globals used by parser. */
char IPGlblCharData[LINE_LEN_LONG];	      /* Used for both parse & eval. */
static FileStackStruct FileStack[FILE_STACK_SIZE];    /* Include file stack. */
static int FileStackPtr = 0;

/* Operator preceeding parser stack, and stack pointer: */
static ParseTree *Stack[MAX_PARSER_STACK];
static int ParserStackPointer = 0;

/* Aliases list - simple macro substitution mechanizem. */
static AliasesStruct GlobalAliasList;

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

static struct ParseTree *GenInputParseTree(void);
static ParseTree *OperatorPrecedence(void);
static int TestPreceeding(int Token1, int Token2);
static int GetToken(RealType *Data);
static int GetVarFuncToken(char *Token, RealType *Data);
static void FlushToEndOfExpr(int FlushStdin);
static void InptPrsrUnGetC(char c);
static char InptPrsrGetC(void);

/*****************************************************************************
*   Main module routine - generate parse tree and then tries to evaluate it. *
* Returns TRUE if succesfull, otherwise check IPGlblParseError/EvalError.    *
*****************************************************************************/
int InputParser(void)
{
    struct ParseTree *PTree;

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

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

    if (IPGlblParseError == 0) {
#	ifdef DEBUG
	    fprintf(stderr, "\nInput generated Parse tree (Max stack = %d)\n",
							MaxStackPointer);
	    InptPrsrPrintTree(PTree, NULL);
	    fprintf(stderr, "\n");
#	endif /* DEBUG */
	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 != 0) {
	    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);
}

/*****************************************************************************
*   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       *
*****************************************************************************/
static ParseTree *GenInputParseTree(void)
{
    ParseTree *Root;
    int i;

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

    Root = OperatorPrecedence();

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

/*****************************************************************************
*  Routine to allocate new ParseTree expression node:			     *
*****************************************************************************/
ParseTree *MyExprMalloc(void)
{
    ParseTree *p;

    p = (ParseTree *) MyMalloc(sizeof(ParseTree), OTHER_TYPE);
    p -> Right = p -> Left = NULL;
    return p;
}

/*****************************************************************************
*  Routine to free one expression node:					     *
*****************************************************************************/
void MyExprFree(ParseTree *Ptr)
{
    MyFree((char *) Ptr, OTHER_TYPE);
}

/*****************************************************************************
*   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 (see Expr2TrG.h for errors     *
* 4. See "Compilers - principles, techniques and tools" by Aho, Sethi &      *
*    Ullman,   pages 207-210.                                                *
*****************************************************************************/
static ParseTree *OperatorPrecedence(void)
{
    int Token, LowHandle, Temp1, Temp2;
    RealType Data;

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

    ParserStackPointer = 0;

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

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

    do {
        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) {
			MyExprFree(Stack[Temp1]);	 /* Free open paran. */
			/* 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] -> U.PObj -> Name);
			    IPGlblParseError = IP_ERR_UndefFunc;
			    return NULL;
			}

                        switch (Stack[Temp1-1] -> NodeKind) {
			    case ARCCOS:  /* If it is of the form Func(Expr) */
			    case ARCSIN:  /* Then reduce it directly to that */
			    case ARCTAN2: /* function, else (default) reduce */
			    case ARCTAN:  /* to sub-expression.              */
			    case COS:
			    case EXP:
			    case FABS:
			    case LN:
			    case LOG:
			    case SIN:
			    case SQRT:
			    case TAN:
			    case CPOLY:
			    case AREA:
			    case VOLUME:
			    case TIME:

			    case VECTOR:
			    case ROTX:
			    case ROTY:
			    case ROTZ:
			    case TRANS:
			    case SCALE:
			    case BOX:
			    case GBOX:
			    case CONE:
			    case CYLIN:
			    case SPHERE:
			    case TORUS:
			    case PLANE:
			    case POLY:
			    case CROSSEC:
			    case SURFREV:
			    case EXTRUDE:
			    case LIST:
			    case LOAD:
			    case CONVEX:

			    case VIEW:
			    case DIR:
			    case CHDIR:
			    case NORMAL:
			    case INCLUDE:
			    case GDUMP:
			    case MDUMP:
			    case FREEOBJ:
			    case INTERACT:
			    case IFCOND:
			    case FORLOOP:
			    case PRHELP:
			    case PAUSE:
			    case ALIAS:
			    case BEEP:
			    case EDIT:
			    case LOGFILE:
			    case COLOR:

				if (ParserStackPointer-Temp1 != 1) {
				    UpdateCharError("",
					Stack[Temp1-1] -> NodeKind);
				    IPGlblParseError = IP_ERR_ParamFunc;
				    return NULL;
				}
				Stack[ParserStackPointer] -> NodeKind -= 1000;
				Stack[Temp1-1] -> NodeKind += 1000;
			        Stack[Temp1-1] -> Right =
						Stack[ParserStackPointer];
				ParserStackPointer -= 2;
				break;

			    case EXIT:   /* Special case of non param. func. */
			    case VARLIST:
			    case SYSTEM:

				if (ParserStackPointer-Temp1 == 1) {
				    UpdateCharError("",
					Stack[Temp1-1] -> NodeKind);
				    IPGlblParseError = IP_ERR_NoParamFunc;
				    return NULL;
				}
				Stack[Temp1-1] -> NodeKind += 1000;
			        Stack[Temp1-1] -> Right = NULL;
				ParserStackPointer --;
				break;

			    default:
				if (ParserStackPointer-Temp1 != 1) {
				    IPGlblParseError = IP_ERR_ParaMatch;
				    return NULL;
				}
                                Stack[Temp1] = Stack[ParserStackPointer--];
				break;
			}
                        Token = GetToken(&Data);       /* Get another token. */
                        continue;
		    }
		    else if (Stack[Temp1] -> NodeKind == TOKENSTART) {
			/* No match for this one! */
                        IPGlblParseError = IP_ERR_ParaMatch;
			return NULL;
		    }
		    break;
                case TOKENEND:
                    if (Stack[Temp1] -> NodeKind == TOKENSTART) {
                        if (ParserStackPointer != 1) {
                            IPGlblParseError = IP_ERR_WrongSyntax;
			    return NULL;
			}
			InptPrsrFreeTree(Stack[Temp1]);	  /* The TOKENSTART. */
			Stack[1] -> NodeKind -= 1000;
			return Stack[1];
		    }
		}

            Temp2 = Temp1-1;		  /* Find the lower bound of handle. */
            while (Stack[Temp2] -> NodeKind >= 1000) Temp2--;
            LowHandle = Temp2 + 1;
            if (LowHandle < 1) {                  /* No low bound was found. */
                IPGlblParseError = IP_ERR_WrongSyntax;
	        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);
			    IPGlblParseError = IP_ERR_ParamExpect;
			    return NULL;
		    }
		    break;
		case 2: /* Its a monadic operator - create the subtree. */
		    switch (Stack[ParserStackPointer-1] -> NodeKind) {
		        case UNARMINUS:
		            Stack[ParserStackPointer-1] -> Right =
						Stack[ParserStackPointer];
		            Stack[ParserStackPointer] -> NodeKind -= 1000;
		            Stack[ParserStackPointer-1] -> NodeKind += 1000;
		            ParserStackPointer--;
		            break;
		        case OPENPARA:
			    IPGlblParseError = IP_ERR_ParaMatch;
			    return NULL;
		        default:
			    UpdateCharError("Found Operator ",
				Stack[ParserStackPointer-1] -> NodeKind);
			    IPGlblParseError = IP_ERR_OneOperand;
			    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 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);
			    IPGlblParseError = IP_ERR_TwoOperand;
			    return NULL;
		    }
		    break;
		default:
		    IPGlblParseError = IP_ERR_WrongSyntax;
		    return NULL;
	    }
        }
        else {		 /* Push that token on stack - it is not handle yet. */
	    Stack[++ParserStackPointer] = MyExprMalloc();

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

            if (ParserStackPointer == MAX_PARSER_STACK-1) {
                IPGlblParseError = IP_ERR_StackOV;
		return NULL;			 /* We ignore data till now. */
	    }
            Stack[ParserStackPointer] -> NodeKind = Token;
            Stack[ParserStackPointer] -> U.R = Data;  /* We might need that. */
	    Stack[ParserStackPointer] -> Right =
	    Stack[ParserStackPointer] -> Left = (ParseTree *) NULL;
	    if (Token == PARAMETER) {
		if ((Stack[ParserStackPointer] -> U.PObj =
				GetObject(IPGlblCharData)) == NULL) {
		    /* Its new one - allocate memory for it. */
		    Stack[ParserStackPointer] -> U.PObj =
			AllocObject(IPGlblCharData, UNDEF_OBJ, NULL);
		}
	    }
	    else
	    if (Token == STRING) {
		Stack[ParserStackPointer] -> U.PObj =
		    AllocObject("", STRING_OBJ, NULL);
		strcpy(Stack[ParserStackPointer] -> U.PObj -> U.Str,
		       IPGlblCharData);
	    }
            Token = GetToken(&Data);	   /* And get new token from stream. */
	}
    }
    while (TRUE);
}

/*****************************************************************************
*   Routine to test precedence of two tokens. returns 0, <0 or >0 according  *
* to comparison results:                                                     *
*****************************************************************************/
static int TestPreceeding(int Token1, int Token2)
{
    int Preced1, Preced2;

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

    switch (Token1) {
	case ARCCOS:
	case ARCSIN:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:

	case VECTOR:
	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:
	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:

	case EXIT:
	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case PAUSE:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case VARLIST:
	case ALIAS:
	case BEEP:
	case EDIT:
	case SYSTEM:
	case LOGFILE:
	case COLOR:
	    Preced1 =130; break;
	case COMMA:
	case COLON:
	case EQUAL:
	    Preced1 = 30; break;
	case NUMBER:
	case PARAMETER:
	case STRING:
	    Preced1 =150; break;
	case PLUS:
	case MINUS:
	    Preced1 = 50; break;
	case MULT:
	case DIV:
	    Preced1 = 70; break;
	case POWER:
	    Preced1 = 90; break;
	case UNARMINUS:
	    Preced1 = 95; break;
	case OPENPARA:
	    Preced1 = 20; break;
	case CLOSPARA:
	    Preced1 =150; break;
	case TOKENSTART:
	case TOKENEND:
	    Preced1 = 10; break;
    }

    switch (Token2) {
	case ARCCOS:
	case ARCSIN:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:

	case VECTOR:
	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:
	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:

	case EXIT:
	case VIEW:
	case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case PAUSE:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case VARLIST:
	case ALIAS:
	case BEEP:
	case EDIT:
	case SYSTEM:
	case LOGFILE:
	case COLOR:
	    Preced2 =120; break;
	case COMMA:
	case COLON:
	case EQUAL:
	    Preced2 = 35; break;
	case NUMBER:
	case PARAMETER:
	case STRING:
	    Preced2 =140; break;
	case PLUS:
	case MINUS:
	    Preced2 = 40; break;
	case MULT:
	case DIV:
	    Preced2 = 60; break;
	case POWER:
	    Preced2 = 80; break;
	case UNARMINUS:
	    Preced2 =100; break;
	case OPENPARA:
	    Preced2 =140; break;
	case CLOSPARA:
	    Preced2 = 15; break;
	case TOKENSTART:
	case TOKENEND:
	    Preced2 =  0; break;
    }

    return Preced1-Preced2 > 0;
}

/*****************************************************************************
*  Routine to update the character error message according to StrMsg & Token *
*****************************************************************************/
void UpdateCharError(char *StrMsg, int Token)
{
    char *TokenChar = NULL;

    if (Token > 1000) Token -= 1000;

    switch (Token) {
	case ARCSIN:
	case ARCCOS:
	case ARCTAN:
	case ARCTAN2:
	case COS:
	case EXP:
	case FABS:
	case LN:
	case LOG:
	case SIN:
	case SQRT:
	case TAN:
	case CPOLY:
	case AREA:
	case VOLUME:
	case TIME:
            TokenChar = NumFuncTable[Token-NUM_FUNC_OFFSET].FuncName;
	    break;
	case VECTOR:
	case ROTX:
	case ROTY:
	case ROTZ:
	case TRANS:
	case SCALE:
	case BOX:
	case GBOX:
	case CONE:
	case CYLIN:
	case SPHERE:
	case TORUS:
	case PLANE:
	case POLY:
	case CROSSEC:
	case SURFREV:
	case EXTRUDE:
	case LIST:
	case LOAD:
	case CONVEX:
            TokenChar = ObjFuncTable[Token-OBJ_FUNC_OFFSET].FuncName;
            break;
	case EXIT:
	case VIEW:
        case DIR:
	case CHDIR:
	case NORMAL:
	case INCLUDE:
	case GDUMP:
	case MDUMP:
	case FREEOBJ:
	case INTERACT:
	case PAUSE:
	case IFCOND:
	case FORLOOP:
	case PRHELP:
	case VARLIST:
	case ALIAS:
	case BEEP:
	case EDIT:
	case SYSTEM:
	case LOGFILE:
	case COLOR:
            TokenChar = GenFuncTable[Token-GEN_FUNC_OFFSET].FuncName;
            break;
	case PLUS:
            TokenChar = "+";
            break;
	case MINUS:
            TokenChar = "-";
            break;
	case MULT:
            TokenChar = "*";
            break;
	case DIV:
            TokenChar = "/";
            break;
	case POWER:
            TokenChar = "^";
	    break;
	case UNARMINUS:
            TokenChar = "(Unar) -";
	    break;
	case COMMA:
	    TokenChar = ",";
	    break;
	case EQUAL:
            TokenChar = "=";
	    break;
	case COLON:
            TokenChar = ":";
	    break;
	default:
            sprintf(IPGlblCharData, "%s - Token %d\n", StrMsg, Token);
            return;
    }
    sprintf(IPGlblCharData, "%s%s", StrMsg, TokenChar);
}

/*****************************************************************************
*   Routine to get the next token out of the expression.                     *
* Gets the expression in S, and current position in i.                       *
* Returns the next token found, set data to the returned value (if any),     *
* and update i to one char ofter the new token found.                        *
*   Note that in minus sign case, it is determined whether it is monadic or  *
* diadic minus by the last token - if the last token was operator or '('     *
* it is monadic minus.                                                       *
*****************************************************************************/
static int GetToken(RealType *Data)
{
    int i, RetVal = 0;
    char c;

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

    if (c == '"') {		  /* Its a string token - read up to next ". */
	i = 0;
	while ((IPGlblCharData[i] = InptPrsrGetC()) != '"') {
	    if (IPGlblCharData[i] == '\\') /* Its escape char. for next one: */
		IPGlblCharData[i] = InptPrsrGetC();
	    i++;
	}
	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()) || isdigit(c) || c == '_')
	    if (islower(c)) IPGlblCharData[++i] = toupper(c);
	    else IPGlblCharData[++i] = c;
	IPGlblCharData[++i] = 0;
	InptPrsrUnGetC(c);

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

	while (isdigit(c = InptPrsrGetC()) || (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()) || (c == '.'))
		IPGlblCharData[++i] = c;
	}
	IPGlblCharData[++i] = 0;

	InptPrsrUnGetC(c);

#	ifdef DOUBLE
	    sscanf(IPGlblCharData, "%lf", Data);
#	else
	    sscanf(IPGlblCharData, "%f", Data);
#	endif /* 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 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 '=': RetVal = EQUAL; break;
	case ',': RetVal = COMMA; break;
	case ':': RetVal = COLON; break;
	case ';': RetVal = TOKENEND; break;	       /* End of expression! */
	default:
	    RetVal = TOKENERROR;
	    IPGlblParseError = IP_ERR_UndefToken;
            break;
    }

    IPGlblILastToken = RetVal;

    return RetVal;
}

/*****************************************************************************
*   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 variable (new or old).						     *
* Note that although the search is linear, It is extremely fast to add new   *
* functions - simply add its token, its entry here, and in the parser itself.*
*****************************************************************************/
static int GetVarFuncToken(char *Token, RealType *Data)
{
    int i;
    char c;

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

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

    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);

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

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

/*****************************************************************************
*   Routine to reset the aliases buffer to a known state.		     *
*****************************************************************************/
void AliasReset(void)
{
    int i;

    for (i=0; i<NUM_OF_ALIASES; i++)
	GlobalAliasList.Aliases[i].Name = NULL;
}

/*****************************************************************************
*   Routine to update (insert, delete or print) the global alias list	     *
*****************************************************************************/
void AliasEdit(char *Name, char *Value)
{
    int i;
    char s[LINE_LEN];

    if (strlen(Name) == 0) {		    /* Print all defined alias list. */
	WndwInputWindowPutStrFS("Alias List:", RED, TRUE);
	for (i=0; i<NUM_OF_ALIASES; i++)
	    if (GlobalAliasList.Aliases[i].Name != NULL) {
		sprintf(s, "Alias \"%s\" - \"%s\"",
			GlobalAliasList.Aliases[i].Name,
			GlobalAliasList.Aliases[i].Value);
		WndwInputWindowPutStrFS(s, RED, FALSE);
	    }
	return;
    }

    if (strlen(Value) == 0) {			  /* Its a delete operation. */
	for (i=0; i<NUM_OF_ALIASES; i++)
	    if (stricmp(Name, GlobalAliasList.Aliases[i].Name) == 0) break;
	if (i<NUM_OF_ALIASES) {	     /* Found alias to delete, so delete it. */
	    MyFree(GlobalAliasList.Aliases[i].Name, OTHER_TYPE);
	    MyFree(GlobalAliasList.Aliases[i].Value, OTHER_TYPE);
	    GlobalAliasList.Aliases[i].Name = NULL;
	}
	else WndwInputWindowPutStr("Alias not found, ignored", RED);
    }
    else {/* Its an insert operation - test for old one, otherwise make new. */
	for (i=0; i<NUM_OF_ALIASES; i++)
	    if (stricmp(Name, GlobalAliasList.Aliases[i].Name) == 0) break;
	if (i<NUM_OF_ALIASES) {	     /* Found alias to replace - replace it. */
	    MyFree(GlobalAliasList.Aliases[i].Value, OTHER_TYPE);
	    GlobalAliasList.Aliases[i].Value =
		MyMalloc(strlen(Value) + 1, OTHER_TYPE);
	    strcpy(GlobalAliasList.Aliases[i].Value, Value);
	}
	else {			   /* Find empty slot and insert as new one. */
	    for (i=0; i<NUM_OF_ALIASES; i++)
		if (GlobalAliasList.Aliases[i].Name == NULL) break;
	    if (i<NUM_OF_ALIASES) {	       /* Found empty slot - use it. */
		GlobalAliasList.Aliases[i].Name =
		    MyMalloc(strlen(Name) + 1, OTHER_TYPE);
		strcpy(GlobalAliasList.Aliases[i].Name, Name);
		GlobalAliasList.Aliases[i].Value =
		    MyMalloc(strlen(Value) + 1, OTHER_TYPE);
		strcpy(GlobalAliasList.Aliases[i].Value, Value);
	    }
	    else WndwInputWindowPutStr("Aliases buffer full, ignored", RED);
	}
    }
}

/*****************************************************************************
*   Routine to expand aliases of the given line using the global defined     *
* alias list as saved in GlobalAliasList.				     *
*****************************************************************************/
void AliasExpand(char *Line)
{
    int i, j, OldSize, NewSize, DiffSize, Count = 0;
    char *alias;

    for (i=0; i<NUM_OF_ALIASES; i++)
	if (GlobalAliasList.Aliases[i].Name != NULL) {
	    do {
		if ((alias = strstr(Line, GlobalAliasList.Aliases[i].Name)) !=
		    NULL) {
		    if (Count++ > 100) {
			WndwInputWindowPutStr("Alias expansion - 100 expansions reached created, aborted:",
				RED);
			return;
		    }
		    OldSize = strlen(GlobalAliasList.Aliases[i].Name);
		    NewSize = strlen(GlobalAliasList.Aliases[i].Value);
		    DiffSize = NewSize - OldSize;
		    if (DiffSize + strlen(Line) > LINE_LEN_LONG - 1) {
			WndwInputWindowPutStr("Alias expansion created too long line, aborted:",
				RED);
			return;
		    }
		    /* Expand/shrink line space according to Name/Value sizes*/
		    if (DiffSize != 0)
			if (NewSize > OldSize) {
			    movmem(alias, &alias[DiffSize], strlen(alias) + 1);
			}
			else {
			    movmem(&alias[-DiffSize], alias,
				strlen(&alias[-DiffSize]) + 1);
			}
		    /* And copy the Value instead of name into line: */
		    for (j=0; j<NewSize; j++) alias[j] =
			GlobalAliasList.Aliases[i].Value[j];
		}
	    }
	    while (alias != NULL);
	}

}

static char UnGetChar;

/*****************************************************************************
*   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.    *
*****************************************************************************/
static char InptPrsrGetC(void)
{
    static char Line[LINE_LEN_LONG] = "";
    static int LineLength = 0, LineCount = 0;
    char c;
#ifndef __MSDOS__
    int i;
#endif /* __MSDOS__ */

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

	    /* Line len. changes by Wndw routine - strip off CR/LF/TAB.      */
#ifdef __MSDOS__
	    WndwInputWindowPutStr(Line, NO_COLOR);
#else
	    if (FileStackPtr != 0)		 /* Input was from keyboard? */
		WndwInputWindowPutStr(Line, NO_COLOR);
	    {
		for (i=0; i<strlen(Line); i++)
		    if (Line[i] == TAB) Line[i] = ' ';	/* Strip off tabs... */
		for (i=strlen(Line); isspace(Line[--i]););   /* Strip CR/LF. */
		Line[i+1] = 0;
	    }
#endif /* __MSDOS__ */
	    LineLength = strlen(Line);            
	} while (LineCount >= LineLength);
	c = Line[LineCount++];
	if (c == '#') {			  /* Its a comment - skip that line. */
            c = ' ';				   /* Must return something. */
            LineCount = LineLength;    /* Force next time to fetch new line. */
	}
#	ifdef DEBUG
	    fprintf(stderr, "%c", c);
#	endif /* DEBUG */
    }
    else {
	c = UnGetChar;
	UnGetChar = 0;
    }

    return c;
}

/*****************************************************************************
*   Routine to unget one char						     *
*****************************************************************************/
static void InptPrsrUnGetC(char c)
{
    UnGetChar = c;
}

/*****************************************************************************
*   Routine to read data up to the next end of expression marker - ';'.	     *
*****************************************************************************/
static 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() != ';');

}

/*****************************************************************************
*   Routine to push new file to read on the FileStack from INCLUDE command:  *
*****************************************************************************/
void FileInclude(char *FileName)
{
    int i;
    FILE *f;
    char s[LINE_LEN], c;

    if (FileStackPtr < FILE_STACK_SIZE) {
	if (strrchr(FileName, '.') == NULL)	        /* If no '.' in name */
	{      /* (nor in its path - actually a bug, but I'll skip that...). */
	    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\n", FileName);
	    WndwInputWindowPutStr(s, RED);
	}
    }
    else WndwInputWindowPutStr("File nesting too deep - ignored\n", RED);
}

/*****************************************************************************
*   Routine to return parsing error if happen one, zero	elsewhere	     *
*****************************************************************************/
int InptPrsrParseError(char **Message)
{
    int	Temp;

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