/******************************************************************************
 *			  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-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:dast@sth.frontec.se                       *
 *                                                                      *
 ************************************************************************/

#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)
#include <sys/types.h>
#include <sys/stat.h>
#include <stdlib.h>
#endif

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

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

static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
				    char *, long, char *);
static char 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, char *);
static ReturnCode INLINE Resize(struct Data *, struct Expr *, char);
static ReturnCode REGARGS SkipStatement(struct Data *);
static ReturnCode REGARGS StoreGlobals(struct Data *, char);
static ReturnCode REGARGS Run(struct Data *, char *, char *, long, unsigned long *);
static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
                                struct Condition *);
/*
 * Global character flags:
 */

const char unsigned 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 	        */
};


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

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

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

ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
				   AREG(1) char **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,
         char *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;
#elif defined(UNIX)
  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 */
    if(!(scr->flags&FPLDATA_LOCKUSED)) {
      UnLock((BPTR)lock);	/* release the lock of the file */
      prog->lock=NULL;		/* no lock */
    } else
      prog->lock=(void *)lock;	/* store lock! */
  } else
    ret=FPLERR_OPEN_ERROR;		/* we couldn't lock on the file */
#elif defined(UNIX)
  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)
  /* file is already opened! */
#endif
  prog->program=(char *)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)
  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)
  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,
				    char *program,
				    long lines,
				    char *name)
{
  struct Program *next, *prog=NULL;
  ReturnCode ret;
  long date=-1;
#ifdef AMIGA
  struct FileLock *lock;
  struct FileInfoBlock fileinfo;
  struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  struct Library *DOSBase = lib->ml_DosBase;
#else
  struct stat statstr;
#endif
  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(!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) ) {
#ifdef AMIGA
      if (lock=(struct FileLock *)Lock((UBYTE *)prog->name, ACCESS_READ)) {
        if (Examine((BPTR)lock, &fileinfo))
          date = GETFILEDATE(fileinfo);
        UnLock((BPTR)lock);
      }
#else
      if(!stat(prog->name, &statstr)) {
	date = statstr.st_mtime;
      }
#endif
      /* 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, NULL, FPLSEND_DONE};
        tags[1] = (unsigned long)prog->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;
    }

/*

  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(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(scr->prog==del)
	scr->prog=scr->prog->next;
#ifdef AMIGA
      if(prog->lock)
	UnLock((BPTR)prog->lock); /* unlock the program if it was locked before! */
#endif
      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) {
	prog=prev;
	prev=NULL;
      } else {
	if(del)
	  break;
      }
    } else {
      prev=prog;
      prog=prog->next;
    }
  }
  return(FPL_OK);
}

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

