compile.c

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

     * This is an array reference!
     */
    CALL(GetArrayNum(scr, expr, &dims, ident));
    code = GETSHORT;
  }

  if(ident->flags&FPL_STRING_VARIABLE) {
    if(PASS2_OPEN_BRACKET == code) {
      
      /*
       * Yet another bracket means this is a single-character access
       * from a string!
       */
       
      P_SHORT; /* pass open bracket */
      CALL(CmpExpr(expr, scr, CON_GROUNDLVL|CON_NUM));
      P_SHORT; /* pass close bracket */
      if(!ident->data.variable.var.str[ dims ] ||
         !ident->data.variable.var.str[ dims ] ->len)
        /* no-length-string */
        return FPLERR_STRING_INDEX;
      if(expr->val.val >= ident->data.variable.var.str[ dims ]->len)
        /* force to zero! */
        expr->val.val=0;

      expr->val.val =
        ident->data.variable.var.str[ dims ]->string[expr->val.val];
    }
    else {
      expr->val.str = ident->data.variable.var.str[ dims ];
      expr->flags |= FPL_NOFREE; /* don't free this! */
    }
  }
  else {
    struct Unary *un; /* Unary information struct pointer */
    long *value = &ident->data.variable.var.val32[ dims ];
    if(PASS2_POSTINC == code ) {
      expr->val.val=(*value)++;
      P_SHORT;
    }
    else if(PASS2_POSTDEC == code) {
      expr->val.val=(*value)--;
      P_SHORT;
    }
    else if(un=expr->unary) {
      if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) {
        expr->val.val=*value;
      } else {
        if(ident->flags&FPL_READONLY)
          return FPLERR_READONLY_VIOLATE;
        if(un->unary==OP_PREINC)
          expr->val.val=++(*value);
        else
          expr->val.val=--(*value);
        expr->unary=un->next;
        FREE(un);
      }
    } else
      expr->val.val=*value;
  }
  return FPL_OK;
}

