/****************************************************************************** * FREXX PROGRAMMING LANGUAGE * ****************************************************************************** script.c The main routine of the language. Handles all keywords, {'s and }'s. *****************************************************************************/ /************************************************************************ * * * fpl.library - A run time library interpreting script langauge. * * Copyright (C) 1992, 1993 FrexxWare * * Author: Daniel Stenberg * * * * This program is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2, or (at your option) * * any later version. * * * * 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. See the * * GNU General Public License for more details. * * * * You should have received a copy of the GNU General Public License * * along with this program; if not, write to the Free Software * * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. * * * * Daniel Stenberg * * Birger Jarlsgatan 93b 3tr * * 113 56 Stockholm * * Sweden * * * * FidoNet 2:201/328 email: dast@sth.frontec.se * * * ************************************************************************/ #ifdef AMIGA #include #include #include #include #elif defined(UNIX) #include #endif /* * If this is the Amiga .library version we must have an ExecBase and a * DosLibrary pointer. */ #if defined(AMIGA) && defined(SHARED) struct ExecBase *SysBase; struct DosLibrary *DOSBase; #endif #include #include #include "script.h" #ifdef DEBUG long mem=0; long maxmem=0; #endif static ReturnCode INLINE AddProgram(struct Data *, struct Program **, char *, long, char *); static char CheckIt(struct Data *, struct Expr *, char, ReturnCode *); static ReturnCode INLINE Declare(struct Expr *, struct Data *, struct Identifier *, long); static ReturnCode INLINE Eatcomment(struct Data *); static ReturnCode Go(struct Data *, struct Expr *val); static ReturnCode Loop(struct Data *, struct Condition *, char, char *); static ReturnCode INLINE Resize(struct Data *, struct Expr *, char); static ReturnCode SkipStatement(struct Data *); static ReturnCode StoreGlobals(struct Data *, char type); /* * Global static string arrays for everywhere access: */ /* All FPL error messages. */ const char *errors[]={ "Couldn't open dos.library V33+", "Division by zero", "Illegal anchor", "Illegal array:", /* */ "Illegal assign", "Illegal break", "Illegal condition operator", "Illegal continue", "Illegal declaration", "Illegal parameter", "Illegal pre operation", "Illegal prototype", "Illegal resize", "Illegal statement", "Illegal variable type", "Internal", "Function not found:", /* */ "Missing apostrophe", "Missing argument", "Missing brace", "Missing bracket", "Missing operand", "Missing parentheses", "Missing semicolon", "Incomplete statement", "File", "Out of memory", "Parameter out of range", "Out of stack space", "Program stopped", "Read only violation:", /* */ "Syntax", "Unbalanced comment", "Unexpected end of program", "Unmatched brace", "Identifier not found:", /* */ "Identifier already used:", /* */ "Unknown" /* MUST be the last member */ }; const char type[256] = { /* Character type codes Hex */ END, 000, 000, 000, 000, 000, 000, 000, /* 00 */ 000, SPA, SPA, 000, 000, SPA, 000, 000, /* 08 */ 000, 000, 000, 000, 000, 000, 000, 000, /* 10 */ 000, 000, 000, 000, 000, 000, 000, 000, /* 18 */ SPA, 000, 000, 000, 000, 000, 000, 000, /* 20 !"#$%&' */ 000, 000, 000, 000, 000, 000, 000, 000, /* 28 ()*+,-./ */ DIG|HEX, DIG|HEX, DIG|HEX, DIG|HEX, /* 30 0123 */ DIG|HEX, DIG|HEX, DIG|HEX, DIG|HEX, /* 34 4567 */ DIG, DIG, 000, 000, 000, 000, 000, 000, /* 38 89:;<=>? */ 000, LET, LET, LET, LET, LET, LET, LET, /* 40 @ABCDEFG */ LET, LET, LET, LET, LET, LET, LET, LET, /* 48 HIJKLMNO */ LET, LET, LET, LET, LET, LET, LET, LET, /* 50 PQRSTUVW */ LET, LET, LET, 000, 000, 000, 000, LET, /* 58 XYZ[\]^_ */ 000, LET|HEX, LET|HEX, LET|HEX, /* 60 `abc */ LET|HEX, LET|HEX, LET|HEX, LET, /* 64 defg */ LET, LET, LET, LET, LET, LET, LET, LET, /* 68 hijklmno */ LET, LET, LET, LET, LET, LET, LET, LET, /* 70 pqrstuvw */ LET, LET, LET, 000, 000, 000, 000, 000, /* 78 xyz{|}~ */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ 000, 000, 000, 000, 000, 000, 000, 000, /* 80 .. FF */ }; static ReturnCode Run(struct Data *, char *, char *, long, unsigned long *); /*************************************************************************** * * fplExecuteFile() * * Executes the specified file as an FPL program. * ******/ ReturnCode PREFIX fplExecuteFile(REG(a0) struct Data *scr, REG(a1) char *filename, REG(a2) unsigned long *tags) { return(Run(scr, filename, NULL, 1, tags)); } /********************************************************************** * * fplExecuteScript() * * Frontend to Run(). * * The error code is returned to daddy... * ******/ ReturnCode PREFIX fplExecuteScript(REG(a0) struct Data *scr, /* nice struct */ REG(a1) char **program, /* program array */ REG(d1) long lines, /* number of lines */ REG(a2) unsigned long *tags) { 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 ReadFile(void *fpl, char *filename, struct Program *prog) { struct Data *scr=(struct Data *)fpl; #ifdef AMIGA /* Amiga version. */ struct FileInfoBlock fileinfo; struct FileLock *lock; struct FileHandle *fileread; #elif defined(UNIX) FILE *stream; #endif ReturnCode ret=FPL_OK; #ifdef AMIGA /* Open dos.library. Lowest acceptable version is V33. */ if(!(DOSBase=(struct DosLibrary *)OpenLibrary(DOSNAME, 33))) return(FPL_COULDNT_OPEN_DOS); /* Lock on source file to get file length! */ if (lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ)) { if (Examine((BPTR)lock, &fileinfo)) prog->size=fileinfo.fib_Size+1; /* Add one for a terminating zero! */ else ret=FPL_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=FPL_OPEN_ERROR; /* we couldn't lock on the file */ #elif defined(UNIX) if (!(stream = fopen(filename, "r"))) ret=FPL_OPEN_ERROR; else { if(fseek(stream, 0, 2)) { fclose(stream); ret=FPL_OPEN_ERROR; } else { prog->size=ftell(stream)+1; fseek(stream, 0, 0); } } #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=FPL_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=FPL_OPEN_ERROR; else (prog->program)[prog->size-1]='\0'; /* add the terminating zero byte. */ #ifdef AMIGA Close((BPTR)fileread); /* close file */ CloseLibrary((struct Library *)DOSBase); /* Close dos.library again. */ #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; if(name) { /* * 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) { 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; if(name) { STRDUPA(prog->name, name); } scr->programs=prog; } else { /* * The program already exists. */ CALL(LeaveProgram(scr, scr->prog)); CALL(GetProgram(scr, 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 DelProgram(struct Data *scr, struct Program *del) { struct Program *prog=scr->programs, *prev=NULL; while(prog) { if(!del || prog==del) { 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); FREEA(prog); if(!del) { prog=prev; prev=NULL; } else { if(del) break; } } else { prev=prog; prog=prog->next; } } return(FPL_OK); } /********************************************************************** * * Run() * *****/ static ReturnCode Run(struct Data *scr, char *filename, char *program, long lines, unsigned long *tags) { ReturnCode ret, end; struct Expr *val; unsigned long *tag=tags; char storeglobals=TRUE; /* DEFAULT: store all exported globals! */ struct Program *thisprog, *prog; struct Store *store; struct Local *glob; #ifdef DEBUG long memory=mem; #endif if(!scr) /* misbehaviour */ return(FPL_ILLEGAL_ANCHOR); if(scr->runs) { /* is this a nested call? */ LeaveProgram(scr, scr->prog); GETMEM(store, sizeof(struct Store)); memcpy(store, &scr->text, sizeof(struct Store)); } else scr->msg = NULL; /* We start with an empty message queue! */ CALL(AddProgram(scr, &prog, program, lines, filename)); if(!prog->program && filename) { /* * It didn't already exist. */ CALL(ReadFile(scr, filename, prog)); /* get file */ prog->flags|=PR_FILENAMEFLUSH; } else if(!filename) prog->flags=PR_USERSUPPLIED; CALL(GetProgram(scr, prog)); /* lock it for our use! */ 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->virfile=thisprog->name; /* starting with this file */ scr->virprg=1; /* starting at virtual line 1 */ scr->level=0; /* level counter */ scr->varlevel=0; /* variable level */ 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 */ while(tag && *tag) { switch(*tag++) { case FPLTAG_COMPILE: scr->compiling = (char)*tag; 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; storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS); break; case FPLTAG_PROGNAME: prog=scr->programs; while(prog) { if(!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: if(*tag) thisprog->flags|=PR_FILENAMEFLUSH; else thisprog->flags&=~PR_FILENAMEFLUSH; break; } tag++; } if(!thisprog->name || scr->compiling) { /* 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); } GETMEM(val, sizeof(struct Expr)); end=Go(scr, val); FREE(val); if(end>FPL_EXIT_OK) { struct fplArgument pass={ NULL, FPL_GENERAL_ERROR, NULL, 0}; pass.key=(void *)scr; pass.argv=(void **)&end; InterfaceCall(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--; CALL(LeaveProgram(scr, thisprog)); /* * 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) { /* is it changed and we should store the info and not compiling */ tag=tags; while(tag && *tag) { switch(*tag++) { case FPLTAG_FILEGLOBALS: /* case FPLTAG_ISCACHED: */ *(long *)*tag=(long)scr->globals; break; } tag++; } if(!(thisprog->flags&PR_GLOBALSTORED)) { if(scr->globals) { /* Store all global symbols!!! */ CALL(StoreGlobals(scr, MALLOC_STATIC)); if(thisprog->flags&PR_CACHEFILE && !(thisprog->flags&PR_USERSUPPLIED)) SwapMem(scr, thisprog->program, MALLOC_STATIC); /* else The memory is allocated by the user or not to be cached! */ 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); /* Delete this program from memory! */ DelProgram(scr, thisprog); /* this also removes the Lock() */ } } if(!--scr->runs) { /* not running any more! */ if(end>FPL_EXIT_OK) { FREEALL(); /* frees all ALLOC_DYNAMIC */ } } else { memcpy(&scr->text, store, sizeof(struct Store)); GetProgram(scr, scr->prog); FREE(store); } 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(!scr->runs++) { ret=InitStack(scr, val, SCR_BRACE| /* to make it loop and enable declarations */ SCR_FUNCTION| /* return on return() */ SCR_GLOBAL, /* global symbol declarations enabled */ NULL); 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_GLOBAL, /* global symbol declarations enabled */ NULL); } #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_GLOBAL, /* global symbol declarations enabled */ NULL); #endif return(ret); } static ReturnCode 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) /* no array but string variable */ SwapMem(scr, var->var.str, 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; isize; 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); } } } 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 Script(struct Data *scr, /* big FPL structure */ struct Expr *val, /* result structure */ char control, /* control byte */ struct Condition *con) { char declare=control&SCR_BRACE; /* 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, FPLSTACK_MINIMUM)) { if(ret==1) return(FPL_OUT_OF_MEMORY); else return(FPL_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++; while(!done) { if(ret=Eat(scr)) { if(scr->varlevel==1 && ret==FPL_UNEXPECTED_END) /* It's OK! */ ret=FPL_OK; if(scr->compiling) COMPILE(COMP_END_OF_PROGRAM); break; } /* call the interval function */ if(scr->interfunc) { if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc)) CALL(Warn(scr, FPL_PROGRAM_STOPPED)); /* >warning< */ } switch(*scr->text) { case CHAR_OPEN_BRACE: /* open brace */ scr->text++; if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); 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(!scr->compiling) { 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; } } else scr->text++; /* pass the brace! */ } else { scr->text++; CleanUp(scr, control, levels); } val->flags=0; if(scr->compiling) { COMPILE(COMP_END_OF_BLOCK); if(scr->varlevel == 0) { /* * This is the end of the ground function. We choose to continue * anyway to scan the entire file! * Then functions can again appear in the code, so we activate the * 'declare' flag again! */ declare = TRUE; break; } } 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; CALL(Getword(scr->buf, scr)); /* get next word */ GetIdentifier(scr, scr->buf, &ident); 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; if(scr->compiling) COMPILE(COMP_START_OF_CODE); /* * 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, FPL_ILLEGAL_DECLARE)); /* WARNING! */ /* declare it anyway!!! */ } CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0)); } else { if(scr->compiling) COMPILESYMBOL(scr->buf); switch(ident->data.external.ID) { case CMD_TYPEDEF: CALL(Getword(scr->buf, scr)); CALL(GetIdentifier(scr, scr->buf, &ident)); if(!ret && (ident->data.external.ID==CMD_INT || ident->data.external.ID==CMD_STRING)) { if(scr->compiling) COMPILESYMBOL(scr->buf); CALL(Getword(scr->buf, scr)); if(scr->compiling) COMPILESYMBOL(scr->buf); 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, FPL_IDENTIFIER_NOT_FOUND)); /* then just skip this statement! */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); } break; case CMD_RETURN: case CMD_EXIT: Eat(scr); if(*scr->text!=CHAR_SEMICOLON) { /* no return code */ brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */ scr->text+=brace; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); /* * If return()ing from a function when scr->strret is TRUE, * return a string. */ if(scr->strret && ident->data.external.ID==CMD_RETURN) { CALL(Expression(val, scr, CON_NORMAL, NULL)); if(!(val->flags&FPL_STRING)) { /* that wasn't a string! */ CALL(Warn(scr, FPL_ILLEGAL_PARAMETER)); } 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=NULL; 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)); } if(scr->compiling) COMPILE(COMP_END_OF_EXPR); if(brace) if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); /* continue */ } else scr->text++; } else { val->val.val=0; val->flags=0; } scr->FPLret=val->val.val; /* set return code! */ if(ret) ; else if(ident->data.external.ID==CMD_RETURN) { val->flags|=FPL_RETURN; /* inform calling function */ ret=FPL_OK; } else ret=FPL_EXIT_OK; /* This will make us return through it all! */ if(scr->compiling) /* compiling, no function actually does anything! */ break; 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, FPL_MISSING_PARENTHESES)); /* please, go on! */ } else scr->text++; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); 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, FPL_MISSING_PARENTHESES)); /* >warning< */ /* continue */ } else scr->text++; if(scr->compiling) COMPILE(COMP_END_OF_EXPR); if(val->val.val || scr->compiling) { /******************** PARSE STATMENT ******************/ Eat(scr); scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE); con2->bracetext=scr->text; con2->braceprg=scr->prg; if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); 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; } text=scr->text; prg=scr->prg; Getword(scr->buf, scr); if(!strcmp("else", scr->buf) && brace && !scr->compiling) { /******************** SKIP STATEMENT ******************/ CALL(SkipStatement(scr)); } else if(!strcmp("else", scr->buf) && (!brace || scr->compiling)) { /******************** PARSE STATMENT ******************/ if(scr->compiling) COMPILESYMBOL("else"); Eat(scr); scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE); con2->bracetext=scr->text; con2->braceprg=scr->prg; if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); 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 */ 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; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL)); if(brace) if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); } else scr->text++; else if(val->val.val<0) { CALL(Warn(scr, FPL_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(scr->compiling) { /* When compiling, do no "real" break! */ scr->text++; break; } if(control&SCR_BRACE) CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)); 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, FPL_MISSING_SEMICOLON)); /* >warning< */ } else scr->text++; if(scr->compiling) break; /* just continue on the next position! */ if(control&SCR_LOOP) { /* loop! */ if(control&SCR_BRACE && !scr->compiling) { 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 */ CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)); } else { /* no braces! */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); } 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; if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); 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++; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL)); if(*scr->text!=CHAR_SEMICOLON) { CALL(Warn(scr, FPL_MISSING_SEMICOLON)); } else scr->text++; GETMEM(con2, sizeof(struct Condition)); con2->check=scr->text; con2->checkl=scr->prg; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL)); if(*scr->text!=CHAR_SEMICOLON) { CALL(Warn(scr, FPL_MISSING_SEMICOLON)); } else scr->text++; con2->postexpr=scr->text; con2->postexprl=scr->prg; if(scr->compiling) { /* Do the last expression too!! */ if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL)); if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_MISSING_SEMICOLON)); } else scr->text++; /* pass the closing parenthesis! */ val->val.val= TRUE; /* always compile everything! */ } else { /* * 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; if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); 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 { if(scr->compiling) COMPILESYMBOL(scr->buf); declare=FALSE; CALL(Expression(val, scr, CON_ACTION|CON_IDENT, ident)); 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); if(*scr->text!=CHAR_SEMICOLON) { CALL(Warn(scr, FPL_MISSING_SEMICOLON)); /* >warning< */ } else scr->text++; } } /* switch (*scr->text) */ if(!(control&SCR_BRACE)) { if(scr->compiling) COMPILE(COMP_END_OF_BLOCK); if(control&SCR_LOOP) { CALL(Loop(scr, con, control, &brace)); if(brace && !scr->compiling) { /* 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) { /* 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 Declare(struct Expr *val, struct Data *scr, struct Identifier *ident, long start) /* start flags */ { ReturnCode ret; long flags=start; char *text; long prg; 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; } if(scr->compiling && !(ident->flags&FPL_IGNORE)) COMPILESYMBOL(scr->buf); text=scr->text; prg=scr->prg; CALL(Getword(scr->buf, scr)); ret=GetIdentifier(scr, scr->buf, &ident); } while(!ret && ident->flags&FPL_KEYWORD_DECLARE); scr->text=text; scr->prg=prg; if(!(flags&CON_DECLARE)) flags|=CON_DECLINT; /* integer declaration is default! */ CALL(Expression(val, scr, CON_GROUNDLVL|flags, NULL)); if(*scr->text!=CHAR_SEMICOLON && (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) { CALL(Warn(scr, FPL_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 */ char i; /* counter to max MAX_DIMS */ int size, min; void *tempvars; struct fplVariable *var; struct Identifier *ident; ReturnCode ret; CALL(Getword(scr->buf, scr)); CALL(GetIdentifier(scr, scr->buf, &ident)); var=&ident->data.variable; if(!(ident->flags&FPL_VARIABLE) || !var->num) { CALL(Warn(scr, FPL_ILLEGAL_RESIZE)); CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); } if(scr->compiling) COMPILESYMBOL(scr->buf); Eat(scr); GETMEM(dims, MAX_DIMS*sizeof(long)); do { if(*scr->text!=CHAR_OPEN_BRACKET) { CALL(Warn(scr, FPL_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(FPL_SYNTAX_ERROR); /* >warning< */ else if(val->val.val<(control&CON_DECLARE?1:0)) /* illegal result of the expression */ return(FPL_ILLEGAL_ARRAY); dims[num++]=val->val.val; /* Add another dimension */ if(num==MAX_DIMS) { /* if we try to declare too many dimensions... */ CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); /* Get to the end of this absurd resize! */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, !(*scr->text==CHAR_SEMICOLON))); break; } /* * Go on as long there are brackets, */ } while(*scr->text==CHAR_OPEN_BRACKET); size=dims[0]; /* array size */ for(i=1; isize); /* number of variables to copy! */ GETMEM(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; isize; i++) { if(var->var.str[i]) FREE(var->var.str[i]); } FREE(var->var.val); var->var.val= tempvars; var->size= size; FREE(var->dims); GETMEM(var->dims, num * sizeof(long)); memcpy(var->dims, dims, num * sizeof(long)); FREE(dims); return(FPL_OK); } /************************************************************************ * * int GetEnd(struct Data *, char, char, char) * * Makes the current position to be the one right after the character * you wanna search for. * * Returns error code. * *****/ ReturnCode GetEnd(struct Data *scr, /* giant script structure */ char leta, /* what character you do wanna find */ char motsats, /* the opposite character do the one above */ char outside) /* TRUE/FALSE if outside an opposite version */ { ReturnCode ret; char quot=FALSE, find=1-outside; long junk; /* only for the ReturnChar() function */ long prg=scr->prg; char *text=scr->text; char check; if(scr->compiling) COMPILE(COMP_ERROR); while(scr->prg<=scr->prog->lines) { check=*scr->text; if(check==leta) { scr->text++; if(!quot && !--find) return(FPL_OK); } else if(check==motsats) { if(!quot) find++; scr->text++; } else if(check==CHAR_QUOTATION_MARK) { scr->text++; if(GetEnd(scr, CHAR_QUOTATION_MARK, (char)255, FALSE)) return(FPL_SYNTAX_ERROR); /* dead end error */ } else if(check==CHAR_APOSTROPHE && leta!=CHAR_QUOTATION_MARK) { scr->text++; CALL(ReturnChar(scr, &junk, FALSE)); if(CHAR_APOSTROPHE!=*scr->text++) return(FPL_MISSING_APOSTROPHE); } else if(check==CHAR_ASCII_ZERO) { CALL(Newline(scr)); } else if(leta==CHAR_QUOTATION_MARK && check == CHAR_BACKSLASH) { CALL(ReturnChar(scr, &junk, TRUE)); } else { if(check==CHAR_NEWLINE) scr->virprg++; scr->text++; if(Eat(scr)) break; } } scr->text=text; scr->prg=prg; return(FPL_MISSING_PARENTHESES); } /********************************************************************** * * Getword() * * Store next word in a buffer. Returns error code! * *******/ ReturnCode Getword(char *buffer, struct Data *scr) { ReturnCode ret; char len=0; if(ret=Eat(scr)) ; else if(!ALPHA(*scr->text)) ret=FPL_SYNTAX_ERROR; else do { if(lentext++; } } while(ALPHANUM(*scr->text)); *buffer=0; return(ret); } /********************************************************************** * * int Eatcomment(struct Data *); * * Jumps to the end of the comment we're standing on. * *******/ static ReturnCode INLINE Eatcomment(struct Data *scr) { ReturnCode ret; scr->text+=2; while(scr->prg<=scr->prog->lines) { switch(*scr->text) { case CHAR_MULTIPLY: if(scr->text[1]==CHAR_DIVIDE) { scr->text+=2; return(FPL_OK); } else scr->text++; break; case CHAR_ASCII_ZERO: CALL(Newline(scr)); break; case CHAR_NEWLINE: scr->text++; scr->virprg++; /* stepped down another virutal line! */ /* * Place to debug-hook! */ if(scr->newline_hook) { CALL(InterfaceCall(scr, scr, scr->newline_hook)); } break; default: scr->text++; break; } } return(FPL_UNBALANCED_COMMENT); } /********************************************************************** * * int Eat(struct Data *); * * This eats all whitespaces, new lines and comments * * Returns error code. * *******/ ReturnCode Eat(struct Data *scr) { ReturnCode ret; char new=0; while(1) { switch(*scr->text) { case CHAR_NEWLINE: scr->text++; scr->virprg++; /* stepped down another virutal line! */ /* * Place to debug-hook! */ if(scr->newline_hook) { CALL(InterfaceCall(scr, scr, scr->newline_hook)); } new=1; break; case CHAR_ASCII_ZERO: CALL(Newline(scr)); /* This really confuses our virtual line counter! */ break; case CHAR_HASH: if(new) { /* This is the first 'real' character after a newline! That means this could be a valid #line-instruction! */ scr->text++; /* pass the hash */ if(!Getword(scr->buf, scr) && strcmp(scr->buf, "line")) { /* If there is a word here, it must be "line", or we skip the line! */ while (*++scr->text!=CHAR_NEWLINE); break; } scr->virprg=Strtol(scr->text, 10, &scr->text); /* get number */ Eat(scr); /* get whitespace */ if(*scr->text==CHAR_QUOTATION_MARK) { /* we have a new virtual file name! */ scr->virfile=scr->text++; /* just point to this text! */ CALL(GetEnd(scr, CHAR_QUOTATION_MARK, 255, FALSE)); Eat(scr); } } else return(FPL_OK); break; case CHAR_DIVIDE: if(scr->text[1]==CHAR_MULTIPLY) { CALL(Eatcomment(scr)); } else if(scr->text[1]==CHAR_DIVIDE) while (*++scr->text && *scr->text!=CHAR_NEWLINE); else return(FPL_OK); break; default: if(!WSPACE(*scr->text)) return(FPL_OK); scr->text++; break; } } } /********************************************************************* * * Newline() * * This routine gets called everytime the interpreter finds an ASCII * zero in the program. This is made like this for future version which * will be able to specify programs in several ways. (Not only the * array and continues memory alternatives!) * *****/ ReturnCode Newline(struct Data *scr) { if(scr->prgprog->lines) { scr->text=(&scr->prog->program)[scr->prg++]; return(FPL_OK); } else return(FPL_UNEXPECTED_END); } /********************************************************************** * * char CheckIt() * * Returns wether we should return from this Script(). * *****/ static char CheckIt(struct Data *scr, /* major script structure */ struct Expr *val, /* result structure */ char control, /* control defines */ ReturnCode *ret) /* return code pointer */ { if(val->flags&FPL_BREAK) { /* * A `break' was hit inside that Script() invoke. */ if(control&SCR_LOOP) { if(control&SCR_BRACE) { /* If we're inside braces, search for the close brace */ if(*ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) return((char)*ret); } 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=FPL_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(*ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) 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 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 */ } } /********************************************************************** * * Loop() * * This function is called at the end of a block, however the block was * started (brace or not brace). * *******/ static ReturnCode Loop(struct Data *scr, struct Condition *con, char 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; /* * 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)) && !scr->compiling) { /* not when compiling! */ 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; 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->buf, scr)) ; else if(strcmp(scr->buf, "while")) ret=FPL_SYNTAX_ERROR; /* >warning< we can continue anyway */ else if(ret=Eat(scr)) ; else if(*scr->text++!=CHAR_OPEN_PAREN) ret=FPL_MISSING_PARENTHESES; /* >warning< */ else { con->check=scr->text; con->checkl=scr->prg; if(scr->compiling) COMPILE(COMP_START_OF_EXPR); if(ret=Expression(&val, scr, CON_GROUNDLVL|CON_NUM, NULL)) ; else if(*scr->text++!=CHAR_CLOSE_PAREN) ret=FPL_MISSING_PARENTHESES; /* >warning< */ else if(scr->compiling) return(FPL_OK); } if(ret) return(ret); } if(!val.val.val || scr->compiling) { /* * 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->buf, scr) || strcmp("while", scr->buf)) ret=FPL_SYNTAX_ERROR; /* >warning< */ else if(ret=GetEnd(scr, CHAR_SEMICOLON, (char)255, FALSE)) ; if(ret) return(ret); } else { /* go to the open brace */ scr->text=con->bracetext; scr->prg=con->braceprg; *cont=TRUE; return(FPL_OK); } } /* * 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 SkipStatement(struct Data *scr) { ReturnCode ret; struct Identifier *ident; CALL(Eat(scr)); if(scr->compiling) COMPILE(COMP_ERROR); if(*scr->text==CHAR_SEMICOLON) scr->text++; else if(*scr->text==CHAR_OPEN_BRACE) { CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE)); } else { /* * Much more trouble this way: */ char *t; long p; Getword(scr->buf, scr); GetIdentifier(scr, scr->buf, &ident); if(!ret) { switch(ident->data.external.ID) { 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->buf, scr); if(!strcmp("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! */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); break; default: ret=TRUE; } } if(ret) { /* * This statement ends at the next semicolon */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); } } return(FPL_OK); } #ifdef UNIX long InterfaceCall(struct Data *scr, void *arg, long (*func)(void *)) { return func(arg); } #endif