script.c

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

        CALL(Put(scr, COMP_END_OF_DECLARE));
      }
    }

    switch(*text) {
    case CHAR_OPEN_BRACE:		/* open brace */
      if(aborted) {
	INFO(scr, CERROR_CANT_REACH_STATEMENT);
	aborted=FALSE; /* no more messages */
      }
      scr->text++;
      CALL(Put(scr, COMP_OPEN_BRACE));
      CALL(Script(scr, val, SCR_NORMAL|SCR_BRACE));
      break;

    case CHAR_CLOSE_BRACE:
      if(control&(SCR_BRACE|SCR_SWITCH)) {
        scr->text++;
        if(control&SCR_DO) {
          CALL(Loop(scr, control, &brace));
        }
	if(control&SCR_SWITCH) {
	  scr->text--; /* back on brace! */
        }
	else {
	  /*
	   * Only do this if not switch(), since switch() doesn't
	   * force a new variable level when it calls this function!
	   */
	  CleanUp(scr, control, levels);
	}
	if (!(control&SCR_DO)) {
          CALL(Put(scr, COMP_CLOSE_BRACE));
        }
        return(FPL_OK);  /* return to calling function */
      }
      INFO(scr, CERROR_ILLEGAL_BRACE, CHAR_CLOSE_BRACE);
      return FPLERR_SYNTAX_ERROR;

    case CHAR_SEMICOLON:
      if(aborted) {
	INFO(scr, CERROR_CANT_REACH_STATEMENT);
	aborted=FALSE; /* no more messages */
      }
      scr->text++;
      break;

    default:
      if(control&SCR_SWITCH) {
	if(ident &&
           (ident->data.external.ID == CMD_CASE ||
	   ident->data.external.ID == CMD_DEFAULT))
	  aborted = FALSE; /* new session at each 'label' */
      }
      if(aborted) {
	if(!(control&SCR_GLOBAL)) {
	  INFO(scr, CERROR_CANT_REACH_STATEMENT);
	  aborted=FALSE; /* no more messages */
	}
	else {
	  CALL(Put(scr, COMP_MAIN_END)); /* end of main */
	  declare = TRUE; /* allow declarations again */
	  aborted = FALSE; /* switch off abort-mode! */
	  done = TRUE; /* yes, we have written MAIN_END */
	}
      }
      if(ident && ident->flags&FPL_KEYWORD) {
	if(ident->flags&FPL_KEYWORD_DECLARE) {
	  if(!declare) {
	    INFO(scr, CERROR_ILLEGAL_DECLARATION);
	    return FPLERR_ILLEGAL_DECLARE;
	  }
	  if(ident->data.external.ID == CMD_TYPEDEF) {
            /*
             * Add as a declarator in the list.
             */
	    CALL(Getword(scr));
	    CALL(GetIdentifier(scr, scr->buf, &ident));
	    if(!ret &&
	       (ident->data.external.ID==CMD_INT ||
		ident->data.external.ID==CMD_STRING)) {
	      CALL(Getword(scr));
	      text=(void *)ident;
	      GETMEM(ident, sizeof(struct Identifier));
	      *ident=*(struct Identifier *)text; /* copy entire structure! */
	      STRDUP(ident->name, scr->buf);
	      ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
						       declarator symbol! */
	      CALL(AddVar(scr, ident, &scr->locals, FALSE));
	    }
	    else {
	      INFO(scr, CERROR_IDENTIFIER_NOT_FOUND, scr->buf);
	      return FPLERR_IDENTIFIER_NOT_FOUND;
	    }
	    if(*scr->text!=CHAR_SEMICOLON) {
	      INFO(scr, CERROR_MISSING_SEMICOLON);
            }
            else 
              ++scr->text;
	  }
	  else {
	    CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
	  }
	}
	else {
	  switch(ident->data.external.ID) {
          case CMD_ELSE:
            INFO(scr, CERROR_ELSE);
            return FPLERR_SYNTAX_ERROR;
          case CMD_SWITCH:
            CALL(Put(scr, COMP_SWITCH));
            CALL(Switch(scr, val, control));
            break;

          case CMD_CASE:    /* 'case' */
            if(!control&SCR_SWITCH) {
              INFO(scr, CERROR_ILLEGAL_XXX, ident->name);
              return FPLERR_ILLEGAL_CASE; /* 'case' not within switch! */
            }
            /*
             * This word can only be found if (control&SCR_SWITCH), and then
             * we must just skip the "case XX:" text and continue.
             */
            CALL(Eat(scr));
            CALL(Put(scr, COMP_CASE));
	    CALL(Put(scr, COMP_START_OF_EXPR));
	    CALL(Expression(val, scr,
			    CON_NORMAL|
			    (scr->switchtype==SWITCH_STR?CON_STRING:
			     CON_NUM),
			    NULL));
	    CALL(Put(scr, COMP_END_OF_EXPR));
	    if(*scr->text!=CHAR_COLON) {
	      INFO(scr, CERROR_MISSING_COLON);
	    }
	    else
	      ++scr->text;
            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);
            break;

          case CMD_DEFAULT: /* 'default' */
            if(!control&SCR_SWITCH) {
              INFO(scr, CERROR_ILLEGAL_XXX, ident->name);
              return FPLERR_ILLEGAL_DEFAULT; /* 'default' not within switch! */
            }
            /*
             * This word can only be found if (control&SCR_SWITCH), and then
             * we must just skip the "default:" text and continue.
             */
            CALL(Put(scr, COMP_DEFAULT));
	    CALL(Eat(scr));
            if(scr->text[0]!=CHAR_COLON) {
	      INFO(scr, CERROR_MISSING_COLON);
            } else
              ++scr->text;
            break;

	  case CMD_RETURN:
	  case CMD_EXIT:
	    Eat(scr);
	    if(ident->data.external.ID==CMD_RETURN) {
              CALL(Put(scr, COMP_RETURN));
            }
            else {
              CALL(Put(scr, COMP_EXIT));
            }

            CALL(Put(scr, COMP_START_OF_EXPR));
	    if(*scr->text!=CHAR_SEMICOLON) { /* no return */
	      brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
	      scr->text+=brace;

	      /*
	       * If return()ing from a function when scr->strret is TRUE,
	       * return a string.
	       */
	      if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
                 (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
		CALL(Expression(val, scr, CON_NORMAL, NULL));
		if(!(val->flags&FPL_STRING)) {
		  /* that wasn't a string! */
                  INFO(scr, CERROR_ILLEGAL_STRING);
		  return FPLERR_UNEXPECTED_INT_STATEMENT;
		} else {
		  /* It was a string! */
		  if(val->flags&FPL_NOFREE) {
		    /*
		     * We're only refering to another string! We can't
		     * allow that since that string might be a local
		     * variable, and all such are about to be deleted now!
		     */
		    struct fplStr *string;
                    if(val->val.str) {
                      /* did we really get a pointer? */
		      GETMEM(string, val->val.str->len+sizeof(struct fplStr));
		      memcpy(string,
			     val->val.str,
			     val->val.str->len+sizeof(struct fplStr));
		      string->alloc=val->val.str->len;
                    }
                    else {
                      GETMEM(string, sizeof(struct fplStr));
                      string->len = string->alloc = 0;
                    }
		    val->val.str=string;
		    val->flags&=~FPL_NOFREE;
		  }
		}

	      } else {
		CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
                scr->returnint = &scr->FPLret; /* point to result */
	      }
	      if(brace) {
                if(*scr->text!=CHAR_CLOSE_PAREN) {
                  INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
                }
                else
                  ++scr->text;
              }
	    } else {
	      val->val.val=0;
	      val->flags=0;
	    }
            CALL(Put(scr, COMP_END_OF_EXPR));
	    scr->FPLret=val->val.val;	/* set return code! */
            CALL(Eat(scr));
	    if(*scr->text!=CHAR_SEMICOLON) {
               INFO(scr, CERROR_MISSING_SEMICOLON);
            }
            else 
              ++scr->text;
	    aborted |= ABORT_RETURN;
	    break;
            
	  case CMD_IF:		/* if() */
	  case CMD_WHILE:	/* while() */
	    Eat(scr);

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

	      PARSE CONDITION

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

            if(ident->data.external.ID==CMD_IF) {
              CALL(Put(scr, COMP_IF));
            }
            else {
              CALL(Put(scr, COMP_WHILE));
            }
	    if(*scr->text!=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_GROUNDLVL|CON_NUM, NULL));
            CALL(Put(scr, COMP_END_OF_EXPR));
	    if(*scr->text!=CHAR_CLOSE_PAREN)
              INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
            else
              ++scr->text;

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

	      PARSE STATMENT

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

	    Eat(scr);
	    scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);

	    if(CMD_WHILE == ident->data.external.ID) {
	      scr->breaks++; /* yet another break level */
	      scr->conts++; /* yet another continue level */
	    }
            CALL(Put(scr, COMP_OPEN_BRACE));
	    CALL(Script(scr, val,
			(short)((brace?SCR_BRACE:0)|
			(ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF) )));
            if(!brace) {
              CALL(Put(scr, COMP_CLOSE_BRACE));
            }
	    if(CMD_WHILE == ident->data.external.ID) {
	      scr->breaks--; /* step down a break level */
	      scr->conts--; /* step down a continue level */
	    }

            Eat(scr); /* we must eat space before storing the position,
                         otherwise we might eat newlines several times! */
            
	    text=scr->text;
	    prg=scr->prg;

	    Getword(scr);

	    if(!strcmp(KEYWORD_ELSE, scr->buf)) {
              CALL(Put(scr, COMP_ELSE));
              CALL(Eat(scr));
	      scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
              CALL(Put(scr, COMP_OPEN_BRACE));
              CALL(Script(scr, val, (short)(brace?SCR_BRACE:0)));
              if(!brace) {
                CALL(Put(scr, COMP_CLOSE_BRACE));
              }
	    }
            else {
              scr->text=text;
              scr->prg=prg;
            }
	    break;
	  case CMD_BREAK:
	    if(!scr->breaks) {
              INFO(scr, CERROR_ILLEGAL_XXX, ident->name);
	      return FPLERR_SYNTAX_ERROR;
            }
	    val->val.val=1;	/* default is break 1 */
	    val->flags=0;	/* reset flags */
	    CALL(Eat(scr));
            CALL(PutArg(scr, COMP_BREAK,
			scr->breaks)); /* maximum levels break allowed */
	    /*
	     * Check if break out of several statements.
	     */
            CALL(Put(scr, COMP_START_OF_EXPR));
	    if(*scr->text!=CHAR_SEMICOLON) {
	      /* Get the result of the expression. */
	      brace=(*scr->text==CHAR_OPEN_PAREN);
	      scr->text+=brace;
	      CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
	      if(brace) {
		if(*scr->text!=CHAR_CLOSE_PAREN) {
		  INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_CLOSE_PAREN);
                }
                else
                  ++scr->text;
              }
	    }
            CALL(Put(scr, COMP_END_OF_EXPR));
	    if(*scr->text!=CHAR_SEMICOLON) {
	      INFO(scr, CERROR_MISSING_SEMICOLON);
            }
            else
              ++scr->text;

	    val->flags|=FPL_BREAK;
	    aborted |= ABORT_BREAK; /* we're broken! */
            break;
            
	  case CMD_CONTINUE:
	    if(!scr->conts) {
              INFO(scr, CERROR_ILLEGAL_XXX, ident->name);
	      return FPLERR_ILLEGAL_CONTINUE;
            }
	    if(*scr->text!=CHAR_SEMICOLON) {
	      INFO(scr, CERROR_MISSING_SEMICOLON);
            }
            else
              ++scr->text;
            CALL(Put(scr, COMP_CONTINUE));
            val->flags=FPL_CONTINUE;
	    aborted |= ABORT_CONT;
            break;
	  case CMD_DO:
	    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_DO));
            CALL(Put(scr, COMP_OPEN_BRACE));
	    CALL(Script(scr, val, (short)(SCR_DO|(brace?SCR_BRACE:0)) ));
	    --scr->breaks; /* increase break level */
	    --scr->conts; /* increase continue level */
	    break;
	  case CMD_FOR:
	    CALL(Eat(scr));
	    if(*scr->text!=CHAR_OPEN_PAREN) 
              INFO(scr, CERROR_MISSING_PARENTHESIS, CHAR_OPEN_PAREN);
            else
              ++scr->text;

            CALL(Put(scr, COMP_FOR));

	    CALL(Eat(scr));