numexpr.c

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

 * Set the int num points to, to any number if you want to limit the number
 * of dimension reads.
 */

static ReturnCode GetArrayInfo(struct Data *scr,
                               long *dims,  /* long array */
                               long *num,   /* number of dims */
                               long control,
                               uchar *name)  /* variable name */
{
  struct Expr *val;
  ReturnCode ret=FPL_OK;
  long maxnum=*num;
  GETMEM(val, sizeof(struct Expr));
  *num=0;
  while(*scr->text==CHAR_OPEN_BRACKET) {
    CALL(Put(scr, COMP_OPEN_BRACKET));
    scr->text++; /* pass the open bracket */
    /* eval the expression: */
    CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));

    if(*scr->text!=CHAR_CLOSE_BRACKET) {
      /* no close bracket means warning */
      INFO(scr, CERROR_MISSING_BRACKET, CHAR_CLOSE_BRACKET);
    } else
      ++scr->text;
    CALL(Put(scr, COMP_CLOSE_BRACKET));

    if(++(*num)>=maxnum) {
      /* we've hit the roof! */
      break;
    } else if(*num==MAX_DIMS) {
      /* if we try to use too many dimensions... */
      INFO(scr, CERROR_TOO_LARGE_ARRAY, name);
      ret=FPLERR_ILLEGAL_ARRAY;
      break;
    }
    /*
     * Go on as long there are braces and we are declaring OR
     * as long the `num' variable tells us (you, know: when
     * you want to read character five in a member of a
     * three dimensional string array, it could look like
     * "int a=string[2][3][4][5];" ... :-)
     */
  }
  FREE(val);
  return(ret);
}

/**********************************************************************
 *
 * inside();
 *
 * This function takes care of the inside function callings within a
 * FPL program (or in a FPL program where the function was declared using
 * `export').
 *
 ******/

static ReturnCode INLINE inside(struct Data *scr,
                                struct fplArgument *arg,
                                struct Identifier *func)
{
  /*
   * The function has been declared as an `inside' one.
   */

  ReturnCode ret=FPL_OK;
  struct Identifier *pident; /* pointer to identifier */
  struct Identifier *ident;
  struct Local *locals=NULL;
  uchar count; /* parameter counter */
  uchar *text;
  struct Expr *val;
  uchar oldret;
  struct fplVariable *tempvar;
  uchar reference;
  long breaks;

  GETMEM(val, sizeof(struct Expr));

  /*
   * We know where to find this function!
   */

  scr->prg=func->data.inside.prg;
  scr->text=scr->program+func->data.inside.col;
  scr->virprg=func->data.inside.virprg;
  scr->virfile=func->data.inside.virfile;

  /**********************************
   * PARSE THE PARAMETER LIST HERE! *
   **********************************/

  CALL(Eat(scr));

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

  CALL(Put(scr, COMP_OPEN_PAREN));

