script.c

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

                  SKIP STATEMENT
  
                  ******************/
  
                CALL(SkipStatement(scr));
                brace=FALSE;
              }
  
              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) && brace) {
                /********************
  
                  SKIP STATEMENT
  
                  ******************/
  
                CALL(SkipStatement(scr));
              } else if(!strcmp(KEYWORD_ELSE, scr->buf) && !brace) {
                /********************
  
                  PARSE STATMENT
  
                  ******************/
  
                Eat(scr);
                scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
                con2->bracetext=scr->text;
                con2->braceprg=scr->prg;
                CALL(Script(scr, val, (short)(brace?SCR_BRACE:0), con2));
                if(CheckIt(scr, val, control, &ret)) {
                  FREE(con2);
                  CleanUp(scr, control, levels);
                  return(ret);
                }
              } else {
                scr->text=text;
                scr->prg=prg;
              }
              FREE(con2);
              break;
            case CMD_BREAK:
              val->val.val=1;     /* default is break 1 */
              val->flags=0;       /* reset flags */
              CALL(Eat(scr));
              /*
               * Check if break out of several statements.
               */
              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) {
                    return FPLERR_MISSING_PARENTHESES;
                  } else
                    scr->text++;
                else if(val->val.val<=0) {
                  return FPLERR_ILLEGAL_BREAK;
                }
              }
              /*
               * Check that the requested number of break levels is possible
               * to break out from!
               */
              if(scr->breaks < val->val.val)
                return FPLERR_ILLEGAL_BREAK;
  
              /*
               * Go to end of statement!!! If this was started without
               * SCR_BRACE set, we're already at the end of the statement!
               */
              if(control&SCR_BRACE) {
                if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
                  return FPLERR_MISSING_BRACE;
  #ifdef DEBUG_BREAKS
                fprintf(stderr, "First: levels %d line %d, brace? %d bl: %d\n",
                        val->val.val, scr->virprg, control&SCR_BRACE?1:0,
                        scr->breaks);
  #endif
              }
              if(control&SCR_DO)
                /* if it was inside a do statement, pass the ending `while' */
                CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
              val->flags|=FPL_BREAK;
              if(control&(SCR_LOOP)) {
                scr->breaks--; /* decrease break level counter */
                if(!--val->val.val)
                  val->flags&=~FPL_BREAK; /* only this break! */
              }
              CleanUp(scr, control, levels);
              return(FPL_OK);
            case CMD_CONTINUE:
              if(*scr->text!=CHAR_SEMICOLON) {
                return FPLERR_MISSING_SEMICOLON;
              } else
                scr->text++;
              if(! scr->breaks)
                return FPLERR_ILLEGAL_CONTINUE;
              if(control&SCR_LOOP) {
  
                if(control&SCR_BRACE) {
                  DelLocalVar(scr, &scr->locals); /* delete all locals */
                  scr->varlevel--;                /* previous variable level */
                  scr->level--;                   /* previous level spectra */
                }
  
                /* loop! */
                CALL(Loop(scr, con, control, &brace));
                if(!brace) {
                  /*
                   * The result of the condition check was FALSE. Move to the end
                   * of the block and continue execution there!
                   */
  
                  if(control&SCR_BRACE) {
                    /* braces */
                    if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
                      return FPLERR_MISSING_BRACE;
                  }
                  val->flags=0;
                } else {
                  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;
                }
              } else {
                /* it's no looping statement! */
  
                if(control&SCR_BRACE) {
                  /* braces */
                  if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
                    return FPLERR_MISSING_BRACE;
                }
                val->flags=FPL_CONTINUE;
                CleanUp(scr, control, levels);
              }
              return(FPL_OK);
            case CMD_DO:
              CALL(Eat(scr));
              GETMEM(con2, sizeof(struct Condition));
              scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
              con2->bracetext=scr->text;
              con2->braceprg=scr->prg;
              con2->check=NULL;
              scr->breaks++; /* increase break level */
              CALL(Script(scr, val, (short)(SCR_DO|(brace?SCR_BRACE:0)), con2));
              FREE(con2);
              if(CheckIt(scr, val, control, &ret)) {
                CleanUp(scr, control, levels);
                return(ret);
              }
              break;
            case CMD_FOR:
              Eat(scr);
              scr->text++;
              CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));
  
              if(*scr->text!=CHAR_SEMICOLON) {
                return FPLERR_MISSING_SEMICOLON;
              } else
                scr->text++;
              GETMEM(con2, sizeof(struct Condition));
  
              con2->check=scr->text;
              con2->checkl=scr->prg;
              CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));
  
              if(*scr->text!=CHAR_SEMICOLON) {
                return FPLERR_MISSING_SEMICOLON;
              } else
                scr->text++;
              con2->postexpr=scr->text;
              con2->postexprl=scr->prg;
              {
                /*
                 * Pass the last expression:
                 */
                CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
              }
              if(!val->val.val) {
                /* We shouldn't enter the loop! Go to end of block:*/
                CALL(SkipStatement(scr));
                FREE(con2);
              } else {
                CALL(Eat(scr));
                scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
                con2->bracetext=scr->text;
                con2->braceprg=scr->prg;
                scr->breaks++; /* increase break level */
                CALL(Script(scr, val, (short)((brace?SCR_BRACE:0)|SCR_FOR), con2));
                FREE(con2);
                if(CheckIt(scr, val, control, &ret)) {
                  CleanUp(scr, control, levels);
                  return(ret);
                }
              }
              break;
            case CMD_RESIZE:
              CALL(Resize(scr, val, control));
              break;
            } /* switch(keyword) */
          } /* if it wasn't a declaring keyword */
        } else {
          declare=FALSE;
          CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
          /*
           * It 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)
            return FPLERR_MISSING_SEMICOLON;
          else
            scr->text++;
        }
      } /* switch (*scr->text) */
  
      if(!(control&(SCR_BRACE|SCR_SWITCH))) {
        if(control&SCR_LOOP) {
          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;
          ret=FPL_OK;
          break; /* return to calling function */
        } else
          break;
      }
    } /* loop! */
  
    if(!ret &&
       control&SCR_FILE &&
       !scr->prog->foundstart &&
       !done) {
      /*
       * We did get here by hitting end of program.
       * Let's set the start-of-main position right here to
       * make another run work fine on this file too!
       */
      StoreBeginning(scr, scr->text, scr->prg);
    }

  } /* for the if(compiled)-else */

  /*
   * Check for that FPLTAG_INTERPRET tag!
   */
  if(ret<=FPL_EXIT_OK && scr->interpret) {
    /* an alternative main program is specified */
    GETMEM(pass, sizeof(struct fplArgument));
    pass->ID=FNC_INTERPRET;
    text = scr->interpret;
    pass->argv=(void **)&text;
    pass->key=scr;
    scr->interpret=NULL; /* disable recursion! */
    CALL(functions(pass));

    CleanUp(scr, control, levels);

    /* we're done for this time, exit! */
    ret = FPL_EXIT_OK;
  }

  CleanUp(scr, control, levels);
  return(ret);
}