static ReturnCode REGARGS
Run(struct Data *scr,
    char *filename,
    char *program,
    long lines,
    unsigned long *tags)
{
  ReturnCode end;
  struct Expr *val;
  unsigned long *tag=tags;
  char storeglobals;	/* DEFAULT: fplInit() value! */
  struct Program *thisprog, *prog;
  struct Store *store;
  struct Local *glob;
  long currcol;
  long *globpointer=NULL;
  char debug_mode = scr->flags & FPLDATA_DEBUG_MODE?1:0; /* are we debugging? */

#ifdef DEBUG
  long memory=mem;
#endif

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

  if(scr->runs) {
    /* this is a nested call! */
    GETMEM(store, sizeof(struct Store));

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

    LeaveProgram(scr, scr->prog);
    memcpy(store, &scr->text, sizeof(struct Store));
  } 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.
       */
      end = ReadFile(scr, filename, prog); /* get file */
      prog->flags|=PR_NAME_IS_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 */

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

        while(tag && *tag) {
          switch(*tag++) {
          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 = (char **)*tag;
            scr->strret=TRUE; /* enable return string */
            break;

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

          case FPLTAG_STARTPOINT:
            scr->text=(char *)*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, (char *)*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) {
          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;

          if(scr->error) {
	    /* We'll fix the error string! */
	    GetErrorMsg(scr, end, scr->error);
	  }

          /* new argv assigning for OS/2 compliance! */
          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;
	      char *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 */
                    newprogram[total_size] = CHAR_ASCII_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;
		      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, debug_mode);

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

    memcpy(&scr->text, store, sizeof(struct Store));
    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)
{
  ReturnCode ret;
#if defined(AMIGA) && defined(SHARED)
  /* The function call below is a assembler routine that allocates a new
     stack to use in the library! */
#if 0
  if(!scr->runs++) {
#endif
    scr->runs++;
    ret=InitStack(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);
#if 0
    EndStack(scr, scr->stack_max);
  } else {
    ret=Script(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);
  }
#endif
#else /* Not Amiga, Not shared! */
  scr->runs++;
  ret=Script(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);
#endif
  return(ret);
}


static ReturnCode REGARGS
StoreGlobals(struct Data *scr,
             char 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 */
      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 */
      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)
{
  char declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  ReturnCode ret;		   /* return value variable */
  struct Condition *con2;      /* recursive check information! */
  char brace=0; /* general TRUE/FALSE variable */
  char *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;
  char *virfile=scr->virfile;
  char 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_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;
  }
  while(!done) {
    if(ret=Eat(scr)) {
      if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
	/* It's OK! */
	ret=FPL_OK;
      break;
    }

    /* call the interval function */
    if(scr->interfunc) {
      if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
	CALL(Warn(scr, FPLERR_PROGRAM_STOPPED)); /* >warning< */
    }

#ifdef DEBUGMAIL
    DebugMail(scr, MAIL_EXECUTE, 500, NULL);
#endif

    switch(*scr->text) {
    case CHAR_OPEN_BRACE:		/* open brace */
      scr->text++;
      CALL(Script(scr, val,
                  SCR_NORMAL|SCR_BRACE,
		  con));
      if(CheckIt(scr, val, control, &ret)) {
	CleanUp(scr, control, levels);
	return(ret);
      }
      break;

    case CHAR_CLOSE_BRACE:
      if(control&SCR_LOOP) {
	if(control&SCR_BRACE) {
	  DelLocalVar(scr, &scr->locals); /* delete all local declarations */
	  scr->varlevel--;                /* previous variable level */
	  scr->level--; 		  /* previous level spectra */
	}
        CALL(Loop(scr, con, control, &brace));
	if(brace) {
	  /* Yes! We should loop! */
	  if(control&SCR_BRACE) {
	    /* bring back the proper values */
	    scr->varlevel++;
	    scr->level++;
	    AddLevel(scr); /* restart this level! */
	    declare=TRUE;
	  }
	  scr->virprg=virprg;
	  scr->virfile=virfile;
	  continue;
	}
        val->flags=0;
      } else {
	scr->text++;
        val->flags=FPL_BRACE;
	CleanUp(scr, control, levels);
      }
      scr->returnint = NULL; /* no result integer! */
      return(FPL_OK);  /* return to calling function */

    case CHAR_SEMICOLON:
      scr->text++;
      break;

    default:
      /*
       * 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(ident && control&SCR_GLOBAL && declare) {
	/* still on ground level and declaration allowed */
	if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
	  /*
	   * We move the pointer for the execution start position to
	   * this position.
	   */
	  scr->prog->startcol=text-(&scr->prog->program)[prg-1];
	  scr->prog->startprg=prg;
	  scr->prog->virprg=scr->virprg;
	  scr->prog->virfile=scr->virfile;
	  /*
	   * This is the end of the declaration phase. Now, let's
	   * check for that FPLTAG_INTERPRET tag to see if we should
	   * have a little fun or simply continue!
	   */
	  if(scr->interpret) {
            done = TRUE;
            continue;
          }
	}
      }
      if(ident && ident->flags&FPL_KEYWORD) {
	if(ident->flags&FPL_KEYWORD_DECLARE) {
	  if(!declare) {
	    CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));   /* WARNING! */
	    /* declare it anyway!!! */
	  }
	  CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));

	} else {
	  switch(ident->data.external.ID) {
          case CMD_SWITCH:
            CALL(Switch(scr, val, control, con));
            if(CheckIt(scr, val, control, &ret)) {
              CleanUp(scr, control, levels);
              return(ret);
            }
            break;

          case CMD_CASE:    /* 'case' */
            if(!control&SCR_SWITCH)
              return FPLERR_ILLEGAL_CASE; /* 'case' not within switch! */
            /*
             * This word can only be found if (control&SCR_SWITCH), and then
             * we must just skip the "case XX:" text and continue.
             */
            CALL(Eat(scr));
            if(scr->text[0]==CHAR_OPEN_PAREN) {
              /*
               * If this is an open parenthesis, we must search for the
               * opposite parenthesis to enable conditional statements
               * using the '?' and ':' operators.
               */
              CALL(GetEnd(scr, CHAR_CLOSE_PAREN,
                          CHAR_OPEN_PAREN, FALSE)); /* find close paren! */
            }
            if(GetEnd(scr, CHAR_COLON, 255, FALSE)) /* find colon! */
              return FPLERR_MISSING_COLON;
            if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
            /* If there was a string return, it should be freed and the
               string really held a string! */
              FREE(val->val.str);
            break;

          case CMD_DEFAULT: /* 'default' */
            if(!control&SCR_SWITCH)
              return FPLERR_ILLEGAL_DEFAULT; /* 'default' not within switch! */
            /*
             * This word can only be found if (control&SCR_SWITCH), and then
             * we must just skip the "default:" text and continue.
             */
            if(scr->text[0]!=CHAR_COLON) {
              if(GetEnd(scr, CHAR_COLON, 255, FALSE))
                return FPLERR_MISSING_COLON;
            } else
              scr->text++;
            break;

	  case CMD_TYPEDEF:
	    CALL(Getword(scr));
	    CALL(GetIdentifier(scr, scr->buf, &ident));
	    if(!ret &&
	       (ident->data.external.ID==CMD_INT ||
		ident->data.external.ID==CMD_STRING)) {
	      CALL(Getword(scr));
	      text=(void *)ident;
	      GETMEM(ident, sizeof(struct Identifier));
	      *ident=*(struct Identifier *)text; /* copy entire structure! */
	      GETMEM(ident->name, strlen(scr->buf)+1);
	      strcpy(ident->name, scr->buf);
	      ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
						       declarator symbol! */
	      CALL(AddVar(scr, ident, &scr->locals));
	    } else {
	      CALL(Warn(scr, FPLERR_IDENTIFIER_NOT_FOUND));
	      /* then just skip this statement! */
	      if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
                return FPLERR_MISSING_SEMICOLON;
	    }
	    break;
	  case CMD_RETURN:
	  case CMD_EXIT:
	    Eat(scr);
            scr->returnint = NULL; /* point to result */
	    if(*scr->text!=CHAR_SEMICOLON) { /* no return */
	      brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
	      scr->text+=brace;

	      /*
	       * If return()ing from a function when scr->strret is TRUE,
	       * return a string.
	       */
	      if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
                 (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
		CALL(Expression(val, scr, CON_NORMAL, NULL));
		if(!(val->flags&FPL_STRING)) {
		  /* that wasn't a string! */
		  CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
		} else {
		  /* It was a string! */
		  if(val->flags&FPL_NOFREE) {
		    /*
		     * We're only refering to another string! We can't
		     * allow that since that string might be a local
		     * variable, and all such are about to be deleted now!
		     */
		    struct fplStr *string;
		    GETMEM(string, val->val.str->len+sizeof(struct fplStr));
		    memcpy(string,
			   val->val.str,
			   val->val.str->len+sizeof(struct fplStr));
		    string->alloc=val->val.str->len;
		    val->val.str=string;
		    val->flags&=~FPL_NOFREE;
		  }
		}

	      } else {
		CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
                scr->returnint = &scr->FPLret; /* point to result */
	      }
	      if(brace)
		if(*scr->text!=CHAR_CLOSE_PAREN) {
		  CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
		  /* continue */
		} else
		  scr->text++;
	    } else {
	      val->val.val=0;
	      val->flags=0;
	    }
	    scr->FPLret=val->val.val;	/* set return code! */
	    if(ident->data.external.ID==CMD_RETURN) {
	      ret=FPL_OK;
	    } else
	      ret=FPL_EXIT_OK; /* This will make us return through it all! */

            val->flags|=FPL_RETURN; /* inform calling function */

	    CleanUp(scr, control, levels);
	    return(ret);
	  case CMD_IF:		/* if() */
	  case CMD_WHILE:	/* while() */
	    Eat(scr);

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

	      PARSE CONDITION

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


	    if(*scr->text!=CHAR_OPEN_PAREN) {
	      CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
	      /* please, go on! */
	    } else
	      scr->text++;

	    GETMEM(con2, sizeof(struct Condition));

	    /* save check position! */
	    con2->check=scr->text;
	    con2->checkl=scr->prg;

	    CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
	    if(*scr->text!=CHAR_CLOSE_PAREN) {
	      CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
	      /* continue */
	    } else
	      scr->text++;

	    if(val->val.val) {
	      /********************

		PARSE STATMENT

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

	      Eat(scr);
	      scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
	      con2->bracetext=scr->text;
	      con2->braceprg=scr->prg;

	      CALL(Script(scr, val,
			  (brace?SCR_BRACE:0)|
			  (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF),
			  con2));
	      if(CheckIt(scr, val, control, &ret)) {
		FREE(con2);
		CleanUp(scr, control, levels);
		return(ret);
	      }
	      brace=TRUE;
	    } else {
	      /********************

		SKIP STATEMENT

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

	      CALL(SkipStatement(scr));
	      brace=FALSE;
	    }

            Eat(scr); /* we must eat space before storing the position,
                         otherwise we might eat newlines several times! */
            
	    text=scr->text;
	    prg=scr->prg;

	    Getword(scr);

	    if(!strcmp(KEYWORD_ELSE, scr->buf) && brace) {
	      /********************

		SKIP STATEMENT

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

	      CALL(SkipStatement(scr));
	    } else if(!strcmp(KEYWORD_ELSE, scr->buf) && !brace) {
	      /********************

		PARSE STATMENT

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

	      Eat(scr);
	      scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
	      con2->bracetext=scr->text;
	      con2->braceprg=scr->prg;
	      CALL(Script(scr, val, (brace?SCR_BRACE:0), con2));
	      if(CheckIt(scr, val, control, &ret)) {
		FREE(con2);
		CleanUp(scr, control, levels);
		return(ret);
	      }
	    } else {
	      scr->text=text;
	      scr->prg=prg;
	    }
	    FREE(con2);
	    break;
	  case CMD_BREAK:
	    val->val.val=1;	/* default is break 1 */
	    val->flags=0;	/* reset flags */
	    CALL(Eat(scr));
	    /*
	     * Check if break out of several statements.
	     */
	    if(*scr->text!=CHAR_SEMICOLON) {
	      /* Get the result of the expression. */
	      brace=*scr->text==CHAR_OPEN_PAREN;
	      scr->text+=brace;
	      CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
	      if(brace)
		if(*scr->text!=CHAR_CLOSE_PAREN) {
		  CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
		} else
		  scr->text++;
	      else if(val->val.val<0) {
		CALL(Warn(scr, FPLERR_ILLEGAL_BREAK));
		val->val.val=1; /* reset! */
	      }
	    }
	    /*
	     * Go to end of statement!!! If this was started without
	     * SCR_BRACE set, we're already at the end of the statement!
	     */
	    if(control&SCR_BRACE) {
	      if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
                return FPLERR_MISSING_BRACE;
#ifdef DEBUG_BREAKS
	      fprintf(stderr, "First: levels %d line %d, brace? %d chars: '%c%c%c%c%c'\n",
		      val->val.val, scr->virprg, control&SCR_BRACE?1:0,
		      scr->text[0], scr->text[1], scr->text[2],
		      scr->text[3], scr->text[4]);
#endif
            }
	    if(control&SCR_DO)
	      /* if it was inside a do statement, pass the ending `while' */
	      CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
	    val->flags|=FPL_BREAK;
	    if(control&(SCR_LOOP))
	      if(!--val->val.val)
		val->flags&=~FPL_BREAK; /* only this break! */
	    CleanUp(scr, control, levels);
	    return(FPL_OK);
	  case CMD_CONTINUE:
	    if(*scr->text!=CHAR_SEMICOLON) {
	      CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));  /* >warning< */
	    } else
	      scr->text++;
	    if(control&SCR_LOOP) {
	      /* loop! */
	      if(control&SCR_BRACE) {
		DelLocalVar(scr, &scr->locals); /* delete all locals */
		scr->varlevel--;                /* previous variable level */
		scr->level--; 	                /* previous level spectra */
	      }
	      CALL(Loop(scr, con, control, &brace));
	      if(!brace) {
		/*
		 * The result of the condition check was FALSE. Move to the end
		 * of the block and continue execution there!
		 */

		if(control&SCR_BRACE) {
		  /* braces */
		  if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
                    return FPLERR_MISSING_BRACE;
		} else {
		  /* no braces! */
		  if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
                    return FPLERR_MISSING_SEMICOLON;
		}
		val->flags=0;
	      } else {
		if(control&SCR_BRACE) {
		  /* bring back the proper values */
		  scr->varlevel++;
		  scr->level++;
		  AddLevel(scr); /* restart this level! */
		  declare=TRUE;
		}
		scr->virprg=virprg;
		scr->virfile=virfile;
		continue;
	      }
	    } else {
	      /* it's no looping statement! */
	      val->flags=FPL_CONTINUE;
	      CleanUp(scr, control, levels);
	    }
	    return(FPL_OK);
	  case CMD_DO:
	    CALL(Eat(scr));
	    GETMEM(con2, sizeof(struct Condition));
	    scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
	    con2->bracetext=scr->text;
	    con2->braceprg=scr->prg;
	    con2->check=NULL;
	    CALL(Script(scr, val, SCR_DO|(brace?SCR_BRACE:0), con2));
	    FREE(con2);
	    if(CheckIt(scr, val, control, &ret)) {
	      CleanUp(scr, control, levels);
	      return(ret);
	    }
	    break;
	  case CMD_FOR:
	    Eat(scr);
	    scr->text++;
	    CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));

	    if(*scr->text!=CHAR_SEMICOLON) {
	      CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
	    } else
	      scr->text++;
	    GETMEM(con2, sizeof(struct Condition));

	    con2->check=scr->text;
	    con2->checkl=scr->prg;
	    CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));

	    if(*scr->text!=CHAR_SEMICOLON) {
	      CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
	    } else
	      scr->text++;
	    con2->postexpr=scr->text;
	    con2->postexprl=scr->prg;
            {
	      /*
	       * Pass the last expression:
	       */
	      CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
	    }
	    if(!val->val.val) {
	      /* We shouldn't enter the loop! Go to end of block:*/
	      CALL(SkipStatement(scr));
	      FREE(con2);
	    } else {
	      CALL(Eat(scr));
	      scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
	      con2->bracetext=scr->text;
	      con2->braceprg=scr->prg;
	      CALL(Script(scr, val, (brace?SCR_BRACE:0)|SCR_FOR, con2));
	      FREE(con2);
	      if(CheckIt(scr, val, control, &ret)) {
		CleanUp(scr, control, levels);
		return(ret);
	      }
	    }
	    break;
	  case CMD_RESIZE:
	    CALL(Resize(scr, val, control));
	    break;
	  } /* switch(keyword) */
        } /* if it wasn't a declaring keyword */
      } else {
	declare=FALSE;
	CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
#if 0
	/*
	 * First check for 'action' in the parsed statement!
         */
        if(!(val->flags&FPL_ACTION)) {
	  /*
	   * No 'action' !
	   */
          CALL(Warn(scr, FPLERR_NO_ACTION));
          /* but we can just as good keep on anyway! */
        }
#endif
	/*
	 * It it returned a string, flush it!
	 */
	if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str) {
	  /* If there was a string return, it should be freed and the
	     string really held a string! */
	  FREE(val->val.str);
	}
	/*
	 * Check for semicolon!
	 */
	if(*scr->text!=CHAR_SEMICOLON) {
	  CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
	} else
	  scr->text++;
      }
    } /* switch (*scr->text) */

    if(!(control&(SCR_BRACE|SCR_SWITCH))) {
      if(control&SCR_LOOP) {
	CALL(Loop(scr, con, control, &brace));
	if(brace) {
	  /* Yes! We should loop! */
	  if(control&SCR_BRACE) {
	    /* bring back the proper values */
	    scr->varlevel++;
	    scr->level++;
	    AddLevel(scr); /* restart this level! */
	    declare=TRUE;
	  }
	  scr->virprg=virprg;
	  scr->virfile=virfile;
	  continue;
	}
	val->flags=0;
	ret=FPL_OK;
	break; /* return to calling function */
      } else
	break;
    }
  } /* loop! */

  /*
   * Check for that FPLTAG_INTERPRET tag!
   */
  if(!ret && scr->interpret) {
    if(!done) {
      /*
       * We did get here by hitting end of program.
       * Let's set the start-of-main position right here to
       * make another run work fine on this file too!
       */
      scr->prog->startcol=scr->text-(&scr->prog->program)[scr->prg-1];
      scr->prog->startprg=scr->prg;
      scr->prog->virprg=scr->virprg;
      scr->prog->virfile=scr->virfile;
    }

    /* an alternative main program is specified */
    GETMEM(pass, sizeof(struct fplArgument));
    pass->ID=FNC_INTERPRET;
    text = scr->interpret;
    pass->argv=(void **)&text;
    pass->key=scr;
    CALL(functions(pass));

    CleanUp(scr, control, levels);

    /* we're done for this time, exit! */
    ret = FPL_EXIT_OK;
  }

  CleanUp(scr, control, levels);
  return(ret);
}

