script.c

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

          InterfaceCallNoStack(scr, &pass, scr->function);
        }

        thisprog->column=scr->text-(&thisprog->program)[scr->prg-1]+1;
        scr->virfile=NULL; /* most likely to not point to anything decent
                              anyway! */

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

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

        thisprog->openings--;
        LeaveProgram(scr, thisprog); /* failure is a victory anyway! */

        /*
         * If the option to cache only programs exporting symbols is turned on,
         * then we must check if any of the globals are exported before caching!
         */

        if(end<=FPL_EXIT_OK && (storeglobals & PR_CACHEEXPORTS)) {
          glob = scr->globals;

          while(glob) {
            /* Traverse all global symbols */

            if(glob->ident->flags&FPL_EXPORT_SYMBOL)
              /* if we found an exported symbol, get out of loop */
              break;

            glob=glob->next; /* goto next global */
          }

          if(!glob)
            /* no exported symbols were found! */
            storeglobals = FALSE; /* do not cache this file! */
        }

        if(end<=FPL_EXIT_OK && storeglobals && thisprog->flags&PR_CACHEFILE) {
         /* no error, store the globals and cache the file */

          if(!(thisprog->flags&PR_GLOBALSTORED)) {

            if(scr->globals) {
	      long total_size;
	      long line=1;
	      uchar *newprogram;
              
              if(!(thisprog->flags&PR_USERSUPPLIED))
                /*
                 * The memory is allocated by FPL itself!
                 */
                SwapMem(scr, thisprog->program, MALLOC_STATIC);
              else {
                /*
                 * The memory is allocated by the user!
                 */
                if(thisprog->flags&PR_KIDNAP_CACHED) {
                  /*
                   * We have been instructed to "take over" all host
                   * allocations that we intend to keep as cached files!
                   */

                  /* start with counting the total size of the program: */
                  for(line = total_size = 0; line<thisprog->lines; line++)
                    total_size += strlen( (&thisprog->program)[line] );

                  /* get enough memory to duplicate it! */
                  newprogram = MALLOCA(total_size + 1 ); /* add for zero */
                  if(newprogram) {
                    /*
                     * We got requested amount of memory to copy the entire
                     * user supplied program!
                     */
                    for(line = total_size = 0; line<thisprog->lines; line++) {
                      strcpy(newprogram+total_size,
                             (&thisprog->program)[line]);
                      total_size += strlen( (&thisprog->program)[line] );
                    }
                    thisprog->program = newprogram;
                    newprogram[total_size] = CHAR_ASCII_ZERO;
                    
                    thisprog->lines = 1; /* this is now in one single line! */

                    /* switch off the now incorrect bit: */
                    thisprog->flags &= ~PR_USERSUPPLIED;
                  }
                  else {
                    /* We couldn't allocate a copy of the program, fail */
                    line=0;
                    end = FPLERR_OUT_OF_MEMORY; /* fail with proper return
                                                   code! */
                  }
                }
              }
	      if(line) {
                /* Store all global symbols!!! */
                StoreGlobals(scr, MALLOC_STATIC); /* ignore return code */

	        /* set the flag saying we did so! */
                thisprog->flags|=PR_GLOBALSTORED;
	      }
            } else
              DelProgram(scr, thisprog); /* this also removes the Lock() */
          }
        } else {
          /*
           * 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!
           */
          if(!thisprog->openings) {
            /* If not in use */
            if(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 ...
             */
            if(!(thisprog->flags&PR_GLOBALSTORED)) {
              /*
               * ...delete this program from memory!
               */
              DelProgram(scr, thisprog); /* this also removes the Lock() */
            }
          }
        }

        if(globpointer)
          *globpointer=(long)scr->globals;

        scr->runs--;
      } /* else
          We didn't get the program, out of memory or stupid interface
          function reply!
         */
    } else
      DelProgram(scr, prog); /* we couldn't load it! */
  }

  /*
   * Reset the debug mode status we had when we entered this function!
   */
  scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE,
                         prev_mode&FPLDATA_DEBUG_MODE);
  /*
   * Reset the isolate status we had when we entered this function!
   */
  scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE,
                         prev_mode&FPLDATA_ISOLATE);

  if(scr->runs) {
    /* still running! */

    memcpy(&scr->store_from, store, offsetof(struct Data, store_end)-
                                    offsetof(struct Data, store_from));
    GetProgram(scr, scr->prog);
    FREE(store);

    /* reset execute point: */
    scr->text=(&scr->prog->program)[scr->prg-1]+ currcol;
  }
  else {
    FREEALL(); /* frees all ALLOC_DYNAMIC */
  }

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

/**********************************************************************
 *
 * Go();
 *
 * This is an own function to make the stack usage in this particular
 * function very small. Then we don't have to copy more than 10-20 bytes
 * of the old stack when swapping to the new in the amiga version of the
 * library!
 *
 ******/

static ReturnCode Go(struct Data *scr, struct Expr *val)
{
#if defined(AMIGA) && defined(SHARED)
  /* The function call below is an assembler routine that allocates a new
     stack to use in the library! */
#define FIRSTFUNC InitStack
#else
  /* Not Amiga or not shared! */
#define FIRSTFUNC Script
#endif

  scr->runs++;
  return FIRSTFUNC(scr, val,
                   SCR_BRACE|    /* to make it loop and enable declarations */
                   SCR_FUNCTION| /* return on return() */
                   SCR_FILE|     /* this level may end with '\0' */
                   SCR_GLOBAL,   /* global symbol declarations enabled */
                   NULL);
}


