script.c

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

            CALL(Put(scr, COMP_START_OF_EXPR));
	    if(CHAR_SEMICOLON != *scr->text) {
	      CALL(Expression(val, scr, CON_GROUNDLVL| CON_ACTION, NULL));
	      if(*scr->text!=CHAR_SEMICOLON) 
		INFO(scr, CERROR_MISSING_SEMICOLON);
	      else
		++scr->text;
	    }
	    else
	      ++scr->text;
            CALL(Put(scr, COMP_END_OF_EXPR));

            CALL(Put(scr, COMP_START_OF_EXPR));
	    if(CHAR_SEMICOLON != *scr->text) {
	      CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
	      if(*scr->text!=CHAR_SEMICOLON) 
		INFO(scr, CERROR_MISSING_SEMICOLON);
	      else
		++scr->text;
	    }
	    else {
	      CALL(PutArg(scr, COMP_NUM_CONSTANT, 1)); /* store a constant 1 */
	      ++scr->text;
	    }
            CALL(Put(scr, COMP_END_OF_EXPR));

	    CALL(Eat(scr));
            CALL(Put(scr, COMP_START_OF_EXPR));
	    if(CHAR_CLOSE_PAREN != *scr->text) {
	      CALL(Expression(val, scr, CON_GROUNDLVL|CON_ACTION, NULL));
	      if(*scr->text!=CHAR_CLOSE_PAREN) 
		INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
	      else
		++scr->text;
	    }
	    else
	      ++scr->text;
            CALL(Put(scr, COMP_END_OF_EXPR));

	    CALL(Eat(scr));
	    scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
	    ++scr->breaks; /* increase break level */
	    ++scr->conts; /* increase continue level */
            CALL(Put(scr, COMP_OPEN_BRACE));
	    CALL(Script(scr, val, (short)((brace?SCR_BRACE:0)|SCR_FOR )));
            if(!brace) {
              CALL(Put(scr, COMP_CLOSE_BRACE));
            }
	    --scr->breaks; /* decrease break level */
	    --scr->conts; /* decrease continue level */
	    break;
	  case CMD_RESIZE:
            CALL(Put(scr, COMP_RESIZE));
	    CALL(Resize(scr, val, control));
	    break;
	  } /* switch(keyword) */
        } /* if it wasn't a declaring keyword */
      }
      else {
	CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
	/*
	 * It returned a string, flush it!
	 */
	if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str) {
	  /* If there was a string return, it should be freed and the
	     string really held a string! */
	  FREE(val->val.str);
	}
	/*
	 * Check for semicolon!
	 */
	if(*scr->text!=CHAR_SEMICOLON) {
	  INFO(scr, CERROR_MISSING_SEMICOLON);
	} else
	  scr->text++;
      }
    } /* switch (*scr->text) */

    if(!(control&(SCR_BRACE|SCR_FUNCTION|SCR_SWITCH))) {
      if(control&SCR_DO) {
        CALL(Loop(scr, control, &brace));
      }
      break;
    }
  } while(1); /* loop! */
  if(control&SCR_GLOBAL) {
    if(!mainstart) {
      /* declaration still allowed, we never found any "real" code */
      CALL(Put(scr, COMP_MAIN_START));
    }
    if(!done) {
      CALL(Put(scr, COMP_MAIN_END)); /* end of main */
    }
  }
  CleanUp(scr, control, levels);
  return(ret);
}

static ReturnCode INLINE
Switch(struct Data *scr,
       struct Expr *val,
       short control)
{
  ReturnCode ret;
  uchar *text;
  long prg;
  struct Identifier *ident;
  CALL(Eat(scr)); /* eat whitespace */

  /* Check the open parenthesis */
  if(scr->text[0]!=CHAR_OPEN_PAREN)
    INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_OPEN_PAREN);
  else
    ++scr->text;

  CALL(Put(scr, COMP_START_OF_EXPR));
  CALL(Expression(val, scr, CON_NORMAL, NULL));
  CALL(Put(scr, COMP_END_OF_EXPR));

  if(val->flags&FPL_STRING)
    /* there was a string statement! */
    scr->switchtype = SWITCH_STR;
  else
    /* there was an integer expression */
    scr->switchtype = SWITCH_NUM;

  /* Check the close parenthesis */
  if(scr->text[0]!=CHAR_CLOSE_PAREN)
    INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
  else
    ++scr->text;

  CALL(Eat(scr)); /* eat whitespace */

  /* Check the open brace */
  if(scr->text[0]!=CHAR_OPEN_BRACE)
    INFO(scr, CERROR_MISSING_BRACE, CHAR_OPEN_BRACE);
  else
    ++scr->text;

  CALL(Put(scr, COMP_OPEN_BRACE));

  scr->breaks++; /* allow another level of break */
  do {
    CALL(Eat(scr));
    text =scr->text;
    prg = scr->prg;
    CALL(Getword(scr));    /* get next word */
    CALL(GetIdentifier(scr, scr->buf, &ident));
    if(ident->data.external.ID != CMD_CASE &&
       (ident->data.external.ID != CMD_DEFAULT)) {
      INFO(scr, CERROR_ILLEGAL_XXX, "switch");
      return FPLERR_SYNTAX_ERROR;
    }
    scr->text = text;
    scr->prg = prg;

    CALL(Script(scr, val, SCR_SWITCH));
  } while(*scr->text != CHAR_CLOSE_BRACE);
  scr->breaks--; /* remove a level of break */
  ++scr->text;
  return FPL_OK;
}