static ReturnCode INLINE
Switch(struct Data *scr,
       struct Expr *val,
       short control,
       struct Condition *con)
{
  ReturnCode ret;
  struct fplStr *string;
  long value;
  char strtype=FALSE;
  char breakout=FALSE;

  /* temporary storage variables */
  char *ttext;
  long tprg;
  char *tvirfile;
  long tvirprg;

  char end=FALSE; /* we have not found the end position */

  long bprg;
  char *btext;
  long bvirprg;
  char *bvirfile;

  long dprg=-1;
  char *dtext;
  long dvirprg;
  char *dvirfile;

  CALL(Eat(scr)); /* eat whitespace */

  /* Check the open parenthesis */
  if(scr->text[0]!=CHAR_OPEN_PAREN) {
    CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  } else
    scr->text++;

  /* Get expression, string or int, static or dynamic! */
  CALL(Expression(val, scr, CON_NORMAL, NULL));

  if(val->flags&FPL_STRING) {
    /* there was a string statement! */
    string = val->val.str;
    if(string)
      strtype=2;
    else
      strtype= 1;

  } else {
    /* there was an integer expression */
    value = val->val.val;
  }

  /* Check the close parenthesis */
  if(scr->text[0]!=CHAR_CLOSE_PAREN) {
    CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  } else
    scr->text++;