  if(func->data.inside.format) {
    /*
     * We won't hit this if no arguments is prototyped.
     */

    count=0; /* parameter counter */
    text=func->data.inside.format;

    if(!*text) {
      if(!Getword(scr) && strcmp(scr->buf, "void")) {
        /* it should be "void" or nothing! If it wasn't we fail! */
	INFO(scr, CERROR_ILLEGAL_PARAMETER);
        return FPLERR_ILLEGAL_DECLARE;
      }
    } else {
      while(*text && !ret) {
        CALL(Getword(scr));
        CALL(GetIdentifier(scr, scr->buf, &ident));
	CALL(Eat(scr));
        if(scr->text[0]==CHAR_MULTIPLY) {
	  reference=TRUE;
	  scr->text++; /* pass it! */
	}
	else
          reference=FALSE; /* no reference! */

        switch(*text) {
        case FPL_STRARG:
        case FPL_INTARG:
	  if(reference) {
	    /*
	     * It was said to a symbol reference!!
	     */
	    INFO(scr, CERROR_ILLEGAL_REFERENCE, ident->name);
            return FPLERR_ILLEGAL_REFERENCE;
	  }

          if((*text==FPL_STRARG &&
             ident->data.external.ID!=CMD_STRING) ||
             (*text==FPL_INTARG &&
             ident->data.external.ID!=CMD_INT)) {
	    INFO(scr, CERROR_ILLEGAL_PARAMETER);
            return FPLERR_ILLEGAL_DECLARE;
	  }
          /*
           * Declare the following word as a string or integer
           * variable.
           */
          GETMEM(pident, sizeof(struct Identifier));

          CALL(Getword(scr));

          tempvar=&pident->data.variable;

          pident->flags=(*text==FPL_INTARG?FPL_INT_VARIABLE:
                         FPL_STRING_VARIABLE)|
                           (ident->flags&FPL_VARIABLE_LESS32);

          STRDUP(pident->name, scr->buf);

          tempvar->num=0; /* This is not an array */

          /*
           * Emulate next level variable declaration by adding one
           * to the ->level member here... dirty but (fully?)
           * functional!!!! ;-)
           */

          pident->level=scr->varlevel+1;
          pident->file=NULL;
          pident->func=func;
	  pident->linenum = scr->virprg;
          CALL(AddVar(scr, pident, &locals, TRUE));
          break;
        case FPL_STRVARARG:
        case FPL_INTVARARG:
	case FPL_STRARRAYVARARG:
	case FPL_INTARRAYVARARG:
	  if(!reference) {
	    /*
	     * It was never said to be a symbol reference!!
	     */
	    INFO(scr, CERROR_ILLEGAL_REFERENCE, ident->name);
            return FPLERR_ILLEGAL_REFERENCE;
	  }
          if((*text==FPL_STRVARARG || *text == FPL_STRARRAYVARARG) &&
	     ident->data.external.ID!=CMD_STRING) {
	    INFO(scr, CERROR_ILLEGAL_PARAMETER);
	    return FPLERR_ILLEGAL_DECLARE;

          } else if((*text==FPL_INTVARARG || *text == FPL_INTARRAYVARARG) &&
		    ident->data.external.ID!=CMD_INT) {
	    INFO(scr, CERROR_ILLEGAL_PARAMETER);
            return FPLERR_ILLEGAL_DECLARE;
          }
          /*
           * Declare the following word as a variable which
           * will use the struct fplVariable pointer as given in the
           * calling parameter list.
           */

          CALL(Getword(scr));

          GETMEM(pident, sizeof(struct Identifier));

	  if(*text == FPL_INTARRAYVARARG ||
	     *text == FPL_STRARRAYVARARG) {
	      CALL(Eat(scr));
              if(CHAR_OPEN_BRACKET != scr->text[0]) {
		INFO(scr, CERROR_ILLEGAL_PARAMETER);
                return FPLERR_ILLEGAL_DECLARE;
	      }
	      if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE)) {
		INFO(scr, CERROR_MISSING_BRACKET, CHAR_CLOSE_BRACKET);
                return FPLERR_MISSING_BRACKET;
	      }
	  }

          if(ident->data.external.ID==CMD_STRING)
            pident->flags = FPL_STRING_VARIABLE|FPL_REFERENCE;
          else
            pident->flags = FPL_INT_VARIABLE|FPL_REFERENCE;
          STRDUP(pident->name, scr->buf);

          pident->level=scr->varlevel+1;
          pident->file=NULL;
          pident->func=func;
	  pident->linenum = scr->virprg;
          CALL(AddVar(scr, pident, &locals, TRUE));
          break;
        }
        CALL(Eat(scr));

        if(*++text && *scr->text++!=CHAR_COMMA)
          /*
           * There is no way out from this error exception. Leaving a parameter
           * really is a sever thing!
           */
          return(FPLERR_MISSING_ARGUMENT);
        count++;
      }
    }

    CALL(Eat(scr));

    if(*scr->text!=CHAR_CLOSE_PAREN) {
      INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
    } else
      ++scr->text;
  }
  else {
    /*
     * No argument is useable to this function. There might be a
     * `void' keyword here, but nothing else! Just search for the
     * closing parenthesis to fasten interpreting!
     */

    if(ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE)) {
      INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
      return FPLERR_MISSING_PARENTHESES;
    }
  }
  CALL(Put(scr, COMP_CLOSE_PAREN));

  /*************************
   * COMPILE THE FUNCTION! *
   *************************/

  oldret=scr->strret;
  scr->strret=func->data.inside.ret==FPL_STRARG; /* should we receive a string? */
  CALL(Eat(scr));
  if(*scr->text!=CHAR_OPEN_BRACE)
    INFO(scr, CERROR_MISSING_BRACE, CHAR_CLOSE_BRACE);
  else
    ++scr->text;
  CALL(Put(scr, COMP_OPEN_BRACE));

  text=(void *)scr->func; /* backup current */
  scr->func=func;

  breaks = scr->breaks;
  scr->breaks=0;

  ret=Script(scr, val, SCR_BRACE|SCR_FUNCTION);

  scr->breaks=breaks;

  /*
   * Delete all variables created on our list for use
   * only in the function we just came back from!
   */
  DelLocalVar(scr, &locals);

  if(!ret && val->flags & FPL_CONTINUE)
    ret = FPLERR_ILLEGAL_CONTINUE;

  if(ret)
    return ret;

  scr->func=(void *)text; /* restore last */

  FREE(val);

  scr->strret=oldret;

  return FPL_OK;
}