static REGARGS void
StoreBeginning(struct Data *scr, char *text, long prg)
{
  scr->prog->startcol=text-(&scr->prog->program)[prg-1];
  scr->prog->startprg=prg;
  scr->prog->virprg=scr->virprg;
  scr->prog->virfile=scr->virfile;
  scr->prog->foundstart=TRUE;

  /* fprintf(stderr, "Setexp:%s", text); */
}

static ReturnCode INLINE
Switch(struct Data *scr,
       struct Expr *val,
       short control,
       struct Condition *con)
{
  ReturnCode ret;
  struct fplStr *string;
  long value;
  uchar strtype=FALSE;
  uchar breakout=FALSE;

  /* temporary storage variables */
  uchar *ttext;
  long tprg;
  uchar *tvirfile;
  long tvirprg;

  uchar end=FALSE; /* we have not found the end position */

  long bprg;
  uchar *btext;
  long bvirprg;
  uchar *bvirfile;

  long dprg=-1;
  uchar *dtext;
  long dvirprg;
  uchar *dvirfile;

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

  /* Check the open parenthesis */
  if(scr->text[0]!=CHAR_OPEN_PAREN) {
    return FPLERR_MISSING_PARENTHESES;
  } else
    scr->text++;

  /* Get expression, string or int, static or dynamic! */
  CALL(Expression(val, scr, CON_NORMAL, NULL));

  if(val->flags&FPL_STRING) {
    /* there was a string statement! */
    string = val->val.str;
    if(string)
      strtype=2;
    else
      strtype= 1;

  } else {
    /* there was an integer expression */
    value = val->val.val;
  }

  /* Check the close parenthesis */
  if(scr->text[0]!=CHAR_CLOSE_PAREN) {
    return FPLERR_MISSING_PARENTHESES;
  } else
    scr->text++;

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

  /* Check the open brace */
  if(scr->text[0]!=CHAR_OPEN_BRACE) {
    return FPLERR_MISSING_BRACE;
  } else
    scr->text++;

  while(!(ret=Eat(scr))) {
    tprg = scr->prg;
    ttext = scr->text;
    tvirprg = scr->virprg;
    tvirfile = scr->virfile;
    if(!Getword(scr)) {
      if(!strcmp("case", scr->buf)) {
        /* This is a valid case-line coming up! */

        /* Get expression, string or int! */
        CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
        if(strtype) {
          /*
           * String comparison:
           */
          value = val->val.str?val->val.str->len:0;

          if(value == (string?string->len:0)) {

            if(value) {
              if(!memcmp(val->val.st