  CALL(Eat(scr)); /* eat whitespace */

  /* Check the open brace */
  if(scr->text[0]!=CHAR_OPEN_BRACE) {
    CALL(Warn(scr, FPLERR_MISSING_BRACE)); /* >warning< */
  } else
    scr->text++;

  while(!(ret=Eat(scr))) {
    tprg = scr->prg;
    ttext = scr->text;
    tvirprg = scr->virprg;
    tvirfile = scr->virfile;
    if(!Getword(scr)) {
      if(!strcmp("case", scr->buf)) {
        /* This is a valid case-line coming up! */

        /* Get expression, string or int! */
        CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
        if(strtype) {
          /*
           * String comparison:
           */
          value = val->val.str?val->val.str->len:0;

          if(value == (string?string->len:0)) {

            if(value) {
              if(!memcmp(val->val.str->string, string->string, value)) {
                /* match! */
                breakout=TRUE;
              }
            } else
              breakout=TRUE;
          }
          if(!val->flags&FPL_NOFREE)
            FREE(val->val.str);
          if(breakout)
            break;
          else
            scr->text++; /* pass the ';' */
        } else {
          /*
           * Integer comparison:
           */
          if(val->val.val == value) {
            breakout = TRUE;
            break;
          } else
            scr->text++; /* pass the ';' */
        }
      } else if(!strcmp("default", scr->buf)) {
        /*
         * Store the default position to make it possible to return to if
         * necessary!
         */

	if(dprg>=0)
	  return FPLERR_ILLEGAL_DEFAULT; /* dual 'default' specified! */

        dprg = scr->prg;
        dtext = scr->text++; /* pass the colon after the assign */
        dvirprg = scr->virprg;
        dvirfile = scr->virfile;

      } else {
        /*
         * Pass the statement!
         */

        /* First, restore the previuos position so that we can skip
           if, while, do and such things without problems! */
        scr->prg=tprg;
        scr->text=ttext;
        scr->virprg=tvirprg;
        scr->virfile=tvirfile;

        CALL(SkipStatement(scr));
      }
    } else {
      /* we didn't get any word */
      if(scr->text[0]==CHAR_CLOSE_BRACE) {
        /*
         * We hit the end without finding our 'case'! Return to the
         * 'default', if any! Store the position to be able to quickly
         * jump down to it again after the possible case-statement.
         */

        scr->text++; /* pass the closing brace */
        if(dprg<0)
          /* we didn't find any 'default' */
          break;
        bprg = scr->prg;
        btext = scr->text;
        bvirprg = scr->virprg;
        bvirfile = scr->virfile;

        end=TRUE; /* we have found the end! */

        scr->prg=dprg;
        scr->text=dtext;
        scr->virprg=dvirprg;
        scr->virfile=dvirfile;
        breakout = TRUE;
        break;

      } else {
        /*
         * Pass the statement!
         */
        CALL(SkipStatement(scr));
      }
    }
  }
  if(breakout) {
    /* we did break out on any of the 'case' or 'default' label lines,
       pass the colon!
     */
    /* CALL(Eat(scr));  eating whitespace shouldn't be necessary here */

    /* Check the colon */
    if(scr->text[0]!=CHAR_COLON) {
      CALL(Warn(scr, FPLERR_MISSING_COLON)); /* missing colon */
    } else
      scr->text++;

    /*
     * run this statement all the way until break or '}'!
     */

    CALL(Script(scr, val, SCR_SWITCH, con));

    if(!(val->flags&FPL_BRACE)) {
      /* we didn't run into the closing brace! */

      if(val->flags&FPL_BREAK && !--val->val.val) {
        /*
         * We got here after hitting a 'break' !!
         */
	val->flags&=~FPL_BREAK; /* only this break and no more ! */
      }

      /*
       * Go to the end of the switch()-statement.
       */
      if(!end) {
        /* we'll have to search for it! */
        if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
          return FPLERR_MISSING_BRACE;
      } else {
        scr->prg=bprg;
        scr->text=btext;
        scr->virprg=bvirprg;
        scr->virfile=bvirfile;
      }
    }

  }
  return ret;
}

static ReturnCode INLINE
Declare(struct Expr *val,
	struct Data *scr,
	struct Identifier *ident,
	long start)			/* start flags */
{
  ReturnCode ret;
  long flags=start;
  do {
    switch(ident->data.external.ID) {
    case CMD_EXPORT:
      flags|=CON_DECLEXP;
      break;
    case CMD_STRING:
      flags|=CON_DECLSTR;
      break;
    case CMD_INT:
      flags|=CON_DECLINT;
      if(ident->flags&FPL_SHORT_VARIABLE)
	flags|=CON_DECL16;
      else if(ident->flags&FPL_CHAR_VARIABLE)
	flags|=CON_DECL8;
      break;
    case CMD_VOID:
      flags|=CON_DECLVOID;
      break;
    case CMD_AUTO:
    case CMD_REGISTER:
      flags&=~(CON_DECLEXP|CON_DECLGLOB);
      break;
    case CMD_CONST:
      flags|=CON_DECLCONST;
      break;
    case CMD_STATIC:
      flags|=CON_DECLSTATIC;
      break;
    }
    CALL(Getword(scr));
    ret=GetIdentifier(scr, scr->buf, &ident);
  } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);

  if(!(flags&CON_DECLARE))
    flags|=CON_DECLINT; /* integer declaration is default! */

  CALL(Expression(val, scr, CON_GROUNDLVL|flags|CON_IDENT, ident));
  if(*scr->text!=CHAR_SEMICOLON &&
     (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) {
    CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  } else
    scr->text++;
  return(FPL_OK);
}



