compile.c

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

/************************************************************************
 *		         FREXX PROGRAMMING LANGUAGE                     *
 ************************************************************************

 Compile.c
 
 Functions to support the compiled programs executions.

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

/************************************************************************
 *                                                                      *
 * fpl.library - A shared library interpreting script langauge.         *
 * Copyright (C) 1992-1994 FrexxWare                                    *
 * Author: Daniel Stenberg                                              *
 *                                                                      *
 * This program is free software; you may redistribute for non          *
 * commercial purposes only. Commercial programs must have a written    *
 * permission from the author to use FPL. FPL is *NOT* public domain!   *
 * Any provided source code is only for reference and for assurance     *
 * that users should be able to compile FPL on any operating system     *
 * he/she wants to use it in!                                           *
 *                                                                      *
 * You may not change, resource, patch files or in any way reverse      *
 * engineer anything in the FPL package.                                *
 *                                                                      *
 * This program is distributed in the hope that it will be useful,      *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
 *                                                                      *
 * Daniel Stenberg                                                      *
 * Ankdammsgatan 36, 4tr                                                *
 * S-171 43 Solna                                                       *
 * Sweden                                                               *
 *                                                                      *
 * FidoNet 2:201/328    email:[e-mail]                       *
 *                                                                      *
 ************************************************************************/

#include "script.h"
#include "compile.h"
#include <stddef.h>

ReturnCode REGARGS
FixVariable(struct Data *scr,
            struct Identifier *ident,
            long control,
            struct Expr *expr);
ReturnCode REGARGS FixFunction(struct Data *,
                               struct Expr **,
                               struct Expr *,
                               Pass2,
                               long);
ReturnCode REGARGS
CmpStringExpr(struct Expr *val,		/* original string -> new */
	     struct Data *scr);		/* standard */

ReturnCode REGARGS
GetArrayNum(struct Data *,
            struct Expr *,
            long *,
            struct Identifier *);

#ifndef AMIGA
/*
 * Return the long value the 4 following chars represent
 */

long REGARGS GetLong(char *x)
{
  return (x[0]<<24) + (x[1]<<16) + (x[2]<<8) + x[3];
}

/*
 * Return the short value the 2 following chars represent
 */

short REGARGS GetShort(char *x)
{
  return (x[0]<<8) + x[1];
}
#endif

/************************************************************************
 *
 * IsCompiled()
 *
 * Returns the start-index if the program sent as parameter is compiled,
 * or a negative value if not.
 *
 *********************************/
 
ReturnCode REGARGS SetupCompiled(struct Program *prog)
{
  uchar *original;
  uchar *progpnt = prog->program;
  if(!progpnt || memcmp(progpnt, COMPILED_HEADER, strlen(COMPILED_HEADER)))
    return -1; /* not compiled, run as usual! */

  if(!(prog->flags&PR_COMPILED)) {
    
    original = progpnt; /* store where we start at! */
  
    /*
     * Compiled programs contain at least this following header that
     * we must pass in an elegant and forward compatible way!
     * 'CODE' is the hunk we're after!
     */
    progpnt += COMPILED_HEADER_LEN; /* get to the first hunk */
  
    while(memcmp(progpnt, COMPILED_HUNK_CODE, strlen(COMPILED_HUNK_CODE))) {
      /*
       * As long as we haven't found the 'CODE' hunk, skip the unknown ones.
       */
      progpnt += COMPILED_HUNKNAME_LEN;
      progpnt += GETLONGX(progpnt) + COMPILED_HUNKLENGTH_LEN;
    }
    
    progpnt += COMPILED_HUNKNAME_LEN + COMPILED_HUNKLENGTH_LEN;
  
    /*
     * Set the information
     */
    
    prog->flags |= PR_COMPILED;
    prog->index = progpnt - original; /* index from start */
    prog->startcol = prog->index;
  }
  return FPL_OK;
}

/*
 * CmpReset() - clears a local variable
 */
 
ReturnCode REGARGS
CmpReset(struct Data *scr,
         long num)
{
  register long size=0;
  long loop;
  struct fplVariable *var = & scr->localinfo.list [ num ]->data.variable;
  loop = var->size;
  if( scr->localinfo.list [ num ]->flags & FPL_INT_VARIABLE) {
    while(size < loop )
      var->var.val32[ size++ ] = 0; /* reset to zero */
  }
  else {
    while(size < loop ) {
      if( var->var.str[ size ] ) {
         /* The string has been set, make it zero length and zero
            terminated */
        var->var.str[ size ]->len = 0;
        var->var.str[ size ]->string[0] = 0;
      }
      size++;
    }
  }
  return FPL_OK;
}

/*
 * ReturnVariable() - returns the identifier pointer to the variable
 */
ReturnCode REGARGS
ReturnVariable(struct Data *scr,
               struct Identifier **ident,
               long flags)
{
  struct Identifier *pident;

  GETMEM(pident, sizeof(struct Identifier));
  memset(pident, 0, sizeof(struct Identifier));
  pident->flags =flags;

  GETMEM(pident->data.variable.var.val32, sizeof(long));
  *pident->data.variable.var.val32=0;
  pident->data.variable.num=0;
  pident->data.variable.size=1;

  pident->file = scr->prog->name;
  
  *ident = pident;
  return FPL_OK;
}

/*
 * CmpExport() - exports a specified function
 */
ReturnCode REGARGS CmpExport(struct Data *scr)
{
  struct Identifier *pident;
  ReturnCode ret;

  GETMEM(pident, sizeof(struct Identifier));
  memset(pident, 0, sizeof(struct Identifier));
  pident->flags = GETLONG | FPL_COMPILER_ADDED;
  P_LONG;
  
  /* start position index (add the actual index too) */
  pident->data.inside.col = scr->prog->index + GETLONG;
  P_LONG;
  pident->data.inside.virfile = scr->virfile;
  if( pident->flags & FPL_STRING_VARIABLE)
    pident->data.inside.ret = FPL_STRARG;
  else /* 'int' or 'void' kind */
    pident->data.inside.ret = FPL_INTARG;

  /*
   * Get name!
   */
  pident->name =
    &scr->prog->program [ scr->prog->index + GETLONG + sizeof(long)];
  P_LONG;

  /*
   * Get parameter format!
   */
  pident->data.inside.format =
    &scr->prog->program [ scr->prog->index + GETLONG + sizeof(long)];
  P_LONG;


  /*
   * Setup the exported variable:
   */
  pident->file = pident->data.inside.file = scr->prog->name;
  pident->data.inside.virfile = scr->virfile;
  pident->data.inside.prg = 1; /* always first line! */
  
  CALL(AddVar(scr, pident, &scr->globals ));

  return FPL_OK;
}

/*
 * CmpDeclare() - declares all kinds of variables
 */
ReturnCode REGARGS
CmpDeclare(struct Data *scr)
{
  long flags;
  long amount;
  long firstid;
  struct Identifier **temp;
  struct Identifier *ident;
  ReturnCode ret;
  
  flags   = GETLONG | FPL_COMPILER_ADDED;
  firstid = GETLONGX(scr->text+sizeof(long));

  if(!(flags&FPL_EXPORT_SYMBOL)) {
    amount  = GETLONGX(scr->text+sizeof(long)*2);
    
    scr->text += sizeof(long)*3; /* pass the three data longs */
    
    if(!(flags&FPL_GLOBAL_SYMBOL)) {
      /* These are local ones */
      
      if(!scr->localinfo.listentries) {
        scr->localinfo.listsize = DEFAULT_LISTSIZE;
        GETMEM(scr->localinfo.list,
               scr->localinfo.listsize*sizeof(struct Identifier *));
      }
      
      /*
       * Have we room for those new local symbols?
       */
      if(firstid + amount >= scr->localinfo.listsize) {
        scr->localinfo.listsize = firstid + amount+1; /* OLD += DEFAULT_LISTSIZE; */
        GETMEM(temp,
               scr->localinfo.listsize*sizeof(struct Identifier *));
        memcpy(temp, scr->localinfo.list, 
               scr->localinfo.listentries * sizeof(struct Identifier *) );
        FREE(scr->localinfo.list);
        scr->localinfo.list = temp;
      }

      
      while(amount--) {
        CALL(ReturnVariable(scr, 
                            &scr->localinfo.list [ firstid ],
                            flags));
        CALL(AddToList(scr, scr->localinfo.list [ firstid ], &scr->locals));
        if(++firstid > scr->localinfo.listentries)
          scr->localinfo.listentries = firstid;
      }
    }
    else {
      /* add to the global list */

      if(!scr->globalinfo->listentries) {
        scr->globalinfo->listsize = DEFAULT_LISTSIZE;
        GETMEMA(scr->globalinfo->list,
               scr->globalinfo->listsize*sizeof(struct Identifier *));
      }
      
      /* this is a certain amount of local symbols */
      if(firstid + amount >= scr->globalinfo->listsize) {
        scr->globalinfo->listsize = firstid + amount + 1;
        GETMEMA(temp,
               scr->globalinfo->listsize*sizeof(struct Identifier *));
        memcpy(temp, scr->globalinfo->list, 
               scr->globalinfo->listentries * sizeof(struct Identifier *) );
        FREEA(scr->globalinfo->list);
        scr->globalinfo->list = temp;
      }
      
      while(amount--) {
        CALL(ReturnVariable(scr, 
                            &scr->globalinfo->list [ firstid ],
                            flags));
        CALL(AddToList(scr, scr->globalinfo->list [ firstid ],
                       &scr->globals));
        if(++firstid > scr->globalinfo->listentries)
          scr->globalinfo->listentries = firstid;
      }
    }
  }
  else {
    CALL(ReturnVariable(scr, &ident, flags));
    ident->name = scr->prog->program + scr->prog->index + firstid +
      sizeof(long); /* skip the hash for now */
    CALL(AddVar(scr, ident, &scr->globals));
    scr->text += sizeof(long)*2;
  }
  
  return FPL_OK;
}

ReturnCode REGARGS
CmpStringExpr(struct Expr *val,		/* original string -> new */
	     struct Data *scr)		/* standard */
{
  ReturnCode ret;
  struct fplStr *whole;

  Pass2 code=GETSHORT;
  
  if(PASS2_STRING_APPEND == code ||
     PASS2_PLUS == code) {

    GETMEM(whole, sizeof(struct fplStr));
    memset(whole, 0, sizeof(struct fplStr));
    
    /* put string in new string variable */
    CALL(StrAssign(val->val.str, scr, &whole,
                   TRUE)); /* TRUE == append */
    
    do {
      
      P_SHORT; /* pass the add instruction */
      CALL(CmpExpr(val, scr, CON_STRING));

      /* append string to that new variable */
      CALL(StrAssign(val->val.str, scr, &whole, TRUE));
      
      if(!(val->flags&FPL_NOFREE) && val->val.str)
	FREE(val->val.str);

      code= GETSHORT;
      
    } while(PASS2_STRING_APPEND == code ||
            PASS2_PLUS == code );
      
    val->val.str = whole; /* get the string info! */
    val->flags&=~FPL_NOFREE; /* free this, yes! */
  }
  return FPL_OK;
}


/*
 * Let's fix this bloody assign, and leave the return code in the
 * (struct Expr *) we get!
 */


