script.c

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

/*

  These following actions don't have to be done!

    CALL(LeaveProgram(scr, scr->prog));
    CALL(GetProgram(scr, prog));
*/
  }

  if(!prog) {
    GETMEMA(prog, sizeof(struct Program));
    memset(prog, 0, sizeof(struct Program));
#ifdef DEBUG
    CheckMem(scr, prog);
#endif
    next=scr->programs;
    prog->next=next;
    prog->program=program;
    prog->lines=lines;
    prog->startprg=1;
    prog->virprg=1;
    prog->flags = (scr->flags&FPLDATA_REREAD_CHANGES?
                    PR_REREAD_CHANGES:0)|
                  (scr->flags&FPLDATA_FLUSH_NOT_IN_USE?
                    PR_FLUSH_NOT_IN_USE:0)|
		  (scr->flags&FPLDATA_KIDNAP_CACHED?
		    PR_KIDNAP_CACHED:0);
    if(program) {
      SetupCompiled(prog);
    }
    if(name) {
      STRDUPA(prog->name, name);
    }
    scr->programs=prog;
  }

  scr->prog=prog;
  *get=prog;
  return(FPL_OK);
}

/**********************************************************************
 *
 * DelProgram()
 *
 * Deletes a specifed program from memory. If NULL is specified where
 * the program struct is supposed, all programs are removed! (Amiga
 * version *have* to do that to UnLock() all files that might be locked
 * when using the FPLTAG_LOCKUSED!
 *
 *******/

ReturnCode REGARGS
DelProgram(struct Data *scr,
           struct Program *del)
{
  struct Program *prog=scr->programs, *prev=NULL;
  while(prog) { /* it must not be running! */
    if((!del || prog==del) && !prog->running) {
      if(prev)
	prev->next=prog->next;
      else
	scr->programs=prog->next;
      if(del && (scr->prog==del))
	scr->prog=scr->prog->next;
      prev=prog->next;
      if(prog->name)
	FREEA(prog->name);
      if(!(prog->flags&PR_USERSUPPLIED) && prog->program) {
        SwapMem(scr, prog->program, MALLOC_DYNAMIC);
        FREE(prog->program);
      }
      FREEA(prog);
      if(del)
        break;
      
      prog=prev;
      prev=NULL;

    }
    else {
      prev=prog;
      prog=prog->next;
    }
  }
  return(FPL_OK);
}

/**********************************************************************
 *
 * This program checks and autoruns .FPC files newer than the .FPL
 * that is about to run.
 */
 
ReturnCode FileCheck(struct Data *scr,
                     char **filename,
                     struct Program *prog)
{
#define SPACE_FOR_FPLC 0 /* strlen(COMPILE_COMMAND) */
                         /* bytes needed to add "fplc " */
  ReturnCode ret=FPL_OK;
  uchar *filebuffer;
  uchar *file;
  uchar ext;
  long timethis;
  long timethat;
  long len=strlen(*filename); /* length of file name */
  if(len >= 4) {
    if(!my_memicmp(UNCOMPILED_EXTENSION,
                   &(*filename)[len-strlen(UNCOMPILED_EXTENSION)],
                   strlen(UNCOMPILED_EXTENSION)+1)) {
      ext=1; /* it is a non-compiled extension */
    }
    else
      ext = 0;
    if(ext) {
      GETMEM(filebuffer, len+1+SPACE_FOR_FPLC);
      file = &filebuffer[SPACE_FOR_FPLC];

      timeoffile(timethis, prog->name); /* big macro */
      
      memcpy(file, *filename, len-strlen(COMPILED_EXTENSION));
      memcpy(&file[len-strlen(COMPILED_EXTENSION)],
             COMPILED_EXTENSION,
             strlen(COMPILED_EXTENSION)+1);

      timeoffile(timethat, file); /* big macro */

      if(timethis > timethat) {
        /* uncompiled is the newest, go with that! */
        FREE(filebuffer);
        return FPL_OK;
      }
      
      /* run the compiled file */
      prog->flags |= PR_SELECTED_FPC;
      *filename = filebuffer;
    }
  }
  return ret;
}