/**********************************************************************
 *
 * Resize()
 *
 * This function resizes a variable array to the new given size.
 *
 *****/

static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, char control)
{
  char num=0; /* number of dimensions */
  long *dims; /* dimension array */
  struct fplVariable *var;
  struct Identifier *ident;
  ReturnCode ret;
  CALL(Getword(scr));
  CALL(GetIdentifier(scr, scr->buf, &ident));
  var=&ident->data.variable;

  if(!(ident->flags&FPL_VARIABLE) || !var->num) {
    return FPLERR_ILLEGAL_RESIZE;
  }

  Eat(scr);
  GETMEM(dims, MAX_DIMS*sizeof(long));

  do {
    if(*scr->text!=CHAR_OPEN_BRACKET) {
      CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
    } else
      scr->text++; /* pass the open bracket */
    /* eval the expression: */
    CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
    if(*scr->text++!=CHAR_CLOSE_BRACKET)
      /* no close bracket means error */
      return(FPLERR_MISSING_BRACKET); /* missing bracket */
    else if(val->val.val<(control&CON_DECLARE?1:0)) {
      /* illegal result of the expression */
      /*
       * Set back original variable name!
       */
      strcpy(scr->buf, ident->name);
      return(FPLERR_ILLEGAL_ARRAY);
    }
    dims[num++]=val->val.val; /* Add another dimension */
    if(num==MAX_DIMS) {
      /* if we try to declare too many dimensions... */
      /*
       * Set back original variable name!
       */
      strcpy(scr->buf, ident->name);
      return FPLERR_ILLEGAL_ARRAY;
    }
    /*
     * Go on as long there are brackets,
     */
  } while(*scr->text==CHAR_OPEN_BRACKET);

  CALL(ArrayResize(scr, num, dims, ident));

  FREE(dims);
  return(FPL_OK);
}


ReturnCode REGARGS
ArrayResize(struct Data *scr,
            long num,   /* number of new dimensions */
            long *dims, /* array of new dim sizes */
            struct Identifier *ident) /* _valid_ variable to resize */
{
  long size;
  long i;
  long min;
  void *tempvars;
  struct fplVariable *var;
  char dynamic=FALSE;
  var=&ident->data.variable;
  
