home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / fpl-v115.lha / FPL / src / script.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-02-28  |  66.0 KB  |  2,346 lines
  1. /******************************************************************************
  2.  *              FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  script.c
  6.  
  7.  The main routine of the language. Handles all keywords, {'s and }'s.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <libraries/dos.h>
  44. #include <proto/dos.h>
  45.  
  46. #include <exec/libraries.h>
  47. #include <dos.h>
  48.  
  49. #elif defined(UNIX)
  50. #include <sys/types.h>
  51. #include <sys/stat.h>
  52. #include <stdlib.h>
  53. #endif
  54.  
  55. #include <stdio.h>
  56. #include <string.h>
  57. #include "script.h"
  58. #include "debug.h"
  59.  
  60. #ifdef DEBUG
  61. long mem=0;
  62. long maxmem=0;
  63. #endif
  64.  
  65. static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
  66.                     char *, long, char *);
  67. static char REGARGS CheckIt(struct Data *, struct Expr *, short, ReturnCode *);
  68. static ReturnCode INLINE Declare(struct Expr *, struct Data *,
  69.                  struct Identifier *, long);
  70. static ReturnCode Go(struct Data *, struct Expr *val);
  71. static ReturnCode REGARGS Loop(struct Data *, struct Condition *, short, char *);
  72. static ReturnCode INLINE Resize(struct Data *, struct Expr *, char);
  73. static ReturnCode REGARGS SkipStatement(struct Data *);
  74. static ReturnCode REGARGS StoreGlobals(struct Data *, char);
  75. static ReturnCode REGARGS Run(struct Data *, char *, char *, long, unsigned long *);
  76. static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
  77.                                 struct Condition *);
  78. /*
  79.  * Global character flags:
  80.  */
  81.  
  82. const char unsigned type[257] = { /* Character type codes */
  83.    _C, /* -1 == regular ANSI C eof character */
  84.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 00        */
  85.    _C,    _S,      _S,     _C,    _C,    _S,    _C,    _C, /* 08        */
  86.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 10        */
  87.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 18        */
  88.    _S,    _P,     _P,     _P,    _P,    _P,    _P,    _P, /* 20    !"#$%&' */
  89.    _P,    _P,     _P,    _P,    _P,    _P,    _P,    _P, /* 28 ()*+,-./ */
  90.  _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, /* 30 01234567 */
  91.  _N|_X, _N|_X,    _P,    _P,    _P,    _P,    _P,    _P, /* 38 89:;<=>? */
  92.    _P, _U|_X,  _U|_X, _U|_X, _U|_X, _U|_X, _U|_X,    _U, /* 40 @ABCDEFG */
  93.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 48 HIJKLMNO */
  94.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 50 PQRSTUVW */
  95.    _U,    _U,      _U,     _P,    _P,    _P,    _P, _P|_W, /* 58 XYZ[\]^_ */
  96.    _P, _L|_X,  _L|_X, _L|_X, _L|_X, _L|_X, _L|_X,    _L, /* 60 `abcdefg */
  97.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 68 hijklmno */
  98.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 70 pqrstuvw */
  99.    _L,    _L,      _L,     _P,    _P,    _P,    _P,   000, /* 78 xyz{|}~    */
  100.   000,   000,     000,    000,   000,   000,   000,   000, /* 80             */
  101.   000,   000,     000,    000,   000,   000,   000,   000, /* 88             */
  102.   000,   000,     000,    000,   000,   000,   000,   000, /* 90             */
  103.   000,   000,     000,    000,   000,   000,   000,   000, /* 98             */
  104.   000,   000,     000,    000,   000,   000,   000,   000, /* A0             */
  105.   000,   000,     000,    000,   000,   000,   000,   000, /* A8             */
  106.   000,   000,     000,    000,   000,   000,   000,   000, /* B0             */
  107.   000,   000,     000,    000,   000,   000,   000,   000, /* B8             */
  108.   000,   000,     000,    000,   000,   000,   000,   000, /* C0             */
  109.   000,   000,     000,    000,   000,   000,   000,   000, /* C8             */
  110.   000,   000,     000,    000,   000,   000,   000,   000, /* D0             */
  111.   000,   000,     000,    000,   000,   000,   000,   000, /* D8             */
  112.   000,   000,     000,    000,   000,   000,   000,   000, /* E0             */
  113.   000,   000,     000,    000,   000,   000,   000,   000, /* E8             */
  114.   000,   000,     000,    000,   000,   000,   000,   000, /* F0             */
  115.   000,   000,     000,    000,   000,   000,   000,   000, /* F8             */
  116. };
  117.  
  118.  
  119. /***************************************************************************
  120.  *
  121.  * fplExecuteFile()
  122.  *
  123.  * Executes the specified file as an FPL program.
  124.  *
  125.  ******/
  126.  
  127. ReturnCode PREFIX fplExecuteFile(AREG(0) struct Data *scr,
  128.                  AREG(1) char *filename,
  129.                  AREG(2) unsigned long *tags)
  130. {
  131. #ifdef DEBUGMAIL
  132.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteFile");
  133. #endif
  134.   return(Run(scr, filename, NULL, 1, tags));
  135. }
  136.  
  137. /**********************************************************************
  138.  *
  139.  * fplExecuteScript()
  140.  *
  141.  * Frontend to Run().
  142.  *
  143.  * The error code is returned to daddy...
  144.  *
  145.  ******/
  146.  
  147. ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
  148.                    AREG(1) char **program, /* program array */
  149.                    DREG(1) long lines,     /* number of lines */
  150.                    AREG(2) unsigned long *tags)
  151. {
  152. #ifdef DEBUGMAIL
  153.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteScript");
  154. #endif
  155.   return(Run(scr, NULL, *program, lines, tags));
  156. }
  157.  
  158.  
  159. /**************************************************************************
  160.  *
  161.  * ReadFile()
  162.  *
  163.  *   Reads the specified file into memory, stores the pointer to the memory
  164.  * area in the pointer `program' points to, and the size of the memory area
  165.  * in the integer `size' points to. I decided to use a different way on Amiga
  166.  * to increase performance a lot.
  167.  *
  168.  *   This function first checks the size of the file it's about to fetch
  169.  * and then reads the entire file at once in one continuos memory area.
  170.  *
  171.  *   Returns the proper return code. If anything goes wrong, there won't be
  172.  * *ANY* program to look at (the pointer will be NULL, but the size will most
  173.  * probably still be correct which means a non-zero value). If this function
  174.  * fails it takes care of freeing the program memory by itself. You only have
  175.  * to free that memory if this functions reports success.
  176.  *
  177.  ********/
  178.  
  179. ReturnCode REGARGS
  180. ReadFile(void *fpl,
  181.          char *filename,
  182.          struct Program *prog)
  183. {
  184.   struct Data *scr=(struct Data *)fpl;
  185. #ifdef AMIGA  /* Amiga version. */
  186.   struct FileInfoBlock fileinfo;
  187.   struct FileLock *lock=NULL;
  188.   struct FileHandle *fileread;
  189.  
  190.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  191.   struct Library *DOSBase = lib->ml_DosBase;
  192. #elif defined(UNIX)
  193.   FILE *stream;
  194.   struct stat statstr;
  195. #endif
  196.   ReturnCode ret=FPL_OK;
  197. #ifdef AMIGA
  198.  
  199.   if(filename && filename[0])
  200.     /* Lock on file */
  201.     lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ);
  202.   if (lock) {
  203.     if (Examine((BPTR)lock, &fileinfo) && fileinfo.fib_Size) {
  204.       /*
  205.        * Only do this if the file was there, and it was larger than zero
  206.        * bytes!
  207.        */
  208.       prog->size = fileinfo.fib_Size+1; /* Add one for a terminating zero! */
  209.     } else
  210.       ret=FPLERR_OPEN_ERROR;    /* something went wrong */
  211.     if(!(scr->flags&FPLDATA_LOCKUSED)) {
  212.       UnLock((BPTR)lock);    /* release the lock of the file */
  213.       prog->lock=NULL;        /* no lock */
  214.     } else
  215.       prog->lock=(void *)lock;    /* store lock! */
  216.   } else
  217.     ret=FPLERR_OPEN_ERROR;        /* we couldn't lock on the file */
  218. #elif defined(UNIX)
  219.   if (!(stream = fopen(filename, "r")))
  220.     ret=FPLERR_OPEN_ERROR;
  221.   else {
  222.     if(fseek(stream, 0, 2)) {
  223.       fclose(stream);
  224.       ret=FPLERR_OPEN_ERROR;
  225.     } else {
  226.       prog->size=ftell(stream)+1;
  227.       fseek(stream, 0, 0);
  228.     }
  229.   }
  230. #endif
  231.  
  232. #ifdef AMIGA
  233.   prog->date = GETFILEDATE(fileinfo);
  234. #else
  235.   if(!stat(filename, &statstr)) {
  236.     prog->date = statstr.st_mtime;
  237.   } else
  238.     ret=FPLERR_OPEN_ERROR;
  239. #endif
  240.  
  241.   if(ret)
  242.     return(ret);
  243.  
  244.   /* Open file for reading. */
  245. #ifdef AMIGA
  246.   /* We could use OpenFromLock() here, but it's a V36+ function! */
  247.   fileread=(struct FileHandle *)Open((UBYTE *)filename, MODE_OLDFILE);
  248. #elif defined(UNIX)
  249.   /* file is already opened! */
  250. #endif
  251.   prog->program=(char *)MALLOC(prog->size); /* Allocate memory for program. */
  252.   if(!prog->program) /* if we didn't get the requested memory: */
  253.     ret=FPLERR_OUT_OF_MEMORY;
  254. #ifdef AMIGA
  255.   else if(Read((BPTR)fileread, prog->program, (LONG)prog->size)<0) /* get entire file */
  256. #elif defined(UNIX)
  257.   else if(!fread(prog->program, 1, prog->size, stream))
  258. #endif
  259.     /* if we couldn't Read() the file: */
  260.     ret=FPLERR_OPEN_ERROR;
  261.   else
  262.     (prog->program)[prog->size-1]='\0'; /* add the terminating zero byte. */
  263. #ifdef AMIGA
  264.   Close((BPTR)fileread); /* close file */
  265. #elif defined(UNIX)
  266.   fclose(stream); /* close the stream */
  267. #endif
  268.   /* only if error and we could allocate the proper memory */
  269.   if(ret && prog->program) {
  270.     FREE(prog->program); /* free the, for the program allocated, memory */
  271.   }
  272.   return(ret); /* get back to parent */
  273. }
  274.  
  275. /**********************************************************************
  276.  *
  277.  * AddProgram();
  278.  *
  279.  * Adds a program to FPL's internal lists of program files.
  280.  *
  281.  ****/
  282.  
  283. static ReturnCode INLINE AddProgram(struct Data *scr,
  284.                     struct Program **get,
  285.                     char *program,
  286.                     long lines,
  287.                     char *name)
  288. {
  289.   struct Program *next, *prog=NULL;
  290.   ReturnCode ret;
  291.   long date=-1;
  292. #ifdef AMIGA
  293.   struct FileLock *lock;
  294.   struct FileInfoBlock fileinfo;
  295.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  296.   struct Library *DOSBase = lib->ml_DosBase;
  297. #else
  298.   struct stat statstr;
  299. #endif
  300.   if(name && name[0]) {
  301.     /*
  302.      * Name was given. Search through the internals to see if
  303.      * we have this file cached already!
  304.      */
  305.     prog=scr->programs;
  306.     while(prog) {
  307.       if(!strcmp(prog->name, name))
  308.     break;
  309.       prog=prog->next;
  310.     }
  311.   }
  312.   if(prog) {
  313.  
  314.     /*
  315.      * The program already exists.
  316.      */
  317.     if( (prog->flags & PR_REREAD_CHANGES) &&
  318.         (prog->flags & PR_NAME_IS_FILENAME) &&
  319.         !(prog->flags&PR_USERSUPPLIED) ) {
  320. #ifdef AMIGA
  321.       if (lock=(struct FileLock *)Lock((UBYTE *)prog->name, ACCESS_READ)) {
  322.         if (Examine((BPTR)lock, &fileinfo))
  323.           date = GETFILEDATE(fileinfo);
  324.         UnLock((BPTR)lock);
  325.       }
  326. #else
  327.       if(!stat(prog->name, &statstr)) {
  328.     date = statstr.st_mtime;
  329.       }
  330. #endif
  331.       /* Compare dates of internal program and actual file */
  332.       if(date != prog->date) {
  333.         /*
  334.          * The dates are different, flush all info that has to do with the
  335.          * file, and re-read it into memory!
  336.          */
  337.         unsigned long tags[]={FPLSEND_FREEFILE, NULL, FPLSEND_DONE};
  338.         tags[1] = (unsigned long)prog->name;
  339.         CALL(Send(scr, tags));
  340.         prog=NULL; /* force a insertion of this file again! */
  341.       }
  342.     }
  343.  
  344.     /*
  345.      * The very same good old program. If the FPLTAG_PREVENT_RUNNING_SAME
  346.      * was used, then abort here and now!
  347.      */
  348.     if(prog && scr->flags&FPLDATA_PREVENT_RUNNING_SAME) {
  349.       *get = NULL;
  350.       return FPL_OK;
  351.     }
  352.  
  353. /*
  354.  
  355.   These following actions don't have to be done!
  356.  
  357.     CALL(LeaveProgram(scr, scr->prog));
  358.     CALL(GetProgram(scr, prog));
  359. */
  360.   }
  361.  
  362.   if(!prog) {
  363.     GETMEMA(prog, sizeof(struct Program));
  364.     memset(prog, 0, sizeof(struct Program));
  365. #ifdef DEBUG
  366.     CheckMem(scr, prog);
  367. #endif
  368.     next=scr->programs;
  369.     prog->next=next;
  370.     prog->program=program;
  371.     prog->lines=lines;
  372.     prog->startprg=1;
  373.     prog->virprg=1;
  374.     prog->flags = (scr->flags&FPLDATA_REREAD_CHANGES?
  375.                     PR_REREAD_CHANGES:0)|
  376.                   (scr->flags&FPLDATA_FLUSH_NOT_IN_USE?
  377.                     PR_FLUSH_NOT_IN_USE:0)|
  378.           (scr->flags&FPLDATA_KIDNAP_CACHED?
  379.             PR_KIDNAP_CACHED:0);
  380.     if(name) {
  381.       STRDUPA(prog->name, name);
  382.     }
  383.     scr->programs=prog;
  384.   }
  385.  
  386.   scr->prog=prog;
  387.   *get=prog;
  388.   return(FPL_OK);
  389. }
  390.  
  391. /**********************************************************************
  392.  *
  393.  * DelProgram()
  394.  *
  395.  * Deletes a specifed program from memory. If NULL is specified where
  396.  * the program struct is supposed, all programs are removed! (Amiga
  397.  * version *have* to do that to UnLock() all files that might be locked
  398.  * when using the FPLTAG_LOCKUSED!
  399.  *
  400.  *******/
  401.  
  402. ReturnCode REGARGS
  403. DelProgram(struct Data *scr,
  404.            struct Program *del)
  405. {
  406.   struct Program *prog=scr->programs, *prev=NULL;
  407.   while(prog) { /* it must not be running! */
  408.     if((!del || prog==del) && !prog->running) {
  409.       if(prev)
  410.     prev->next=prog->next;
  411.       else
  412.     scr->programs=prog->next;
  413.       if(scr->prog==del)
  414.     scr->prog=scr->prog->next;
  415. #ifdef AMIGA
  416.       if(prog->lock)
  417.     UnLock((BPTR)prog->lock); /* unlock the program if it was locked before! */
  418. #endif
  419.       prev=prog->next;
  420.       if(prog->name)
  421.     FREEA(prog->name);
  422.       if(!(prog->flags&PR_USERSUPPLIED) && prog->program) {
  423.         SwapMem(scr, prog->program, MALLOC_DYNAMIC);
  424.         FREE(prog->program);
  425.       }
  426.       FREEA(prog);
  427.       if(!del) {
  428.     prog=prev;
  429.     prev=NULL;
  430.       } else {
  431.     if(del)
  432.       break;
  433.       }
  434.     } else {
  435.       prev=prog;
  436.       prog=prog->next;
  437.     }
  438.   }
  439.   return(FPL_OK);
  440. }
  441.  
  442. /**********************************************************************
  443.  *
  444.  * Run()
  445.  *
  446.  *****/
  447.  
  448. static ReturnCode REGARGS
  449. Run(struct Data *scr,
  450.     char *filename,
  451.     char *program,
  452.     long lines,
  453.     unsigned long *tags)
  454. {
  455.   ReturnCode end;
  456.   struct Expr *val;
  457.   unsigned long *tag=tags;
  458.   char storeglobals;    /* DEFAULT: fplInit() value! */
  459.   struct Program *thisprog, *prog;
  460.   struct Store *store;
  461.   struct Local *glob;
  462.   long currcol;
  463.   long *globpointer=NULL;
  464.   char debug_mode = scr->flags & FPLDATA_DEBUG_MODE?1:0; /* are we debugging? */
  465.  
  466. #ifdef DEBUG
  467.   long memory=mem;
  468. #endif
  469.  
  470.   if(!scr)
  471.     /* misbehaviour */
  472.     return(FPLERR_ILLEGAL_ANCHOR);
  473.  
  474.   if(scr->runs) {
  475.     /* this is a nested call! */
  476.     GETMEM(store, sizeof(struct Store));
  477.  
  478.     currcol=scr->text-(&scr->prog->program)[scr->prg-1];
  479.  
  480.     LeaveProgram(scr, scr->prog);
  481.     memcpy(store, &scr->text, sizeof(struct Store));
  482.   } else {
  483.     scr->msg = NULL;  /* We start with an empty message queue! */
  484.     scr->varlevel =0; /* start at locale level 0 */
  485.   }
  486.   end = AddProgram(scr, &prog, program, lines, filename);
  487.  
  488.   if(NULL == prog && FPL_OK == end) {
  489.     /*
  490.      * This execution was simply prevented due to circumstances!
  491.      */
  492.   }
  493.   else if(end <= FPL_EXIT_OK) {
  494.  
  495.     if(!prog->program && filename) {
  496.       /*
  497.        * It didn't already exist.
  498.        */
  499.       end = ReadFile(scr, filename, prog); /* get file */
  500.       prog->flags|=PR_NAME_IS_FILENAME;
  501.     } else if(!filename)
  502.       prog->flags=PR_USERSUPPLIED;
  503.  
  504.     if(end <= FPL_EXIT_OK) {
  505.  
  506.       end=GetProgram(scr, prog); /* lock it for our use! */
  507.  
  508.       if(end <= FPL_EXIT_OK) {
  509.  
  510.         thisprog=scr->prog;
  511.         if(scr->flags&FPLDATA_CACHEALLFILES) {
  512.           thisprog->flags|=PR_CACHEFILE;
  513.           if(scr->flags&FPLDATA_CACHEEXPORTS)
  514.             thisprog->flags|=PR_CACHEEXPORTS;
  515.         } else
  516.           thisprog->flags&=~PR_CACHEFILE;
  517.  
  518.         thisprog->openings++;
  519.  
  520.         scr->prg=thisprog->startprg;     /* starting line number */
  521.         scr->text=(&thisprog->program)[thisprog->startprg-1]+
  522.           thisprog->startcol; /* execute point */
  523.  
  524.         scr->ret=FPL_OK;        /* return code reset */
  525.         scr->virprg=thisprog->virprg;    /* starting at right virtual line */
  526.         scr->virfile=thisprog->virfile;    /* starting at right virtual file */
  527.         scr->level=0;            /* level counter */
  528.         scr->strret=FALSE;        /* we don't want no string back! */
  529.         scr->interpret=NULL;        /* no interpret tag as default */
  530.         scr->locals=NULL;        /* local symbol list */
  531.         scr->globals=NULL;        /* global symbol list */
  532.         scr->FPLret=0;        /* initialize return code value */
  533.         scr->string_return=NULL;    /* no string returns allowed */
  534.  
  535.         while(tag && *tag) {
  536.           switch(*tag++) {
  537.           case FPLTAG_DEBUG:
  538.         scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE, *tags);
  539.         break;
  540.  
  541.           case FPLTAG_REREAD_CHANGES:
  542.         thisprog->flags = BitToggle(thisprog->flags,
  543.                     PR_REREAD_CHANGES, *tags);
  544.             break;
  545.  
  546.           case FPLTAG_FLUSH_NOT_IN_USE:
  547.         thisprog->flags = BitToggle(thisprog->flags,
  548.                     PR_FLUSH_NOT_IN_USE, *tags);
  549.             break;
  550.  
  551.           case FPLTAG_KIDNAP_CACHED:
  552.         thisprog->flags = BitToggle(thisprog->flags,
  553.                     PR_KIDNAP_CACHED, *tags);
  554.             break;
  555.  
  556.           case FPLTAG_STRING_RETURN:
  557.             scr->string_return = (char **)*tag;
  558.             scr->strret=TRUE; /* enable return string */
  559.             break;
  560.  
  561.           case FPLTAG_INTERPRET:
  562.             scr->interpret=(char *)*tag;
  563.             break;
  564.  
  565.           case FPLTAG_STARTPOINT:
  566.             scr->text=(char *)*tag;
  567.             break;
  568.           case FPLTAG_STARTLINE:
  569.             scr->prg=(long)*tag;
  570.             break;
  571.           case FPLTAG_USERDATA:
  572.             scr->userdata=(void *)*tag;
  573.             break;
  574.           case FPLTAG_CACHEFILE:
  575.             if(*tag) {
  576.               thisprog->flags|=PR_CACHEFILE;
  577.               if(*tag=FPLCACHE_EXPORTS)
  578.                 thisprog->flags|=PR_CACHEEXPORTS;
  579.             } else
  580.               thisprog->flags&=~PR_CACHEFILE;
  581.             break;
  582.           case FPLTAG_PROGNAME:
  583.         if(*tag) {
  584.               prog=scr->programs;
  585.               while(prog) {
  586.                 if(prog->name && !strcmp(prog->name, (char *)*tag))
  587.                   break;
  588.                 prog=prog->next;
  589.               }
  590.               if(!prog) {
  591.                 /*
  592.                  * The program was not found, then set/rename the
  593.                  * current program to this name!
  594.                  */
  595.                 if(thisprog->name) {
  596.                   FREEA(thisprog->name);
  597.                 }
  598.                 STRDUPA(thisprog->name, *tag);
  599.               } else {
  600.                 /*
  601.                  * We found another progam with that name. Execute that
  602.                  * instead of this!
  603.                  */
  604.                 DelProgram(scr, thisprog);
  605.                 thisprog=prog;
  606.               }
  607.         }
  608.             break;
  609.           case FPLTAG_FILENAMEGET:
  610.         thisprog->flags = BitToggle(thisprog->flags,
  611.                     PR_FILENAMEFLUSH, *tags);
  612.             break;
  613.           case FPLTAG_ISCACHED:
  614.             globpointer = (long *)*tag;
  615.             break;
  616.           }
  617.           tag++;
  618.         }
  619.  
  620.         if(!thisprog->name) {
  621.           /* If no name has been given, do not store any global symbols from it! */
  622.           STRDUPA(thisprog->name, FPLTEXT_UNKNOWN_PROGRAM);
  623.           storeglobals=FALSE;
  624.           thisprog->flags&=~(PR_CACHEFILE|PR_CACHEEXPORTS);
  625.         } else
  626.           storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS);
  627.  
  628.         scr->virfile=thisprog->name; /* starting with this file */
  629.  
  630.         val= MALLOC(sizeof(struct Expr));
  631.         if(val) {
  632.           end=Go(scr, val);
  633.           if(end<=FPL_EXIT_OK &&
  634.              scr->string_return) {
  635.             /*
  636.              * No error and
  637.              * we accept string returns and...
  638.              */
  639.             if((val->flags&(FPL_STRING|FPL_RETURN)) ==
  640.                (FPL_STRING|FPL_RETURN) &&
  641.                val->val.str) {
  642.               /*
  643.                * ...there was a final "return" or "exit" keyword.
  644.                * and we have a returned string to deal with.
  645.                */
  646.   
  647.               /* assign the pointer */
  648.               *scr->string_return = val->val.str->string;
  649.   
  650.               /* make it a "static" allocation */
  651.               SwapMem(scr, val->val.str, MALLOC_STATIC);
  652.             }
  653.             else {
  654.               /*
  655.                * If not, reset the pointer to NULL!
  656.                */
  657.               *scr->string_return = NULL;
  658.             }
  659.           }
  660.           FREE(val);
  661.         } else
  662.           end=FPLERR_OUT_OF_MEMORY;
  663.  
  664.         if(end>FPL_EXIT_OK) {
  665.           struct fplArgument pass={
  666.             NULL, FPL_GENERAL_ERROR, NULL, 0};
  667.           void *array[1];
  668.           pass.key=(void *)scr;
  669.           array[0] = (void *)end;
  670.           pass.argv= array;
  671.  
  672.           if(scr->error) {
  673.         /* We'll fix the error string! */
  674.         GetErrorMsg(scr, end, scr->error);
  675.       }
  676.  
  677.           /* new argv assigning for OS/2 compliance! */
  678.           InterfaceCallNoStack(scr, &pass, scr->function);
  679.         }
  680.  
  681.         thisprog->column=scr->text-(&thisprog->program)[scr->prg-1]+1;
  682.         scr->virfile=NULL; /* most likely to not point to anything decent
  683.                               anyway! */
  684.  
  685.         /*
  686.          * Go through the ENTIRE locals list and delete all. Otherwise they will
  687.          * ruin the symbol table.
  688.          */
  689.  
  690.         while(scr->locals)
  691.           DelLocalVar(scr, &scr->locals);
  692.  
  693.         thisprog->openings--;
  694.         LeaveProgram(scr, thisprog); /* failure is a victory anyway! */
  695.  
  696.         /*
  697.          * If the option to cache only programs exporting symbols is turned on,
  698.          * then we must check if any of the globals are exported before caching!
  699.          */
  700.  
  701.         if(end<=FPL_EXIT_OK && (storeglobals & PR_CACHEEXPORTS)) {
  702.           glob = scr->globals;
  703.  
  704.           while(glob) {
  705.             /* Traverse all global symbols */
  706.  
  707.             if(glob->ident->flags&FPL_EXPORT_SYMBOL)
  708.               /* if we found an exported symbol, get out of loop */
  709.               break;
  710.  
  711.             glob=glob->next; /* goto next global */
  712.           }
  713.  
  714.           if(!glob)
  715.             /* no exported symbols were found! */
  716.             storeglobals = FALSE; /* do not cache this file! */
  717.         }
  718.  
  719.         if(end<=FPL_EXIT_OK && storeglobals && thisprog->flags&PR_CACHEFILE) {
  720.          /* no error, store the globals and cache the file */
  721.  
  722.           if(!(thisprog->flags&PR_GLOBALSTORED)) {
  723.  
  724.             if(scr->globals) {
  725.           long total_size;
  726.           long line=1;
  727.           char *newprogram;
  728.               {
  729.         if(!(thisprog->flags&PR_USERSUPPLIED))
  730.           /*
  731.            * The memory is allocated by FPL itself!
  732.            */
  733.                   SwapMem(scr, thisprog->program, MALLOC_STATIC);
  734.         else {
  735.                   /*
  736.                    * The memory is allocated by the user!
  737.            */
  738.           if(thisprog->flags&PR_KIDNAP_CACHED) {
  739.             /*
  740.              * We have been instructed to "take over" all host
  741.              * allocations that we intend to keep as cached files!
  742.              */
  743.  
  744.             /* start with counting the total size of the program: */
  745.             for(line = total_size = 0; line<thisprog->lines; line++)
  746.               total_size += strlen( (&thisprog->program)[line] );
  747.  
  748.             /* get enough memory to duplicate it! */
  749.             newprogram = MALLOCA(total_size + 1 ); /* add for zero */
  750.                     newprogram[total_size] = CHAR_ASCII_ZERO;
  751.             if(newprogram) {
  752.               /*
  753.                * We got requested amount of memory to copy the entire
  754.                * user supplied program!
  755.                */
  756.                       for(line = total_size = 0; line<thisprog->lines; line++) {
  757.                         strcpy(newprogram+total_size,
  758.                    (&thisprog->program)[line]);
  759.             total_size += strlen( (&thisprog->program)[line] );
  760.               }
  761.               thisprog->program = newprogram;
  762.               thisprog->lines = 1; /* this is now in one single line! */
  763.  
  764.                       /* switch off the now incorrect bit: */
  765.               thisprog->flags &= ~PR_USERSUPPLIED;
  766.             }
  767.             else {
  768.               /* We couldn't allocate a copy of the program, fail */
  769.               line=0;
  770.               end = FPLERR_OUT_OF_MEMORY; /* fail with proper return
  771.                                              code! */
  772.             }
  773.           }
  774.         }
  775.           }
  776.           if(line) {
  777.                 /* Store all global symbols!!! */
  778.                 StoreGlobals(scr, MALLOC_STATIC); /* ignore return code */
  779.  
  780.             /* set the flag saying we did so! */
  781.                 thisprog->flags|=PR_GLOBALSTORED;
  782.           }
  783.             } else
  784.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  785.           }
  786.         } else {
  787.           /*
  788.            * We must delete the global symbol lists
  789.            * properly and not just free the memory. Otherwise we might free memory
  790.            * used in the middle of the list we intend to save for next run!
  791.            */
  792.           if(!thisprog->openings) {
  793.             /* If not in use */
  794.             if(scr->globals)
  795.             /* There is some global symbols to delete! */
  796.             DelLocalVar(scr, &scr->globals);
  797.  
  798.             /*
  799.              * Check if this program was stored in memory earlier (in
  800.              * another run). If not ...
  801.              */
  802.             if(!(thisprog->flags&PR_GLOBALSTORED)) {
  803.               /*
  804.                * ...delete this program from memory!
  805.                */
  806.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  807.             }
  808.           }
  809.         }
  810.  
  811.         if(globpointer)
  812.           *globpointer=(long)scr->globals;
  813.  
  814.         scr->runs--;
  815.       } /* else
  816.           We didn't get the program, out of memory or stupid interface
  817.           function reply!
  818.          */
  819.     } else
  820.       DelProgram(scr, prog); /* we couldn't load it! */
  821.   }
  822.  
  823.   /*
  824.    * Reset the debug mode status we had when we entered this function!
  825.    */
  826.   scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE, debug_mode);
  827.  
  828.   if(scr->runs) {
  829.     /* still running! */
  830.  
  831.     memcpy(&scr->text, store, sizeof(struct Store));
  832.     GetProgram(scr, scr->prog);
  833.     FREE(store);
  834.  
  835.     /* reset execute point: */
  836.     scr->text=(&scr->prog->program)[scr->prg-1]+ currcol;
  837.   }
  838.   else {
  839.     FREEALL(); /* frees all ALLOC_DYNAMIC */
  840.   }
  841.  
  842.   return(end==FPL_EXIT_OK?FPL_OK:end);
  843. }
  844.  
  845. /**********************************************************************
  846.  *
  847.  * Go();
  848.  *
  849.  * This is an own function to make the stack usage in this particular
  850.  * function very small. Then we don't have to copy more than 10-20 bytes
  851.  * of the old stack when swapping to the new in the amiga version of the
  852.  * library!
  853.  *
  854.  ******/
  855.  
  856. static ReturnCode Go(struct Data *scr, struct Expr *val)
  857. {
  858.   ReturnCode ret;
  859. #if defined(AMIGA) && defined(SHARED)
  860.   /* The function call below is a assembler routine that allocates a new
  861.      stack to use in the library! */
  862. #if 0
  863.   if(!scr->runs++) {
  864. #endif
  865.     scr->runs++;
  866.     ret=InitStack(scr, val,
  867.           SCR_BRACE| /* to make it loop and enable declarations */
  868.           SCR_FUNCTION| /* return on return() */
  869.                   SCR_FILE|   /* this level may end with '\0' */
  870.           SCR_GLOBAL, /* global symbol declarations enabled */
  871.           NULL);
  872. #if 0
  873.     EndStack(scr, scr->stack_max);
  874.   } else {
  875.     ret=Script(scr, val,
  876.            SCR_BRACE| /* to make it loop and enable declarations */
  877.            SCR_FUNCTION| /* return on return() */
  878.                SCR_FILE|   /* this level may end with '\0' */
  879.            SCR_GLOBAL, /* global symbol declarations enabled */
  880.            NULL);
  881.   }
  882. #endif
  883. #else /* Not Amiga, Not shared! */
  884.   scr->runs++;
  885.   ret=Script(scr, val,
  886.          SCR_BRACE|    /* to make it loop and enable declarations */
  887.          SCR_FUNCTION| /* return on return() */
  888.              SCR_FILE|   /* this level may end with '\0' */
  889.          SCR_GLOBAL, /* global symbol declarations enabled */
  890.          NULL);
  891. #endif
  892.   return(ret);
  893. }
  894.  
  895.  
  896. static ReturnCode REGARGS
  897. StoreGlobals(struct Data *scr,
  898.              char type)
  899. {
  900.   struct Local *local, *prev=NULL;
  901.   struct Identifier *ident;
  902.   struct fplVariable *var;
  903.  
  904.   if(scr->prog->running>1)
  905.     /*
  906.      * It's enough if we commit this only on the ground level exit!
  907.      */
  908.     return(FPL_OK);
  909.  
  910.   local=scr->globals;
  911.   while(local) {
  912.     ident=local->ident;
  913.     if(ident->flags&FPL_VARIABLE) {
  914.       SwapMem(scr, local, type);        /* preserve the chain! */
  915.       SwapMem(scr, ident, type);        /* structure */
  916.       SwapMem(scr, ident->name, type);    /* name */
  917.       var=&ident->data.variable;
  918.  
  919.       SwapMem(scr, var->var.val32, type); /* variable area */
  920.  
  921.       if(!var->num && ident->flags&FPL_STRING_VARIABLE && var->var.str[0])
  922.     /* no array but assigned string variable */
  923.     SwapMem(scr, var->var.str[0], type);    /* string */
  924.       else if(var->num) {
  925.     /* array */
  926.     SwapMem(scr, var->dims, type); /* dim info */
  927.     if(ident->flags&FPL_STRING_VARIABLE) {
  928.       int i;
  929.       for(i=0; i<var->size; i++) {
  930.         /* Take one pointer at a time */
  931.         if(var->var.str[i])
  932.           /* if the value is non-zero, it contains the allocated length
  933.          of the corresponding char pointer in the ->array->vars
  934.          array! */
  935.           SwapMem(scr, var->var.str[i], type);
  936.           }
  937.       SwapMem(scr, var->var.str, type);
  938.     }
  939.       }
  940.     } else if(ident->flags&FPL_FUNCTION) {
  941.       SwapMem(scr, local, type);        /* preserve the chain! */
  942.       SwapMem(scr, ident, type);        /* structure */
  943.       SwapMem(scr, ident->name, type);    /* name */
  944.       SwapMem(scr, ident->data.inside.format, type);    /* parameter string */
  945.     }
  946.     prev=local;
  947.     local=local->next;
  948.   }
  949.   if(prev) {
  950.     prev->next=scr->usersym; /* link in front of our previous list! */
  951.     scr->usersym=scr->globals;
  952.   }
  953.   scr->globals=NULL;
  954.   return(FPL_OK);
  955. }
  956.  
  957. /**************************************************************************
  958.  *
  959.  * int Script(struct Data *);
  960.  *
  961.  * Interprets an FPL program, very recursive. Returns progress in an integer,
  962.  * and the FPL program result code in the int scr->ret.
  963.  * USE AS FEW VARIABLES AS POSSIBLE to spare stack usage!
  964.  *
  965.  **********/
  966.  
  967. ReturnCode ASM
  968. Script(AREG(2) struct Data *scr,  /* big FPL structure */
  969.        AREG(3) struct Expr *val,  /* result structure  */
  970.        DREG(2) short control,      /* control byte */
  971.        AREG(1) struct Condition *con)
  972. {
  973.   char declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  974.   ReturnCode ret;           /* return value variable */
  975.   struct Condition *con2;      /* recursive check information! */
  976.   char brace=0; /* general TRUE/FALSE variable */
  977.   char *text; /* position storage variable */
  978.   long prg;   /* position storage variable */
  979.   long levels=scr->level; /* previous level spectra */
  980.   struct Identifier *ident; /* used when checking keywords */
  981.   long virprg=scr->virprg;
  982.   char *virfile=scr->virfile;
  983.   char done=FALSE; /* TRUE when exiting */
  984.   struct fplArgument *pass;
  985.  
  986. #if defined(AMIGA) && defined(SHARED)
  987.   if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  988.     if(ret==1)
  989.       return(FPLERR_OUT_OF_MEMORY);
  990.     else
  991.       return(FPLERR_OUT_OF_STACK);
  992.   }
  993. #endif
  994.  
  995.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  996.     /*
  997.      * New symbol declaration level!
  998.      */
  999.     scr->varlevel++;
  1000.     CALL(AddLevel(scr));
  1001.   }
  1002.  
  1003.   if(control&SCR_FUNCTION)
  1004.     scr->level=0; /* number of levels to look for variables */
  1005.   else if(control&SCR_BRACE)
  1006.     scr->level++;
  1007.  
  1008.   if(scr->flags&FPLDATA_DEBUG_MODE) {
  1009.     /*
  1010.      * If debug mode is on already here, it means that our previous level
  1011.      * had it and we must make sure that they will even when we return.
  1012.      * (Without that bit, CleanUp() will switch off debug mode!)
  1013.      */
  1014.     control|=SCR_DEBUG;
  1015.   }
  1016.   while(!done) {
  1017.     if(ret=Eat(scr)) {
  1018.       if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
  1019.     /* It's OK! */
  1020.     ret=FPL_OK;
  1021.       break;
  1022.     }
  1023.  
  1024.     /* call the interval function */
  1025.     if(scr->interfunc) {
  1026.       if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  1027.     CALL(Warn(scr, FPLERR_PROGRAM_STOPPED)); /* >warning< */
  1028.     }
  1029.  
  1030. #ifdef DEBUGMAIL
  1031.     DebugMail(scr, MAIL_EXECUTE, 500, NULL);
  1032. #endif
  1033.  
  1034.     switch(*scr->text) {
  1035.     case CHAR_OPEN_BRACE:        /* open brace */
  1036.       scr->text++;
  1037.       CALL(Script(scr, val,
  1038.                   SCR_NORMAL|SCR_BRACE,
  1039.           con));
  1040.       if(CheckIt(scr, val, control, &ret)) {
  1041.     CleanUp(scr, control, levels);
  1042.     return(ret);
  1043.       }
  1044.       break;
  1045.  
  1046.     case CHAR_CLOSE_BRACE:
  1047.       if(control&SCR_LOOP) {
  1048.     if(control&SCR_BRACE) {
  1049.       DelLocalVar(scr, &scr->locals); /* delete all local declarations */
  1050.       scr->varlevel--;                /* previous variable level */
  1051.       scr->level--;           /* previous level spectra */
  1052.     }
  1053.         CALL(Loop(scr, con, control, &brace));
  1054.     if(brace) {
  1055.       /* Yes! We should loop! */
  1056.       if(control&SCR_BRACE) {
  1057.         /* bring back the proper values */
  1058.         scr->varlevel++;
  1059.         scr->level++;
  1060.         AddLevel(scr); /* restart this level! */
  1061.         declare=TRUE;
  1062.       }
  1063.       scr->virprg=virprg;
  1064.       scr->virfile=virfile;
  1065.       continue;
  1066.     }
  1067.         val->flags=0;
  1068.       } else {
  1069.     scr->text++;
  1070.         val->flags=FPL_BRACE;
  1071.     CleanUp(scr, control, levels);
  1072.       }
  1073.       scr->returnint = NULL; /* no result integer! */
  1074.       return(FPL_OK);  /* return to calling function */
  1075.  
  1076.     case CHAR_SEMICOLON:
  1077.       scr->text++;
  1078.       break;
  1079.  
  1080.     default:
  1081.       /*
  1082.        * Time to parse the statement!
  1083.        */
  1084.  
  1085.       text=scr->text;             /* store current position */
  1086.       prg=scr->prg;
  1087.       if(!Getword(scr))    /* get next word */
  1088.         GetIdentifier(scr, scr->buf, &ident);
  1089.       else {
  1090.     prg=-1;    /* we have not read a word! */
  1091.         ident=NULL;
  1092.       }
  1093.       if(ident && control&SCR_GLOBAL && declare) {
  1094.     /* still on ground level and declaration allowed */
  1095.     if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
  1096.       /*
  1097.        * We move the pointer for the execution start position to
  1098.        * this position.
  1099.        */
  1100.       scr->prog->startcol=text-(&scr->prog->program)[prg-1];
  1101.       scr->prog->startprg=prg;
  1102.       scr->prog->virprg=scr->virprg;
  1103.       scr->prog->virfile=scr->virfile;
  1104.       /*
  1105.        * This is the end of the declaration phase. Now, let's
  1106.        * check for that FPLTAG_INTERPRET tag to see if we should
  1107.        * have a little fun or simply continue!
  1108.        */
  1109.       if(scr->interpret) {
  1110.             done = TRUE;
  1111.             continue;
  1112.           }
  1113.     }
  1114.       }
  1115.       if(ident && ident->flags&FPL_KEYWORD) {
  1116.     if(ident->flags&FPL_KEYWORD_DECLARE) {
  1117.       if(!declare) {
  1118.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));   /* WARNING! */
  1119.         /* declare it anyway!!! */
  1120.       }
  1121.       CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
  1122.  
  1123.     } else {
  1124.       switch(ident->data.external.ID) {
  1125.           case CMD_SWITCH:
  1126.             CALL(Switch(scr, val, control, con));
  1127.             if(CheckIt(scr, val, control, &ret)) {
  1128.               CleanUp(scr, control, levels);
  1129.               return(ret);
  1130.             }
  1131.             break;
  1132.  
  1133.           case CMD_CASE:    /* 'case' */
  1134.             if(!control&SCR_SWITCH)
  1135.               return FPLERR_ILLEGAL_CASE; /* 'case' not within switch! */
  1136.             /*
  1137.              * This word can only be found if (control&SCR_SWITCH), and then
  1138.              * we must just skip the "case XX:" text and continue.
  1139.              */
  1140.             CALL(Eat(scr));
  1141.             if(scr->text[0]==CHAR_OPEN_PAREN) {
  1142.               /*
  1143.                * If this is an open parenthesis, we must search for the
  1144.                * opposite parenthesis to enable conditional statements
  1145.                * using the '?' and ':' operators.
  1146.                */
  1147.               CALL(GetEnd(scr, CHAR_CLOSE_PAREN,
  1148.                           CHAR_OPEN_PAREN, FALSE)); /* find close paren! */
  1149.             }
  1150.             if(GetEnd(scr, CHAR_COLON, 255, FALSE)) /* find colon! */
  1151.               return FPLERR_MISSING_COLON;
  1152.             if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
  1153.             /* If there was a string return, it should be freed and the
  1154.                string really held a string! */
  1155.               FREE(val->val.str);
  1156.             break;
  1157.  
  1158.           case CMD_DEFAULT: /* 'default' */
  1159.             if(!control&SCR_SWITCH)
  1160.               return FPLERR_ILLEGAL_DEFAULT; /* 'default' not within switch! */
  1161.             /*
  1162.              * This word can only be found if (control&SCR_SWITCH), and then
  1163.              * we must just skip the "default:" text and continue.
  1164.              */
  1165.             if(scr->text[0]!=CHAR_COLON) {
  1166.               if(GetEnd(scr, CHAR_COLON, 255, FALSE))
  1167.                 return FPLERR_MISSING_COLON;
  1168.             } else
  1169.               scr->text++;
  1170.             break;
  1171.  
  1172.       case CMD_TYPEDEF:
  1173.         CALL(Getword(scr));
  1174.         CALL(GetIdentifier(scr, scr->buf, &ident));
  1175.         if(!ret &&
  1176.            (ident->data.external.ID==CMD_INT ||
  1177.         ident->data.external.ID==CMD_STRING)) {
  1178.           CALL(Getword(scr));
  1179.           text=(void *)ident;
  1180.           GETMEM(ident, sizeof(struct Identifier));
  1181.           *ident=*(struct Identifier *)text; /* copy entire structure! */
  1182.           GETMEM(ident->name, strlen(scr->buf)+1);
  1183.           strcpy(ident->name, scr->buf);
  1184.           ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
  1185.                                declarator symbol! */
  1186.           CALL(AddVar(scr, ident, &scr->locals));
  1187.         } else {
  1188.           CALL(Warn(scr, FPLERR_IDENTIFIER_NOT_FOUND));
  1189.           /* then just skip this statement! */
  1190.           if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  1191.                 return FPLERR_MISSING_SEMICOLON;
  1192.         }
  1193.         break;
  1194.       case CMD_RETURN:
  1195.       case CMD_EXIT:
  1196.         Eat(scr);
  1197.             scr->returnint = NULL; /* point to result */
  1198.         if(*scr->text!=CHAR_SEMICOLON) { /* no return */
  1199.           brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
  1200.           scr->text+=brace;
  1201.  
  1202.           /*
  1203.            * If return()ing from a function when scr->strret is TRUE,
  1204.            * return a string.
  1205.            */
  1206.           if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
  1207.                  (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
  1208.         CALL(Expression(val, scr, CON_NORMAL, NULL));
  1209.         if(!(val->flags&FPL_STRING)) {
  1210.           /* that wasn't a string! */
  1211.           CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1212.         } else {
  1213.           /* It was a string! */
  1214.           if(val->flags&FPL_NOFREE) {
  1215.             /*
  1216.              * We're only refering to another string! We can't
  1217.              * allow that since that string might be a local
  1218.              * variable, and all such are about to be deleted now!
  1219.              */
  1220.             struct fplStr *string;
  1221.             GETMEM(string, val->val.str->len+sizeof(struct fplStr));
  1222.             memcpy(string,
  1223.                val->val.str,
  1224.                val->val.str->len+sizeof(struct fplStr));
  1225.             string->alloc=val->val.str->len;
  1226.             val->val.str=string;
  1227.             val->flags&=~FPL_NOFREE;
  1228.           }
  1229.         }
  1230.  
  1231.           } else {
  1232.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1233.                 scr->returnint = &scr->FPLret; /* point to result */
  1234.           }
  1235.           if(brace)
  1236.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1237.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1238.           /* continue */
  1239.         } else
  1240.           scr->text++;
  1241.         } else {
  1242.           val->val.val=0;
  1243.           val->flags=0;
  1244.         }
  1245.         scr->FPLret=val->val.val;    /* set return code! */
  1246.         if(ident->data.external.ID==CMD_RETURN) {
  1247.           ret=FPL_OK;
  1248.         } else
  1249.           ret=FPL_EXIT_OK; /* This will make us return through it all! */
  1250.  
  1251.             val->flags|=FPL_RETURN; /* inform calling function */
  1252.  
  1253.         CleanUp(scr, control, levels);
  1254.         return(ret);
  1255.       case CMD_IF:        /* if() */
  1256.       case CMD_WHILE:    /* while() */
  1257.         Eat(scr);
  1258.  
  1259.         /*********************
  1260.  
  1261.           PARSE CONDITION
  1262.  
  1263.           *******************/
  1264.  
  1265.  
  1266.         if(*scr->text!=CHAR_OPEN_PAREN) {
  1267.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1268.           /* please, go on! */
  1269.         } else
  1270.           scr->text++;
  1271.  
  1272.         GETMEM(con2, sizeof(struct Condition));
  1273.  
  1274.         /* save check position! */
  1275.         con2->check=scr->text;
  1276.         con2->checkl=scr->prg;
  1277.  
  1278.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1279.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1280.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1281.           /* continue */
  1282.         } else
  1283.           scr->text++;
  1284.  
  1285.         if(val->val.val) {
  1286.           /********************
  1287.  
  1288.         PARSE STATMENT
  1289.  
  1290.         ******************/
  1291.  
  1292.           Eat(scr);
  1293.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1294.           con2->bracetext=scr->text;
  1295.           con2->braceprg=scr->prg;
  1296.  
  1297.           CALL(Script(scr, val,
  1298.               (brace?SCR_BRACE:0)|
  1299.               (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF),
  1300.               con2));
  1301.           if(CheckIt(scr, val, control, &ret)) {
  1302.         FREE(con2);
  1303.         CleanUp(scr, control, levels);
  1304.         return(ret);
  1305.           }
  1306.           brace=TRUE;
  1307.         } else {
  1308.           /********************
  1309.  
  1310.         SKIP STATEMENT
  1311.  
  1312.         ******************/
  1313.  
  1314.           CALL(SkipStatement(scr));
  1315.           brace=FALSE;
  1316.         }
  1317.  
  1318.             Eat(scr); /* we must eat space before storing the position,
  1319.                          otherwise we might eat newlines several times! */
  1320.             
  1321.         text=scr->text;
  1322.         prg=scr->prg;
  1323.  
  1324.         Getword(scr);
  1325.  
  1326.         if(!strcmp(KEYWORD_ELSE, scr->buf) && brace) {
  1327.           /********************
  1328.  
  1329.         SKIP STATEMENT
  1330.  
  1331.         ******************/
  1332.  
  1333.           CALL(SkipStatement(scr));
  1334.         } else if(!strcmp(KEYWORD_ELSE, scr->buf) && !brace) {
  1335.           /********************
  1336.  
  1337.         PARSE STATMENT
  1338.  
  1339.         ******************/
  1340.  
  1341.           Eat(scr);
  1342.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1343.           con2->bracetext=scr->text;
  1344.           con2->braceprg=scr->prg;
  1345.           CALL(Script(scr, val, (brace?SCR_BRACE:0), con2));
  1346.           if(CheckIt(scr, val, control, &ret)) {
  1347.         FREE(con2);
  1348.         CleanUp(scr, control, levels);
  1349.         return(ret);
  1350.           }
  1351.         } else {
  1352.           scr->text=text;
  1353.           scr->prg=prg;
  1354.         }
  1355.         FREE(con2);
  1356.         break;
  1357.       case CMD_BREAK:
  1358.         val->val.val=1;    /* default is break 1 */
  1359.         val->flags=0;    /* reset flags */
  1360.         CALL(Eat(scr));
  1361.         /*
  1362.          * Check if break out of several statements.
  1363.          */
  1364.         if(*scr->text!=CHAR_SEMICOLON) {
  1365.           /* Get the result of the expression. */
  1366.           brace=*scr->text==CHAR_OPEN_PAREN;
  1367.           scr->text+=brace;
  1368.           CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1369.           if(brace)
  1370.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1371.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1372.         } else
  1373.           scr->text++;
  1374.           else if(val->val.val<0) {
  1375.         CALL(Warn(scr, FPLERR_ILLEGAL_BREAK));
  1376.         val->val.val=1; /* reset! */
  1377.           }
  1378.         }
  1379.         /*
  1380.          * Go to end of statement!!! If this was started without
  1381.          * SCR_BRACE set, we're already at the end of the statement!
  1382.          */
  1383.         if(control&SCR_BRACE) {
  1384.           if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1385.                 return FPLERR_MISSING_BRACE;
  1386. #ifdef DEBUG_BREAKS
  1387.           fprintf(stderr, "First: levels %d line %d, brace? %d chars: '%c%c%c%c%c'\n",
  1388.               val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  1389.               scr->text[0], scr->text[1], scr->text[2],
  1390.               scr->text[3], scr->text[4]);
  1391. #endif
  1392.             }
  1393.         if(control&SCR_DO)
  1394.           /* if it was inside a do statement, pass the ending `while' */
  1395.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  1396.         val->flags|=FPL_BREAK;
  1397.         if(control&(SCR_LOOP))
  1398.           if(!--val->val.val)
  1399.         val->flags&=~FPL_BREAK; /* only this break! */
  1400.         CleanUp(scr, control, levels);
  1401.         return(FPL_OK);
  1402.       case CMD_CONTINUE:
  1403.         if(*scr->text!=CHAR_SEMICOLON) {
  1404.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));  /* >warning< */
  1405.         } else
  1406.           scr->text++;
  1407.         if(control&SCR_LOOP) {
  1408.           /* loop! */
  1409.           if(control&SCR_BRACE) {
  1410.         DelLocalVar(scr, &scr->locals); /* delete all locals */
  1411.         scr->varlevel--;                /* previous variable level */
  1412.         scr->level--;                     /* previous level spectra */
  1413.           }
  1414.           CALL(Loop(scr, con, control, &brace));
  1415.           if(!brace) {
  1416.         /*
  1417.          * The result of the condition check was FALSE. Move to the end
  1418.          * of the block and continue execution there!
  1419.          */
  1420.  
  1421.         if(control&SCR_BRACE) {
  1422.           /* braces */
  1423.           if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1424.                     return FPLERR_MISSING_BRACE;
  1425.         } else {
  1426.           /* no braces! */
  1427.           if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  1428.                     return FPLERR_MISSING_SEMICOLON;
  1429.         }
  1430.         val->flags=0;
  1431.           } else {
  1432.         if(control&SCR_BRACE) {
  1433.           /* bring back the proper values */
  1434.           scr->varlevel++;
  1435.           scr->level++;
  1436.           AddLevel(scr); /* restart this level! */
  1437.           declare=TRUE;
  1438.         }
  1439.         scr->virprg=virprg;
  1440.         scr->virfile=virfile;
  1441.         continue;
  1442.           }
  1443.         } else {
  1444.           /* it's no looping statement! */
  1445.           val->flags=FPL_CONTINUE;
  1446.           CleanUp(scr, control, levels);
  1447.         }
  1448.         return(FPL_OK);
  1449.       case CMD_DO:
  1450.         CALL(Eat(scr));
  1451.         GETMEM(con2, sizeof(struct Condition));
  1452.         scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1453.         con2->bracetext=scr->text;
  1454.         con2->braceprg=scr->prg;
  1455.         con2->check=NULL;
  1456.         CALL(Script(scr, val, SCR_DO|(brace?SCR_BRACE:0), con2));
  1457.         FREE(con2);
  1458.         if(CheckIt(scr, val, control, &ret)) {
  1459.           CleanUp(scr, control, levels);
  1460.           return(ret);
  1461.         }
  1462.         break;
  1463.       case CMD_FOR:
  1464.         Eat(scr);
  1465.         scr->text++;
  1466.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));
  1467.  
  1468.         if(*scr->text!=CHAR_SEMICOLON) {
  1469.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1470.         } else
  1471.           scr->text++;
  1472.         GETMEM(con2, sizeof(struct Condition));
  1473.  
  1474.         con2->check=scr->text;
  1475.         con2->checkl=scr->prg;
  1476.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));
  1477.  
  1478.         if(*scr->text!=CHAR_SEMICOLON) {
  1479.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1480.         } else
  1481.           scr->text++;
  1482.         con2->postexpr=scr->text;
  1483.         con2->postexprl=scr->prg;
  1484.             {
  1485.           /*
  1486.            * Pass the last expression:
  1487.            */
  1488.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
  1489.         }
  1490.         if(!val->val.val) {
  1491.           /* We shouldn't enter the loop! Go to end of block:*/
  1492.           CALL(SkipStatement(scr));
  1493.           FREE(con2);
  1494.         } else {
  1495.           CALL(Eat(scr));
  1496.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1497.           con2->bracetext=scr->text;
  1498.           con2->braceprg=scr->prg;
  1499.           CALL(Script(scr, val, (brace?SCR_BRACE:0)|SCR_FOR, con2));
  1500.           FREE(con2);
  1501.           if(CheckIt(scr, val, control, &ret)) {
  1502.         CleanUp(scr, control, levels);
  1503.         return(ret);
  1504.           }
  1505.         }
  1506.         break;
  1507.       case CMD_RESIZE:
  1508.         CALL(Resize(scr, val, control));
  1509.         break;
  1510.       } /* switch(keyword) */
  1511.         } /* if it wasn't a declaring keyword */
  1512.       } else {
  1513.     declare=FALSE;
  1514.     CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
  1515. #if 0
  1516.     /*
  1517.      * First check for 'action' in the parsed statement!
  1518.          */
  1519.         if(!(val->flags&FPL_ACTION)) {
  1520.       /*
  1521.        * No 'action' !
  1522.        */
  1523.           CALL(Warn(scr, FPLERR_NO_ACTION));
  1524.           /* but we can just as good keep on anyway! */
  1525.         }
  1526. #endif
  1527.     /*
  1528.      * It it returned a string, flush it!
  1529.      */
  1530.     if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str) {
  1531.       /* If there was a string return, it should be freed and the
  1532.          string really held a string! */
  1533.       FREE(val->val.str);
  1534.     }
  1535.     /*
  1536.      * Check for semicolon!
  1537.      */
  1538.     if(*scr->text!=CHAR_SEMICOLON) {
  1539.       CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1540.     } else
  1541.       scr->text++;
  1542.       }
  1543.     } /* switch (*scr->text) */
  1544.  
  1545.     if(!(control&(SCR_BRACE|SCR_SWITCH))) {
  1546.       if(control&SCR_LOOP) {
  1547.     CALL(Loop(scr, con, control, &brace));
  1548.     if(brace) {
  1549.       /* Yes! We should loop! */
  1550.       if(control&SCR_BRACE) {
  1551.         /* bring back the proper values */
  1552.         scr->varlevel++;
  1553.         scr->level++;
  1554.         AddLevel(scr); /* restart this level! */
  1555.         declare=TRUE;
  1556.       }
  1557.       scr->virprg=virprg;
  1558.       scr->virfile=virfile;
  1559.       continue;
  1560.     }
  1561.     val->flags=0;
  1562.     ret=FPL_OK;
  1563.     break; /* return to calling function */
  1564.       } else
  1565.     break;
  1566.     }
  1567.   } /* loop! */
  1568.  
  1569.   /*
  1570.    * Check for that FPLTAG_INTERPRET tag!
  1571.    */
  1572.   if(!ret && scr->interpret) {
  1573.     if(!done) {
  1574.       /*
  1575.        * We did get here by hitting end of program.
  1576.        * Let's set the start-of-main position right here to
  1577.        * make another run work fine on this file too!
  1578.        */
  1579.       scr->prog->startcol=scr->text-(&scr->prog->program)[scr->prg-1];
  1580.       scr->prog->startprg=scr->prg;
  1581.       scr->prog->virprg=scr->virprg;
  1582.       scr->prog->virfile=scr->virfile;
  1583.     }
  1584.  
  1585.     /* an alternative main program is specified */
  1586.     GETMEM(pass, sizeof(struct fplArgument));
  1587.     pass->ID=FNC_INTERPRET;
  1588.     text = scr->interpret;
  1589.     pass->argv=(void **)&text;
  1590.     pass->key=scr;
  1591.     CALL(functions(pass));
  1592.  
  1593.     CleanUp(scr, control, levels);
  1594.  
  1595.     /* we're done for this time, exit! */
  1596.     ret = FPL_EXIT_OK;
  1597.   }
  1598.  
  1599.   CleanUp(scr, control, levels);
  1600.   return(ret);
  1601. }
  1602.  
  1603. static ReturnCode INLINE
  1604. Switch(struct Data *scr,
  1605.        struct Expr *val,
  1606.        short control,
  1607.        struct Condition *con)
  1608. {
  1609.   ReturnCode ret;
  1610.   struct fplStr *string;
  1611.   long value;
  1612.   char strtype=FALSE;
  1613.   char breakout=FALSE;
  1614.  
  1615.   /* temporary storage variables */
  1616.   char *ttext;
  1617.   long tprg;
  1618.   char *tvirfile;
  1619.   long tvirprg;
  1620.  
  1621.   char end=FALSE; /* we have not found the end position */
  1622.  
  1623.   long bprg;
  1624.   char *btext;
  1625.   long bvirprg;
  1626.   char *bvirfile;
  1627.  
  1628.   long dprg=-1;
  1629.   char *dtext;
  1630.   long dvirprg;
  1631.   char *dvirfile;
  1632.  
  1633.   CALL(Eat(scr)); /* eat whitespace */
  1634.  
  1635.   /* Check the open parenthesis */
  1636.   if(scr->text[0]!=CHAR_OPEN_PAREN) {
  1637.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1638.   } else
  1639.     scr->text++;
  1640.  
  1641.   /* Get expression, string or int, static or dynamic! */
  1642.   CALL(Expression(val, scr, CON_NORMAL, NULL));
  1643.  
  1644.   if(val->flags&FPL_STRING) {
  1645.     /* there was a string statement! */
  1646.     string = val->val.str;
  1647.     if(string)
  1648.       strtype=2;
  1649.     else
  1650.       strtype= 1;
  1651.  
  1652.   } else {
  1653.     /* there was an integer expression */
  1654.     value = val->val.val;
  1655.   }
  1656.  
  1657.   /* Check the close parenthesis */
  1658.   if(scr->text[0]!=CHAR_CLOSE_PAREN) {
  1659.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1660.   } else
  1661.     scr->text++;
  1662.  
  1663.   CALL(Eat(scr)); /* eat whitespace */
  1664.  
  1665.   /* Check the open brace */
  1666.   if(scr->text[0]!=CHAR_OPEN_BRACE) {
  1667.     CALL(Warn(scr, FPLERR_MISSING_BRACE)); /* >warning< */
  1668.   } else
  1669.     scr->text++;
  1670.  
  1671.   while(!(ret=Eat(scr))) {
  1672.     tprg = scr->prg;
  1673.     ttext = scr->text;
  1674.     tvirprg = scr->virprg;
  1675.     tvirfile = scr->virfile;
  1676.     if(!Getword(scr)) {
  1677.       if(!strcmp("case", scr->buf)) {
  1678.         /* This is a valid case-line coming up! */
  1679.  
  1680.         /* Get expression, string or int! */
  1681.         CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
  1682.         if(strtype) {
  1683.           /*
  1684.            * String comparison:
  1685.            */
  1686.           value = val->val.str?val->val.str->len:0;
  1687.  
  1688.           if(value == (string?string->len:0)) {
  1689.  
  1690.             if(value) {
  1691.               if(!memcmp(val->val.str->string, string->string, value)) {
  1692.                 /* match! */
  1693.                 breakout=TRUE;
  1694.               }
  1695.             } else
  1696.               breakout=TRUE;
  1697.           }
  1698.           if(!val->flags&FPL_NOFREE)
  1699.             FREE(val->val.str);
  1700.           if(breakout)
  1701.             break;
  1702.           else
  1703.             scr->text++; /* pass the ';' */
  1704.         } else {
  1705.           /*
  1706.            * Integer comparison:
  1707.            */
  1708.           if(val->val.val == value) {
  1709.             breakout = TRUE;
  1710.             break;
  1711.           } else
  1712.             scr->text++; /* pass the ';' */
  1713.         }
  1714.       } else if(!strcmp("default", scr->buf)) {
  1715.         /*
  1716.          * Store the default position to make it possible to return to if
  1717.          * necessary!
  1718.          */
  1719.  
  1720.     if(dprg>=0)
  1721.       return FPLERR_ILLEGAL_DEFAULT; /* dual 'default' specified! */
  1722.  
  1723.         dprg = scr->prg;
  1724.         dtext = scr->text++; /* pass the colon after the assign */
  1725.         dvirprg = scr->virprg;
  1726.         dvirfile = scr->virfile;
  1727.  
  1728.       } else {
  1729.         /*
  1730.          * Pass the statement!
  1731.          */
  1732.  
  1733.         /* First, restore the previuos position so that we can skip
  1734.            if, while, do and such things without problems! */
  1735.         scr->prg=tprg;
  1736.         scr->text=ttext;
  1737.         scr->virprg=tvirprg;
  1738.         scr->virfile=tvirfile;
  1739.  
  1740.         CALL(SkipStatement(scr));
  1741.       }
  1742.     } else {
  1743.       /* we didn't get any word */
  1744.       if(scr->text[0]==CHAR_CLOSE_BRACE) {
  1745.         /*
  1746.          * We hit the end without finding our 'case'! Return to the
  1747.          * 'default', if any! Store the position to be able to quickly
  1748.          * jump down to it again after the possible case-statement.
  1749.          */
  1750.  
  1751.         scr->text++; /* pass the closing brace */
  1752.         if(dprg<0)
  1753.           /* we didn't find any 'default' */
  1754.           break;
  1755.         bprg = scr->prg;
  1756.         btext = scr->text;
  1757.         bvirprg = scr->virprg;
  1758.         bvirfile = scr->virfile;
  1759.  
  1760.         end=TRUE; /* we have found the end! */
  1761.  
  1762.         scr->prg=dprg;
  1763.         scr->text=dtext;
  1764.         scr->virprg=dvirprg;
  1765.         scr->virfile=dvirfile;
  1766.         breakout = TRUE;
  1767.         break;
  1768.  
  1769.       } else {
  1770.         /*
  1771.          * Pass the statement!
  1772.          */
  1773.         CALL(SkipStatement(scr));
  1774.       }
  1775.     }
  1776.   }
  1777.   if(breakout) {
  1778.     /* we did break out on any of the 'case' or 'default' label lines,
  1779.        pass the colon!
  1780.      */
  1781.     /* CALL(Eat(scr));  eating whitespace shouldn't be necessary here */
  1782.  
  1783.     /* Check the colon */
  1784.     if(scr->text[0]!=CHAR_COLON) {
  1785.       CALL(Warn(scr, FPLERR_MISSING_COLON)); /* missing colon */
  1786.     } else
  1787.       scr->text++;
  1788.  
  1789.     /*
  1790.      * run this statement all the way until break or '}'!
  1791.      */
  1792.  
  1793.     CALL(Script(scr, val, SCR_SWITCH, con));
  1794.  
  1795.     if(!(val->flags&FPL_BRACE)) {
  1796.       /* we didn't run into the closing brace! */
  1797.  
  1798.       if(val->flags&FPL_BREAK && !--val->val.val) {
  1799.         /*
  1800.          * We got here after hitting a 'break' !!
  1801.          */
  1802.     val->flags&=~FPL_BREAK; /* only this break and no more ! */
  1803.       }
  1804.  
  1805.       /*
  1806.        * Go to the end of the switch()-statement.
  1807.        */
  1808.       if(!end) {
  1809.         /* we'll have to search for it! */
  1810.         if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1811.           return FPLERR_MISSING_BRACE;
  1812.       } else {
  1813.         scr->prg=bprg;
  1814.         scr->text=btext;
  1815.         scr->virprg=bvirprg;
  1816.         scr->virfile=bvirfile;
  1817.       }
  1818.     }
  1819.  
  1820.   }
  1821.   return ret;
  1822. }
  1823.  
  1824. static ReturnCode INLINE
  1825. Declare(struct Expr *val,
  1826.     struct Data *scr,
  1827.     struct Identifier *ident,
  1828.     long start)            /* start flags */
  1829. {
  1830.   ReturnCode ret;
  1831.   long flags=start;
  1832.   do {
  1833.     switch(ident->data.external.ID) {
  1834.     case CMD_EXPORT:
  1835.       flags|=CON_DECLEXP;
  1836.       break;
  1837.     case CMD_STRING:
  1838.       flags|=CON_DECLSTR;
  1839.       break;
  1840.     case CMD_INT:
  1841.       flags|=CON_DECLINT;
  1842.       if(ident->flags&FPL_SHORT_VARIABLE)
  1843.     flags|=CON_DECL16;
  1844.       else if(ident->flags&FPL_CHAR_VARIABLE)
  1845.     flags|=CON_DECL8;
  1846.       break;
  1847.     case CMD_VOID:
  1848.       flags|=CON_DECLVOID;
  1849.       break;
  1850.     case CMD_AUTO:
  1851.     case CMD_REGISTER:
  1852.       flags&=~(CON_DECLEXP|CON_DECLGLOB);
  1853.       break;
  1854.     case CMD_CONST:
  1855.       flags|=CON_DECLCONST;
  1856.       break;
  1857.     case CMD_STATIC:
  1858.       flags|=CON_DECLSTATIC;
  1859.       break;
  1860.     }
  1861.     CALL(Getword(scr));
  1862.     ret=GetIdentifier(scr, scr->buf, &ident);
  1863.   } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);
  1864.  
  1865.   if(!(flags&CON_DECLARE))
  1866.     flags|=CON_DECLINT; /* integer declaration is default! */
  1867.  
  1868.   CALL(Expression(val, scr, CON_GROUNDLVL|flags|CON_IDENT, ident));
  1869.   if(*scr->text!=CHAR_SEMICOLON &&
  1870.      (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) {
  1871.     CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1872.   } else
  1873.     scr->text++;
  1874.   return(FPL_OK);
  1875. }
  1876.  
  1877.  
  1878.  
  1879. /**********************************************************************
  1880.  *
  1881.  * Resize()
  1882.  *
  1883.  * This function resizes a variable array to the new given size.
  1884.  *
  1885.  *****/
  1886.  
  1887. static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, char control)
  1888. {
  1889.   char num=0; /* number of dimensions */
  1890.   long *dims; /* dimension array */
  1891.   struct fplVariable *var;
  1892.   struct Identifier *ident;
  1893.   ReturnCode ret;
  1894.   CALL(Getword(scr));
  1895.   CALL(GetIdentifier(scr, scr->buf, &ident));
  1896.   var=&ident->data.variable;
  1897.  
  1898.   if(!(ident->flags&FPL_VARIABLE) || !var->num) {
  1899.     return FPLERR_ILLEGAL_RESIZE;
  1900.   }
  1901.  
  1902.   Eat(scr);
  1903.   GETMEM(dims, MAX_DIMS*sizeof(long));
  1904.  
  1905.   do {
  1906.     if(*scr->text!=CHAR_OPEN_BRACKET) {
  1907.       CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  1908.     } else
  1909.       scr->text++; /* pass the open bracket */
  1910.     /* eval the expression: */
  1911.     CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1912.     if(*scr->text++!=CHAR_CLOSE_BRACKET)
  1913.       /* no close bracket means error */
  1914.       return(FPLERR_MISSING_BRACKET); /* missing bracket */
  1915.     else if(val->val.val<(control&CON_DECLARE?1:0)) {
  1916.       /* illegal result of the expression */
  1917.       /*
  1918.        * Set back original variable name!
  1919.        */
  1920.       strcpy(scr->buf, ident->name);
  1921.       return(FPLERR_ILLEGAL_ARRAY);
  1922.     }
  1923.     dims[num++]=val->val.val; /* Add another dimension */
  1924.     if(num==MAX_DIMS) {
  1925.       /* if we try to declare too many dimensions... */
  1926.       /*
  1927.        * Set back original variable name!
  1928.        */
  1929.       strcpy(scr->buf, ident->name);
  1930.       return FPLERR_ILLEGAL_ARRAY;
  1931.     }
  1932.     /*
  1933.      * Go on as long there are brackets,
  1934.      */
  1935.   } while(*scr->text==CHAR_OPEN_BRACKET);
  1936.  
  1937.   CALL(ArrayResize(scr, num, dims, ident));
  1938.  
  1939.   FREE(dims);
  1940.   return(FPL_OK);
  1941. }
  1942.  
  1943.  
  1944. ReturnCode REGARGS
  1945. ArrayResize(struct Data *scr,
  1946.             long num,   /* number of new dimensions */
  1947.             long *dims, /* array of new dim sizes */
  1948.             struct Identifier *ident) /* _valid_ variable to resize */
  1949. {
  1950.   long size;
  1951.   long i;
  1952.   long min;
  1953.   void *tempvars;
  1954.   struct fplVariable *var;
  1955.   char dynamic=FALSE;
  1956.   var=&ident->data.variable;
  1957.   
  1958.   size=dims[0]; /* array size */
  1959.   for(i=1; i<num; i++)
  1960.     size*=dims[i];
  1961.  
  1962.   min=MIN(size, var->size); /* number of variables to copy! */
  1963.  
  1964.   if(MALLOC_DYNAMIC == TypeMem(ident)) {
  1965.     dynamic = TRUE;
  1966.     GETMEM(tempvars, size * sizeof(void *)); /* data adjust! */
  1967.   }
  1968.   else {
  1969.     GETMEMA(tempvars, size * sizeof(void *)); /* data adjust! */
  1970.   }
  1971.   memcpy(tempvars, var->var.str, min * sizeof(void *));
  1972.   if(size>var->size)
  1973.     /*
  1974.      * If we create a few more than before, empty that data!
  1975.      */
  1976.     memset((char *)tempvars+var->size*sizeof(void *), 0,
  1977.        (size-var->size)*sizeof(void *));
  1978.  
  1979.   if(ident->flags&FPL_STRING_VARIABLE)
  1980.     for(i=min; i<var->size; i++) {
  1981.       if(var->var.str[i]) {
  1982.     FREE_KIND(var->var.str[i]);
  1983.       }
  1984.     }
  1985.  
  1986.   FREE_KIND(var->var.val);
  1987.   var->var.val= tempvars;
  1988.  
  1989.   var->size= size;
  1990.   var->num = num;
  1991.   FREE_KIND(var->dims);
  1992.   if(dynamic) {
  1993.     GETMEM(var->dims, num * sizeof(long));
  1994.   }
  1995.   else {
  1996.     GETMEMA(var->dims, num * sizeof(long));
  1997.   }
  1998.   memcpy(var->dims, dims, num * sizeof(long));
  1999.  
  2000.   return FPL_OK;
  2001. }
  2002.  
  2003. /**********************************************************************
  2004.  *
  2005.  * char CheckIt()
  2006.  *
  2007.  * Returns wether we should return from this Script().
  2008.  *
  2009.  *****/
  2010.  
  2011. static char REGARGS
  2012. CheckIt(struct Data *scr, /* major script structure */
  2013.         struct Expr *val, /* result structure */
  2014.         short control,    /* control defines */
  2015.         ReturnCode *ret)  /* return code pointer */
  2016. {
  2017.   if(val->flags&FPL_BREAK) {
  2018.     /*
  2019.      * A `break' was hit inside that Script() invoke.
  2020.      */
  2021.     if(control&SCR_BRACE) {
  2022.       /*
  2023.        * If we're inside braces, search for the close brace!
  2024.        */
  2025.       if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2026.     *ret = FPLERR_ILLEGAL_BREAK;
  2027.     return((char)*ret);
  2028.       }
  2029.     }
  2030. #ifdef DEBUG_BREAKS
  2031.     fprintf(stderr, "EOS: levels %d line %d, brace? %d chars: '%c%c%c%c%c'\n",
  2032.         val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  2033.         scr->text[0], scr->text[1], scr->text[2],
  2034.         scr->text[3], scr->text[4]);
  2035. #endif
  2036.  
  2037.     if(control&(SCR_LOOP)) {
  2038.       if(control&SCR_DO) {
  2039.         /*
  2040.          * We're inside a do-statement! We must pass the ending "while"
  2041.          * before returning! We do it the easy way: look for the closing
  2042.          * parenthesis!
  2043.          */
  2044.     if(*ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE))
  2045.       return((char)*ret);
  2046.         else if(*ret = Eat(scr))
  2047.       return((char)*ret);
  2048.         else if(scr->text[0] != CHAR_SEMICOLON) {
  2049.           if(*ret = Warn(scr, FPLERR_MISSING_SEMICOLON))
  2050.             return((char)*ret);
  2051.         } else
  2052.           scr->text++; /* pass the semicolon */
  2053.       }
  2054.       if(--val->val.val<1)
  2055.     val->flags&=~FPL_BREAK; /* clear the break bit! */
  2056.       return(TRUE);
  2057.     } else if(!(control&SCR_FUNCTION))
  2058.       return(TRUE);
  2059.     else if(val->val.val<2) {
  2060.       val->flags&=~FPL_BREAK; /* clear the break bit! */
  2061.       return(FALSE); /* no more break! */
  2062.     }
  2063.     *ret=FPLERR_ILLEGAL_BREAK;
  2064.     return(TRUE);
  2065.   } else if(val->flags&FPL_RETURN)
  2066.     /* The FPL function did end in a return() */
  2067.     return(TRUE);
  2068.   else if(val->flags&FPL_CONTINUE) {
  2069.     if(control&SCR_LOOP) {
  2070.       if(control&SCR_BRACE) {
  2071.     /* If we're inside braces, search for the close brace */
  2072.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2073.           *ret = FPLERR_MISSING_BRACE;
  2074.       return((char)*ret);
  2075.         }
  2076.     scr->text--; /* move one step back to stand on the close brace */
  2077.     return(FALSE);
  2078.       }
  2079.     } else
  2080.       /* this is not a looping block, break out of it! */
  2081.       return(TRUE);
  2082.   }
  2083.   return(FALSE);
  2084. }
  2085.  
  2086. /**********************************************************************
  2087.  *
  2088.  * CleanUp()
  2089.  *
  2090.  * Deletes/frees all local variable information.
  2091.  *
  2092.  *******/
  2093.  
  2094. void REGARGS
  2095. CleanUp(struct Data *scr,
  2096.         long control,
  2097.         long levels)
  2098. {
  2099.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  2100.     DelLocalVar(scr, &scr->locals);
  2101.     scr->varlevel--;
  2102.     scr->level=levels; /* new variable amplitude */
  2103.   }
  2104.  
  2105.   if(!(control&SCR_DEBUG)) {
  2106.     /* previous version did not run in debug mode, switch it off! */
  2107.     scr->flags&=~FPLDATA_DEBUG_MODE;
  2108.   }
  2109. }
  2110.  
  2111.  
  2112. /**********************************************************************
  2113.  *
  2114.  * Loop()
  2115.  *
  2116.  * This function is called at the end of a block, however the block was
  2117.  * started (brace or not brace).
  2118.  *
  2119.  *******/
  2120.  
  2121. static ReturnCode REGARGS
  2122. Loop(struct Data *scr,
  2123.      struct Condition *con,
  2124.      short control,
  2125.      char *cont) /* store TRUE or FALSE if loop or not */
  2126. {
  2127.   ReturnCode ret = FPL_OK;
  2128.   char *temptext=scr->text; /* store current position */
  2129.   long temprg=scr->prg;
  2130.   struct Expr *val;
  2131.  
  2132.   GETMEM(val, sizeof(struct Expr));
  2133.  
  2134.   /*
  2135.    * First check if the block just parsed begun with a while() or for()
  2136.    * or perhaps a do in which we know the statment position!
  2137.    */
  2138.  
  2139.   if((control&SCR_WHILE ||
  2140.       control&SCR_FOR ||
  2141.       (control&SCR_DO && con->check))) {
  2142.     if(control&SCR_FOR) {     /* check if the pre keyword was for() */
  2143.       scr->text=con->postexpr;/* perform the post expression */
  2144.       scr->prg=con->postexprl;
  2145.       CALL(Expression(val, scr, CON_GROUNDLVL|CON_PAREN, NULL));
  2146.     }
  2147.     /*
  2148.      * Do the condition check. The only statement if it was a while() or
  2149.      * do while or the second statement if it was a for().
  2150.      *
  2151.      * If it was a for() as pre statement, the statement could contain
  2152.      * nothing but a semicolon and then equals TRUE.
  2153.      */
  2154.     scr->text=con->check;
  2155.     scr->prg=con->checkl;
  2156.     CALL(Expression(val, scr, CON_GROUNDLVL|
  2157.             (control&SCR_FOR?CON_SEMICOLON:0)|CON_NUM, NULL));
  2158.  
  2159.     if(val->val.val) { /* the result of the condition was true */
  2160.       scr->text=con->bracetext; /* return to the open brace */
  2161.       scr->prg=con->braceprg;
  2162.       *cont=TRUE;
  2163.       FREE(val);
  2164.       return(FPL_OK);
  2165.     }
  2166.   }
  2167.  
  2168.   if(control&SCR_DO) {
  2169.     /* This a do while end. */
  2170.  
  2171.     if(!con->check) {
  2172.       /*
  2173.        * We *DON'T* know the condition position. We have to scan forward
  2174.        * to get it!
  2175.        */
  2176.       if(*scr->text==CHAR_CLOSE_BRACE)
  2177.     /* pass the close brace */
  2178.     scr->text++;
  2179.       if(ret=Getword(scr))
  2180.     ;
  2181.       else if(strcmp(scr->buf, "while"))
  2182.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2183.       else if(ret=Eat(scr))
  2184.     ;
  2185.       else if(*scr->text++!=CHAR_OPEN_PAREN)
  2186.     ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2187.       else {
  2188.     con->check=scr->text;
  2189.     con->checkl=scr->prg;
  2190.     if(ret=Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL))
  2191.       ;
  2192.     else if(*scr->text++!=CHAR_CLOSE_PAREN)
  2193.       ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2194.       }
  2195.       if(ret)
  2196.     return(ret);
  2197.     }
  2198.     if(!val->val.val) {
  2199.       /*
  2200.        * If we had the check point up there and the condition equaled
  2201.        * FALSE. Now we have to pass the the while keyword following the
  2202.        * close brace.
  2203.        */
  2204.       scr->text=temptext;
  2205.       scr->prg=temprg;
  2206.  
  2207.       if(*scr->text==CHAR_CLOSE_BRACE)
  2208.     /* pass the close brace */
  2209.     scr->text++;
  2210.  
  2211.       if(Getword(scr) || strcmp("while", scr->buf))
  2212.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2213.       else if(GetEnd(scr, CHAR_SEMICOLON, (char)255, FALSE))
  2214.     ret = FPLERR_MISSING_SEMICOLON;
  2215.       if(ret)
  2216.     return(ret);
  2217.     } else {
  2218.       /* go to the open brace */
  2219.       scr->text=con->bracetext;
  2220.       scr->prg=con->braceprg;
  2221.       *cont=TRUE;
  2222.       FREE(val);
  2223.       return(FPL_OK);
  2224.     }
  2225.   }
  2226.  
  2227.   FREE(val);
  2228.  
  2229.   /*
  2230.    * The condition check has failed!
  2231.    */
  2232.  
  2233.   *cont=FALSE;
  2234.  
  2235.   if(!(control&SCR_DO)) {
  2236.     /* it's not a do-while loop */
  2237.  
  2238.     scr->text=temptext;
  2239.     scr->prg=temprg;
  2240.  
  2241.     Eat(scr);
  2242.  
  2243.     if(control&SCR_BRACE && *scr->text==CHAR_CLOSE_BRACE)
  2244.       /* pass the close brace */
  2245.       scr->text++;
  2246.   }
  2247.  
  2248.   return(ret);
  2249. }
  2250.  
  2251. /**********************************************************************
  2252.  *
  2253.  * ReturnCode SkipStatement();
  2254.  *
  2255.  *  This function should pass one statement. Statements starting with
  2256.  * "for", "do", "while" or "if" really can be meesy and in such cases
  2257.  * this function recurse extensively!!!
  2258.  *
  2259.  ******/
  2260.  
  2261. static ReturnCode REGARGS
  2262. SkipStatement(struct Data *scr)
  2263. {
  2264.   ReturnCode ret;
  2265.   struct Identifier *ident;
  2266.   CALL(Eat(scr));
  2267.  
  2268.   if(*scr->text==CHAR_SEMICOLON)
  2269.     scr->text++;
  2270.   else if(*scr->text==CHAR_OPEN_BRACE) {
  2271.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2272.       return FPLERR_MISSING_BRACE;
  2273.   } else {
  2274.     /*
  2275.      * Much more trouble this way:
  2276.      */
  2277.  
  2278.     char *t;
  2279.     long p;
  2280.  
  2281.     ret = Getword(scr);
  2282.     if(!ret) {
  2283.       GetIdentifier(scr, scr->buf, &ident);
  2284.       switch(ident?ident->data.external.ID:0) {
  2285.       case CMD_IF:
  2286.       case CMD_WHILE:
  2287.         Eat(scr);
  2288.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2289.         CALL(SkipStatement(scr));
  2290.  
  2291.         t=scr->text;
  2292.         p=scr->prg;
  2293.  
  2294.         Getword(scr);
  2295.  
  2296.         if(!strcmp(KEYWORD_ELSE, scr->buf)) {
  2297.           CALL(SkipStatement(scr));
  2298.         } else {
  2299.           /*
  2300.            * Restore pointers.
  2301.            */
  2302.           scr->text=t;
  2303.           scr->prg=p;
  2304.         }
  2305.         break;
  2306.       case CMD_FOR:
  2307.         Eat(scr);
  2308.         /* Now we must stand on an open parenthesis */
  2309.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2310.         CALL(SkipStatement(scr));
  2311.         break;
  2312.       case CMD_DO:
  2313.         Eat(scr);
  2314.         CALL(SkipStatement(scr));
  2315.  
  2316.         /*
  2317.          * The next semicolon must be the one after the
  2318.          * following `while' keyword!
  2319.          */
  2320.         if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2321.           return FPLERR_MISSING_SEMICOLON;
  2322.         break;
  2323.       default:
  2324.         ret=TRUE;
  2325.       }
  2326.     }
  2327.     if(ret) {
  2328.       /*
  2329.        * This statement ends at the next semicolon
  2330.        */
  2331.       if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2332.         return FPLERR_MISSING_SEMICOLON;
  2333.     }
  2334.   }
  2335.   return(FPL_OK);
  2336. }
  2337.  
  2338. #ifdef UNIX
  2339. long InterfaceCall(struct Data *scr,
  2340.            void *arg,
  2341.            long (*func)(void *))
  2342. {
  2343.   return func(arg);
  2344. }
  2345. #endif
  2346.