numexpr.c

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

                CALL(Expression(val, scr, (a==FPL_STRARG?CON_STRING:0), NULL));

                if(a==FPL_STRARG || val->flags&FPL_STRING) {
		  CALL(StringExpr(val, scr)); /* get more strings? */

                  /* Enter string symbol in the created format string! */
                  pass->format[pass->argc]=FPL_STRARG;

                  if(val->val.str) {
                    /* Set this to TRUE if deallocation is wanted on this
                       string after the function call! */
                    array[pass->argc]=!(val->flags&FPL_NOFREE);
                    /*
                     * Point to the string (that is zero terminated)!
                     */
                    pass->argv[pass->argc]=val->val.str->string;
                  } else {
                    GETMEM(string, sizeof(struct fplStr));
		    memset(string, 0, sizeof(struct fplStr));
		    pass->argv[pass->argc]=string->string;
                    array[pass->argc]=1; /* allocation has been done! */
                  }
                } else {
                  pass->format[pass->argc]=a;
                  pass->argv[pass->argc]=0;
                }
                pass->argc++;
                break;
              case FPL_INTARG:
                CALL(Expression(val, scr, CON_NUM, NULL));
                pass->format[pass->argc]=FPL_INTARG;
                pass->argv[pass->argc++]=(void *)val->val.val;
                break;
	      case FPL_OPTVARARG:
              case FPL_STRVARARG:
              case FPL_INTVARARG:
	      case FPL_INTARRAYVARARG:
	      case FPL_STRARRAYVARARG:
                {
                  register ReturnCode ok;
                  if(*scr->text != CHAR_AND) {
                    ok = FPLERR_ILLEGAL_REFERENCE;
                  }
                  else {
                      CALL(Put(scr, COMP_VARIABLE_REFERENCE));
                      scr->text++;
                      ok = FPL_OK;
                  }
                  CALL(Getword(scr));
                  /* Use the `pident' pointer here, cause the `ident' pointer
                     is already being used by the function we're about to
                     invoke! */
                  GetIdentifier(scr, scr->buf, &pident);

                  if(pident && ok && !(pident->flags&FPL_REFERENCE)) {
                    /*
                     * No &-character, and the variable isn't an existing
                     * reference type!
                     */
                    INFO(scr, CERROR_ILLEGAL_REFERENCE, pident->name);
                    return FPLERR_ILLEGAL_REFERENCE; /* no reference! */
                  }
                  if(pident && !(pident->flags&FPL_EXPORT_SYMBOL)) {
                    /*
                     * This should contain many more error checks!!!
                     */

                    /* 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,
                                Gethash(scr->buf) ));
                    CALL(PutString(scr, COMP_NOTHING, scr->buf, -1));
                  }
                  
                }

		if(FPL_INTARRAYVARARG == a || FPL_STRARRAYVARARG == a) {
		  if(!pident->data.variable.num) {
		    INFO(scr, CERROR_ILLEGAL_REFERENCE, pident->name);
		    return FPLERR_ILLEGAL_REFERENCE;
		  }
		}
		else if(FPL_OPTVARARG != a && pident->data.variable.num) {
		  /* only straight variables! */
		  INFO(scr, CERROR_ILLEGAL_PARAMETER);
		  return FPLERR_ILLEGAL_PARAMETER;
		}
                if( (pident->flags&FPL_INT_VARIABLE &&
		     (a==FPL_STRVARARG || a == FPL_STRARRAYVARARG)) ||
		   (pident->flags&FPL_STRING_VARIABLE &&
		    (a==FPL_INTVARARG || a == FPL_INTARRAYVARARG))) {
		  INFO(scr, CERROR_ILLEGAL_PARAMETER);
		  return FPLERR_ILLEGAL_PARAMETER;
                } else
		    pass->argv[pass->argc]=NULL;

                pass->format[pass->argc++]=
		  (pident->flags&FPL_STRING?
		 (pident->data.variable.num?FPL_STRARRAYVARARG:FPL_STRVARARG):
		   (pident->data.variable.num?FPL_INTARRAYVARARG:
		    FPL_INTVARARG));
                Eat(scr);
                break;
              default:
		INFO(scr, CERROR_ILLEGAL_PARAMETER);
		return FPLERR_ILLEGAL_PARAMETER;
              }
              if(*text!=FPL_ARGLIST)
                text++;
              if(*scr->text==CHAR_COMMA && *text) {
                scr->text++;
		CALL(Eat(scr)); /* eat white space! */
                CALL(Put(scr, COMP_COMMA));
              }
              else if(*scr->text!=CHAR_CLOSE_PAREN) {
                if(*text)
                  INFO(scr, CERROR_ILLEGAL_PARAMETER);
                else
                  INFO(scr, CERROR_EXPECTED_PAREN, CHAR_CLOSE_PAREN);
                return FPLERR_SYNTAX_ERROR;
              }
            }
            pass->format[pass->argc]=CHAR_ASCII_ZERO;
            if(text && *text && !(*text&CASE_BIT)) {
              /*
               * This is a serious mis-use. The function is called with to few
               * parameters. At least one parameter missing is a required one.
               */
	      INFO(scr, CERROR_MISSING_ARGUMENT, pass->name);
              return FPLERR_MISSING_ARGUMENT;
            }
          } else
            pass->format=NULL;

          if(*scr->text!=CHAR_CLOSE_PAREN) {
	    INFO(scr, CERROR_EXPECTED_PAREN, CHAR_CLOSE_PAREN);
            return FPLERR_TOO_MANY_PARAMETERS; /* too many parameters! */
	  }
	  ++scr->text;
          CALL(Put(scr, COMP_CLOSE_PAREN));

          switch(hit) {
            case FPL_STRARG:
              /* We got a zero length string or no string at all! */
              expr->val.str=NULL; /* no string! */
            
              expr->flags=FPL_STRING|FPL_ACTION;
	      control |= CON_STRING;
              break;
            case FPL_INTARG:
            default:
              /* only if integer! or the function is non-existent */
              expr->val.val=0;
              break;
          }

          if(!ident) {
            /*
             * The function we invoked was not found regularly!
	     * Free the name we allocated temporarily.
	     */
            FREE(pass->name); /* the name was strdup()'ed! */
	  }
          CALL(PutString(scr, COMP_TYPE_OF_ARGUMENTS, pass->format?pass->format:"", -1));

          while(pass->argc--) {
            if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) {
              /* free the string if it's been marked to be freed!! */
              FREE((uchar *)pass->argv[pass->argc]-
                   offsetof(struct fplStr, string));
            }
          }
          if(pass->format) {
            FREE(pass->argv);
            FREE(pass->format);
            FREE(array);
          }
          FREE(pass);