  size=dims[0]; /* array size */
  for(i=1; i<num; i++)
    size*=dims[i];

  min=MIN(size, var->size); /* number of variables to copy! */

  if(MALLOC_DYNAMIC == TypeMem(ident)) {
    dynamic = TRUE;
    GETMEM(tempvars, size * sizeof(void *)); /* data adjust! */
  }
  else {
    GETMEMA(tempvars, size * sizeof(void *)); /* data adjust! */
  }
  memcpy(tempvars, var->var.str, min * sizeof(void *));
  if(size>var->size)
    /*
     * If we create a few more than before, empty that data!
     */
    memset((char *)tempvars+var->size*sizeof(void *), 0,
	   (size-var->size)*sizeof(void *));

  if(ident->flags&FPL_STRING_VARIABLE)
    for(i=min; i<var->size; i++) {
      if(var->var.str[i]) {
	FREE_KIND(var->var.str[i]);
      }
    }

  FREE_KIND(var->var.val);
  var->var.val= tempvars;

  var->size= size;
  var->num = num;
  FREE_KIND(var->dims);
  if(dynamic) {
    GETMEM(var->dims, num * sizeof(long));
  }
  else {
    GETMEMA(var->dims, num * sizeof(long));
  }
  memcpy(var->dims, dims, num * sizeof(long));

  return FPL_OK;
}

/**********************************************************************
 *
 * char CheckIt()
 *
 * Returns wether we should return from this Script().
 *
 *****/

static char REGARGS
CheckIt(struct Data *scr, /* major script structure */
        struct Expr *val, /* result structure */
        short control,    /* control defines */
        ReturnCode *ret)  /* return code pointer */
{
  if(val->flags&FPL_BREAK) {
    /*
     * A `break' was hit inside that Script() invoke.
     */
    if(control&SCR_BRACE) {
      /*
       * If we're inside braces, search for the close brace!
       */
      if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
	*ret = FPLERR_ILLEGAL_BREAK;
	return((char)*ret);
      }
    }
#ifdef DEBUG_BREAKS
    fprintf(stderr, "EOS: levels %d line %d, brace? %d chars: '%c%c%c%c%c'\n",
	    val->val.val, scr->virprg, control&SCR_BRACE?1:0,
	    scr->text[0], scr->text[1], scr->text[2],
	    scr->text[3], scr->text[4]);
#endif

    if(control&(SCR_LOOP)) {
      if(control&SCR_DO) {
        /*
         * We're inside a do-statement! We must pass the ending "while"
         * before returning! We do it the easy way: look for the closing
         * parenthesis!
         */
	if(*ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE))
	  return((char)*ret);
        else if(*ret = Eat(scr))
	  return((char)*ret);
        else if(scr->text[0] != CHAR_SEMICOLON) {
          if(*ret = Warn(scr, FPLERR_MISSING_SEMICOLON))
            return((char)*ret);
        } else
          scr->text++; /* pass the semicolon */
      }
      if(--val->val.val<1)
	val->flags&=~FPL_BREAK; /* clear the break bit! */
      return(TRUE);
    } else if(!(control&SCR_FUNCTION))
      return(TRUE);
    else if(val->val.val<2) {
      val->flags&=~FPL_BREAK; /* clear the break bit! */
      return(FALSE); /* no more break! */
    }
    *ret=FPLERR_ILLEGAL_BREAK;
    return(TRUE);
  } else if(val->flags&FPL_RETURN)
    /* The FPL function did end in a return() */
    return(TRUE);
  else if(val->flags&FPL_CONTINUE) {
    if(control&SCR_LOOP) {
      if(control&SCR_BRACE) {
	/* If we're inside braces, search for the close brace */
	if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
          *ret = FPLERR_MISSING_BRACE;
	  return((char)*ret);
        }
	scr->text--; /* move one step back to stand on the close brace */
	return(FALSE);
      }
    } else
      /* this is not a looping block, break out of it! */
      return(TRUE);
  }
  return(FALSE);
}

/**********************************************************************
 *
 * CleanUp()
 *
 * Deletes/frees all local variable information.
 *
 *******/

void REGARGS
CleanUp(struct Data *scr,
        long control,
        long levels)
{
  if(control&(SCR_BRACE|SCR_FUNCTION)) {
    DelLocalVar(scr, &scr->locals);
    scr->varlevel--;
    scr->level=levels; /* new variable amplitude */
  }

  if(!(control&SCR_DEBUG)) {
    /* previous version did not run in debug mode, switch it off! */
    scr->flags&=~FPLDATA_DEBUG_MODE;
  }
}


/**********************************************************************
 *
 * Loop()
 *
 * This function is called at the end of a block, however the block was
 * started (brace or not brace).
 *
 *******/