ReturnCode REGARGS
FixFunction(struct Data *scr,
            struct Expr **exprp,
            struct Expr *val, /* pass on struct pointer */
            Pass2 origcode,
            long control)
{
  struct fplArgument *pass; /* struct pointer to send as argument to
                               the function handler */
  struct fplArgument *arg2; /* backup pointer */
  ReturnCode ret;

  long numofargs; /* amount of arguments used in program */
  uchar *text; /* pointer to argument format string */
  uchar *run; /* pointer to new interpret position (local) */
  uchar *array;
  struct Expr *expr=*exprp;
  struct Identifier *ident;
  struct fplMsg *msg;
  struct CompiledInfo *comp;
  uchar *newformat=NULL;

  uchar hit;
  expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */

  GETMEM(pass, sizeof(struct fplArgument));

  switch(origcode) {
    case PASS2_CALL_INTERNAL_FUNCTION:
      pass->name=NULL;
      pass->ID=GETLONG;
      break;
      
    case PASS2_CALL_LOCAL_FUNCTION:
      run = &scr->prog->program [ GETLONG + scr->prog->index ];
      /* 'run' points to the new interpret position */
      break;
      
    case PASS2_CALL_EXPORT_FUNCTION:
      /* this function is called and recognized by actual name */
      pass->name =
        &scr->prog->program [ GETLONG + scr->prog->index + sizeof(long)];
      break;
  }
  
  P_LONG; /* pass function ID or index or string pointer */
  
  P_SHORT; /* pass PASS2_TYPE_OF_ARGUMENTS */
  
  text = &scr->prog->program [ GETLONG + scr->prog->index ];
  /* 'text' points to a string now, that holds the length in the
     first 32 bits */
  numofargs = GETLONGX(text); /* thats the length */
  text += sizeof(long); /* now point to the actual zero terminated string */

  P_LONG; /* pass parameter string index */
  
  pass->argc=0;
  pass->key=(void *)scr;
  pass->format = text; /* already set and known */
  /*
   * FIX the other pass members to be set correctly too!
   */
  
  if(numofargs) {
    uchar a;

    /* if the function takes arguments */

    /*
     * Allocate arrays to use for data storage while parsing
     * the arguments.
     */

    /* allocate an array */
    GETMEM(pass->argv, sizeof(uchar *)* (numofargs+1) );

    /* allocate allocate-flag string */
    GETMEM(array, sizeof(uchar)* (numofargs+1) );

    /* new format string */
    GETMEM(newformat, sizeof(uchar)* (numofargs+1) );
    
    do {
      a=*text;

      switch(a) {
      case FPL_OPTEXPRARG:
      case FPL_OPTARG:
      case FPL_STRARG:
        CALL(CmpExpr(val, scr, (a==FPL_STRARG?CON_STRING:0) ));

	if(a==FPL_STRARG || val->flags&FPL_STRING) {
          CALL(CmpStringExpr(val, scr)); /* get more strings? */
  
          if(val->val.str) {
            /* Set this to TRUE if deallocation is wanted on this
               string after the function call! */
            array[pass->argc]=!(val->flags&FPL_NOFREE);
            /*
             * Point to the string (that is zero terminated)!
             */
            pass->argv[pass->argc]=val->val.str->string;
          } else {
            register struct fplStr *string;
            GETMEM(string, sizeof(struct fplStr));
            memset(string, 0, sizeof(struct fplStr));
            pass->argv[pass->argc]=string->string;
            array [ pass->argc ] = TRUE; /* allocation has been done! */
          }
          newformat[pass->argc]=FPL_STRARG;
	}
	else {
          newformat[pass->argc]=FPL_INTARG;
          pass->argv[pass->argc]=(void *)val->val.val;
	}
        pass->argc++;
        break;
      case FPL_INTARG:
        CALL(CmpExpr(val, scr, CON_NUM));
        newformat[pass->argc]=FPL_INTARG;
        pass->argv[pass->argc++]=(void *)val->val.val;
        break;
      case FPL_OPTVARARG:
      case FPL_STRVARARG:
      case FPL_INTVARARG:
      case FPL_INTARRAYVARARG:
      case FPL_STRARRAYVARARG:
        {
          register ReturnCode ok;
          register Pass2 code;
          if(GETSHORT != PASS2_VARIABLE_REFERENCE) {
            ok = FPLERR_ILLEGAL_REFERENCE;
          }
          else {
            ok = FPL_OK;
            P_SHORT; /* pass that one */
          }
          
          /* Get identifier */
          
          code = GETSHORT;
          P_SHORT; 
          switch(code) {
          case PASS2_REF_LOCAL_SYMBOL:
            ident = scr->localinfo.list[ GETLONG ];
            break;
          case PASS2_REF_GLOBAL_SYMBOL:
            ident = scr->globalinfo->list[ GETLONG ];
            break;
          case PASS2_REF_EXPORT_SYMBOL:
            {
              register char *pnt;
              pnt = (uchar *) &scr->prog->program[ GETLONG +
                scr->prog->index + sizeof(long)];  /* skip hash for now */
              CALL(GetIdentifier(scr, pnt, &ident));
            }
            break;
          }
          P_LONG; /* pass data */

          if(ok) {
            /* missing contensof-operator! */
            if(ident->flags&FPL_REFERENCE)
              /* get the referenced variable instead! */
              ident = ident->data.variable.ref;
            else
              return ok; /* no reference! */
          }
        }

        if(FPL_INTARRAYVARARG == a || FPL_STRARRAYVARARG == a) {
          if(!ident->data.variable.num)
            return FPLERR_ILLEGAL_REFERENCE;
        }
        else if(FPL_OPTVARARG != a && ident->data.variable.num)
          /* only straight variables! */
          return FPLERR_ILLEGAL_PARAMETER;

        if( (ident->flags&FPL_INT_VARIABLE &&
             (a==FPL_STRVARARG || a == FPL_STRARRAYVARARG)) ||
           (ident->flags&FPL_STRING_VARIABLE &&
            (a==FPL_INTVARARG || a == FPL_INTARRAYVARARG))) {
          return FPLERR_ILLEGAL_VARIABLE;
        }
        pass->argv[pass->argc]=(void *)ident;
        newformat[pass->argc++]=
	  (ident->flags&FPL_STRING?
	 (ident->data.variable.num?FPL_STRARRAYVARARG:FPL_STRVARARG):
	   (ident->data.variable.num?FPL_INTARRAYVARARG: FPL_INTVARARG));
        break;
      }
      P_SHORT; /* pass the COMMA or CLOSE_PAREN */
    } while (*++text);
    newformat[pass->argc]=CHAR_ASCII_ZERO;
    pass->format = newformat;
  }
  else
    P_SHORT; /* pass the closing paren */

  /*
   * Call the function!
   */

  if(PASS2_CALL_INTERNAL_FUNCTION == origcode) {
    CALL(functions(pass));
  }
  else {
    /*
     * Allocate temporary storage for our local symbols.
     */
    GETMEM(comp, sizeof(struct CompiledInfo));
    memcpy(comp, &scr->localinfo, sizeof(struct CompiledInfo)); /* copy */
    /*
     * Clear the items to enforce a new allocated list
     */
    scr->localinfo.listentries = scr->localinfo.listsize =0;
      
    arg2 = scr->arg; /* store the old */
    scr->arg = pass; /* for compiled functions */
      
    text = scr->text; /* store current interpret position */
      
    if(PASS2_CALL_LOCAL_FUNCTION == origcode) {
      char oldret;
      
      scr->text = run; /* set interpret point to local function index */
      /*
       * Recurse this at the new position.
       */
      oldret=scr->strret;
      scr->strret=control&CON_STRING?1:0; /* should we receive a string? */
      CALL(Script(scr, val, SCR_BRACE|SCR_FUNCTION, NULL));
      scr->strret=oldret;
    }
    else {
      /* EXPORTED FUNCTION */
      ret=GetIdentifier(scr, pass->name, &ident);
      if(ret) {
        /* copy the variable name to make a decent error */
        strcpy(scr->buf, pass->name);
        return ret;
      }
      pass->ID=ident->data.external.ID; /* set ID */
      CALL(CallFunction(scr, pass, ident));
    }
    
    scr->text = text; /* restore previous execute point */
    scr->arg = arg2;  /* restore previous argument pointer */
    
    /*
     * Free the previous local variables and get back our old
     */
    if(scr->localinfo.listsize) {
      /* There is an allocated one here */
      FREE(scr->localinfo.list);
    }
    memcpy(&scr->localinfo, comp,
           sizeof(struct CompiledInfo)); /* copy */
    FREE(comp);
  }

  CALL(GetMessage(scr, FPLMSG_RETURN, &msg));
  if(control & CON_NUM)
    hit = FPL_INTARG;
  else if(control & CON_STRING)
    hit = FPL_STRARG;
  else {
    if(msg) {
      if(msg->flags&FPLMSG_FLG_INT) {
        /* There is a return 'int' message! This may well be a
           function returning int! */
        hit = FPL_INTARG;
      }
      else {
        /* found string, it returned a 'string' !!! */
        hit = FPL_STRARG;
      }
    }
    else
      hit = FPL_INTARG;
    /* There is no return nor hint! */
  }

  switch(hit) {
    case FPL_STRARG:
      if(msg && ((msg->flags&FPLMSG_FLG_BITS) != FPLMSG_FLG_STRING))
        return FPLERR_UNEXPECTED_INT_STATEMENT;
      if(!msg || !msg->message[0])
        /* We got a zero length string or no string at all! */
        expr->val.str=NULL; /* no string! */
      else
        /* the copied string! */
        expr->val.str=(struct fplStr *)msg->message[0];
      expr->flags=FPL_STRING|FPL_ACTION;
      break;
    case FPL_INTARG:
    default:
      if(msg && ((msg->flags&FPLMSG_FLG_BITS) != FPLMSG_FLG_INT))
        return FPLERR_UNEXPECTED_STRING_STATEMENT;
      /* only if integer! or the function is non-existent */
      expr->val.val=(msg?(long)msg->message[0]:0);
      CALL(NewMember(scr, exprp));
      break;
  }
  if(msg)
    DeleteMessage(scr, msg);

  while(pass->argc--) {
    if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) {
      /* free the string if it's been marked to be freed!! */
      FREE((uchar *)pass->argv[pass->argc]-
           offsetof(struct fplStr, string));
    }
  }
  if(numofargs) {
    FREE(pass->argv);
    FREE(array);
    FREE(newformat);
  }
  FREE(pass);
  return FPL_OK;
}

