compile.c

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

        }
        if(*string && MALLOC_STATIC == TypeMem(ident) )
          SwapMem(scr, *string, MALLOC_STATIC);
       
        if((CHAR_PLUS == type) && !(val->flags&FPL_NOFREE) && val->val.str)
          /* Only do this if appending! */
          FREE(val->val.str);
      }
    }
    if(!multi)
      break;
      
    P_SHORT; /* pass END_OF_EXPR */

#if 0
    code = GETSHORT;
    
    P_SHORT; /* pass COMMA or CLOSE_BRACE */
#endif

  } while( dim > 0 ); /* repeat while we still assign first or more dims */

  if(string) {
    val->val.str=*string;
    val->flags=FPL_STRING|FPL_NOFREE;
  }
  else
    val->flags=0;

  if(array)
    FREE(array); /* free temporary space */
  return FPL_OK;
}

static ReturnCode ReferToThis(struct Identifier **ident)
{
  if(!((*ident)->flags&FPL_REFERENCE))
    return FPLERR_ILLEGAL_REFERENCE; /* referenced a non-reference! */
  if(!(*ident)->data.variable.ref)
    return FPLERR_ILLEGAL_REFERENCE; /* illegal reference! */
  *ident = (*ident)->data.variable.ref; /* use the "actual" variable! */
  return FPL_OK;
}

ReturnCode REGARGS
CmpExpr(struct Expr *val, /* return value struct pointer */
        struct Data *scr, /* everything */
        long control)     /* ESPECIALLLY DEFINED */
{
  struct Expr *expr, *basexpr;
  ReturnCode ret;
  struct Identifier *ident; /* general purpose struct identifier pointer */
  long num;
  uchar *pnt;
  Pass2 code;
  uchar contentsof=FALSE;
#if defined(AMIGA) && defined(SHARED)
  if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
    if(ret==1)
      return(FPLERR_OUT_OF_MEMORY);
    else
      return(FPLERR_OUT_OF_STACK);
  }
