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]                       *
 *                                                                      *
 ************************************************************************/

#ifdef COMPILE
 
#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 *);

/************************************************************************
 *
 * 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 || strncmp(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(strcmp(progpnt, COMPILED_HUNK_CODE)) {
      /*
       * As long as we haven't found the 'CODE' hunk, skip the unknown ones.
       */
      progpnt += COMPILED_HUNKNAME_LEN;
      progpnt += *(long *)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;
  
  *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_INT_VARIABLE)
    pident->data.inside.ret = FPL_INTARG;
  else
    pident->data.inside.ret = FPL_STRARG;

  /*
   * 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->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 = *(long *)(scr->text+sizeof(long));

  if(!(flags&FPL_EXPORT_SYMBOL)) {
    amount  = *(long *)(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;

  if(PASS2_STRING_APPEND == GETSHORT) {

    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);

    } while(PASS2_STRING_APPEND == GETSHORT);
      
    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++ ]