numexpr.c

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

              } else {
                /* multi [compound] assign! */

                do {
                  hit=TRUE;
                  while(hit) {
                    /* parse the controlling braces and commas */
                    switch(*scr->text) {
                    case CHAR_COMMA:
                      CALL(Put(scr, COMP_COMMA));
                      ++scr->text;
                      break;
                    case CHAR_CLOSE_BRACE:
                      CALL(Put(scr, COMP_CLOSE_BRACE));
                      if(--num<0) {
			INFO(scr, CERROR_ILLEGAL_ARRAY);
                        return FPLERR_ILLEGAL_ARRAY;
		      }
                      else
                        ++scr->text;
                      break;
                    case CHAR_OPEN_BRACE:
                      CALL(Put(scr, COMP_OPEN_BRACE));
                      if(++num>(pident?pident->data.variable.num:MAX_DIMS)) {
			INFO(scr, CERROR_ILLEGAL_ARRAY);
                        return FPLERR_ILLEGAL_ARRAY;
                      }
		      else
                        ++scr->text;
                      break;
                    default:
                      hit=FALSE;
                      break;
                    }
                    if(hit) {
                      CALL(Eat(scr));
                    }
                    else
                      break;
                  }

                  if(!num)
                    break;

                  /* 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 if we're appending! */
                    FREE(val->val.str);
                  }

                 /* while  */
                } while(1);
              }
              expr->val.str=NULL;
              expr->flags|=FPL_STRING|FPL_NOFREE;
            } else {
              expr->val.str=NULL;
              expr->flags|=FPL_STRING|FPL_NOFREE;
	      CALL(StringExpr(expr, scr));
            }
          } else {
            /*
             * Integer variable...
             */
            if(control&CON_STRING) {
              /* NO integers allowed! */
              INFO(scr, CERROR_ILLEGAL_NUMERICAL);
              return FPLERR_UNEXPECTED_INT_STATEMENT;
            }
            if(!expr->operator && !expr->unary &&
               ASSIGN_OPERATOR) {

              /* integer assign */

              uchar array=FALSE;    /* is it an array variable */
              uchar multi=FALSE;    /* mutiple variable */
              uchar was=*scr->text;

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

              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;
              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) {
                CALL(Put(scr, COMP_START_OF_EXPR));
                CALL(Expression(val, scr, CON_NORMAL|(pident?CON_NUM:0), NULL));
                CALL(Put(scr, COMP_END_OF_EXPR));

                expr->val.val=0;
              } else {
                /* multi [compound] assign */

                do {
                  hit=TRUE;
                  while(hit) {
                    /* parse the controlling braces and commas */
                    switch(*scr->text) {
                    case CHAR_COMMA:
                      CALL(Put(scr, COMP_COMMA));
                      ++scr->text;
                      break;
                    case CHAR_CLOSE_BRACE:
                      CALL(Put(scr, COMP_CLOSE_BRACE));
                      if(--num<0) {
			INFO(scr, CERROR_ILLEGAL_ARRAY);
                        return FPLERR_ILLEGAL_ARRAY;
                      }
		      else
                        ++scr->text;
                      break;
                    case CHAR_OPEN_BRACE:
                      CALL(Put(scr, COMP_OPEN_BRACE));
                      if(++num>(pident?pident->data.variable.num:MAX_DIMS)) {
			INFO(scr, CERROR_ILLEGAL_ARRAY);
                        return FPLERR_ILLEGAL_ARRAY;
                      }
		      else
                        ++scr->text;
                      break;
                    default:
                      hit=FALSE;
                      break;
                    }
                    if(hit) {
                      CALL(Eat(scr));
                    }
                    else
                      break;
                  }

                  if(!num)
                    break;

                  /* assign! */
                  CALL(Put(scr, COMP_START_OF_EXPR));
                  CALL(Expression(val, scr, CON_NORMAL|(pident?CON_NUM:0), NULL));
                  CALL(Put(scr, COMP_END_OF_EXPR));
                  expr->val.val=0;

                  /* while  */
                } while(1);
              }
              expr->flags|=FPL_NOFREE; /* the memory pointed to by the expr->val.val
                                          is strings of proper variables. Do
                                          not free them now! */
            } else {
              /*
               * No assignment, primary operator or none at all!
               */
              if(control&CON_DECLARE)
                expr->val.val=0;
              else {
                if(*point==CHAR_PLUS && point[1]==CHAR_PLUS) {
                  /*post increment*/
                  if(pident && pident->flags&FPL_READONLY) {
                    INFO(scr, CERROR_READONLY_VIOLATE, pident->name);
                    return FPLERR_READONLY_VIOLATE;                  
                  }
                  expr->flags|=FPL_ACTION;
                  expr->val.val=0;
                  scr->text+=2;
                  CALL(Put(scr, COMP_POSTINC));
                } else if(*point==CHAR_MINUS && point[1]==CHAR_MINUS) {
                  /* post decrement */
                  if(pident && pident->flags&FPL_READONLY) {
                    INFO(scr, CERROR_READONLY_VIOLATE, pident->name);
                    return FPLERR_READONLY_VIOLATE;                  
                  }

                  expr->flags|=FPL_ACTION;
                  expr->val.val=0;
                  scr->text+=2;
                  CALL(Put(scr, COMP_POSTDEC));
                } else {
                  /* plain variable or pre operation */
                  if(un=expr->unary) {
                    if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) {
                      expr->val.val=0;
                    } else {
                      if(pident && pident->flags&FPL_READONLY) {
                        INFO(scr, CERROR_READONLY_VIOLATE, pident->name);
                        return FPLERR_READONLY_VIOLATE;
                      }
                      if(un->unary==OP_PREINC) {
                        expr->val.val=0;
                      }
                      else {
                        expr->val.val=0;
                      }
                      expr->unary=un->next;
                      FREE(un);
                    }
                  } else
                    expr->val.val=0;
                }
              }
              CALL(NewMember(scr, &expr));
            }
          }   /* end of integer handling */
        }
        else {                     /* some sort of function */
          /*
           * FUNCTION HANDLER PART:
           */

          struct fplArgument *pass; /* struct pointer to send as argument to
                                       the function handler */
          long allocspace;

          if(ret) {
            if(*scr->text!=CHAR_OPEN_PAREN)
              /* If the following character is not an open parenthesis, fail! */
              return(ret);
          }

          num=0;    /* number of arguments */

          expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */

          GETMEM(pass, sizeof(struct fplArgument));

          if(!ident) {
            /* The function does not exist as a declared function! */
            STRDUP(pass->name, scr->buf);
            pass->ID=FPL_UNKNOWN_FUNCTION;
            text="a>"; /* optional parameter list as argument! */
          } else {
            pass->name=ident->name;
            pass->ID=ident->data.external.ID;
            text=ident->data.inside.format;
          }
          pass->argc=0;
          pass->key=(void *)scr;

          if(!ident || FPL_OPTEXPRARG == ident->data.inside.ret) {
            /*
             * The function we invoked was not found regularly!
	     * Set return type!
	     */

	    /*
             * We try to determine whether it should return an int or a string.
             * We interpret the return value as we should do to make it pass
             * as a valid expression. That is, if the flag tells us this
             * should be a string expression to be valid, we take it as a
             * string, but if it tells us its an integer expression, we read
             * it as an integer!!!
             */

            if(control&CON_STRING)
              hit = FPL_STRARG;
            else {
              if(control&CON_NUM)
                hit = FPL_INTARG;
              else
                /*
                 * We don't know which kind of return code the function
                 * should give us!
                 */
                hit = FPL_OPTEXPRARG;
            }

	  } else {
            hit = UPPER(ident->data.inside.ret);
            if(control&CON_STRING && (hit!=FPL_STRARG)) {
              INFO(scr, CERROR_ILLEGAL_STRING);
              return FPLERR_UNEXPECTED_INT_STATEMENT;
            }
            if(control&CON_NUM && (hit!=FPL_INTARG)) {
              INFO(scr, CERROR_ILLEGAL_NUMERICAL);
              return FPLERR_UNEXPECTED_STRING_STATEMENT;
            }
          }

          pass->ret = hit;
#if 0 /* old style local function call */
          if(ident && !(ident->flags&FPL_EXPORT_SYMBOL)) {
            /* local, number-referenced identifier! */
            CALL(PutArg(scr, COMP_CALL_LOCAL_FUNCTION, ident->number));
          }
          else
#endif
          if(ident && (ident->flags&FPL_INTERNAL_FUNCTION)) {
            /* internal function call! */
            CALL(PutArg(scr, COMP_CALL_INTERNAL_FUNCTION, ident->data.external.ID));
          }
          else {
            /* name-referenced identifier! */
            CALL(PutArg(scr, COMP_CALL_FUNCTION, Gethash(pass->name) ));
            CALL(PutString(scr, COMP_NOTHING, pass->name, -1));
          }

          if(*scr->text!=CHAR_OPEN_PAREN) {
            INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_OPEN_PAREN);
            return FPLERR_MISSING_PARENTHESES;
          }
          else
            ++scr->text;

          CALL(Eat(scr));

          CALL(Put(scr, COMP_OPEN_PAREN));

          if(text && *text) {
            uchar b='a';
            uchar a;

            /* if the function takes arguments */

            /*
             * Allocate arrays to use for data storage while parsing
             * the arguments. Maximum number of arguments is
             * MAX_ARGUMENTS.
             */

            num=strlen(text);   /* number of arguments to this function */

            if(text[num-1]!=FPL_ARGLIST)
              allocspace=num+1;
            else
              allocspace=MAX_ARGUMENTS;

            /*
             * By adjusting the number of allocated bytes to the smallest
             * necessary, my recursive example program used only a fifth
             * as much memory as when always allocating memory for
             * MAX_ARGUMENTS.
             */

            /* allocate an array */
            GETMEM(pass->argv, sizeof(uchar *)*allocspace);

            /* allocate new format string */
            GETMEM(pass->format, sizeof(uchar)*allocspace);

            /* allocate allocate-flag string */
            GETMEM(array, sizeof(uchar)*allocspace);

            while(!ret && *scr->text!=CHAR_CLOSE_PAREN && text && *text) {
              CALL(Eat(scr));
              b=(*text==FPL_ARGLIST)?b:UPPER(*text);
	      if(FPL_OPTARG == b &&
		 CHAR_AND == scr->text[0])
                a = FPL_OPTVARARG;
	      else
                a = b;

              if(pass->argc==allocspace) {
                uchar *temp;
                GETMEM(temp, sizeof(uchar *)*(allocspace+MAX_ARGUMENTS));
                memcpy(temp, pass->argv, sizeof(uchar *)*allocspace);
                FREE(pass->argv);
                pass->argv=(void **)temp;

                GETMEM(temp, sizeof(uchar)*(allocspace+MAX_ARGUMENTS));
                memcpy(temp, pass->format, sizeof(uchar)*allocspace);
                FREE(pass->format);
                pass->format=temp;

                GETMEM(temp, sizeof(uchar)*(allocspace+MAX_ARGUMENTS));
                memcpy(temp, array, sizeof(uchar)*allocspace);
                FREE(array);
                array=temp;
                
                allocspace += MAX_ARGUMENTS;
              }

              switch(a) {
	      case FPL_OPTEXPRARG:
              case FPL_OPTARG:
              case FPL_STRARG: