script.c

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

          /* falls through! */
        case PASS2_IF_BRANCH:  /* OFFSET follows */
          prg = GETLONG;
          P_LONG; /* pass offset */
          CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM)); /* get result */
          
          if(brace ^ (val->val.val?TRUE:FALSE))
            scr->text = &scr->prog->program[ scr->prog->index + prg ];
          else
            P_SHORT; /* pass end of expr */
          brace = FALSE; /* it has served its purpose, set back to FALSE */
          break;
	  
        case PASS2_MAIN_START: /* OFFSET the main program starts at */
          scr->prog->startcol=
            scr->prog->index + GETLONG;
          P_LONG; /* pass the argument */
          scr->prog->foundstart=TRUE;
          break;
          
        case PASS2_RETURN:
        case PASS2_EXIT:
          if(scr->strret) {
            /*
             * This function is supposed to return a string. Get it.
             */
            CALL(CmpExpr(val, scr, CON_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!
               */
              register 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;
                strtags[1]=(long)string->string;
                strtags[3]=string->len;
                CALL(Send(scr, strtags));
              }
              else {
                strtags[1] = strtags[3] = 0;
                CALL(Send(scr, strtags));
              }
            }
            else {
              if(val->val.str) {
                strtags[1]=(long)val->val.str->string;
                strtags[3]=val->val.str->len;
              }
              else
                strtags[1] = strtags[3] = 0;
              CALL(Send(scr, strtags));
            }
          }
          else {
            CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM));
	    scr->FPLret=val->val.val;	/* set return code! */
            scr->returnint = &scr->FPLret; /* point to result */
            inttags[1]=val->val.val;
            CALL(Send(scr, inttags));
	  }
          done = TRUE;
          if(PASS2_EXIT == code)
            ret = FPL_EXIT_OK; /* exit from this file */
          break;

        case PASS2_RESET_VARIABLE:
          CALL(CmpReset(scr, GETLONG)); /* reset the local variable to
                                           "scratch position" */
          P_LONG;
          break;
          
        default:
          scr->text-=sizeof(short); /* back on the instruction */
          CALL(CmpExpr(val, scr, CON_NORETURN|CON_GROUNDLVL));
          break;
      }
    }
    if(scr->localinfo.listsize) {
      FREE(scr->localinfo.list);
      scr->localinfo.listentries = scr->localinfo.listsize =0;
    }
  }
  else {
  
    while(!done) {
      if(ret=Eat(scr)) {
        if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
          /* It's OK! */
          ret=FPL_OK;
        break;
      }
  
      /* call the interval function */
      if(scr->interfunc) {
        if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
          return FPLERR_PROGRAM_STOPPED;
      }
  
  #ifdef DEBUGMAIL
      DebugMail(scr, MAIL_EXECUTE, 500, NULL);
  #endif
  
      switch(*scr->text) {
      case CHAR_OPEN_BRACE:               /* open brace */
        scr->text++;
        CALL(Script(scr, val,
                    SCR_NORMAL|SCR_BRACE,
                    con));
        if(CheckIt(scr, val, control, &ret)) {
          CleanUp(scr, control, levels);
          return(ret);
        }
        break;
  
      case CHAR_CLOSE_BRACE:
        if(control&SCR_LOOP) {
          if(control&SCR_BRACE) {
            DelLocalVar(scr, &scr->locals); /* delete all local declarations */
            scr->varlevel--;                /* previous variable level */
            scr->level--;                   /* previous level spectra */
          }
          CALL(Loop(scr, con, control, &brace));
          if(brace) {
            /* Yes! We should loop! */
            if(control&SCR_BRACE) {
              /* bring back the proper values */
              scr->varlevel++;
              scr->level++;
              AddLevel(scr); /* restart this level! */
              declare=TRUE;
            }
            scr->virprg=virprg;
            scr->virfile=virfile;
            continue;
          }
          val->flags=0;
        } else {
          scr->text++;
          val->flags=FPL_BRACE;
          CleanUp(scr, control, levels);
        }
        scr->returnint = NULL; /* no result integer! */
        return(FPL_OK);  /* return to calling function */
  
      case CHAR_SEMICOLON:
        scr->text++;
        break;
  
      default:
        /*
         * Time to parse the statement!
         */
  
        text=scr->text;                /* store current position */
        prg=scr->prg;
        if(!Getword(scr))    /* get next word */
          GetIdentifier(scr, scr->buf, &ident);
        else {
          prg=-1;    /* we have not read a word! */
          ident=NULL;
        }
        if(ident && control&SCR_GLOBAL && declare) {
          /* still on ground level and declaration allowed */
          if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
            if(!scr->prog->foundstart) {
              /*
               * Only do this if this point isn't already known!
               * We move the pointer for the execution start position to
               * this position.
               */
              StoreBeginning(scr, text, prg);
            }
            /*
             * This is the end of the declaration phase. Now, let's
             * check for that FPLTAG_INTERPRET tag to see if we should
             * have a little fun or simply continue!
             */
            if(scr->interpret) {
              done = TRUE;
              continue;
            }
          }
        }
        if(ident && ident->flags&FPL_KEYWORD) {
          if(ident->flags&FPL_KEYWORD_DECLARE) {
            if(!declare)
              return FPLERR_ILLEGAL_DECLARE;
            CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
  
          } else {
            switch(ident->data.external.ID) {
            case CMD_SWITCH:
              scr->breaks++; /* allow another level of break */
              CALL(Switch(scr, val, control, con));
              if(CheckIt(scr, val, control, &ret)) {
                CleanUp(scr, control, levels);
                return(ret);
              }
              break;
  
            case CMD_CASE:    /* 'case' */
              if(!control&SCR_SWITCH)
                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));
              if(scr->text[0]==CHAR_OPEN_PAREN) {
                /*
                 * If this is an open parenthesis, we must search for the
                 * opposite parenthesis to enable conditional statements
                 * using the '?' and ':' operators.
                 */
                CALL(GetEnd(scr, CHAR_CLOSE_PAREN,
                            CHAR_OPEN_PAREN, FALSE)); /* find close paren! */
              }
              if(GetEnd(scr, CHAR_COLON, 255, FALSE)) /* find colon! */
                return FPLERR_MISSING_COLON;
              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)
                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.
               */
              if(scr->text[0]!=CHAR_COLON) {
                if(GetEnd(scr, CHAR_COLON, 255, FALSE))
                  return FPLERR_MISSING_COLON;
              } else
                scr->text++;
              break;
  
            case CMD_TYPEDEF:
              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! */
                GETMEM(ident->name, strlen(scr->buf)+1);
                strcpy(ident->name, scr->buf);
                ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
                                                         declarator symbol! */
                CALL(AddVar(scr, ident, &scr->locals));
              } else
                return FPLERR_IDENTIFIER_NOT_FOUND;
              break;
            case CMD_RETURN:
            case CMD_EXIT:
              Eat(scr);
              scr->breaks=0; /* reset number of allowed breaks */
              scr->returnint = NULL; /* point to result */
              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! */
                    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;
                      }
                      strtags[1]=(long)string->string;
                      strtags[3]=string->len;
                      CALL(Send(scr, strtags));
  
                      val->val.str=string;
                      val->flags&=~FPL_NOFREE;
                    }
                    else {
                      strtags[1]=(long)val->val.str->string;
                      strtags[3]=val->val.str->len;
                      CALL(Send(scr, strtags));
                    }
                  }
  
                } else {
                  CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
                  scr->returnint = &scr->FPLret; /* point to result */
                  inttags[1]=val->val.val;
                  CALL(Send(scr, inttags));
                }
                if(brace)
                  if(*scr->text!=CHAR_CLOSE_PAREN)
                    return FPLERR_MISSING_PARENTHESES;
                    /* continue */
                  else
                    scr->text++;
              } else {
                val->val.val=0;
                val->flags=0;
              }
              scr->FPLret=val->val.val;   /* set return code! */
              if(ident->data.external.ID==CMD_RETURN) {
                ret=FPL_OK;
              } else
                ret=FPL_EXIT_OK; /* This will make us return through it all! */
  
              val->flags|=FPL_RETURN; /* inform calling function */
  
              CleanUp(scr, control, levels);
              return(ret);
            case CMD_IF:          /* if() */
            case CMD_WHILE:       /* while() */
              Eat(scr);
  
              /*********************
  
                PARSE CONDITION
  
                *******************/
  
  
              if(*scr->text!=CHAR_OPEN_PAREN)
                return FPLERR_MISSING_PARENTHESES;
                /* please, go on! */
              else
                scr->text++;
  
              GETMEM(con2, sizeof(struct Condition));
  
              /* save check position! */
              con2->check=scr->text;
              con2->checkl=scr->prg;
  
              CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
              if(*scr->text!=CHAR_CLOSE_PAREN) {
                return FPLERR_MISSING_PARENTHESES;
                /* continue */
              } else
                scr->text++;
  
              if(val->val.val) {
                /********************
  
                  PARSE STATMENT
  
                  ******************/
  
                Eat(scr);
                scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
                con2->bracetext=scr->text;
                con2->braceprg=scr->prg;
  
                if(CMD_WHILE == ident->data.external.ID)
                  scr->breaks++; /* yet another break level */
                CALL(Script(scr, val,
                            (short)((brace?SCR_BRACE:0)|
                            (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF)),
                            con2));
                if(CheckIt(scr, val, control, &ret)) {
                  FREE(con2);
                  CleanUp(scr, control, levels);
                  return(ret);
                }
                brace=TRUE;
              } else {
                /********************