ReturnCode REGARGS AssignArg(struct Data *scr)
{
  long varnum;
  long argnum;
  struct Identifier *ident;
  struct fplVariable *tempvar;
  
  varnum = GETLONG;
  P_LONG;
  argnum = GETLONG;
  P_LONG;
  
  ident = scr->localinfo.list[ varnum ]; /* the local variable */
  tempvar=&ident->data.variable;
  
  if(ident->flags & FPL_REFERENCE)
    ident->data.variable.ref = (struct Identifier *)scr->arg->argv[ argnum ];
  else if(ident->flags & FPL_STRING_VARIABLE) {
    /* Store string length in variable `len' */
    register long len=GETSTRLEN(scr->arg->argv[ argnum ]);
    GETMEM(tempvar->var.str[0], sizeof(struct fplStr)+len);
    tempvar->var.str[0]->alloc=len;

    /* We copy the ending zero termination too! */
    memcpy(tempvar->var.str[0]->string,
           ((uchar *)scr->arg->argv[ argnum ]),
           len+1);
    tempvar->var.str[0]->len=len;
  }
  else {
    /* Integer assign */
    tempvar->var.val32[0]=(long)scr->arg->argv[ argnum ];
  }
  return FPL_OK;
}

ReturnCode REGARGS CmpSwitch(struct Data *scr,
                             struct Expr *val)
{
  ReturnCode ret;
  struct fplStr *string;
  long value;
  long index; /* current index information */
  char wasstring=FALSE;
  char jump=FALSE;