ReturnCode REGARGS
AssignVar(struct Data *scr,
          struct Expr *val,
          struct Identifier *ident,
          long type) /* assign type */
{
  ReturnCode ret;
  long pos=0;
  Pass2 code;
  long dim;
  long dimensions=0;
  long *array=NULL;
  char multi=FALSE;

  long value;
  uchar *valuep;
  struct fplStr **string=NULL;

  scr->text += sizeof(long)*2; /* pass the information data */
  code = GETSHORT;
  if( PASS2_OPEN_BRACKET == code && ident->data.variable.num ) {
    /*
     * This is an array member assign!
     */
    GETMEM(array, ident->data.variable.num*sizeof(long));
    do {
      P_SHORT; /* pass open bracket */
      CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM));
      P_SHORT; /* pass close bracket */
      if(val->val.val < 0)
        /* illegal result of the expression */
        return FPLERR_ILLEGAL_ARRAY;
      array[ dimensions++ ] = val->val.val;
      if(dimensions == ident->data.variable.num )
        /* we've hit the roof! */
        break;
    } while(PASS2_OPEN_BRACKET == GETSHORT);
    code = GETSHORT;
  }
  if(PASS2_OPEN_BRACE == code) {
    P_SHORT;
    dim=1; /* first dimension assign */
    multi=TRUE;
    if(!array) {
      /* then get an array! */
      GETMEM(array, ident->data.variable.num * sizeof(long));
      /* and clear it */
      memset(array, 0, ident->data.variable.num * sizeof(long) );
      /* set number of dimensions */
      dimensions = ident->data.variable.num;
    }
  }
  do {
    if(multi) {
      code = GETSHORT;
      switch(code) {
      case PASS2_OPEN_BRACE:
        ++dim;
        P_SHORT;
        continue;
      case PASS2_CLOSE_BRACE:
        --dim;
        P_SHORT;
        array[dim]=0; /* start over at zero at this dimension */
        continue;
      case PASS2_COMMA:
        array[ dim-1 ] ++;
        P_SHORT;
        continue;
      }
    }
    if(array) {
      pos = ArrayNum(dimensions, ident->data.variable.num,
                     array, ident->data.variable.dims);
      if( 0 > pos) {
        scr->buf[0]=0;
        return FPLERR_ILLEGAL_ARRAY;
      }
    }
    if(ident->flags&FPL_INT_VARIABLE) {
      CALL(CmpExpr(val, scr, CON_NORMAL));
      CALL(CmpAssign(scr, val->val.val,
                     &ident->data.variable.var.val32[pos],
                     ident->flags, (uchar)type));
      val->val.val=ident->data.variable.var.val32[pos];
    }
    else {
      /*
       * String assigns
       */
      if(!multi &&
         PASS2_OPEN_BRACKET == code) {
        /* single character assign! */
        P_SHORT; /* pass open bracket */
        CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM));
        P_SHORT; /* pass close bracket */
        if(!ident->data.variable.var.str[ pos ] ||
           !ident->data.variable.var.str[ pos ] ->len)
          /* no-length-string */
          return FPLERR_STRING_INDEX;
        if(val->val.val >= ident->data.variable.var.str[ pos ]->len)
          /* force to zero! */
          val->val.val=0;
        valuep = (uchar *)&ident->data.variable.var.str[ pos ]->string[val->val.val];
        value = *(uchar *)valuep;
        CALL(CmpExpr(val, scr, CON_NORMAL));
        CALL(CmpAssign(scr, val->val.val, &value, FPL_CHAR_VARIABLE, (uchar)type));
        val->val.val= *valuep = (uchar)value; /* assign it for real! */
      }
      else {
        CALL( CmpExpr(val, scr, CON_STRING) );
        CALL( CmpStringExpr(val, scr) ); /* check for more */
	
        string = &ident->data.variable.var.str[pos];
        if((CHAR_PLUS != type) && val->flags&FPL_NOFREE) {
          /*
           * Only do this this is not an append action _and_
           * we can't free this string (== someone else is
           * taking care of this string!)
           */
          if(*string) {
            FREE_KIND(*string); /* free old string */
          }
          if(val->val.str) {
            /* duplicate string */
            STRFPLDUP((*string), val->val.str);
          }
          else
            *string=NULL;
        }
	else {
          CALL(StrAssign(val->val.str, scr, string,
                         (uchar)(CHAR_PLUS == type)) ); /* TRUE or FALSE if append */