script.c

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

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

 script.c

 The main routine of the language. Handles all keywords, {'s and }'s.

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

/************************************************************************
 *                                                                      *
 * fpl.library - A shared library interpreting script langauge.         *
 * Copyright (C) 1992-1997 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 67 Solna                                                       *
 * Sweden                                                               *
 *                                                                      *
 * FidoNet 2:201/328    email:[e-mail]                       *
 *                                                                      *
 ************************************************************************/

#ifdef AMIGA
#include <exec/types.h>
#include <proto/exec.h>
#include <libraries/dos.h>
#include <proto/dos.h>

#include <exec/libraries.h>
#include <dos.h>

#elif defined(UNIX) || defined(WIN32)
#include <sys/types.h>
#include <sys/stat.h>
#include <stdlib.h>
#endif

#include <stdio.h>
#include <string.h>
#include "script.h"

#ifdef DEBUG
long mem=0;
long maxmem=0;
#endif

static ReturnCode INLINE Declare(struct Expr *, struct Data *,
				 struct Identifier *, long);
static ReturnCode REGARGS Loop(struct Data *, short, uchar *);
static ReturnCode INLINE Resize(struct Data *, struct Expr *, short);
static ReturnCode INLINE Switch(struct Data *, struct Expr *, short);
/*
 * Global character flags:
 */

const uchar type[257] = { /* Character type codes */
   _C, /* -1 == regular ANSI C eof character */
   _C,    _C,	  _C,	 _C,    _C,    _C,    _C,    _C, /* 00		*/
   _C,    _S,	  _S,	 _C,    _C,    _S,    _C,    _C, /* 08		*/
   _C,    _C,	  _C,	 _C,    _C,    _C,    _C,    _C, /* 10		*/
   _C,    _C,	  _C,	 _C,    _C,    _C,    _C,    _C, /* 18		*/
   _S,    _P,     _P,	 _P,    _P,    _P,    _P,    _P, /* 20	!"#$%&' */
   _P,    _P,     _P,    _P,    _P,    _P,    _P,    _P, /* 28 ()*+,-./ */
 _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, /* 30 01234567 */
 _N|_X, _N|_X,    _P,    _P,    _P,    _P,    _P,    _P, /* 38 89:;<=>? */
   _P, _U|_X,  _U|_X, _U|_X, _U|_X, _U|_X, _U|_X,    _U, /* 40 @ABCDEFG */
   _U,    _U,	  _U,	 _U,    _U,    _U,    _U,    _U, /* 48 HIJKLMNO */
   _U,    _U,	  _U,	 _U,    _U,    _U,    _U,    _U, /* 50 PQRSTUVW */
   _U,    _U,	  _U,	 _P,    _P,    _P,    _P, _P|_W, /* 58 XYZ[\]^_ */
   _P, _L|_X,  _L|_X, _L|_X, _L|_X, _L|_X, _L|_X,    _L, /* 60 `abcdefg */
   _L,    _L,	  _L,	 _L,    _L,    _L,    _L,    _L, /* 68 hijklmno */
   _L,    _L,	  _L,	 _L,    _L,    _L,    _L,    _L, /* 70 pqrstuvw */
   _L,    _L,	  _L,	 _P,    _P,    _P,    _P,   000, /* 78 xyz{|}~	*/
  000,   000,	 000,	000,   000,   000,   000,   000, /* 80 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* 88 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* 90 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* 98 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* A0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* A8 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* B0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* B8 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* C0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* C8 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* D0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* D8 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* E0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* E8 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* F0 	        */
  000,   000,	 000,	000,   000,   000,   000,   000, /* F8 	        */
};

/**************************************************************************
 *
 * ReadFile()
 *
 *   Reads the specified file into memory, stores the pointer to the memory
 * area in the pointer `program' points to, and the size of the memory area
 * in the integer `size' points to. I decided to use a different way on Amiga
 * to increase performance a lot.
 *
 *   This function first checks the size of the file it's about to fetch
 * and then reads the entire file at once in one continuos memory area.
 *
 *   Returns the proper return code. If anything goes wrong, there won't be
 * *ANY* program to look at (the pointer will be NULL, but the size will most
 * probably still be correct which means a non-zero value). If this function
 * fails it takes care of freeing the program memory by itself. You only have
 * to free that memory if this functions reports success.
 *
 ********/

ReturnCode REGARGS
ReadFile(void *fpl,
         uchar *filename)
{
  ReturnCode ret=FPL_OK;
#if 1
  struct Data *scr=(struct Data *)fpl;
#ifdef AMIGA  /* Amiga version. */
  struct FileInfoBlock fileinfo;
  struct FileLock *lock=NULL;
  struct FileHandle *fileread;

#elif defined(UNIX) || defined(WIN32)
  FILE *stream;
#endif
#ifdef AMIGA

  if(filename && filename[0])
    /* Lock on file */
    lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ);
  if (lock) {
    if (Examine((BPTR)lock, &fileinfo) && fileinfo.fib_Size) {
      /*
       * Only do this if the file was there, and it was larger than zero
       * bytes!
       */
      scr->size = fileinfo.fib_Size+1; /* Add one for a terminating zero! */
    } else
      ret=FPLERR_OPEN_ERROR;	/* something went wrong */
    UnLock((BPTR)lock);	/* release the lock of the file */
  } else
    ret=FPLERR_OPEN_ERROR;		/* we couldn't lock on the file */
#elif defined(UNIX) || defined(WIN32)
  if (!(stream = fopen(filename, "r")))
    ret=FPLERR_OPEN_ERROR;
  else {
    if(fseek(stream, 0, 2)) {
      fclose(stream);
      ret=FPLERR_OPEN_ERROR;
    } else {
      scr->size=ftell(stream)+1;
      fseek(stream, 0, 0);
    }
  }
#endif

  if(ret)
    return(ret);

  /* Open file for reading. */
#ifdef AMIGA
  /* We could use OpenFromLock() here, but it's a V36+ function! */
  fileread=(struct FileHandle *)Open((UBYTE *)filename, MODE_OLDFILE);
#endif
  scr->program=(uchar *)MALLOC(scr->size); /* Allocate memory for program. */
  if(!scr->program) /* if we didn't get the requested memory: */
    ret=FPLERR_OUT_OF_MEMORY;
#ifdef AMIGA
  else if(Read((BPTR)fileread, scr->program, (LONG)scr->size)<0) /* get entire file */
#elif defined(UNIX) || defined(WIN32)
  else if(!fread(scr->program, 1, scr->size, stream))
#endif
    /* if we couldn't Read() the file: */
    ret=FPLERR_OPEN_ERROR;
  else
    scr->program[scr->size-1]='\0'; /* add the terminating zero byte. */
#ifdef AMIGA
  Close((BPTR)fileread); /* close file */
#elif defined(UNIX) || defined(WIN32)
  fclose(stream); /* close the stream */
#endif
  /* only if error and we could allocate the proper memory */
  if(ret && scr->program) {
    FREE(scr->program); /* free the, for the program allocated, memory */
  }
#else
  scr->mainbuf[0]=0; /* zero terminate the buffer */
  scr->fileread = fopen(filename, "r");
  if(!scr->fileread)
    ret=FPLERR_OPEN_ERROR;;
#endif
  return ret; /* get back to parent */
}

