numexpr.c

类PASCAL语言的编译器,LINUX环境的,我没试过是否正确.

/******************************************************************************
 *                        FREXX PROGRAMMING LANGUAGE                          *
 ******************************************************************************

 numexpr.c

 Supports *FULL* C language expression operator priority and much more...!

 *****************************************************************************/

/************************************************************************
 *                                                                      *
 * fpl.library - A shared library interpreting script langauge.         *
 * Copyright (C) 1992-1996 FrexxWare                                    *
 * Author: Daniel Stenberg                                              *
 *                                                                      *
 * This program is free software; you may redistribute for non          *
 * commercial purposes only. Commercial programs must have a written    *
 * permission from the author to use FPL. FPL is *NOT* public domain!   *
 * Any provided source code is only for reference and for assurance     *
 * that users should be able to compile FPL on any operating system     *
 * he/she wants to use it in!                                           *
 *                                                                      *
 * You may not change, resource, patch files or in any way reverse      *
 * engineer anything in the FPL package.                                *
 *                                                                      *
 * This program is distributed in the hope that it will be useful,      *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
 *                                                                      *
 * Daniel Stenberg                                                      *
 * Ankdammsgatan 36, 4tr                                                *
 * S-171 43 Solna                                                       *
 * Sweden                                                               *
 *                                                                      *
 * FidoNet 2:201/328    email:[e-mail]                       *
 *                                                                      *
 ************************************************************************/

#ifdef AMIGA
#include <exec/types.h>
#include <proto/exec.h>
#elif defined(UNIX)
#include <sys/types.h>
#endif

#include "script.h"
#include <stdio.h>
#include <stddef.h>
#include <limits.h>

static ReturnCode AddUnary(struct Data *, struct Expr *, Operator);
static ReturnCode Calc(struct Data *, struct Expr *, struct Expr *, char);
static ReturnCode INLINE GetArrayInfo(struct Data *, long *, long *, long, uchar *);
static ReturnCode INLINE Convert(struct Expr *, struct Data *);
static void Clean(struct Data *, struct Expr *);
static ReturnCode INLINE PrototypeInside(struct Data *,
					 struct Expr *val,
					 long,
					 struct Identifier *);
static ReturnCode INLINE inside(struct Data *, struct fplArgument *,
                                struct Identifier *);


/***********************************************************************
 *
 * int Expression(struct Expr *, struct Data *, uchar, struct Local *)
 *
 * Returns a nonzero value if any error occured.
 * The result of the Expression is returned in the Expr structure which you
 * give the pointer to in the first argument.
 *
 *****************/

ReturnCode REGARGS
Expression(struct Expr *val, /* return value struct pointer */
           struct Data *scr, /* everything */
           long control,    /* ESPECIALLLY DEFINED */
           struct Identifier *ident) /* pointer to the pointer holding
                                        the local variable names linked
                                        list */
{
  struct Expr *expr, *basexpr;
  ReturnCode ret;
  struct Identifier *pident; /* general purpose struct identifier pointer */
  struct Unary *un; /* general purpose struct Unary pointers */
  long *dims=NULL; /* dimension pointer for variable arrays! */
  uchar *text;     /* general purpose char pointer */
  uchar hit;
  uchar *array;
  long num;
  struct fplStr *string;

  GETMEM(expr, sizeof(struct Expr));
  memset(expr, 0, sizeof(struct Expr));
  basexpr=expr;

  while (1) {
#if 0     
    INFO(scr, CERROR_CMPPOS);
#endif
    if(ret=Eat(scr)) {       /* getaway blanks and comments */
      if(control&CON_END && ret==FPLERR_UNEXPECTED_END) {
        /* If there can be an unexpected ending, break out of the loop
           with a nice return code! */
        break;
      }
    }
#if 1
    else if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL))
      /* get outta string calcs if not on ground level! */
      break;