static ReturnCode INLINE PrototypeInside(struct Data *scr,
					 struct Expr *val,
					 long control,
					 struct Identifier *ident)
{
  struct Identifier *pident;
  long pos=0;
  ReturnCode ret = FPL_OK;
  uchar *array;
  uchar found=ident?TRUE:FALSE;

  if(!found) {
    GETMEM(pident, sizeof(struct Identifier));
    STRDUP(pident->name, scr->buf);
  }
  else {
    /* we already know about this function! */
    if(ident->flags&
       (FPL_INTERNAL_FUNCTION|FPL_KEYWORD|FPL_EXTERNAL_FUNCTION)) {
      INFO(scr, CERROR_IDENTIFIER_USED, ident->name);
      return FPLERR_IDENTIFIER_USED;
    }
    else if(!(ident->flags&FPL_INSIDE_NOTFOUND)) {
      /* already defined!!! */
      INFO(scr, CERROR_ALREADY_DEFINED, ident->name, ident->linenum);
      return FPLERR_SYNTAX_ERROR;
    }
    pident = ident;
  }

  if(!found || (found && ident->flags&FPL_INSIDE_NOTFOUND)) {
    /* we know where this is... */
    pident->data.inside.col=scr->text-scr->program;
    pident->data.inside.prg=scr->prg;
    pident->data.inside.file=NULL;
    pident->data.inside.virprg=scr->virprg;
    pident->data.inside.virfile=scr->virfile;

    pident->file=NULL;
    pident->func=scr->func; /* declared in this function */
    pident->level=control&CON_DECLGLOB?0:scr->varlevel;
  }

  if(found) {
    /*
     * We already know about this function!
     */
     CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  }
  else {
  
    pident->flags=FPL_INSIDE_FUNCTION|
      (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
        (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:0);
  
    scr->text++; /* pass the open parenthesis */
  
    CALL(Eat(scr));
  
    GETMEM(array, MAX_ARGUMENTS * sizeof(uchar));
  
    while(pos<MAX_ARGUMENTS) {
      if(*scr->text==CHAR_CLOSE_PAREN) {
        scr->text++;
        break;
      }
      CALL(Getword(scr));
      CALL(GetIdentifier(scr, scr->buf, &ident));
      CALL(Eat(scr));
      switch(ident->data.external.ID) {
      case CMD_VOID:
        if(*scr->text++!=CHAR_CLOSE_PAREN)
          return FPLERR_ILLEGAL_PROTOTYPE;
        break;
  
      case CMD_STRING:
      case CMD_INT:
        if(*scr->text==CHAR_MULTIPLY) {
          scr->text++;
          Getword(scr); /* eat word if there's any! */
          if(CHAR_OPEN_BRACKET == scr->text[0]) {
            if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE))
              return FPLERR_MISSING_BRACKET;
            array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARRAYVARARG:
            FPL_INTARRAYVARARG;
          }