/***************************************************************************
 *
 * fplExecuteFile()
 *
 * Executes the specified file as an FPL program.
 *
 ******/

ReturnCode REGARGS fplExecuteFile(struct Data *scr,
				  uchar *filename)
{
  ReturnCode end, ret;
  struct Expr *val;

  scr->varlevel =0; /* start at locale level 0 */

  STRDUP(scr->virfile, filename); /* allocate this */
  scr->filename = filename; /* original and startup name */

  end = ReadFile(scr, filename); /* get file */
  if(end>FPL_EXIT_OK) {
    scr->virfile = filename;
    scr->text=NULL;
    scr->virprg = 0;
    INFO(scr, CERROR_FILE_NOT_FOUND, filename);
    return FPLERR_OPEN_ERROR;
  }

  scr->prg=1;
  scr->text=scr->program;

  /* fprintf(stderr, "Exp:%s", scr->text); */

  scr->ret=FPL_OK;                /* return code reset */
  scr->virprg=1;
  scr->level=0;                   /* level counter */
  scr->strret=FALSE;              /* we don't want no string back! */
  scr->locals=NULL;               /* local symbol list */
  scr->globals=NULL;              /* global symbol list */
  scr->FPLret=0;                  /* initialize return code value */

  val= MALLOC(sizeof(struct Expr));
  if(val) {
    CALL(Eat(scr));
    CALL(HashScan(scr));
    end=Script(scr, val,
               SCR_FUNCTION| /* return on return() */
               SCR_FILE|     /* this level may end with '\0' */
               SCR_GLOBAL);  /* global symbol declarations enabled */
    FREE(val);
  } else
    end=FPLERR_OUT_OF_MEMORY;

  if(end>FPL_EXIT_OK) {
    if(!scr->newerror) {
      char buffer[FPL_ERRORMSG_LENGTH];
      /* We'll fix the error string! */
      GetErrorMsg(scr, end, buffer);
  
      printf("*** BEEP! Report this occurence to the authors!!\n"
             "OLD STYLE ERROR MESSAGE:\n"
             "%s!\n"
             "Line %d in file %s!\n",
             buffer, scr->virprg, scr->virfile);
    }
  }
  else {
    if(scr->cmdline[LINE_VERBOSE]) {
      fprintf(stderr,
              " === Symbols used: ===\n"
              "Max concurrent amount: %d\n"
              "Total amount in file: %d\n",
              scr->maxvariables, scr->totalvariables);
    }
  }

  /*
   * Go through the ENTIRE locals list and delete all. Otherwise they will
   * ruin the symbol table.
   */

  while(scr->locals)
    DelLocalVar(scr, &scr->locals);

 /*
  * We must delete the global symbol lists
  * properly and not just free the memory. Otherwise we might free memory
  * used in the middle of the list we intend to save for next run!
  */
  while(scr->globals)
    /* There is some global symbols to delete! */
    DelLocalVar(scr, &scr->globals);

  /*
   * Check if this program was stored in memory earlier (in
   * another run). If not ...
   */
  FREE(scr->program);
  FREE(scr->virfile);

  return(end==FPL_EXIT_OK?FPL_OK:end);
}