#endif

  GETMEM(expr, sizeof(struct Expr));
  memset(expr, 0, sizeof(struct Expr));
  basexpr=expr;

  do {
    code = GETSHORT;
    P_SHORT; /* pass the instruction code */

    switch(code) {
      case PASS2_LINE_NUMBER:
        scr->virprg = GETLONG;
        P_LONG;
        continue;
      /*
       * Three cases of simple references.
       */
      case PASS2_REF_LOCAL_SYMBOL:
        ident = scr->localinfo.list[ GETLONG ];
        P_LONG;
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(FixVariable(scr, ident, control, expr));
        CALL(NewMember(scr, &expr));
        break;
      case PASS2_REF_GLOBAL_SYMBOL:
        ident = scr->globalinfo->list[ GETLONG ];
        P_LONG;
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(FixVariable(scr, ident, control, expr));
        CALL(NewMember(scr, &expr));
        break;
      case PASS2_REF_EXPORT_SYMBOL:
        pnt = (uchar *) &scr->prog->program[ GETLONG +
          scr->prog->index +
            sizeof(long)];  /* skip hash for now */
        CALL(GetIdentifier(scr, pnt, &ident));
        P_LONG;
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(FixVariable(scr, ident, control, expr));
        CALL(NewMember(scr, &expr));
        break;

      /*
       * Three cases of assigns.
       */
      case PASS2_ASSIGN_LOCAL_SYMBOL:
        /* (varnum) (assign type);... local list */
        ident = scr->localinfo.list[ GETLONG ];
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(AssignVar(scr, expr, ident, GETLONGX(scr->text+sizeof(long)) ));
        CALL(NewMember(scr, &expr));
        P_SHORT; /* pass the end of expr code */
        break;
      case PASS2_ASSIGN_GLOBAL_SYMBOL:
        /* (varnum) (assign type);... global list */
        ident = scr->globalinfo->list[ GETLONG ];
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(AssignVar(scr, expr, ident, GETLONGX(scr->text+sizeof(long)) ));
        CALL(NewMember(scr, &expr));
        P_SHORT; /* pass the end of expr code */
        break;
      case PASS2_ASSIGN_EXPORT_SYMBOL:
        /* (assigntyp) (string-offset) */
        num = GETLONG; /* assign type */
        pnt = (uchar *)
          &scr->prog->program[GETLONGX(scr->text+ sizeof(long)) +
                              scr->prog->index +
                              sizeof(long) ];  /* skip hash for now */
        CALL(GetIdentifier(scr, pnt, &ident));
        if(contentsof) {
          CALL(ReferToThis(&ident));
          contentsof=FALSE;
        }
        CALL(AssignVar(scr, expr, ident, num ));
        CALL(NewMember(scr, &expr));
        P_SHORT; /* pass the end of expr code */
        break;

      case PASS2_CALL_LOCAL_FUNCTION:
      case PASS2_CALL_INTERNAL_FUNCTION:
      case PASS2_CALL_EXPORT_FUNCTION:
        {
          struct Expr **exprp;
          GETMEM(exprp, sizeof(struct Expr *));
          *exprp = expr;
          CALL(FixFunction(scr, exprp, val, code, control));
          expr = *exprp;
          FREE(exprp);
        }
        break;

      case PASS2_CONTENTSOF:
        /*
         * This is the 'contents of' operator!
         */
        contentsof=TRUE;
        break;

      case PASS2_NUM_CONSTANT:
        expr->val.val=GETLONG;
        P_LONG;
        CALL(NewMember(scr, &expr));
        break;

      case PASS2_STRING_CONSTANT: /* OFFSET to <length> <string> */
        pnt = GETLONG + scr->prog->index + scr->prog->program;
        num = GETLONGX(pnt);
        GETMEM(expr->val.str, sizeof(struct fplStr)+ num);
        expr->val.str->alloc = expr->val.str->len = num;
        memcpy(expr->val.str->string,
               pnt+sizeof(long), num + 1); /* copy the zero termination too */
        expr->flags=FPL_STRING;
        P_LONG; /* pass the string offset */
        CALL(CmpStringExpr(expr, scr));
        break;
        
      case PASS2_OPEN_PAREN:
        CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM));
        expr->val.val=val->val.val;
        CALL(NewMember(scr, &expr));
        P_SHORT; /* pass close paren */
        break;

      case PASS2_NOTOPERATOR:
        CALL(AddUnary(scr, expr, OP_NOT));
        break;

      case PASS2_ONCECOMPLEMENT:
        CALL(AddUnary(scr, expr, OP_COMPL));
        break;

      case PASS2_PREINC:
        CALL(AddUnary(scr, expr, OP_PREINC));
        break;

      case PASS2_PREDEC:
        CALL(AddUnary(scr, expr, OP_PREDEC));
        break;

      case PASS2_NEGATE:
        CALL(AddUnary(scr, expr, OP_MINUS));
        break;

      case PASS2_EQUAL:
        expr->operator=OP_EQUAL;
        break;
      case PASS2_LOGICAND:
        /*
         * This is a logical AND (&&)
         */

        /*
         * Get result from everything to the left of this!
         */
        CALL(Calc(scr, val, basexpr));

        /*
         * Clean the expression so far.
         */
        Clean(scr, basexpr);    /* erase the list */

        /*
         * Start a new list with this result
         */
        GETMEM(expr, sizeof(struct Expr));
        memset(expr, 0, sizeof(struct Expr));
        basexpr=expr;
        expr->val.val = val->val.val;

        if(!expr->val.val) {
          /*
           * In this case, its like in the 'a && b' expression and 'a'
           * equals 0. Then we should skip the 'b' expression.
           */
          scr->text =
            &scr->prog->program [ scr->prog->index + GETLONG ];
        }
        else
          P_LONG; /* pass index */
        break;

      case PASS2_BINARYAND:
        expr->operator=OP_BINAND;
        break;
      case PASS2_LOGICOR:
        /*
         * This is a logical OR operator (||)
         */

        /*
         * Get result from everything to the left of this!
         */
        CALL(Calc(scr, val, basexpr));

        /*
         * Clean the expression so far.
         */
        Clean(scr, basexpr);    /* erase the list */

        /*
         * Start a new list with this result
         */
        GETMEM(expr, sizeof(struct Expr));
        memset(expr, 0, sizeof(struct Expr));
        basexpr=expr;
        expr->val.val = val->val.val;

        if(expr->val.val) {
          /*
           * In this case, its like in the 'a || b' expression and 'a'
           * equals 1. Then we should skip the 'b' expression.
           */
          scr->text =
            &scr->prog->program [ scr->prog->index + GETLONG ];
        }
        else
          P_LONG; /* pass index */
        break;
      case PASS2_BINARYOR:
        expr->operator=OP_BINOR;
        break;
      case PASS2_PLUS:
	if(control&CON_STRING) {
          scr->text -= sizeof(short); /* back on the instruction code */
          code = PASS2_END_OF_EXPR; /* force break-out-of-loop */
	}
	else
          expr->operator=OP_PLUS;
        break;
      case PASS2_MINUS:
        expr->operator=OP_MINUS;
        break;
      case PASS2_CONDOPSTART:
        /*
         * This is the first operator in a conditional operator sequence (?)
         */

        /*
         * Get result from everything to the left of this!
         */
        CALL(Calc(scr, val, basexpr));

        /*
         * Clean the expression so far.
         */
        Clean(scr, basexpr);    /* erase the list */

        /*
         * Start a new list with this result
         */
        GETMEM(expr, sizeof(struct Expr));
        memset(expr, 0, sizeof(struct Expr));
        expr->flags = FPL_OPERAND;
        basexpr=expr;

        if(val->val.val) {
          /*
           * In this case, its like in the 'a ? b : c' expression and 'a'
           * equals 1. Then we should skip the 'c' expression.
           */
          P_LONG; /* pass index */
          
          CALL(CmpExpr(val, scr, CON_NORMAL));
          /*
           * We're on a LABEL_GOTO right now!
           */
          P_SHORT; /* pass the instruction */
          /* goto the new position */
          scr->text =
            &scr->prog->program [ scr->prog->index + GETLONG ];
        }
        else {
          /*
           * In this case, its like in the 'a ? b : c' expression and 'a'
           * equals 0. Then we should skip the 'b' expression.
           */
           /* goto position */
          scr->text =
            &scr->prog->program [ scr->prog->index + GETLONG ];
          CALL(CmpExpr(val, scr, CON_NORMAL));
        }
        expr->val.val = val->val.val;
        break;
      case PASS2_MULTIPLY:
        expr->operator=OP_MULTIPLY;
        break;
      case PASS2_DIVISION:
        expr->operator=OP_DIVISION;
        break;
      case PASS2_REMAIN:
        expr->operator=OP_REMAIN;
        break;
      case PASS2_XOR:
        expr->operator=OP_BINXOR;
        break;
      case PASS2_LESSEQ:
        expr->operator=OP_LESSEQ;
        break;
      case PASS2_SHIFTLEFT:
        expr->operator=OP_SHIFTL;
        break;
      case PASS2_LESS:
        expr->operator=OP_LESS;
        break;
      case PASS2_GREATEQ:
        expr->operator= OP_GRETEQ;
        break;
      case PASS2_SHIFTRIGHT:
        expr->operator=OP_SHIFTR;
        break;
      case PASS2_GREATER:
        expr->operator=OP_GRET;
        break;
      case PASS2_NOTEQUAL:
        expr->operator=OP_NOTEQ;
        break;
      case PASS2_COMMA:
        if(control&CON_GROUNDLVL) {
          /*
           * Get result from everything to the left of this!
           * For unary operators.
           */
          CALL(Calc(scr, val, basexpr));
          
          Clean(scr, basexpr);
          GETMEM(basexpr, sizeof(struct Expr));
          expr=basexpr;
          expr->val.val=0;
          expr->unary=NULL;
          expr->operator=expr->flags=OP_NOTHING;
          expr->next=NULL;
          break;
        }
        /* FALLS THROUGH */
      /* case PASS2_END_OF_EXPR: */
      default:
        scr->text -= sizeof(short); /* back on the instruction code */
        code = PASS2_END_OF_EXPR; /* force break-out-of-loop */
        break;
    }