/**********************************************************************
 *
 * Run()
 *
 *****/

static ReturnCode REGARGS
Run(struct Data *scr,
    uchar *filename,
    uchar *program,
    long lines,
    unsigned long *tags)
{
  ReturnCode end;
  struct Expr *val;
  unsigned long *tag=tags;
  uchar storeglobals;	/* DEFAULT: fplInit() value! */
  struct Program *thisprog, *prog;
  struct Store *store;
  struct Local *glob;
  long currcol;
  long *globpointer=NULL;

  /* Store the 'soft' debugging information! */
  long prev_mode = scr->flags & (FPLDATA_DEBUG_MODE|FPLDATA_ISOLATE);

#ifdef DEBUG
  long memory=mem;
#endif

  if(!scr)
    /* misbehaviour */
    return(FPLERR_ILLEGAL_ANCHOR);

  if(scr->runs) {
    /* this is a nested call! */
    GETMEM(store, offsetof(struct Data, store_end)-
                  offsetof(struct Data, store_from));

    currcol=scr->text-(&scr->prog->program)[scr->prg-1];

    LeaveProgram(scr, scr->prog);
    memcpy(store, &scr->store_from, offsetof(struct Data, store_end)-
                                    offsetof(struct Data, store_from));
  } else {
    scr->msg = NULL;  /* We start with an empty message queue! */
    scr->varlevel =0; /* start at locale level 0 */
  }
  end = AddProgram(scr, &prog, program, lines, filename);

  if(NULL == prog && FPL_OK == end) {
    /*
     * This execution was simply prevented due to circumstances!
     */
  }
  else if(end <= FPL_EXIT_OK) {

    if(!prog->program && filename) {
      /*
       * It didn't already exist.
       */
      if(scr->flags & (FPLDATA_AUTORUN|FPLDATA_AUTOCOMPILE))
        FileCheck(scr, &filename, prog);
      end = ReadFile(scr, filename, prog); /* get file */
      prog->flags|=PR_NAME_IS_FILENAME;
      SetupCompiled(prog);
      if(prog->flags & PR_SELECTED_FPC) {
        FREE(filename);
      }
    }
    else if(!filename)
      prog->flags=PR_USERSUPPLIED;

    if(end <= FPL_EXIT_OK) {

      end=GetProgram(scr, prog); /* lock it for our use! */

      if(end <= FPL_EXIT_OK) {

        thisprog=scr->prog;
        if(scr->flags&FPLDATA_CACHEALLFILES) {
          thisprog->flags|=PR_CACHEFILE;
          if(scr->flags&FPLDATA_CACHEEXPORTS)
            thisprog->flags|=PR_CACHEEXPORTS;
        } else
          thisprog->flags&=~PR_CACHEFILE;

        thisprog->openings++;

        scr->prg=thisprog->startprg;     /* starting line number */
        scr->text=(&thisprog->program)[thisprog->startprg-1]+
          thisprog->startcol; /* execute point */


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

        scr->ret=FPL_OK;		/* return code reset */
        scr->virprg=thisprog->virprg;	/* starting at right virtual line */
        scr->virfile=thisprog->virfile;	/* starting at right virtual file */
        scr->level=0;			/* level counter */
        scr->strret=FALSE;		/* we don't want no string back! */
        scr->interpret=NULL;		/* no interpret tag as default */
        scr->locals=NULL;		/* local symbol list */
        scr->globals=NULL;		/* global symbol list */
        scr->FPLret=0;			/* initialize return code value */
        scr->string_return=NULL;	/* no string returns allowed */
        scr->msg = NULL;                /* no pending messages */

        while(tag && *tag) {
          switch(*tag++) {
          case FPLTAG_ISOLATE:
	    scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE, *tags);
	    break;

          case FPLTAG_DEBUG:
	    scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE, *tags);
	    break;

          case FPLTAG_REREAD_CHANGES:
	    thisprog->flags = BitToggle(thisprog->flags,
					PR_REREAD_CHANGES, *tags);
            break;

          case FPLTAG_FLUSH_NOT_IN_USE:
	    thisprog->flags = BitToggle(thisprog->flags,
					PR_FLUSH_NOT_IN_USE, *tags);
            break;

          case FPLTAG_KIDNAP_CACHED:
	    thisprog->flags = BitToggle(thisprog->flags,
					PR_KIDNAP_CACHED, *tags);
            break;

          case FPLTAG_STRING_RETURN:
            scr->string_return = (uchar **)*tag;
            scr->strret=TRUE; /* enable return string */
            break;

          case FPLTAG_INTERPRET:
            scr->interpret=(uchar *)*tag;
            break;

          case FPLTAG_STARTPOINT:
            scr->text=(uchar *)*tag;
            break;
          case FPLTAG_STARTLINE:
            scr->prg=(long)*tag;
            break;
          case FPLTAG_USERDATA:
            scr->userdata=(void *)*tag;
            break;
          case FPLTAG_CACHEFILE:
            if(*tag) {
              thisprog->flags|=PR_CACHEFILE;
              if(*tag=FPLCACHE_EXPORTS)
                thisprog->flags|=PR_CACHEEXPORTS;
            } else
              thisprog->flags&=~PR_CACHEFILE;
            break;
          case FPLTAG_PROGNAME:
	    if(*tag) {
              prog=scr->programs;
              while(prog) {
                if(prog->name && !strcmp(prog->name, (uchar *)*tag))
                  break;
                prog=prog->next;
              }
              if(!prog) {
                /*
                 * The program was not found, then set/rename the
                 * current program to this name!
                 */
                if(thisprog->name) {
                  FREEA(thisprog->name);
                }
                STRDUPA(thisprog->name, *tag);
              } else {
                /*
                 * We found another progam with that name. Execute that
                 * instead of this!
                 */
                DelProgram(scr, thisprog);
                thisprog=prog;
              }
	    }
            break;
          case FPLTAG_FILENAMEGET:
	    thisprog->flags = BitToggle(thisprog->flags,
					PR_FILENAMEFLUSH, *tags);
            break;
          case FPLTAG_ISCACHED:
            globpointer = (long *)*tag;
            break;
          }
          tag++;
        }

        if(!thisprog->name) {
          /* If no name has been given, do not store any global symbols from it! */
          STRDUPA(thisprog->name, FPLTEXT_UNKNOWN_PROGRAM);
          storeglobals=FALSE;
          thisprog->flags&=~(PR_CACHEFILE|PR_CACHEEXPORTS);
        } else
          storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS);

        scr->virfile=thisprog->name; /* starting with this file */
        val= MALLOC(sizeof(struct Expr));
        if(val) {
          memset(val, 0, sizeof(struct Expr)); /* initial clear */
          end=Go(scr, val);
          if(end<=FPL_EXIT_OK &&
             scr->string_return) {
            /*
             * No error and
             * we accept string returns and...
             */
            if((val->flags&(FPL_STRING|FPL_RETURN)) ==
               (FPL_STRING|FPL_RETURN) &&
               val->val.str) {
              /*
               * ...there was a final "return" or "exit" keyword.
               * and we have a returned string to deal with.
               */
  
              /* assign the pointer */
              *scr->string_return = val->val.str->string;
  
              /* make it a "static" allocation */
              SwapMem(scr, val->val.str, MALLOC_STATIC);
            }
            else {
              /*
               * If not, reset the pointer to NULL!
               */
              *scr->string_return = NULL;
            }
          }
          FREE(val);
        } else
          end=FPLERR_OUT_OF_MEMORY;

        if(end>FPL_EXIT_OK) {
          struct fplArgument pass={
            NULL, FPL_GENERAL_ERROR, NULL, 0};
          void *array[1];
          pass.key=(void *)scr;
          array[0] = (void *)end;
          pass.argv= array;

          thisprog = scr->prog;
          
          if(thisprog->flags&PR_COMPILED)
            scr->buf[0]=0; /* no damned identifier */
            
          if(scr->error) {
	    /* We'll fix the error string! */
	    GetErrorMsg(scr, end, scr->error);
	  }

          /* new argv assigning for OS/2 compliance! */