#endif
    if(!(expr->flags&FPL_OPERAND)) {  /* operand coming up */

      if(control&CON_IDENT ||
         isident(*scr->text)) {
        /*
         * It's a valid identifier character.
         */
        uchar *point;
        num=0; /* Dimension counter when taking care of array variables */

        if(control&CON_IDENT) {
          if(!(control&CON_LEVELOK) && !ident)
            ret=FPLERR_IDENTIFIER_NOT_FOUND;
          control&=~CON_IDENT; /* switch off that bit to get away from any
                                  trouble such as double using this! */
        } else {
          CALL(Getword(scr));
          ret=GetIdentifier(scr, scr->buf, &ident);
	  if(ret)
	    ident=NULL;
        }

        point=scr->text;
        Eat(scr); /* getaway blanks */

        /*
         * `ret' can only be FPL_OK or FPLERR_IDENTIFIER_NOT_FOUND at this
         * position.
         */

        if(control&CON_DECLARE && *scr->text==CHAR_OPEN_PAREN) {
	  CALL(PrototypeInside(scr, val, control, ident));
	  expr->flags|=FPL_OPERAND|FPL_ACTION;

        } else if(control&CON_DECLARE ||
                  (ident && ident->flags&FPL_VARIABLE) ||
                  (!ident && scr->text[0]!=CHAR_OPEN_PAREN)) {
          /* The ident check above really must be there, otherwise we might
             read it when it is a NULL pointer" */

          /* it's a variable */
          pident=ident;
          if(ret &&                     /* we didn't find it... */
             !(control&CON_DECLARE)) {  /* and we're not declaring! */
            /*
             * We didn't find the requested identifier and we're *NOT*
             * declaring. This means exported, name-referenced identifier!
             */
            CALL(PutArg(scr, COMP_REF_EXPORT_SYMBOL, Gethash(scr->buf) ));
            CALL(PutString(scr, COMP_NOTHING, scr->buf, -1));
          }
          else if(!ret) {
	    if((ident && ident->flags&FPL_REFERENCE) &&
               !(control&CON_LEVELOK)) {
	      INFO(scr, CERROR_ILLEGAL_REFERENCE, ident->name);
	      return FPLERR_ILLEGAL_VARIABLE; /* this is a reference _only_! */
	    }
            /* The symbol was found */
	    if(control&CON_LEVELOK) /* level _is_ OK! */
	      ;
            else if(control&CON_DECLARE &&
	       (ident->level>=scr->varlevel || scr->varlevel==1)) {
              /*
               * If the name already declared in this (or higher) level
               * and declaration is wanted.
               */
              INFO(scr, CERROR_IDENTIFIER_USED, scr->buf);
              return FPLERR_IDENTIFIER_USED;
            } else if(!(control&CON_DECLARE) &&
                      (ident->level && /* not global */
                       ident->level<(scr->varlevel-scr->level))) {
              /*
               * From the wrong program level and we're not declaring.
               */
              INFO(scr, CERROR_IDENTIFIER_NOT_FOUND, scr->buf);
              return FPLERR_IDENTIFIER_NOT_FOUND;
            }
            else if(ident->flags&FPL_STATIC_VARIABLE &&
                    ((ident->func && (ident->func==scr->func)) ||
                     ident->level>scr->varlevel)
                    ) {
              /*
               * A static variable declared either in the wrong function or
               * in a higher level!
               */
              INFO(scr, CERROR_IDENTIFIER_NOT_FOUND, scr->buf);
              return FPLERR_IDENTIFIER_NOT_FOUND;
            }
          }

          text = NULL; /* no name information yet! */

	  control &= ~CON_LEVELOK; /* forget about the level OK stuff!! */

          if(control&CON_DECLARE) {
            expr->flags|=FPL_ACTION;
            GETMEM(pident, sizeof(struct Identifier));

            pident->level=
              (control&(CON_DECLEXP|CON_DECLGLOB))?0:scr->varlevel;
            pident->flags=
              (control&CON_DECLINT?FPL_INT_VARIABLE:FPL_STRING_VARIABLE)|
                (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
                  (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:
                    (control&CON_DECLSTATIC?FPL_STATIC_VARIABLE:0))|
                    (control&CON_DECL8?FPL_CHAR_VARIABLE:
                     (control&CON_DECL16?FPL_SHORT_VARIABLE:0))|
                       (control&CON_DECLCONST?FPL_READONLY:0);

            pident->file=NULL; /* file */

            pident->func=scr->func; /* declared in this function */

            /* Get variable name */
            if(text)
              /*
               * The name has already been allocated above!
               */
              pident->name = text;
            else {
              /*
               * Get the name!
               */
              STRDUP(pident->name, scr->buf); /* no real strdup */
            }
	    pident->linenum = scr->virprg;
            /*
             * We add the symbol to the local data in all cases except when
             * the symbol is global or static.
             */
            CALL(AddVar(scr, pident,
                        control&(CON_DECLGLOB|CON_DECLSTATIC)?
                        &scr->globals:&scr->locals,
                        TRUE));

	    if(*scr->text==CHAR_OPEN_BRACKET) {
	      /*
	       * It's an array. Get the result of the expression within the
	       * square brackets.
	       */
	      
	      /* emulate declaration time if the variable wasn't found and
		 is expected to be an exported one! */
	      num = MAX_DIMS;
	      CALL(GetArrayInfo(scr, dims, &num, control|CON_DECLARE, text));
	      point=scr->text; /* move point to current location  */
	      Eat(scr); /* pass all traling whitespaces */
	    }
            if(num) {
              /*
               * Array variable declaration! It is a bit different from
               * common variable declaration.
               */
              pident->data.variable.num=num;   /* number of dimensions */

              /* reset num: */
              num=1;
            } else {
              pident->data.variable.num=0;
            }

          }
          else {
            if(pident) {
              if(!(pident->flags&FPL_EXPORT_SYMBOL)) {
                /* local, number-referenced identifier! */
                CALL(PutArg(scr, pident->flags&FPL_GLOBAL_SYMBOL?
                            COMP_REF_GLOBAL_SYMBOL:
                            COMP_REF_LOCAL_SYMBOL, pident->number));
              }
              else {
                /* exported, name-referenced identifier! */
                CALL(PutArg(scr, COMP_REF_EXPORT_SYMBOL, pident->hash));
                CALL(PutString(scr, COMP_NOTHING, pident->name, -1));
              }
            }
	    
	    if(*scr->text==CHAR_OPEN_BRACKET) {
	      /*
	       * It's an array. Get the result of the expression within the
	       * square brackets.
	       */
	      
	      /* emulate declaration time if the variable wasn't found and
		 is expected to be an exported one! */
	      if(num = (pident?pident->data.variable.num:MAX_DIMS)) {
		CALL(GetArrayInfo(scr, dims, &num, control|CON_DECLARE, text));
		point=scr->text; /* move point to current location  */
		Eat(scr); /* pass all traling whitespaces */
	      }
	    }

          }

          /*
           * Now when all declarations is done, all assigns are left:
           */

          expr->flags|=FPL_OPERAND;
          if ((!pident && control&CON_STRING) ||
              (pident && pident->flags&FPL_STRING_VARIABLE)) {

            /*
             * String variable
             */

            if(*scr->text==CHAR_OPEN_BRACKET) { /* just one character */
              /*
               * Get the result of the expression.
               */
              ++scr->text;
              CALL(Put(scr, COMP_OPEN_BRACKET));
              CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
              if(*scr->text!=CHAR_CLOSE_BRACKET) {
                INFO(scr, CERROR_MISSING_BRACKET, CHAR_CLOSE_BRACKET);
              }
              else
                ++scr->text;
              CALL(Put(scr, COMP_CLOSE_BRACKET));

              CALL(Eat(scr)); /* eat white space */

              if(ASSIGN_OPERATOR) {
                uchar was=*scr->text;
                if(pident && pident->flags&FPL_READONLY) {
                  INFO(scr, CERROR_READONLY_VIOLATE, pident->name);
                  return FPLERR_READONLY_VIOLATE;
                }
                expr->flags|=FPL_ACTION;
                if(*scr->text==CHAR_ASSIGN)
                  scr->text++;
                else if(scr->text[2]==CHAR_ASSIGN)
                  scr->text+=3;
                else
                  scr->text+=2;
                /* single assign */
                CALL(PutArg(scr, COMP_ASSIGN, was));
                CALL(Put(scr, COMP_START_OF_EXPR));
                CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
                CALL(Put(scr, COMP_END_OF_EXPR));
              }

              expr->val.val=0;
              CALL(NewMember(scr, &expr));
            } else if(control&CON_NUM) {
              /* NO strings allowed! */
              INFO(scr, CERROR_ILLEGAL_NUMERICAL);
              return FPLERR_UNEXPECTED_STRING_STATEMENT;
              /* be able to continue here, we must pass everything that has to
                 to with the strings in this expression */
            } else if (*scr->text==CHAR_ASSIGN || (*scr->text==CHAR_PLUS &&
                        scr->text[1]==CHAR_ASSIGN)) {
              uchar array=FALSE;
              uchar multi=FALSE;
              uchar app=(*scr->text==CHAR_PLUS);

              if(pident && pident->flags&FPL_READONLY &&
                 !(control&CON_DECLARE)) {
                INFO(scr, CERROR_READONLY_VIOLATE, pident->name);
                return FPLERR_READONLY_VIOLATE;
              }
              CALL(PutArg(scr, COMP_ASSIGN, *scr->text));
              scr->text+=1+app;
              expr->flags|=FPL_ACTION;
              if(pident && pident->data.variable.num) { /* if array member assign */
                Eat(scr);
                if(*scr->text==CHAR_OPEN_BRACE) {
                  CALL(Put(scr, COMP_OPEN_BRACE));
                  /* multi-array assign */
                  multi=TRUE;
                  ++scr->text;
                  CALL(Eat(scr));
                }
                array=TRUE;
              }

              if(!multi) {
                /* single (array) variable assign */
                CALL(Put(scr, COMP_START_OF_EXPR));
		CALL(Expression(val, scr, CON_STRING, NULL));
		CALL(StringExpr(val, scr)); /* get more strings? */
                CALL(Put(scr, COMP_END_OF_EXPR));

                if(app && !(val->flags&FPL_NOFREE) && val->val.str)
                  /* Only do this if appending! */
                  FREE(val->val.str);