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 43 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>

#else
#include <sys/types.h>
#include <sys/stat.h>
#ifdef SUNOS
#include <varargs.h>
#else
#include <stdarg.h>
#endif
#endif

#include <stdlib.h> /* for the system() call i.e */
#include <stddef.h> /* for offsetof() */
#include <stdio.h>
#include <string.h>
#include "script.h"
#include "debug.h"
#include "compile.h"

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

static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
				    uchar *, long, uchar *);
static uchar REGARGS CheckIt(struct Data *, struct Expr *, short, ReturnCode *);
static ReturnCode INLINE Declare(struct Expr *, struct Data *,
				 struct Identifier *, long);
static ReturnCode Go(struct Data *, struct Expr *val);
static ReturnCode REGARGS Loop(struct Data *, struct Condition *, short, uchar *);
static ReturnCode INLINE Resize(struct Data *, struct Expr *, short);
static ReturnCode REGARGS SkipStatement(struct Data *);
static ReturnCode REGARGS StoreGlobals(struct Data *, uchar);
static ReturnCode REGARGS Run(struct Data *, uchar *, uchar *, long, unsigned long *);
static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
                                struct Condition *);
static REGARGS void StoreBeginning(struct Data *, char *, long);
/*
 * 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 	        */
};

unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
unsigned long strtags[]={FPLSEND_STRING, 0,
                         FPLSEND_STRLEN, 0,
                         FPLSEND_DONTCOPY_STRING, TRUE,
                         FPLSEND_DONE};

#ifndef AMIGA /* if not using SAS/C on Amiga */

/******************************************************/
/* Parameter list frontends of the library functions: */
/******************************************************/

#ifdef VARARG_FUNCTIONS
long fplExecuteFileTags(void *anchor, uchar *program, ...)
{
  va_list tags;
  long ret;
#ifdef SUNOS
  va_start(tags); /* get parameter list */
#else
  va_start(tags, program); /* get parameter list */
#endif
  ret = fplExecuteFile(anchor, program, (unsigned long *)tags);
  va_end(tags);
  return ret;
}
#else /* VARARG_FUNCTIONS */
long PREFIX fplExecuteFileTags(void *anchor, uchar *program, unsigned long tags, ...)
{
  return(fplExecuteFile(anchor, program, (unsigned long *)&tags));
}
#endif

#endif

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

ReturnCode PREFIX fplExecuteFile(AREG(0) struct Data *scr,
				 AREG(1) uchar *filename,
				 AREG(2) unsigned long *tags)
{
#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteFile");
#endif
  return(Run(scr, filename, NULL, 1, tags));
}


#ifndef AMIGA /* if not using SAS/C on Amiga */

#ifdef VARARG_FUNCTIONS
long fplExecuteScriptTags(void *anchor, uchar **program, long lines, ...)
{
  va_list tags;
  long ret;
#ifdef SUNOS
  va_start(tags); /* get parameter list */
#else
  va_start(tags, lines); /* get parameter list */
#endif
  ret = fplExecuteScript(anchor, program, lines, (unsigned long *)tags);
  va_end(tags);
  return ret;
}
#else /* VARARG_FUNCTIONS */

long PREFIX fplExecuteScriptTags(void *anchor, uchar **program, long lines,
                                 unsigned long tags, ...)
{
  return(fplExecuteScript(anchor, program, lines, (unsigned long *)&tags));
}
#endif

#endif

/**********************************************************************
 *
 * fplExecuteScript()
 *
 * Frontend to Run().
 *
 * The error code is returned to daddy...
 *
 ******/

ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
				   AREG(1) uchar **program, /* program array */
				   DREG(1) long lines, 	/* number of lines */
				   AREG(2) unsigned long *tags)
{
#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteScript");
#endif
  return(Run(scr, NULL, *program, lines, tags));
}


/**************************************************************************
 *
 * 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,
         struct Program *prog)
{
  struct Data *scr=(struct Data *)fpl;
#ifdef AMIGA  /* Amiga version. */
  struct FileInfoBlock fileinfo;
  struct FileLock *lock=NULL;
  struct FileHandle *fileread;

  struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  struct Library *DOSBase = lib->ml_DosBase;
#else
  FILE *stream;
  struct stat statstr;
#endif
  ReturnCode ret=FPL_OK;
#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!
       */
      prog->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 {
      prog->size=ftell(stream)+1;
      fseek(stream, 0, 0);
    }
  }
#endif

#ifdef AMIGA
  prog->date = GETFILEDATE(fileinfo);
#else
  if(!stat(filename, &statstr)) {
    prog->date = statstr.st_mtime;
  } else
    ret=FPLERR_OPEN_ERROR;
#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);
#elif defined(UNIX) || defined(WIN32)
  /* file is already opened! */
#endif
  prog->program=(uchar *)MALLOC(prog->size); /* Allocate memory for program. */
  if(!prog->program) /* if we didn't get the requested memory: */
    ret=FPLERR_OUT_OF_MEMORY;
#ifdef AMIGA
  else if(Read((BPTR)fileread, prog->program, (LONG)prog->size)<0) /* get entire file */
#elif defined(UNIX) || defined(WIN32)
  else if(!fread(prog->program, 1, prog->size, stream))
#endif
    /* if we couldn't Read() the file: */
    ret=FPLERR_OPEN_ERROR;
  else
    (prog->program)[prog->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 && prog->program) {
    FREE(prog->program); /* free the, for the program allocated, memory */
  }
  return(ret); /* get back to parent */
}

/**********************************************************************
 *
 * AddProgram();
 *
 * Adds a program to FPL's internal lists of program files.
 *
 ****/

static ReturnCode INLINE AddProgram(struct Data *scr,
				    struct Program **get,
				    uchar *program,
				    long lines,
				    uchar *name)
{
  struct Program *next, *prog=NULL;
  ReturnCode ret;
  long date=-1;
  if(name && name[0]) {
    /*
     * Name was given. Search through the internals to see if
     * we have this file cached already!
     */
    prog=scr->programs;
    while(prog) {
      if(prog->name && !strcmp(prog->name, name))
	break;
      prog=prog->next;
    }
  }
  if(prog) {

    /*
     * The program already exists.
     */
    if( (prog->flags & PR_REREAD_CHANGES) &&
        (prog->flags & PR_NAME_IS_FILENAME) &&
        !(prog->flags&PR_USERSUPPLIED) ) {

      timeoffile(date, name); /* big macro */

      /* Compare dates of internal program and actual file */
      if(date != prog->date) {
        /*
         * The dates are different, flush all info that has to do with the
         * file, and re-read it into memory!
         */
        unsigned long tags[]={FPLSEND_FREEFILE, 0, FPLSEND_DONE};
        tags[1] = (unsigned long)name;
        CALL(Send(scr, tags));
        prog=NULL; /* force a insertion of this file again! */
      }
    }

    /*
     * The very same good old program. If the FPLTAG_PREVENT_RUNNING_SAME
     * was used, then abort here and now!
     */
    if(prog && scr->flags&FPLDATA_PREVENT_RUNNING_SAME) {
      *get = NULL;
      return FPL_OK;
    }