#if 0
    if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL))
      /* get outta string calcs if not on ground level! */
      break;
#endif
#if 0
    if(control&CON_STRING)
      /* get outta string calcs if not on ground level! */
      break;
#endif
  } while(PASS2_END_OF_EXPR != code);

  if(!(control&CON_NORETURN)) {
    /*
     * Get result of the current expression.
     */
    CALL(Calc(scr, val, basexpr));
  }
  Clean(scr, basexpr);    /* erase the rest of the list */
  return(FPL_OK);
}

ReturnCode REGARGS
GetArrayNum(struct Data *scr,
            struct Expr *expr,
            long *dims,
            struct Identifier *ident)
{
  long *array;
  ReturnCode ret;
  *dims=0;
  /*
   * This is an array reference!
   */
  GETMEM(array, ident->data.variable.num*sizeof(long));
  do {
    P_SHORT; /* pass open bracket */
    CALL(CmpExpr(expr, scr, CON_GROUNDLVL|CON_NUM));
    P_SHORT; /* pass close bracket */
    if(expr->val.val < 0)
      /* illegal result of the expression */
      return FPLERR_ILLEGAL_ARRAY;
    array[ (*dims)++ ] = expr->val.val;
    if(*dims == ident->data.variable.num )
      /* we've hit the roof! */
      break;
  } while(PASS2_OPEN_BRACKET == GETSHORT);
  *dims = ArrayNum(*dims, ident->data.variable.num, array,
                    ident->data.variable.dims);
  if( 0 > *dims)
    return FPLERR_ILLEGAL_ARRAY;
  FREE(array); /* free temporary space */
  
  return FPL_OK;
}

ReturnCode REGARGS
FixVariable(struct Data *scr,
            struct Identifier *ident,
            long control,
            struct Expr *expr)
{
  Pass2 code;
  long *array=NULL;
  long dims=0;
  ReturnCode ret;
  
  if(!ident)
    return FPLERR_IDENTIFIER_NOT_FOUND;

  code = GETSHORT;

  if(PASS2_RESIZE == code) {
    /*
     * Ooops! ;) This is a resize operation and not at all any
     * 'real' variable reference.
     */
    P_SHORT; /* pass resize instruction */
    GETMEM(array, MAX_DIMS*sizeof(long));
    do {
      P_SHORT; /* pass open bracket */
      CALL(CmpExpr(expr, scr, CON_GROUNDLVL|CON_NUM));
      P_SHORT; /* pass close bracket */
      array[ dims++ ] = expr->val.val;
    } while(PASS2_OPEN_BRACKET == GETSHORT);
    CALL(ArrayResize(scr, dims, array, ident));
    FREE(array); /* free temporary space */
    return FPL_OK;
  }

  if( PASS2_OPEN_BRACKET == code && ident->data.variable.num ) {
    /*