static ReturnCode INLINE
Declare(struct Expr *val,
	struct Data *scr,
	struct Identifier *ident,
	long start)			/* start flags */
{
  ReturnCode ret;
  long flags=start;
  do {
    switch(ident->data.external.ID) {
    case CMD_EXPORT:
      flags|=CON_DECLEXP;
      break;
    case CMD_STRING:
      flags|=CON_DECLSTR;
      break;
    case CMD_INT:
      flags|=CON_DECLINT;
      if(ident->flags&FPL_SHORT_VARIABLE)
	flags|=CON_DECL16;
      else if(ident->flags&FPL_CHAR_VARIABLE)
	flags|=CON_DECL8;
      break;
    case CMD_VOID:
      flags|=CON_DECLVOID;
      break;
    case CMD_AUTO:
    case CMD_REGISTER:
      /* flags&=~(CON_DECLEXP|CON_DECLGLOB); */
      break;
    case CMD_CONST:
      flags|=CON_DECLCONST;
      break;
    case CMD_STATIC:
      flags|=CON_DECLSTATIC;
      break;
    }
    CALL(Getword(scr));
    ret=GetIdentifier(scr, scr->buf, &ident);
  } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);

  if(!(flags&CON_DECLARE))
    flags|=CON_DECLINT; /* integer declaration is default! */

  CALL(Expression(val, scr, CON_GROUNDLVL|flags|CON_IDENT, ident));
  if(*scr->text!=CHAR_SEMICOLON) {
    if(val->flags&FPL_DEFUNCTION) {
      if(*scr->text!=CHAR_CLOSE_BRACE) {
	INFO(scr, CERROR_MISSING_BRACE, CHAR_CLOSE_BRACE);
        return FPLERR_MISSING_BRACE;
      }
    }
    else {
      INFO(scr, CERROR_MISSING_SEMICOLON);
      return FPLERR_MISSING_SEMICOLON;
    }
  }
  scr->text++;
  return(FPL_OK);
}



/**********************************************************************
 *
 * Resize()
 *
 * This function resizes a variable array to the new given size.
 *
 *****/

static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, short control)
{
  uchar num=0; /* number of dimensions */
  long *dims; /* dimension array */
  struct fplVariable *var;
  struct Identifier *ident;
  ReturnCode ret;
  CALL(Getword(scr));
  GetIdentifier(scr, scr->buf, &ident);
  if(ident) {
    var=&ident->data.variable;

    if(!(ident->flags&FPL_VARIABLE) || !var->num) {
      return FPLERR_ILLEGAL_RESIZE;
    }
  }
  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));
  }

  Eat(scr);
  GETMEM(dims, MAX_DIMS*sizeof(long));

  do {
    if(*scr->text!=CHAR_OPEN_BRACKET) {
      INFO(scr, CERROR_MISSING_BRACKET, CHAR_OPEN_BRACKET);
    }
    else
      ++scr->text; /* pass the open bracket */

    /* eval the expression: */
    CALL(Put(scr, COMP_START_OF_EXPR));
    CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
    CALL(Put(scr, COMP_END_OF_EXPR));

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

    dims[num++] = val->val.val; /* Add another dimension */
    
    if( num==MAX_DIMS ) {
      /* if we try to declare too many dimensions... */
      /*
       * Set back original variable name!
       */
      if(ident)
        strcpy(scr->buf, ident->name);
      ret = FPLERR_ILLEGAL_ARRAY;
      INFO(scr, CERROR_ILLEGAL_ARRAY);
      break;
    }
    /*
     * Go on as long there are brackets,
     */
  } while(*scr->text==CHAR_OPEN_BRACKET);

  FREE(dims);
  return ret;
}

/**********************************************************************
 *
 * CleanUp()
 *
 * Deletes/frees all local variable information.
 *
 *******/

void REGARGS
CleanUp(struct Data *scr,
        long control,
        long levels)
{
  if(control&(SCR_BRACE|SCR_FUNCTION)) {
    int deleted = DelLocalVar(scr, &scr->locals);

    if(scr->maxvariables < scr->currvariables+deleted)
      scr->maxvariables += scr->currvariables+deleted;

    PutArg(scr, COMP_AMOUNT_VARIABLES, deleted); /* ignores return code! */

    scr->varlevel--;
    scr->level=levels; /* new variable amplitude */
  }
}


/**********************************************************************
 *
 * Loop()
 *
 * This function is called at the end of a block, however the block was
 * started (brace or not brace).
 *
 *******/

static ReturnCode REGARGS
Loop(struct Data *scr,
     short control,
     uchar *cont) /* store TRUE or FALSE if loop or not */
{
  ReturnCode ret = FPL_OK;
  if(control&SCR_DO) {
    struct Expr *val;

    GETMEM(val, sizeof(struct Expr));

    /* This a do while end. */
    do {
      CALL(Put(scr, COMP_CLOSE_BRACE));
      if(ret=Getword(scr))
        break;
      if(strcmp(scr->buf, "while")) {
	INFO(scr, CERROR_MISSING_WHILE);
        ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
        break;
      }
      CALL(Put(scr, COMP_DO_CONDITION));
      if(ret=Eat(scr))
        break;
      if(*scr->text!=CHAR_OPEN_PAREN) {
	INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_OPEN_PAREN);
      }
      else
	++scr->text;
      CALL(Put(scr, COMP_START_OF_EXPR));
      if(ret=Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL))
        break;
      if(*scr->text!=CHAR_CLOSE_PAREN) {
	INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
      }
      else
	++scr->text;
      CALL(Put(scr, COMP_END_OF_EXPR));
    } while(0); /* only used to break out from! */

    FREE(val);

  }
  return(ret);
}