static ReturnCode REGARGS
Loop(struct Data *scr,
     struct Condition *con,
     short control,
     char *cont) /* store TRUE or FALSE if loop or not */
{
  ReturnCode ret = FPL_OK;
  char *temptext=scr->text; /* store current position */
  long temprg=scr->prg;
  struct Expr *val;

  GETMEM(val, sizeof(struct Expr));

  /*
   * First check if the block just parsed begun with a while() or for()
   * or perhaps a do in which we know the statment position!
   */

  if((control&SCR_WHILE ||
      control&SCR_FOR ||
      (control&SCR_DO && con->check))) {
    if(control&SCR_FOR) {	 /* check if the pre keyword was for() */
      scr->text=con->postexpr;/* perform the post expression */
      scr->prg=con->postexprl;
      CALL(Expression(val, scr, CON_GROUNDLVL|CON_PAREN, NULL));
    }
    /*
     * Do the condition check. The only statement if it was a while() or
     * do while or the second statement if it was a for().
     *
     * If it was a for() as pre statement, the statement could contain
     * nothing but a semicolon and then equals TRUE.
     */
    scr->text=con->check;
    scr->prg=con->checkl;
    CALL(Expression(val, scr, CON_GROUNDLVL|
		    (control&SCR_FOR?CON_SEMICOLON:0)|CON_NUM, NULL));

    if(val->val.val) { /* the result of the condition was true */
      scr->text=con->bracetext; /* return to the open brace */
      scr->prg=con->braceprg;
      *cont=TRUE;
      FREE(val);
      return(FPL_OK);
    }
  }

  if(control&SCR_DO) {
    /* This a do while end. */

    if(!con->check) {
      /*
       * We *DON'T* know the condition position. We have to scan forward
       * to get it!
       */
      if(*scr->text==CHAR_CLOSE_BRACE)
	/* pass the close brace */
	scr->text++;
      if(ret=Getword(scr))
	;
      else if(strcmp(scr->buf, "while"))
	ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
      else if(ret=Eat(scr))
	;
      else if(*scr->text++!=CHAR_OPEN_PAREN)
	ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
      else {
	con->check=scr->text;
	con->checkl=scr->prg;
	if(ret=Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL))
	  ;
	else if(*scr->text++!=CHAR_CLOSE_PAREN)
	  ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
      }
      if(ret)
	return(ret);
    }
    if(!val->val.val) {
      /*
       * If we had the check point up there and the condition equaled
       * FALSE. Now we have to pass the the while keyword following the
       * close brace.
       */
      scr->text=temptext;
      scr->prg=temprg;

      if(*scr->text==CHAR_CLOSE_BRACE)
	/* pass the close brace */
	scr->text++;

      if(Getword(scr) || strcmp("while", scr->buf))
	ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
      else if(GetEnd(scr, CHAR_SEMICOLON, (char)255, FALSE))
	ret = FPLERR_MISSING_SEMICOLON;
      if(ret)
	return(ret);
    } else {
      /* go to the open brace */
      scr->text=con->bracetext;
      scr->prg=con->braceprg;
      *cont=TRUE;
      FREE(val);
      return(FPL_OK);
    }
  }

  FREE(val);

  /*
   * The condition check has failed!
   */

  *cont=FALSE;

  if(!(control&SCR_DO)) {
    /* it's not a do-while loop */

    scr->text=temptext;
    scr->prg=temprg;

    Eat(scr);

    if(control&SCR_BRACE && *scr->text==CHAR_CLOSE_BRACE)
      /* pass the close brace */
      scr->text++;
  }

  return(ret);
}

/**********************************************************************
 *
 * ReturnCode SkipStatement();
 *
 *  This function should pass one statement. Statements starting with
 * "for", "do", "while" or "if" really can be meesy and in such cases
 * this function recurse extensively!!!
 *
 ******/

static ReturnCode REGARGS
SkipStatement(struct Data *scr)
{
  ReturnCode ret;
  struct Identifier *ident;
  CALL(Eat(scr));

  if(*scr->text==CHAR_SEMICOLON)
    scr->text++;
  else if(*scr->text==CHAR_OPEN_BRACE) {
    if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
      return FPLERR_MISSING_BRACE;
  } else {
    /*
     * Much more trouble this way:
     */

    char *t;
    long p;

    ret = Getword(scr);
    if(!ret) {
      GetIdentifier(scr, scr->buf, &ident);
      switch(ident?ident->data.external.ID:0) {
      case CMD_IF:
      case CMD_WHILE:
        Eat(scr);
        CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
        CALL(SkipStatement(scr));

        t=scr->text;
        p=scr->prg;

        Getword(scr);

        if(!strcmp(KEYWORD_ELSE, scr->buf)) {
          CALL(SkipStatement(scr));
        } else {
          /*
           * Restore pointers.
           */
          scr->text=t;
          scr->prg=p;
        }
        break;
      case CMD_FOR:
        Eat(scr);
        /* Now we must stand on an open parenthesis */
        CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
        CALL(SkipStatement(scr));
        break;
      case CMD_DO:
        Eat(scr);
        CALL(SkipStatement(scr));

        /*
         * The next semicolon must be the one after the
         * following `while' keyword!
         */
        if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
          return FPLERR_MISSING_SEMICOLON;
        break;
      default:
        ret=TRUE;
      }
    }
    if(ret) {
      /*
       * This statement ends at the next semicolon
       */
      if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
        return FPLERR_MISSING_SEMICOLON;
    }
  }
  return(FPL_OK);
}

#ifdef UNIX
long InterfaceCall(struct Data *scr,
		   void *arg,
		   long (*func)(void *))
{
  return func(arg);
}
#endif