  /* Get expression, string or int, static or dynamic! */
  CALL(CmpExpr(val, scr, CON_NORMAL));
  if(val->flags&FPL_STRING) {
    /* string statement! */
    string = val->val.str;
    wasstring=TRUE;
  }
  else {
    /* integer expression */
    value = val->val.val;
  }
  P_SHORT; /* pass the END_OF_EXPR mark */
  do {
    P_SHORT; /* pass the CASE mark */
    index = GETLONG;
    P_LONG;  /* pass the index */
  
    /* Get expression, string or int! */
    CALL(CmpExpr(val, scr, wasstring?CON_STRING:CON_NUM));
    if(wasstring) {
      /*
       * String comparison:
       */
      value = val->val.str?val->val.str->len:0; /* get length */
  
      if(value == (string?string->len:0)) { /* compare lengts */
        if(value) {
          if(!memcmp(val->val.str->string, string->string, value)) {
            /* match! */
            jump=TRUE;
          }
        } else
          jump=TRUE;
      }
      if(!val->flags&FPL_NOFREE)
        FREE(val->val.str);
    }
    else {
      /*
       * Integer comparison:
       */
      if(val->val.val == value)
        jump = TRUE; /* match */
    }
    if(jump) {
      /* goto index */
      scr->text = &scr->prog->program[scr->prog->index + index];
      break; /* we're done! */
    }
    P_SHORT; /* pass the END_OF_EXPR */
  } while(PASS2_CASE == GETSHORT);
  
  return FPL_OK;
}

ReturnCode REGARGS CmpBreak(struct Data *scr,
                            struct Expr *val)
{
  ReturnCode ret;

  /* Get integer expression */
  CALL(CmpExpr(val, scr, CON_NUM));
  
  P_SHORT; /* pass END_OF_EXPR */
  
  if(val->val.val<=0)
    return FPLERR_ILLEGAL_BREAK;
    
  while(--val->val.val && PASS2_LABEL_GOTO == GETSHORT)
    scr->text += sizeof(short)+sizeof(long);

  if(PASS2_END_OF_EXPR == GETSHORT) {
    P_SHORT; /* just pass it and act cool! */
  }
  return FPL_OK; /* leave this standing on the goto! */
}