/****************************************************************************** * FREXX PROGRAMMING LANGUAGE * ****************************************************************************** numexpr.c Supports *FULL* C language expression operator priority and much more...! *****************************************************************************/ /************************************************************************ * * * 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 /* for the atoi() prototype */ #elif defined(UNIX) #include #endif #include "script.h" #include #include #include static ReturnCode AddUnary(struct Data *, struct Expr *, Operator); static ReturnCode INLINE Calc(struct Data *, struct Expr *, struct Expr *); static void INLINE HandleString(struct Data *, struct Expr *); static ReturnCode INLINE GetArrayInfo(struct Data *, long *, long *, long); static ReturnCode INLINE Convert(struct Expr *, struct Data *); static void INLINE Clean(struct Data *, struct Expr *); static long ArrayNum(long, long, long *, long *); static ReturnCode INLINE CallFunction(struct Data *, struct fplArgument *, struct Identifier *); static ReturnCode INLINE PrototypeInside(struct Data *, struct Expr *val, long, struct Identifier *); static ReturnCode INLINE inside(struct Data *, struct fplArgument *, struct Identifier *); /*********************************************************************** * * int Expression(struct Expr *, struct Data *, char, struct Local *) * * Returns a nonzero value if any error occured. * The result of the Expression is returned in the Expr structure which you * give the pointer to in the first argument. * *****************/ ReturnCode Expression(struct Expr *val, /* return value struct pointer */ struct Data *scr, /* everything */ long control, /* ESPECIALLLY DEFINED */ struct Identifier *ident) /* pointer to the pointer holding the local variable names linked list */ { struct Expr *expr, *basexpr; ReturnCode ret; struct Identifier *pident; /* general purpose struct identifier pointer */ struct Unary *un; /* general purpose struct Unary pointers */ long *dims=NULL; /* dimension pointer for variable arrays! */ long pos; /* general purpose integer */ char *text; /* general purpose char pointer */ char hit; char *array; long num; struct fplMsg *msg; struct fplStr *string; #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 GETMEM(expr, sizeof(struct Expr)); memset(expr, 0, sizeof(struct Expr)); basexpr=expr; while (1) { if(ret=Eat(scr)) { /* getaway blanks and comments */ if(control&CON_END && ret==FPL_UNEXPECTED_END) { /* If there can be an unexpected ending, break out of the loop with a nice return code! */ break; } } else if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL)) /* get outta string calcs if not on ground level! */ break; if(!(expr->flags&FPL_OPERAND)) { /* operand coming up */ if(control&CON_IDENT || ALPHA(*scr->text)) { /* * It's a valid identifier character. */ char *point; num=0; /* Dimension counter when taking care of array variables */ if(control&CON_IDENT) { if(!ident) ret=FPL_IDENTIFIER_NOT_FOUND; control&=~CON_IDENT; /* switch off that bit to get away from any trouble such as double using this! */ } else { CALL(Getword(scr->buf, scr)); ret=GetIdentifier(scr, scr->buf, &ident); if(scr->compiling) COMPILESYMBOL(scr->buf); } point=scr->text; Eat(scr); /* getaway blanks */ /* * `ret' can only be FPL_OK or FPL_IDENTIFIER_NOT_FOUND at this * position. */ if(control&CON_DECLARE && *scr->text==CHAR_OPEN_PAREN) { CALL(PrototypeInside(scr, val, control, ident)); expr->flags|=FPL_OPERAND|FPL_ACTION; } else if(control&CON_DECLARE || (ident && ident->flags&FPL_VARIABLE)) { /* The ident check above really must be there, otherwise we might read it when it is a NULL pointer" */ /* it's a variable */ pident=ident; if(ret && /* we didn't find it... */ !(control&CON_DECLARE)) /* and we're not declaring! or */ /* * We didn't find the requested identifier and we're *NOT* * declaring. This means error! */ return(ret); else if(!ret) { /* The symbol was found */ if(control&CON_DECLARE && (ident->level>=scr->varlevel || scr->varlevel==1)) { /* * If the name already declared in this (or higher) level * and declaration is wanted. */ if((ident->flags&FPL_STATIC_VARIABLE && control&CON_DECLSTATIC && ident->level==scr->varlevel) || /* * If this is a `static' variable and the variable already * exists on this very level in this very function as static, * then skip this. It's perfectly OK to jump to the ending * semicolon since this has been parsed before! */ (ident->flags&FPL_EXPORT_SYMBOL && control&CON_DECLEXP)) { /* * If this is an `export' symbol and it already exists as an * `export' symbol! Then just ignore this! */ /* * The current implementation unfortunately uses the statement * below to pass this declaration. That means comma- * separated exported symbols will be passed if only the first * is alredy declared... This will although work in all those * cases it is the SAME code that is executed twice! */ CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE)); scr->text--; /* get back on the semicolon! */ break; } else { CALL(Warn(scr, FPL_IDENTIFIER_USED)); /* run it over! */ DelIdentifier(scr, ident->name, NULL); } } else if(!(control&CON_DECLARE) && (ident->level && /* not global */ ident->level<(scr->varlevel-scr->level))) /* * From the wrong program level and we're not declaring. */ return(FPL_IDENTIFIER_NOT_FOUND); else if(ident->flags&FPL_STATIC_VARIABLE && ((ident->func && (ident->func==scr->func)) || ident->level>scr->varlevel) ) /* * A static variable declared either in the wrong function or * in a higher level! */ return(FPL_IDENTIFIER_NOT_FOUND); } if(*scr->text==CHAR_OPEN_BRACKET) { /* * It's an array. Get the result of the expression within the * square brackets. */ if(!dims) { GETMEM(dims, MAX_DIMS*sizeof(long)); } if(!(control&CON_DECLARE) && pident->data.variable.size) num=pident->data.variable.num; if(control&CON_DECLARE || num) { CALL(GetArrayInfo(scr, dims, &num, control)); if(!(control&CON_DECLARE)) { if(num>pident->data.variable.num) { /* * If not declaring and overfilled quota: fail! */ CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); /* force to no more dims than declared! */ num=pident->data.variable.num; } else { for(pos=0; posdata.variable.dims[pos]<=dims[pos]) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); /* force to no more than declared! */ pident->data.variable.dims[pos]=dims[pos]-1; } } } point=scr->text; /* move point to current location */ Eat(scr); /* pass all traling whitespaces */ } } if(control&CON_DECLARE) { expr->flags|=FPL_ACTION; GETMEM(pident, sizeof(struct Identifier)); pident->level= (control&(CON_DECLEXP|CON_DECLGLOB))?0:scr->varlevel; pident->flags= (control&CON_DECLINT?FPL_INT_VARIABLE:FPL_STRING_VARIABLE)| (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)| (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:0)| (control&CON_DECL8?FPL_CHAR_VARIABLE: (control&CON_DECL16?FPL_SHORT_VARIABLE:0))| (control&CON_DECLCONST?FPL_READONLY:0)| (control&CON_DECLSTATIC?FPL_STATIC_VARIABLE:0); pident->file=control&CON_DECLEXP?NULL:scr->prog->name; /* file */ pident->func=scr->func; /* declared in this function */ /* Get memory for the variable name */ STRDUP(pident->name, scr->buf); /* no real strdup */ if(num) { /* * Array variable declaration! It is a bit different from * common variable declaration so I decided to put the code * for it right here: */ long size=dims[0]; /* array size */ for(pos=1; posdata.variable.dims, num * sizeof(long)); /* Copy the dim info to the newly allocated area */ memcpy((void *)pident->data.variable.dims, dims, num*sizeof(long)); /* Get memory for the array */ GETMEM(pident->data.variable.var.val32, size * sizeof(long)); /* Set all string lengths to NULL and integers to zero: */ memset(pident->data.variable.var.val32, 0, size * sizeof(void *)); pident->data.variable.size=size; /* total number of array members */ pident->data.variable.num=num; /* number of dimensions */ /* reset the dims array! */ memset((void *)dims, 0, sizeof(long) * num); /* reset num: */ num=1; } else { #ifdef DEBUG CheckMem(scr, pident); #endif GETMEM(pident->data.variable.var.val32, sizeof(long)); *pident->data.variable.var.val32=0; pident->data.variable.num=0; pident->data.variable.size=1; } /* * We add the symbol to the local data in all cases except when * the symbol is global or static. */ CALL(AddVar(scr, pident, control&(CON_DECLGLOB|CON_DECLSTATIC)? &scr->globals:&scr->locals)); } /* * Now when all declarations is done, all assigns are left: */ expr->flags|=FPL_OPERAND; if (pident->flags&FPL_STRING_VARIABLE) { /* string variable */ if(*scr->text==CHAR_OPEN_BRACKET) { /* just one character */ /* * Get the result of the expression. */ char *value; if(scr->compiling) COMPILE(COMP_ARRAY); CALL(Expression(val, (scr->text++, scr), CON_GROUNDLVL|CON_NUM, NULL)); if(*scr->text!=CHAR_CLOSE_BRACKET) { CALL(Warn(scr, FPL_MISSING_BRACKET)); /* we can continue anyway! */ } else scr->text++; if(&pident->data.variable.var.str[num] && (val->val.val >= pident->data.variable.var.str[num]->len)) { /* force to zero! */ val->val.val=0; } else if(val->val.val<0) { CALL(Warn(scr, FPL_OUT_OF_REACH)); /* force zero! */ val->val.val=0; } /* * (I) Here we should be able to operate the character read * from the string. ++ and -- should work to enable advanced * string modification handling without the * overhead of getting the string, changing it and then re- * assign it back. This *MUST* be implemented soon cause * it's a real killer! */ value=(char *)&pident->data.variable.var.str[num]->string[val->val.val]; if(ASSIGN_OPERATOR) { char was=*scr->text; long valint=*value; expr->flags|=FPL_ACTION; if(*scr->text==CHAR_ASSIGN) scr->text++; else if(scr->text[2]==CHAR_ASSIGN) scr->text+=3; else scr->text+=2; /* single assign */ CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL)); CALL(CmpAssign(scr, val->val.val, &valint, FPL_CHAR_VARIABLE, was)); *value=valint; } expr->val.val=*value; /* only one byte */ CALL(NewMember(scr, &expr)); } else if(control&CON_NUM) { /* NO strings allowed! */ CALL(Warn(scr, FPL_ILLEGAL_STATEMENT)); /* be able to continue here, we must pass everything that has to to with the strings in this expression */ } else if (!(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) && (*scr->text==CHAR_ASSIGN || *scr->text==CHAR_PLUS && scr->text[1]==CHAR_ASSIGN)) { char array=FALSE; char multi=FALSE; struct fplStr **string; /* current string */ char app=(*scr->text==CHAR_PLUS); if(scr->compiling) { if(app) COMPILE(COMP_CMPPLUS); else COMPILE(COMP_ASSIGN); } scr->text+=1+app; expr->flags|=FPL_ACTION; if(pident->data.variable.num) { /* if array member assign */ Eat(scr); if(*scr->text==CHAR_OPEN_BRACE) { /* array assign */ multi=TRUE; scr->text++; CALL(Eat(scr)); } array=TRUE; } if(!multi) { /* single (array) variable assign */ if(array) { pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; /* we don't know what was meant! */ } } else pos=0; string=&pident->data.variable.var.str[pos]; CALL(Expression(val, scr, CON_STRING, NULL)); if(!(val->flags&FPL_STRING)) { CALL(Warn(scr, FPL_ILLEGAL_ASSIGN)); } CALL(StrAssign(val->val.str, scr, string, app)); if(app && !(val->flags&FPL_NOFREE)) /* Only do this if appending! */ FREE(val->val.str); } else { /* multi [compound] assign! */ /* * Count the preceding open braces to get proper level * to assign in. */ while(*scr->text==CHAR_OPEN_BRACE) { num++; /* next dimension */ scr->text++; /* pass it! */ CALL(Eat(scr)); } do { while(1) { hit=TRUE; /* parse the controlling braces and commas */ switch(*scr->text) { case CHAR_CLOSE_BRACE: if(scr->compiling) COMPILE(COMP_END_OF_BLOCK); num--; /* back one dimension */ if(num>=0 && numdata.variable.num) dims[num]=0; else { CALL(Warn(scr,FPL_ILLEGAL_ARRAY)); num=0; /* force counter to zero! */ } scr->text++; break; case CHAR_COMMA: /* * Increase the last dimension member for next loop: */ if(scr->compiling) COMPILE(COMP_COMMA); if(num>0 && num<=pident->data.variable.num) dims[num-1]++; else { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); /* force counter back to top position! */ num=pident->data.variable.num; } scr->text++; break; case CHAR_OPEN_BRACE: if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); num++; /* next dimension */ scr->text++; break; default: hit=FALSE; break; } if(hit && !ret) { CALL(Eat(scr)); } else break; } if(!num) break; pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; /* force back to sane number */ } /* assign! */ string=&pident->data.variable.var.str[pos]; CALL(Expression(val, scr, CON_STRING, NULL)); if(!(val->flags&FPL_STRING)) { CALL(Warn(scr, FPL_ILLEGAL_ASSIGN)); } CALL(StrAssign(val->val.str, scr, string, app)); if(app && !(val->flags&FPL_NOFREE)) /* only if we're appending! */ FREE(val->val.str); /* while */ } while(1); } expr->val.str=*string; expr->flags|=FPL_STRING|FPL_NOFREE; } else { if(control&CON_DECLARE) expr->val.val=0; else if(pident->data.variable.num) { pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; /* force back to sane number */ } expr->val.str=pident->data.variable.var.str[pos]; } else expr->val.str=pident->data.variable.var.str[0]; expr->flags|=FPL_STRING|FPL_NOFREE; } } else { /* integer variable... */ if(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) { if(!pident->data.variable.num) expr->val.val=pident->data.variable.var.val32[0]; else { pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; /* force back to sane number */ } expr->val.val=pident->data.variable.var.val32[pos]; } } else if(!expr->operator && !expr->unary && ASSIGN_OPERATOR) { /* integer assign */ char array=FALSE; /* is it an array variable */ char multi=FALSE; /* mutiple variable */ char was=*scr->text; expr->flags|=FPL_ACTION; if(*scr->text==CHAR_ASSIGN) scr->text++; else if(scr->text[2]==CHAR_ASSIGN) scr->text+=3; else scr->text+=2; if(pident->data.variable.num) { /* if array member assign */ Eat(scr); if(*scr->text==CHAR_OPEN_BRACE) { if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); /* array assign */ multi=TRUE; scr->text++; CALL(Eat(scr)); } array=TRUE; } if(!multi) { if(!array) pos=0; else { /* single (array) variable assign */ pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; /* force back to a decent number */ } } if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL)); if(scr->compiling) COMPILE(COMP_END_OF_EXPR); CALL(CmpAssign(scr, val->val.val, &pident->data.variable.var.val32[pos], pident->flags, was)); expr->val.val=pident->data.variable.var.val32[pos]; } else { /* multi [compound] assign */ /* * Count the preceding open braces to get proper level * to assign in. */ while(*scr->text==CHAR_OPEN_BRACE) { num++; /* next dimension */ scr->text++; /* pass it! */ CALL(Eat(scr)); } do { while(1) { char hit=TRUE; /* parse the controlling braces and commas */ switch(*scr->text) { case CHAR_CLOSE_BRACE: if(scr->compiling) COMPILE(COMP_END_OF_BLOCK); num--; /* back one dimension */ if(num>=0 && numdata.variable.num) dims[num]=0; else { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); num=0; } scr->text++; break; case CHAR_COMMA: /* * Increase the last dimension member for next loop: */ if(scr->compiling) COMPILE(COMP_COMMA); if(num>0 && num<=pident->data.variable.num) dims[num-1]++; else { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); num=pident->data.variable.num; } scr->text++; break; case CHAR_OPEN_BRACE: if(scr->compiling) COMPILE(COMP_START_OF_BLOCK); num++; /* next dimension */ scr->text++; break; default: hit=FALSE; break; } if(hit && !ret) { CALL(Eat(scr)); } else break; } if(!num) break; pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; } /* assign! */ if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL)); if(scr->compiling) COMPILE(COMP_END_OF_EXPR); CALL(CmpAssign(scr, val->val.val, &pident->data.variable.var.val32[pos], pident->flags, was)); expr->val.val=pident->data.variable.var.val32[pos]; /* while */ } while(1); } expr->flags|=FPL_NOFREE; /* the memory pointed to by the expr->val.val is strings of proper variables. Do not free them now! */ } else { /* * No assignment, primary operator or none at all! */ long *value; if(control&CON_DECLARE) expr->val.val=0; else { if(pident->data.variable.num) { pos=ArrayNum(num, pident->data.variable.num, dims, pident->data.variable.dims); if(pos<0) { CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); pos=0; } } else pos=0; value=&pident->data.variable.var.val32[pos]; if(*point==CHAR_PLUS && point[1]==CHAR_PLUS) { /*post increment*/ if(scr->compiling) COMPILE(COMP_POSTINC); expr->flags|=FPL_ACTION; expr->val.val=(*value)++; scr->text+=2; } else if(*point==CHAR_MINUS && point[1]==CHAR_MINUS) { /* post decrement */ if(scr->compiling) COMPILE(COMP_POSTDEC); expr->flags|=FPL_ACTION; expr->val.val=(*value)--; scr->text+=2; } else { /* plain variable or pre operation */ if(un=expr->unary) { if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) { expr->val.val=*value; } else { if(un->unary==OP_PREINC) expr->val.val=++(*value); else expr->val.val=--(*value); expr->unary=un->next; FREE(un); } } else expr->val.val=*value; } if(pident->flags&FPL_VARIABLE_LESS32) { if(pident->flags&FPL_CHAR_VARIABLE) { expr->val.val=(long)((signed char)expr->val.val); *value=(long)((signed char)*value); } else { /* sixteen bits */ expr->val.val=(long)((signed short)expr->val.val); *value=(long)((signed short)*value); } } } CALL(NewMember(scr, &expr)); } } /* end of integer handling */ } else if(ret && (*scr->text!=CHAR_OPEN_PAREN)) return(ret); /* FPL_IDENTIFIER_NOT_FOUND */ else { /* some sort of function */ /* * FUNCTION HANDLER PART: */ struct fplArgument *pass; /* struct pointer to send as argument to the function handler */ char allocspace; if(ret) { if(!(scr->flags&FPLDATA_ALLFUNCTIONS) || *scr->text!=CHAR_OPEN_PAREN) /* If the ability to parse all functions isn't turned on, or if the following character is not an open parenthesis, fail! */ return(ret); } num=0; /* number of arguments */ expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */ GETMEM(pass, sizeof(struct fplArgument)); if(!ident) { /* The function does not exist as a declared function! */ STRDUP(pass->name, scr->buf); pass->ID=FPL_UNKNOWN_FUNCTION; text="o>"; /* optional parameter list as argument! */ } else { pass->name=ident->name; pass->ID=ident->data.external.ID; text=ident->data.inside.format; } pass->argc=0; pass->key=(void *)scr; if(*scr->text!=CHAR_OPEN_PAREN) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); /* >warning< */ } else scr->text++; if(scr->compiling) COMPILE(COMP_START_OF_PARAMETERS); CALL(Eat(scr)); if(text && *text) { unsigned char a=0; /* if the function takes arguments */ if(*text==FPL_ARGLIST) /* can't start with paramter list */ text="o>"; /* use optional parameter list as default then! */ /* * Allocate arrays to use for data storage while parsing * the arguments. Maximum number of arguments is * MAX_ARGUMENTS. */ num=strlen(text); /* number of arguments to this function */ if(text[num-1]!=FPL_ARGLIST) allocspace=num+1; else allocspace=MAX_ARGUMENTS; /* * By adjusting the number of allocated bytes to the smallest * necessary, my recursive example program used only a fifth * as much memory as when always allocating memory for * MAX_ARGUMENTS. */ /* allocate an array */ GETMEM(pass->argv, sizeof(char *)*allocspace); /* allocate new format string */ GETMEM(pass->format, sizeof(char)*allocspace); /* allocate allocate-flag string */ GETMEM(array, sizeof(char)*allocspace); while(!ret && *scr->text!=CHAR_CLOSE_PAREN && text && *text) { a=(*text==FPL_ARGLIST)?a:UPPER(*text); switch(a) { case FPL_OPTARG: case FPL_STRARG: CALL(Expression(val, scr, (a==FPL_STRARG?CON_STRING:0), NULL)); if(a==FPL_STRARG && !(val->flags&FPL_STRING)) { CALL(Warn(scr, FPL_ILLEGAL_PARAMETER)); } if(a==FPL_STRARG || val->flags&FPL_STRING) { /* Enter string symbol in the created format string! */ pass->format[pass->argc]=FPL_STRARG; if(val->val.str) { /* Set this to TRUE if deallocation is wanted on this string after the function call! */ array[pass->argc]=!(val->flags&FPL_NOFREE); /* * Point to the string (that is zero terminated)! */ pass->argv[pass->argc]=val->val.str->string; } else { GETMEM(string, sizeof(struct fplStr)); memset(string, 0, sizeof(struct fplStr)); pass->argv[pass->argc]=string->string; array[pass->argc]=1; /* allocation has been done! */ } } else { pass->format[pass->argc]=FPL_INTARG; pass->argv[pass->argc]=(void *)val->val.val; } pass->argc++; break; case FPL_INTARG: CALL(Expression(val, scr, CON_NUM, NULL)); pass->format[pass->argc]=FPL_INTARG; pass->argv[pass->argc++]=(void *)val->val.val; break; case FPL_STRVARARG: case FPL_INTVARARG: CALL(Getword(scr->buf, scr)); /* Use the `pident' pointer here, cause the `ident' pointer is already being used by the function we're about to invoke! */ CALL(GetIdentifier(scr, scr->buf, &pident)); if(scr->compiling) COMPILESYMBOL(scr->buf); if(pident->flags&FPL_INT_VARIABLE && a==FPL_STRVARARG || pident->flags&FPL_STRING_VARIABLE && a==FPL_INTVARARG) { CALL(Warn(scr, FPL_ILLEGAL_VARIABLE)); pass->argv[pass->argc]=NULL; /* can't copy wrong variable! */ } else pass->argv[pass->argc]=(void *)pident; pass->format[pass->argc++]=(a==FPL_STRVARARG?a:FPL_INTVARARG); Eat(scr); break; default: CALL(Warn(scr, FPL_ILLEGAL_PARAMETER)); break; /* just ignore it and be happy! */ } if(*text!=FPL_ARGLIST) text++; if(*scr->text==CHAR_COMMA) { scr->text++; if(scr->compiling) COMPILE(COMP_COMMA); } } pass->format[pass->argc]=CHAR_ASCII_ZERO; if(text && *text && !(*text&CASE_BIT)) { return(FPL_MISSING_ARGUMENT); /* * This is a serious mis-use. The function is called with to few * parameters. At least one parameter missing is a required one. * I really can't figure out a way to survive such a shock! */ } } else pass->format=NULL; if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_SYNTAX_ERROR)); /* >warning< */ /* It's ok to continue without the parenthesis! */ } else scr->text++; if(scr->compiling) COMPILE(COMP_END_OF_PARAMETERS); if(!ident || FPL_OPTARG == hit) { /* * The function we invoked was not found regularly! * Set return type! */ /* * We try to determine whether it should return an int or a string. * We interpret the return value as we should do to make it pass * as a valid expression. That is, if the flag tells us this * should be a string expression to be valid, we take it as a * string, but if it tells us its an integer expression, we read * it as an integer!!! */ if(control&CON_STRING) hit = FPL_STRARG; else { if(control&CON_NUM) hit = FPL_INTARG; else /* * We don't know which kind of return code the function * should give us! */ hit = FPL_OPTARG; } } else hit=UPPER(ident->data.inside.ret); pass->ret = hit; /* set return type member of pass struct */ /* * Call the function if not compiling! */ if(!scr->compiling) CALL(CallFunction(scr, pass, ident)); if(!ident) { /* * The function we invoked was not found regularly! * Free the name we allocated temporarily and set * return type to optional! */ FREE(pass->name); /* the name was strdup()'ed! */ } if(FPL_OPTARG == hit) { CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg)); if(!msg) { /* There is no 'int' return. Check if there is any 'string' return, otherwise say it is an 'int' anyway! */ CALL(GetMessage(scr, FPLMSG_RETURN_STRING, &msg)); if(!msg) /* no string either, default to int! */ hit = FPL_INTARG; else /* found string, it returned a 'string' !!! */ hit = FPL_STRARG; } else { /* There is a return 'int' message! This may well be a function returning int! */ hit = FPL_INTARG; } } if(hit==FPL_STRARG) /* if the return value should be a string: */ HandleString(scr, expr); else { /* only if integer! or the function is non-existent */ CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg)); expr->val.val=(msg?(long)msg->message[0]:0); CALL(NewMember(scr, &expr)); if(msg) CALL(DeleteMessage(scr, msg)); } while(pass->argc--) { if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) { /* free the string if it's been marked to be freed!! */ FREE((char *)pass->argv[pass->argc]- offsetof(struct fplStr, string)); } } if(pass->format) { FREE(pass->argv); FREE(pass->format); FREE(array); } FREE(pass); } } else { pos=0; switch(*scr->text) { case CHAR_ZERO: /* * Numbers starting with a '0' can be hex/oct/bin. */ switch(scr->text[1]) { case CHAR_X: /* hexadecimal number parser */ for(scr->text+=2; HEXANUM(*scr->text); scr->text++) expr->val.val=expr->val.val*16+ (NUMBER(*scr->text)? *scr->text-CHAR_ZERO: UPPER(*scr->text)-CHAR_UPPER_A+10); if(scr->compiling) COMPILEINT(expr->val.val); break; case CHAR_B: /* binary number parser */ for(scr->text+=2;*scr->text==CHAR_ZERO || *scr->text==CHAR_ONE;) expr->val.val=expr->val.val*2+ *scr->text++ - CHAR_ZERO; if(scr->compiling) COMPILEINT(expr->val.val); break; case CHAR_ZERO: case CHAR_ONE: case CHAR_TWO: case CHAR_THREE: case CHAR_FOUR: case CHAR_FIVE: case CHAR_SIX: case CHAR_SEVEN: /* octal number parser */ for(scr->text++;*scr->text>=CHAR_ZERO && *scr->text<=CHAR_SEVEN;) expr->val.val=expr->val.val*8+ *scr->text++ - CHAR_ZERO; if(scr->compiling) COMPILEINT(expr->val.val); break; default: /* a single zero is simply 0 */ scr->text++; expr->val.val=0; if(scr->compiling) COMPILEINT(0); break; } CALL(NewMember(scr, &expr)); break; /* end of case CHAR_ZERO: */ case CHAR_ONE: case CHAR_TWO: case CHAR_THREE: case CHAR_FOUR: case CHAR_FIVE: case CHAR_SIX: case CHAR_SEVEN: case CHAR_EIGHT: case CHAR_NINE: /* * We hit a number between 1 and 9. */ do expr->val.val= expr->val.val*10 + *scr->text++ - CHAR_ZERO; while(NUMBER(*scr->text)); if(scr->compiling) COMPILEINT(expr->val.val); CALL(NewMember(scr, &expr)); break; case CHAR_QUOTATION_MARK: CALL(Convert(val, scr)); /* This returned a string! */ expr->val.str=val->val.str; expr->flags=FPL_STRING; if(scr->compiling) COMPILESTRING(expr->val.str->string); break; case CHAR_APOSTROPHE: /* * Apostrophes surround character. Returns ASCII code. */ CALL(ReturnChar((scr->text++, scr), &expr->val.val, FALSE)); if(*scr->text!=CHAR_APOSTROPHE) { CALL(Warn(scr, FPL_MISSING_APOSTROPHE)); /* >warning< */ /* just continue as nothing has ever happened! */ } else scr->text++; if(scr->compiling) COMPILEINT(expr->val.val); CALL(NewMember(scr, &expr)); break; case CHAR_OPEN_PAREN: if(scr->compiling) COMPILE(COMP_START_OF_EXPR); CALL(Expression(val, (++scr->text, scr), CON_GROUNDLVL|CON_NUM, NULL)); if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); /* >warning< */ /* Go on anyway! */ } else scr->text++; if(scr->compiling) COMPILE(COMP_END_OF_EXPR); expr->val.val=val->val.val; CALL(NewMember(scr, &expr)); break; case CHAR_NOT_OPERATOR: CALL(AddUnary(scr, expr, OP_NOT)); ++scr->text; if(scr->compiling) COMPILE(COMP_NOT); break; case CHAR_ONCE_COMPLEMENT: CALL(AddUnary(scr, expr, OP_COMPL)); ++scr->text; if(scr->compiling) COMPILE(COMP_1COMPL); break; case CHAR_PLUS: if(scr->text[1]==CHAR_PLUS) { expr->flags|=FPL_ACTION; scr->text+=2; CALL(AddUnary(scr, expr, OP_PREINC)); if(scr->compiling) COMPILE(COMP_PREINC); } else { CALL(AddUnary(scr, expr, OP_PLUS)); scr->text++; if(scr->compiling) COMPILE(COMP_PLUS); } break; case CHAR_MINUS: if(scr->text[1]==CHAR_MINUS) { expr->flags|=FPL_ACTION; scr->text+=2; CALL(AddUnary(scr, expr, OP_PREDEC)); if(scr->compiling) COMPILE(COMP_PREDEC); } else { CALL(AddUnary(scr, expr, OP_MINUS)); scr->text++; if(scr->compiling) COMPILE(COMP_MINUS); } break; default: if((*scr->text==CHAR_SEMICOLON && control&CON_SEMICOLON) || (*scr->text==CHAR_CLOSE_PAREN && control&CON_PAREN) && basexpr==expr && expr->operator==OP_NOTHING) { /* for(;;) support. There must not have been a previous operand or operator */ pos=expr->val.val=TRUE; if(scr->compiling) COMPILE(COMP_END_OF_EXPR); } else { /* no operand results in error! */ CALL(Warn(scr, FPL_MISSING_OPERAND)); /* WARNING! */ expr->operator=OP_NOTHING; /* reset */ } break; } if(pos) break; } } else { /* waiting for operator */ char *point=scr->text; switch(*scr->text) { case CHAR_ASSIGN: if(scr->text[1]==CHAR_ASSIGN) { expr->operator=OP_EQUAL; scr->text+=2; if(scr->compiling) COMPILE(COMP_EQUAL); } break; case CHAR_AND: if(scr->text[1]==CHAR_AND) { expr->operator=OP_LOGAND; scr->text+=2; if(scr->compiling) COMPILE(COMP_LOGAND); } else { expr->operator=OP_BINAND; scr->text++; if(scr->compiling) COMPILE(COMP_BINAND); } break; case CHAR_OR: if(scr->text[1]==CHAR_OR) { expr->operator=OP_LOGOR; scr->text+=2; if(scr->compiling) COMPILE(COMP_LOGOR); } else { expr->operator=OP_BINOR; scr->text++; if(scr->compiling) COMPILE(COMP_BINOR); } break; case CHAR_PLUS: expr->operator=OP_PLUS; ++scr->text; if(scr->compiling) COMPILE(COMP_PLUS); break; case CHAR_MINUS: expr->operator=OP_MINUS; ++scr->text; if(scr->compiling) COMPILE(COMP_MINUS); break; case CHAR_QUESTION: expr->operator=OP_COND1; ++scr->text; if(scr->compiling) COMPILE(COMP_COND1); break; case CHAR_COLON: expr->operator=OP_COND2; ++scr->text; if(scr->compiling) COMPILE(COMP_COND2); break; case CHAR_MULTIPLY: expr->operator=OP_MULTIPLY; ++scr->text; if(scr->compiling) COMPILE(COMP_MULTIPLY); break; case CHAR_DIVIDE: expr->operator=OP_DIVISION; ++scr->text; if(scr->compiling) COMPILE(COMP_MULTIPLY); break; case CHAR_REMAIN: expr->operator=OP_REMAIN; ++scr->text; if(scr->compiling) COMPILE(COMP_REMAIN); break; case CHAR_XOR: expr->operator=OP_BINXOR; ++scr->text; if(scr->compiling) COMPILE(COMP_BINXOR); break; case CHAR_LESS_THAN: if(scr->text[1]==CHAR_ASSIGN) { scr->text+=2; expr->operator=OP_LESSEQ; if(scr->compiling) COMPILE(COMP_LESSEQ); } else if(scr->text[1]==CHAR_LESS_THAN) { scr->text+=2; expr->operator=OP_SHIFTL; if(scr->compiling) COMPILE(COMP_SHIFTL); } else { scr->text++; expr->operator=OP_LESS; if(scr->compiling) COMPILE(COMP_LESS); } break; case CHAR_GREATER_THAN: if(scr->text[1]==CHAR_ASSIGN) { expr->operator= OP_GRETEQ; scr->text+=2; if(scr->compiling) COMPILE(COMP_GRETEQ); } else if(scr->text[1]==CHAR_GREATER_THAN) { scr->text+=2; expr->operator=OP_SHIFTR; if(scr->compiling) COMPILE(COMP_SHIFTR); } else { scr->text++; expr->operator=OP_GRET; if(scr->compiling) COMPILE(COMP_GRET); } break; case CHAR_NOT_OPERATOR: if(scr->text[1]==CHAR_ASSIGN) { expr->operator=OP_NOTEQ; scr->text+=2; if(scr->compiling) COMPILE(COMP_NOTEQUAL); } break; case CHAR_COMMA: if(control&CON_GROUNDLVL) { Clean(scr, basexpr); GETMEM(basexpr, sizeof(struct Expr)); expr=basexpr; expr->val.val=0; expr->unary=NULL; expr->operator=expr->flags=OP_NOTHING; expr->next=NULL; scr->text++; if(scr->compiling) COMPILE(COMP_COMMA); } break; } if(point==scr->text) break; expr->flags&=~FPL_OPERAND; /* clear the operand bit */ } } if(!(control&CON_DECLARE)) { /* Get result of the current expression */ CALL(Calc(scr, val, basexpr)); /* * If this was a stand alone statement, including no action returns an * error! */ if(control&CON_ACTION && !(val->flags&FPL_ACTION)) { CALL(Warn(scr, FPL_NO_ACTION)); /* but we can just as good keep on anyway! */ } } Clean(scr, basexpr); /* erase the rest of the list */ if(dims) FREE(dims); return(FPL_OK); } /********************************************************************** * * ReturnCode Calc(); * * Returns the result in the first Expr struct of the expression that * the second parameter holds. This function does not free the expression * list. * *******/ static ReturnCode INLINE Calc(struct Data *scr, struct Expr *val, struct Expr *basexpr) { /* lower value=higher priority. Order as the operator list in script.h: *| + - / * << >> % & | ^ && || ~ ? : == <= >= < > != ! */ const static unsigned char priority[]={ 255, 1, 1, 0, 0, 2, 2, 0, 5, 7, 6, 8, 9, 255, 10, 10, 4, 3, 3, 3, 3, 4, 255 }; ReturnCode ret; unsigned char pri, minpri=255, maxpri=0; struct Expr *expr=basexpr, *last; struct Unary *un, *next; /* first all Unary expressions */ if(!(expr->flags&FPL_STRING)) while(expr) { if(priority[expr->operator]operator]; /* get the lowest priority */ if(priority[expr->operator]>maxpri && expr->operator!=OP_NOTHING) maxpri=priority[expr->operator]; /* get the highest priority */ if(expr->flags&FPL_STRING) { CALL(Warn(scr, FPL_ILLEGAL_VARIABLE)); /* * A string among the integers! * We remove this and try next! */ last=expr->next; FREE(expr); /* delete this bastard from the expression!!! */ expr=last; } else { un=expr->unary; while(un) { switch(un->unary) { case OP_NOT: expr->val.val=!expr->val.val; break; case OP_COMPL: expr->val.val=~expr->val.val; break; case OP_MINUS: expr->val.val=-expr->val.val; break; /*simply ignored! case OP_PLUS: break; */ case OP_PREDEC: case OP_PREINC: CALL(Warn(scr, FPL_ILLEGAL_PREOPERATION)); /* just ignore it! */ } next=un->next; FREE(un); un=next; } } expr=expr->next; } /* * Calculate all members of the linked list in the proper way and put * the result in "val->val.val" before returning "ret". Check for operators * with priority within `minpri' and `maxpri' which we got in the loop * above. * * Check priority level by priority level and perform the right actions. * When reaching the maxpri, there is only one number left: the result! */ for(pri=minpri; pri<=maxpri; pri++) { last=expr=basexpr; while(expr=expr->next) { if(priority[expr->operator]==pri) { last->flags|=expr->flags; switch(expr->operator) { case OP_MULTIPLY: last->val.val*=expr->val.val; break; case OP_DIVISION: if(!expr->val.val) { CALL(Warn(scr, FPL_DIVISION_BY_ZERO)); /* we give a zero as result! */ last->val.val=0; } else last->val.val/=expr->val.val; break; case OP_REMAIN: if(!expr->val.val) { CALL(Warn(scr, FPL_DIVISION_BY_ZERO)); last->val.val=0; } else last->val.val%=expr->val.val; break; case OP_SHIFTL: last->val.val<<=expr->val.val; break; case OP_SHIFTR: last->val.val>>=expr->val.val; break; case OP_BINAND: last->val.val&=expr->val.val; break; case OP_BINOR: last->val.val|=expr->val.val; break; case OP_BINXOR: last->val.val^=expr->val.val; break; case OP_PLUS: last->val.val+=expr->val.val; break; case OP_MINUS: last->val.val-=expr->val.val; break; case OP_EQUAL: last->val.val=last->val.val==expr->val.val; break; case OP_NOTEQ: last->val.val=last->val.val!=expr->val.val; break; case OP_LESSEQ: last->val.val=last->val.val<=expr->val.val; break; case OP_LESS: last->val.val=last->val.valval.val; break; case OP_GRETEQ: last->val.val=last->val.val>=expr->val.val; break; case OP_GRET: last->val.val=last->val.val>expr->val.val; break; case OP_LOGOR: last->val.val=last->val.val||expr->val.val; break; case OP_LOGAND: last->val.val=last->val.val&&expr->val.val; break; case OP_COND1: if(expr->next && expr->next->operator==OP_COND2) { last->val.val=last->val.val?expr->val.val:expr->next->val.val; } else { CALL(Warn(scr, FPL_ILLEGAL_CONDOP)); /* WARNING! */ last->val.val=expr->val.val; /* get the number we have! */ } break; } last->next=expr->next; FREE(expr); expr=last; } else last=expr; } } val->val.val=basexpr->val.val; /* get the final value */ val->flags=basexpr->flags; /* copy the flags */ return(FPL_OK); } /********************************************************************** * * AddUnary(); * * Build a linked list on the unary member of the Expr struct! * ******/ static ReturnCode AddUnary(struct Data *scr, struct Expr *expr, Operator unary) { struct Unary *next=expr->unary; GETMEM(expr->unary, sizeof(struct Unary)); expr->unary->unary=unary; expr->unary->next=next; return(FPL_OK); } /********************************************************************** * * Clean() * * Erases every track of the linked TalStruct list... * ******/ static void INLINE Clean(struct Data *scr, struct Expr *basexpr) { struct Expr *last; while(basexpr) { last=basexpr->next; FREE(basexpr); basexpr=last; } } /********************************************************************** * * HandleString(); * * Assigns the proper members in the Expr struct after a respons from * a user specified function. * *****/ static void INLINE HandleString(struct Data *scr, struct Expr *expr) { struct fplMsg *msg; GetMessage(scr, FPLMSG_RETURN_STRING, &msg); if(!msg || !msg->message[0]) /* We got a zero length string or no string at all! */ expr->val.str=NULL; /* no string! */ else expr->val.str=(struct fplStr *)msg->message[0]; /* the copied string! */ expr->flags=FPL_STRING|FPL_ACTION; if(msg) DeleteMessage(scr, msg); } /********************************************************************** * * Convert() * * Converts the following "string" in the line to a string which it returns. * *********/ static ReturnCode INLINE Convert(struct Expr *expr, struct Data *scr) { ReturnCode ret=FPL_OK; long a; unsigned long pos=0; /* start position */ struct fplStr *pointer, *pek; GETMEM(pointer, sizeof(struct fplStr) + ADDSTRING_DEFAULT); /* create default string space */ pointer->alloc=ADDSTRING_DEFAULT; pointer->len=0; expr->val.str=pointer; #ifdef DEBUG CheckMem(scr, pointer); #endif do { scr->text++; while(*scr->text!=CHAR_QUOTATION_MARK) { CALL(ReturnChar(scr, &a, TRUE)); if(a) { pointer->string[pos]=a; if(++pos>=pointer->alloc) { GETMEM(pek, (pointer->alloc+=ADDSTRING_INC)+sizeof(struct fplStr)); memcpy(pek, pointer, pos+sizeof(struct fplStr)); FREE(pointer); pointer=pek; expr->val.str=pointer; } } } scr->text++; CALL(Eat(scr)); } while(*scr->text==CHAR_QUOTATION_MARK); pointer->string[pos]=0; /* zero terminate */ pointer->len=pos; /* length of string */ expr->val.str=pointer; expr->flags|=FPL_STRING; return(ret); } /********************************************************************** * * GetArrayInfo() * * Read the []'s and store the information. Make sure you're standing on * the open bracket! * * Set the int num points to, to any number if you want to limit the number * of dimension reads. */ static ReturnCode INLINE GetArrayInfo(struct Data *scr, long *dims, /* long array */ long *num, /* number of dims */ long control) { struct Expr val; ReturnCode ret=FPL_OK; long maxnum=*num; *num=0; if(scr->compiling) COMPILE(COMP_START_OF_ARRAYINFO); if(*scr->text==CHAR_OPEN_BRACKET) { do { if(scr->compiling) COMPILE(COMP_START_OF_EXPR); 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 */ CALL(Warn(scr, FPL_MISSING_BRACKET)); /* >warning< */ /* go on anyway! */ } else scr->text++; if(scr->compiling) COMPILE(COMP_END_OF_EXPR); if(val.val.val<(control&CON_DECLARE?1:0)) { /* illegal result of the expression */ CALL(Warn(scr, FPL_ILLEGAL_ARRAY)); val.val.val=(control&CON_DECLARE?1:0); /* reset to decent number! */ } dims[(*num)++]=val.val.val; /* Add another dimension */ if(*num==maxnum) { /* we've hit the roof! */ break; } else if(*num==MAX_DIMS) { /* if we try to use too many dimensions... */ ret=FPL_ILLEGAL_ARRAY; break; } /* * Go on as long there are braces and we are declaring OR * as long the `num' variable tells us (you, know: when * you want to read character five in a member of a * three dimensional string array, it could look like * "int a=string[2][3][4][5];" ... :-) */ } while(*scr->text==CHAR_OPEN_BRACKET); } if(scr->compiling) COMPILE(COMP_END_OF_ARRAYINFO); return(ret); } /********************************************************************** * * ArrayNum() * * Return which array position we should look in when the user wants the * array member presented as a number of dimensions and an array with the * dimension sizes. * ******/ static long ArrayNum(long num, /* number of dimensions specified */ long dnum, /* number of dimensions declared */ long *dims, /* dimensions specified */ long *decl) /* declared dimension information */ { long i; long pos=0; long base=1; if(num!=dnum) /* * Then we can't get proper information!!! */ return(-1); for(i=0; i=decl[i]) return(-1); pos+=dims[i]*base; base*=decl[i]; } return(pos); } /********************************************************** * * CallFunction() * * Calls a function. Internal, external or inside!! * *******/ static ReturnCode INLINE CallFunction(struct Data *scr, struct fplArgument *pass, struct Identifier *ident) { ReturnCode ret; if(ident && ident->flags&FPL_INSIDE_FUNCTION) { CALL(inside(scr, pass, ident)); } else if(ident && ident->flags&FPL_INTERNAL_FUNCTION) { CALL(functions(pass)); } else { /* if (EXTERNAL_FUNCTION) */ pass->funcdata=ident?ident->data.external.data:(void *)NULL; #if defined(AMIGA) && defined(SHARED) if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) { if(ret==1) return(FPL_OUT_OF_MEMORY); else return(FPL_OUT_OF_STACK); } #endif if(ident && ident->data.external.func) { /* * If this is non-zero, a function specific function pointer * has been assigned to it! In that case we should call that * function instead of the traditional, global one! */ CALL(InterfaceCall(scr, pass, ident->data.external.func)); } else { CALL(InterfaceCall(scr, pass, scr->function)); } } return(FPL_OK); } /********************************************************************** * * inside(); * * This function takes care of the inside function callings within a * FPL program (or in a FPL program where the function was declared using * `export'). * ******/ static ReturnCode INLINE inside(struct Data *scr, struct fplArgument *arg, struct Identifier *func) { /* * The function has been declared as an `inside' one. */ ReturnCode ret=FPL_OK; struct Identifier *pident; /* pointer to identifier */ struct Identifier *ident; char *t=scr->text; struct Local *locals=NULL; long p=scr->prg; char *file=scr->prog->name; long vp=scr->virprg; char *vf=scr->virfile; char count; /* parameter counter */ char *text; struct Condition con; struct Expr val; struct fplStr *string; char oldret; static unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE}; static unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0, FPLSEND_DONE}; char cont; long search; struct Program *prog=scr->prog; struct fplVariable *tempvar; if(file!=func->data.inside.file) { struct Program *prog=scr->programs; while(prog) { if(!strcmp(prog->name, func->data.inside.file)) break; prog=prog->next; } if(prog) { CALL(LeaveProgram(scr, scr->prog)); CALL(GetProgram(scr, prog)); scr->prog=prog; } else return(FPL_INTERNAL_ERROR); /* This is a dead-end error! */ } if(func->flags&FPL_INSIDE_NOTFOUND) { /* * We have no current information about where this function * is to be found. Search for it and store the location in * ->text and ->prg. */ cont=TRUE; search=(func->data.inside.ret==FPL_STRARG)?CMD_STRING: (func->data.inside.ret==FPL_INTARG)?CMD_INT:CMD_VOID; /* * Start searching from the declaration position to enable local functions! */ scr->text=(&scr->prog->program)[scr->prog->startprg-1]+ func->data.inside.col; scr->prg=func->data.inside.prg; scr->virprg=func->data.inside.virprg; scr->virfile=func->data.inside.virfile; while(cont && !ret) { switch(*scr->text) { case CHAR_OPEN_BRACE: /* ...go to the corresponding brace */ ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE); break; case CHAR_OPEN_PAREN: /* ...go to the corresponding parenthesis */ ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE); break; case CHAR_QUOTATION_MARK: scr->text++; /* dirty use of function: */ ret=GetEnd(scr, CHAR_QUOTATION_MARK, CHAR_QUOTATION_MARK, FALSE); break; case CHAR_ASCII_ZERO: if(Newline(scr)) ret=FPL_INSIDE_NOT_FOUND; break; case CHAR_DIVIDE: /* to eat comments */ case CHAR_SPACE: case CHAR_TAB: case CHAR_NEWLINE: if(Eat(scr)) ret=FPL_INSIDE_NOT_FOUND; if(*scr->text==CHAR_HASH) { /* This should read a #line statement for new virtual line number */ while(*scr->text++!=CHAR_NEWLINE); scr->virprg++; } break; case CHAR_CLOSE_BRACE: /* local function searches might hit this! */ ret=FPL_INSIDE_NOT_FOUND; break; default: if(ALPHA(*scr->text)) { Getword(scr->buf, scr); GetIdentifier(scr, scr->buf, &pident); if(pident && /* valid identifier */ pident->data.external.ID==search) { /* and it's the right one */ if(!Getword(scr->buf, scr)) { GetIdentifier(scr, scr->buf, &pident); if(pident && pident->flags&FPL_INSIDE_FUNCTION) /* an inside */ cont=strcmp(pident->name, func->name); /* is it the right? */ } } else while(ALPHA(*scr->text)) scr->text++; } else scr->text++; break; } } if(ret) { strcpy(scr->buf, func->name); /* enable better error report! */ scr->prg=p; scr->text=t; scr->virprg=vp; return(FPL_INSIDE_NOT_FOUND); /* dead end error */ } func->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1]; func->data.inside.prg=scr->prg; func->data.inside.virprg=scr->virprg; func->data.inside.virfile=scr->virfile; func->flags&=~FPL_INSIDE_NOTFOUND; /* we have found it! */ } else { /* * We know where to find this function! */ scr->prg=func->data.inside.prg; scr->text=(&scr->prog->program)[scr->prg-1]+func->data.inside.col; scr->virprg=func->data.inside.virprg; scr->virfile=func->data.inside.virfile; } /********************************** * PARSE THE PARAMETER LIST HERE! * **********************************/ CALL(Eat(scr)); if(*scr->text!=CHAR_OPEN_PAREN) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); /* we can survive without that! */ } else scr->text++; if(func->data.inside.format) { /* * We won't hit this if no arguments is prototyped. */ count=0; /* parameter counter */ text=func->data.inside.format; if(!*text) { if(!Getword(scr->buf, scr) && strcmp(scr->buf, "void")) { /* it should be "void" or nothing! If it wasn't we fail! */ CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); } } else { while(*text && !ret) { CALL(Getword(scr->buf, scr)); CALL(GetIdentifier(scr, scr->buf, &ident)); switch(*text) { case FPL_STRARG: case FPL_INTARG: if(*text==FPL_STRARG && ident->data.external.ID!=CMD_STRING) { CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); /* we create the variable that was declared in the prototype! */ } else if(*text==FPL_INTARG && ident->data.external.ID!=CMD_INT) { CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); /* we create the variable that was declared in the prototype! */ } /* * Declare the following word as a string or integer * variable. */ GETMEM(pident, sizeof(struct Identifier)); CALL(Getword(scr->buf, scr)); /* OLD: GETMEM(tempvar, sizeof(struct fplVariable)); */ tempvar=&pident->data.variable; pident->flags=(*text==FPL_INTARG?FPL_INT_VARIABLE: FPL_STRING_VARIABLE)| (ident->flags&FPL_VARIABLE_LESS32); STRDUP(pident->name, scr->buf); tempvar->num=0; /* This is not an array */ tempvar->size=1; /* This is not an array */ GETMEM(tempvar->var.val32, sizeof(void *)); if(*text==FPL_INTARG) { tempvar->var.val32[0]=(long)arg->argv[count]; } else { /* Store string length in variable `len' */ register long len=GETSTRLEN(arg->argv[count]); GETMEM(tempvar->var.str[0], sizeof(struct fplStr)+len); tempvar->var.str[0]->alloc=len; /* We copy the ending zero termination too! */ memcpy(tempvar->var.str[0]->string, ((char *)arg->argv[count]), len+1); tempvar->var.str[0]->len=len; } /* * Emulate next level variable declaration by adding one * to the ->level member here... dirty but (fully?) * functional!!!! ;-) */ pident->level=scr->varlevel+1; pident->file=scr->prog->name; pident->func=func; CALL(AddVar(scr, pident, &locals)); break; case FPL_STRVARARG: case FPL_INTVARARG: if(*text==FPL_STRVARARG && ident->data.external.ID!=CMD_STRING) { CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); /* create a string reference anyway! */ } else if(*text==FPL_INTVARARG && ident->data.external.ID!=CMD_INT) { CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); /* create an int reference anyway! */ } else CALL(Eat(scr)); else if(*scr->text!=CHAR_AND) { /* if it's not a proper reference sign here, warn! */ CALL(Warn(scr, FPL_ILLEGAL_PROTOTYPE)); /* keep it up anyway! */ } /* * Declare the following word as a variable which * will use the struct fplVariable pointer as given in the * calling parameter list. */ scr->text++; CALL(Getword(scr->buf, scr)); if(arg->argv[count]) { /* * If the wrong kind of variable was sent in the function call, no * varible will be sent, and no one will be declared. */ GETMEM(pident, sizeof(struct Identifier)); *pident=*(struct Identifier *)arg->argv[count]; pident->flags|=FPL_COPIED_DATA; pident->data.variable.temp= &((struct Identifier *)arg->argv[count])->data.variable; /* original fplVariable position */ STRDUP(pident->name, scr->buf); pident->level=scr->varlevel+1; pident->file=scr->prog->name; pident->func=func; CALL(AddVar(scr, pident, &locals)); } break; } CALL(Eat(scr)); if(*++text && *scr->text++!=CHAR_COMMA) /* * There is no way out from this error exception. Leaving a parameter * really is a sever thing! */ return(FPL_MISSING_ARGUMENT); count++; } } CALL(Eat(scr)); if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_ILLEGAL_DECLARE)); /* who needs ending parentheses? */ } else scr->text++; } else { /* * No argument is useable to this function. There might be a * `void' keyword here, but nothing else! Just search for the * closing parenthesis to fasten interpreting! */ if(ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE)) { CALL(Warn(scr, FPL_MISSING_PARENTHESES)); /* ok, then search for the open brace where the program starts! */ ret=GetEnd(scr, CHAR_OPEN_BRACE, CHAR_OPEN_PAREN, FALSE); if(ret) { CALL(Warn(scr, FPL_MISSING_BRACE)); } else scr->text--; /* back on brace */ /* ok, then we say that the program starts right here! */ } } /********************* * RUN THE FUNCTION! * *********************/ oldret=scr->strret; scr->strret=func->data.inside.ret==FPL_STRARG; /* should we receive a string? */ CALL(Eat(scr)); if(*scr->text!=CHAR_OPEN_BRACE) { CALL(Warn(scr, FPL_MISSING_BRACE)); /* we can do with a start without it! */ } else scr->text++; con.bracetext=scr->text; con.braceprg=scr->prg; text=(void *)scr->func; /* backup current */ scr->func=func; scr->prog->openings++; ret=Script(scr, &val, SCR_BRACE|SCR_FUNCTION, &con); scr->prog->openings--; /* * Delete all variables created on our list for use * only in the function we just came back from! */ DelLocalVar(scr, &locals); if(ret) return(ret); scr->func=(void *)text; /* restore last */ if(scr->strret) { /* we should return a string */ string=val.val.str; strtags[1]=(long)string->string; strtags[3]=string->len; CALL(fplSend(scr, strtags)); FREE(string); } else { inttags[1]=val.val.val; CALL(fplSend(scr, inttags)); } scr->text=t; scr->prg=p; scr->virprg=vp; scr->virfile=vf; scr->strret=oldret; if(scr->prog!=prog) { CALL(LeaveProgram(scr, scr->prog)); scr->prog=prog; CALL(GetProgram(scr, scr->prog)); } return(FPL_OK); } static ReturnCode INLINE PrototypeInside(struct Data *scr, struct Expr *val, long control, struct Identifier *ident) { /* * Prototyping an `inside' function! * * We have already received the return type, now we must * parse the paraters given within the parentheses. Legal * parameters are only combinations of `string', `int', * `string &' and `int &', or a single `void' (if no argument * should be sent to the function). Arguments specified in * a prototype is required, there is no way to specify an * optional parameter or a parameter list. */ struct Identifier *pident, *wident; long pos=0; ReturnCode ret = FPL_OK; char *array; char found=ident?TRUE:FALSE; /* For compiling: */ struct Local *locals=NULL; struct fplVariable *tempvar; if(!found) { GETMEM(pident, sizeof(struct Identifier)); STRDUP(pident->name, scr->buf); } else { /* we already know about this function! */ if(ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD|FPL_EXTERNAL_FUNCTION)) return FPL_IDENTIFIER_USED; pident = ident; } if(!found || (found && ident->flags&FPL_INSIDE_NOTFOUND)) { /* we know where this is... */ pident->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1]; pident->data.inside.prg=scr->prg; pident->data.inside.file=scr->prog->name; pident->data.inside.virprg=scr->virprg; pident->data.inside.virfile=scr->virfile; pident->file=control&CON_DECLEXP?NULL:scr->prog->name; /* file! */ pident->func=scr->func; /* declared in this function */ pident->level=control&CON_DECLGLOB?0:scr->varlevel; } if(found) { /* we already know about this function! */ CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE)); CALL(Eat(scr)); if(scr->text[0]==CHAR_OPEN_BRACE) { /* now the function is found! */ if(!(ident->flags&FPL_INSIDE_NOTFOUND)) /* the function has already been defined and is defined here again! */ return FPL_IDENTIFIER_USED; ident->flags&=~FPL_INSIDE_NOTFOUND; CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE)); scr->text--; /* back on close brace */ val->flags|=FPL_DEFUNCTION; } return FPL_OK; } pident->flags=FPL_INSIDE_FUNCTION| (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0); scr->text++; /* pass the open parenthesis */ if(scr->compiling) COMPILE(COMP_START_OF_PARAMETERS); CALL(Eat(scr)); GETMEM(array, MAX_ARGUMENTS * sizeof(char)); while(postext==CHAR_CLOSE_PAREN) { scr->text++; break; } CALL(Getword(scr->buf, scr)); CALL(GetIdentifier(scr, scr->buf, &ident)); CALL(Eat(scr)); switch(ident->data.external.ID) { case CMD_VOID: if(scr->compiling) COMPILE(COMP_NO_PARAMETER); if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_ILLEGAL_PROTOTYPE)); CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE)); } else scr->text++; break; case CMD_STRING: case CMD_INT: if(*scr->text==CHAR_AND) { scr->text++; if(scr->compiling) COMPILE(COMP_VARIABLEREF); array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRVARARG: FPL_INTVARARG; } else array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARG: FPL_INTARG; if(scr->compiling) { if(ident->data.external.ID==CMD_STRING) COMPILE(COMP_STRING_PARAMETER); else COMPILE(COMP_INT_PARAMETER); if(ALPHA(*scr->text)) { Getword(scr->buf, scr); COMPILESYMBOL(scr->buf); /* * Declare that word as a string or integer variable. */ GETMEM(wident, sizeof(struct Identifier)); tempvar=&wident->data.variable; wident->flags=(ident->data.external.ID==CMD_INT)?FPL_INT_VARIABLE: FPL_STRING_VARIABLE| (ident->flags&FPL_VARIABLE_LESS32); STRDUP(wident->name, scr->buf); tempvar->num=0; /* This is not an array */ tempvar->size=1; /* This is not an array */ GETMEM(tempvar->var.val32, sizeof(void *)); if(ident->data.external.ID==CMD_INT) { tempvar->var.val32[0]=(long)0; } else { GETMEM(tempvar->var.str[0], sizeof(struct fplStr)); memset(tempvar->var.str[0], 0, sizeof(struct fplStr)); } /* * Emulate next level variable declaration by adding one * to the ->level member here... dirty but (fully?) * functional!!!! ;-) */ wident->level=scr->varlevel+1; wident->file=scr->prog->name; wident->func=scr->func; CALL(AddVar(scr, wident, &locals)); } CALL(Eat(scr)); } break; default: CALL(Warn(scr, FPL_ILLEGAL_PROTOTYPE)); continue; /* if we against all odds are ordered to go on! */ } if(CMD_VOID == ident->data.external.ID) break; pos++; if(ALPHA(*scr->text)) { Getword(scr->buf, scr); CALL(Eat(scr)); } if(*scr->text==CHAR_COMMA) scr->text++; else if(*scr->text!=CHAR_CLOSE_PAREN) { CALL(Warn(scr, FPL_ILLEGAL_PROTOTYPE)); /* we can go on if we just forgot the closing parenthesis */ } } array[pos]=0; /* terminate string */ /* * We have all information now. AddIdentifier(). */ pident->data.inside.ret=(control&CON_DECLSTR)?FPL_STRARG: (control&CON_DECLINT)?FPL_INTARG:FPL_VOIDARG; GETMEM(pident->data.inside.format, pos+1); strcpy(pident->data.inside.format, array); FREE(array); CALL(Eat(scr)); /* Eat white space */ if(scr->compiling) COMPILE(COMP_END_OF_PARAMETERS); if(*scr->text==CHAR_OPEN_BRACE) { /* It's the actual function!!! */ if(!scr->compiling) { CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE)); scr->text--; /* back on close brace */ } val->flags|=FPL_DEFUNCTION; } else { val->flags&=~FPL_DEFUNCTION; pident->flags|=FPL_INSIDE_NOTFOUND; } CALL(AddVar(scr, pident, control&CON_DECLGLOB?&scr->globals:&scr->locals)); if(scr->compiling) { if(val->flags&FPL_DEFUNCTION) { struct Condition con; struct Expr expr; scr->text++; /* pass the open brace! */ COMPILE(COMP_START_OF_BLOCK); ret = Script(scr, &expr, SCR_BRACE|SCR_FUNCTION, &con); if(!ret) scr->text--; /* back on close brace */ val->flags|=FPL_DEFUNCTION; } /* * Delete all variables created on our list for use * only in the function we just came back from! */ DelLocalVar(scr, &locals); } return(ret); }