#if 0
          CALL(NewMember(scr, &expr));
#endif
        }
      }
      else {

          switch(*scr->text) {
          case CHAR_AND:
            /* This is the reference-this operator! */
            CALL(Put(scr, COMP_VARIABLE_REFERENCE));
            ++scr->text; /* pass the & */
            CALL(Getword(scr));
            GetIdentifier(scr, scr->buf, &ident);

            if(ident && !(ident->flags&FPL_EXPORT_SYMBOL)) {
              /*
               * This should contain many more error checks!!!
               */

              /* local, number-referenced identifier! */
              CALL(PutArg(scr,  ident->flags&FPL_GLOBAL_SYMBOL?
                                COMP_REF_GLOBAL_SYMBOL:
                                COMP_REF_LOCAL_SYMBOL, ident->number));
            }
            else {
              /* exported, name-referenced identifier! */
              CALL(PutArg(scr, COMP_REF_EXPORT_SYMBOL,
                          Gethash(scr->buf) ));
              CALL(PutString(scr, COMP_NOTHING, scr->buf, -1));
            }
            CALL(NewMember(scr, &expr));
            break;
	  case CHAR_MULTIPLY:
	    /*
	     * This is the 'contents of' operator!
	     * The contents of the variable that follows this sign should
	     * get the following rvalue.
	     * Of course, we must first check that this really is a
	     * 'pointer' to a variable.
	     */

	    while(*++scr->text==CHAR_MULTIPLY); /* just in case! */

            CALL(Put(scr, COMP_CONTENTSOF));

	    CALL(Getword(scr));
	    if(control&CON_DECLARE) {
              INFO(scr, CERROR_NOT_YET_SUPPORTED);
	      return FPLERR_SYNTAX_ERROR; /* not yet supported */
            }
            CALL(GetIdentifier(scr, scr->buf, &ident));
	    if(ident && !(ident->flags&FPL_REFERENCE)) {
              INFO(scr, CERROR_ILLEGAL_REFERENCE, scr->buf);
	      return FPLERR_ILLEGAL_REFERENCE; /* referenced a non-reference! */
            }
	    /* we have an identifier and the level is OK! */
	    control |= CON_IDENT|CON_LEVELOK;
#if 0
            if(ident && !(ident->flags&FPL_EXPORT_SYMBOL)) {
              /* local, number-referenced identifier! */
              CALL(PutArg(scr,  ident->flags&FPL_GLOBAL_SYMBOL?
                            COMP_REF_GLOBAL_SYMBOL:
                            COMP_REF_LOCAL_SYMBOL, ident->number));
            }
            else {
              /* exported, name-referenced identifier! */
              CALL(PutArg(scr, COMP_REF_EXPORT_SYMBOL, Gethash(scr->buf)));
              CALL(PutString(scr, COMP_NOTHING, scr->buf, -1));
            }
#endif
            continue;

          case CHAR_ZERO:
            /*
             * Numbers starting with a '0' can be hex/oct/bin.
             */
            if(control&CON_STRING) {
              /* NO integers allowed! */
              INFO(scr, CERROR_ILLEGAL_STRING);
              return FPLERR_UNEXPECTED_INT_STATEMENT;
            }
            switch(scr->text[1]) {
            case CHAR_X:
            case CHAR_UPPER_X:
              /* hexadecimal number parser */
              for(scr->text+=2; isxdigit(*scr->text); scr->text++)
                expr->val.val=expr->val.val*16+ (isdigit(*scr->text)?
                                         *scr->text-CHAR_ZERO:
                                         UPPER(*scr->text)-CHAR_UPPER_A+10);
              break;
            case CHAR_B:
            case CHAR_UPPER_B:
              /* binary number parser */
              for(scr->text+=2;*scr->text==CHAR_ZERO || *scr->text==CHAR_ONE;)
                expr->val.val=expr->val.val*2+ *scr->text++ - CHAR_ZERO;
              break;
            case CHAR_ZERO:
            case CHAR_ONE:
            case CHAR_TWO:
            case CHAR_THREE:
            case CHAR_FOUR:
            case CHAR_FIVE:
            case CHAR_SIX:
            case CHAR_SEVEN:
              /* octal number parser */
              for(scr->text++; isodigit(*scr->text);)
                expr->val.val=expr->val.val*8+ *scr->text++ - CHAR_ZERO;
              break;
            default:
              /* a single zero is simply 0 */
              scr->text++;
              expr->val.val=0;
              break;
            }
            CALL(PutArg(scr, COMP_NUM_CONSTANT, expr->val.val));
            CALL(NewMember(scr, &expr));
            break;
  	  /* end of case CHAR_ZERO: */

          case CHAR_ONE:
          case CHAR_TWO:
          case CHAR_THREE:
          case CHAR_FOUR:
          case CHAR_FIVE:
          case CHAR_SIX:
          case CHAR_SEVEN:
          case CHAR_EIGHT:
          case CHAR_NINE:
            /*
             * We hit a number between 1 and 9.
             */
            if(control&CON_STRING) {
              /* NO integers allowed! */
              INFO(scr, CERROR_ILLEGAL_STRING);
              return FPLERR_UNEXPECTED_INT_STATEMENT;
            }
            do
              expr->val.val= expr->val.val*10 + *scr->text++ - CHAR_ZERO;
            while(isdigit(*scr->text));
            CALL(PutArg(scr, COMP_NUM_CONSTANT, expr->val.val));
            CALL(NewMember(scr, &expr));
  	  break;

  	  case CHAR_QUOTATION_MARK:
            if(control&CON_NUM) {
              /* NO integers allowed! */
              INFO(scr, CERROR_ILLEGAL_NUMERICAL);
              return FPLERR_UNEXPECTED_STRING_STATEMENT;
            }
            CALL(Convert(val, scr));
            /* This returned a string! */
            expr->val.str=val->val.str;
            expr->flags=FPL_STRING;
            CALL(PutString(scr, COMP_STRING_CONSTANT, expr->val.str->string,
                           expr->val.str->len));
	    CALL(StringExpr(expr, scr));
  	  break;

  	  case CHAR_APOSTROPHE:
            /*
             * Apostrophes surround character. Returns ASCII code.
             */
            if(control&CON_STRING) {
              /* NO integers allowed! */
              INFO(scr, CERROR_ILLEGAL_STRING);
              return FPLERR_UNEXPECTED_INT_STATEMENT;
            }
            CALL(ReturnChar((scr->text++, scr), &expr->val.val, FALSE));
            if(*scr->text!=CHAR_APOSTROPHE)
              INFO(scr, CERROR_MISSING_SINGLEQUOTE);
            else
              ++scr->text;
            CALL(PutArg(scr, COMP_NUM_CONSTANT, expr->val.val));
            CALL(NewMember(scr, &expr));
  	  break;

  	  case CHAR_OPEN_PAREN:
            CALL(Put(scr, COMP_OPEN_PAREN));
	    ++scr->text;
            CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
            if(*scr->text!=CHAR_CLOSE_PAREN)
              INFO(scr, CERROR_MISSING_PARENTHESIS);
            else
              ++scr->text;
            CALL(Put(scr, COMP_CLOSE_PAREN));
            expr->val.val=val->val.val;
            CALL(NewMember(scr, &expr));
            break;

  	  case CHAR_NOT_OPERATOR:
            CALL(AddUnary(scr, expr, OP_NOT));
            CALL(Put(scr, COMP_NOTOPERATOR));
            ++scr->text;
            break;

  	  case CHAR_ONCE_COMPLEMENT:
            CALL(AddUnary(scr, expr, OP_COMPL));
            CALL(Put(scr, COMP_ONCECOMPLEMENT));
            ++scr->text;
  	    break;

  	  case CHAR_PLUS:
            if(scr->text[1]==CHAR_PLUS) {
              expr->flags|=FPL_ACTION;
              scr->text+=2;
              CALL(AddUnary(scr, expr, OP_PREINC));
              CALL(Put(scr, COMP_PREINC));
            } else {
              CALL(AddUnary(scr, expr, OP_PLUS));
              scr->text++;
            }
            break;

  	  case CHAR_MINUS:
            if(scr->text[1]==CHAR_MINUS) {