/**************************************************************************
 *
 * int Script(struct Data *);
 *
 * Interprets an FPL program, very recursive. Returns progress in an integer,
 * and the FPL program result code in the int scr->ret.
 * USE AS FEW VARIABLES AS POSSIBLE to spare stack usage!
 *
 **********/

ReturnCode ASM
Script(AREG(2) struct Data *scr,  /* big FPL structure */
       AREG(3) struct Expr *val,  /* result structure  */
       DREG(2) short control)     /* control byte */
{
  /* declaration allowed? */
  uchar declare=control&(SCR_BRACE|SCR_FUNCTION)?1:0;
  ReturnCode ret; /* return value variable */
  uchar brace=0; /* general TRUE/FALSE variable */
  uchar *text; /* position storage variable */
  long prg;   /* position storage variable */
  long levels=scr->level; /* previous level spectra */
  struct Identifier *ident; /* used when checking keywords */
  uchar done=FALSE; /* TRUE when MAIN_END has been output */

  uchar aborted=FALSE;  /* set true if the statement is returned,  broken
			   or continued */
  uchar mainstart=FALSE;
			   
#define ABORT_RETURN (1<<0)
#define ABORT_BREAK  (1<<1)
#define ABORT_CONT   (1<<2)

  if(control&(SCR_BRACE|SCR_FUNCTION)) {
    /*
     * New symbol declaration level!
     */
    scr->varlevel++;
    CALL(AddLevel(scr));
  }

  if(control&SCR_FUNCTION)
    scr->level=0; /* number of levels to look for variables */
  else if(control&SCR_BRACE)
    scr->level++;

  do {
    if(ret=Eat(scr)) {
      if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
	/* It's OK! */
	ret=FPL_OK;
      break;
    }

    /*
     * Time to parse the statement!
     */

    text=scr->text;                /* store current position */
    prg=scr->prg;
    if(!Getword(scr)) {    /* get next word */
      GetIdentifier(scr, scr->buf, &ident);
    }
    else {
      prg=-1;    /* we have not read a word! */
      ident=NULL;
    }

    if(declare && (!ident || !(ident->flags&FPL_KEYWORD_DECLARE))) {
      declare=FALSE;
      if(control&SCR_GLOBAL) {
        /* still on ground level and declaration allowed */
        CALL(Put(scr, COMP_MAIN_START));
        mainstart=TRUE;
      }
      else {