static ReturnCode REGARGS
StoreGlobals(struct Data *scr,
             uchar type)
{
  struct Local *local, *prev=NULL;
  struct Identifier *ident;
  struct fplVariable *var;

  if(scr->prog->running>1)
    /*
     * It's enough if we commit this only on the ground level exit!
     */
    return(FPL_OK);

  local=scr->globals;
  while(local) {
    ident=local->ident;
    if(ident->flags&FPL_VARIABLE) {
      SwapMem(scr, local, type);		/* preserve the chain! */
      SwapMem(scr, ident, type);		/* structure */

      if(!(ident->flags&FPL_COMPILER_ADDED))
        SwapMem(scr, ident->name, type);	/* name */

      var=&ident->data.variable;

      SwapMem(scr, var->var.val32, type); /* variable area */

      if(!var->num && ident->flags&FPL_STRING_VARIABLE && var->var.str[0])
	/* no array but assigned string variable */
	SwapMem(scr, var->var.str[0], type);	/* string */
      else if(var->num) {
	/* array */
	SwapMem(scr, var->dims, type); /* dim info */
	if(ident->flags&FPL_STRING_VARIABLE) {
	  int i;
	  for(i=0; i<var->size; i++) {
	    /* Take one pointer at a time */
	    if(var->var.str[i])
	      /* if the value is non-zero, it contains the allocated length
		 of the corresponding char pointer in the ->array->vars
		 array! */
	      SwapMem(scr, var->var.str[i], type);
          }
	  SwapMem(scr, var->var.str, type);
	}
      }
    } else if(ident->flags&FPL_FUNCTION) {
      SwapMem(scr, local, type);		/* preserve the chain! */
      SwapMem(scr, ident, type);		/* structure */
      if(!(ident->flags&FPL_COMPILER_ADDED)) {
        SwapMem(scr, ident->name, type);		/* name */
        SwapMem(scr, ident->data.inside.format, type);	/* parameter string */
      }
    }
    prev=local;
    local=local->next;
  }
  if(prev) {
    prev->next=scr->usersym; /* link in front of our previous list! */
    scr->usersym=scr->globals;
  }
  scr->globals=NULL;
  return(FPL_OK);
}

/**************************************************************************
 *
 * 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 */
       AREG(1) struct Condition *con)
{
  uchar declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  ReturnCode ret;		   /* return value variable */
  struct Condition *con2;      /* recursive check information! */
  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 */
  long virprg=scr->virprg;
  uchar *virfile=scr->virfile;
  uchar done=FALSE; /* TRUE when exiting */
  struct fplArgument *pass;

#if defined(AMIGA) && defined(SHARED)
  if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
    if(ret==1)
      return(FPLERR_OUT_OF_MEMORY);
    else
      return(FPLERR_OUT_OF_STACK);
  }
#endif

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

    if((control&(SCR_BRACE|SCR_FUNCTION|SCR_FILE|SCR_GLOBAL)) ==
               (SCR_BRACE|SCR_FUNCTION|SCR_FILE|SCR_GLOBAL)) {
      /* first line in the script/file */
      Eat(scr);
      if(!strncmp("#!", scr->text, 2)) {
        /* unix-style shell type line found, skip it */
        while(*++scr->text && (CHAR_NEWLINE!=scr->text[0]));
      }
    }

  }

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

  if(scr->flags&FPLDATA_DEBUG_MODE) {
    /*
     * If debug mode is on already here, it means that our previous level
     * had it and we must make sure that they will even when we return.
     * (Without that bit, CleanUp() will switch off debug mode!)
     */
    control|=SCR_DEBUG;
  }

  if(scr->prog->flags&PR_COMPILED) {
    /*
     * Halleluja! This is a compiled mega-mighty-cool FPL program designed
     * for maximum interpreting speed.
     */
     
    /* THE FOLLOWING LINE IS TEMPORARY ADDED HERE: */
    scr->globalinfo = &scr->prog->globalinfo;
     
    brace = FALSE; /* set to false from start, set it back after usage!	*/
    
    while(!done) {
      Pass2 code; /* compiled instruction */

      if(scr->interfunc) {
        /* call the interval function */
        if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  	  return FPLERR_PROGRAM_STOPPED;
      }
      code = GETSHORT;

      P_SHORT; /* pass the instruction */

      switch(code) {
        /* These codes are defined in pass2.h */
        case PASS2_LINE_NUMBER:
          scr->virprg = GETLONG;
          P_LONG;
          break;
          
        case PASS2_BREAK_EXPR:
          CALL(CmpBreak(scr, val));
          break;
          
        case PASS2_SWITCH:
          CALL(CmpSwitch(scr, val));
          break;
          
        case PASS2_END_OF_EXPR:
          break;

        case PASS2_DECLARE:
          CALL(CmpDeclare(scr));
          break;

        case PASS2_EXPORT_FUNCTION:
          CALL(CmpExport(scr));
          break;

        case PASS2_ASSIGN_ARGUMENT: /* [var number] [argument number] */
          CALL(AssignArg(scr));
          break;
          
        case PASS2_LABEL_GOTO: /* OFFSET to set the program pointer to */
          scr->text = &scr->prog->program[ scr->prog->index + GETLONG ];
          break;

        case PASS2_IFNOT_BRANCH:       /* OFFSET follows */
          brace = TRUE;