dvander@27: /* Pawn compiler - File input, preprocessing and lexical analysis functions dvander@27: * dvander@27: * Copyright (c) ITB CompuPhase, 1997-2006 dvander@27: * dvander@27: * This software is provided "as-is", without any express or implied warranty. dvander@27: * In no event will the authors be held liable for any damages arising from dvander@27: * the use of this software. dvander@27: * dvander@27: * Permission is granted to anyone to use this software for any purpose, dvander@27: * including commercial applications, and to alter it and redistribute it dvander@27: * freely, subject to the following restrictions: dvander@27: * dvander@27: * 1. The origin of this software must not be misrepresented; you must not dvander@27: * claim that you wrote the original software. If you use this software in dvander@27: * a product, an acknowledgment in the product documentation would be dvander@27: * appreciated but is not required. dvander@27: * 2. Altered source versions must be plainly marked as such, and must not be dvander@27: * misrepresented as being the original software. dvander@27: * 3. This notice may not be removed or altered from any source distribution. dvander@27: * faluco@62: * Version: $Id: sc2.c 3636 2006-08-14 15:42:05Z thiadmer $ dvander@27: */ dvander@27: #include dvander@27: #include dvander@27: #include dvander@27: #include dvander@27: #include dvander@27: #include dvander@27: #include "lstring.h" dvander@27: #include "sc.h" dvander@27: #if defined LINUX || defined __FreeBSD__ || defined __OpenBSD__ dvander@27: #include dvander@27: #endif dvander@27: dvander@27: #if defined FORTIFY dvander@27: #include dvander@27: #endif dvander@27: dvander@27: /* flags for litchar() */ dvander@27: #define RAWMODE 1 dvander@27: #define UTF8MODE 2 dvander@27: static cell litchar(const unsigned char **lptr,int flags); dvander@27: static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag); dvander@27: dvander@27: static void substallpatterns(unsigned char *line,int buffersize); dvander@27: static int match(char *st,int end); dvander@27: static int alpha(char c); dvander@27: dvander@27: #define SKIPMODE 1 /* bit field in "#if" stack */ dvander@27: #define PARSEMODE 2 /* bit field in "#if" stack */ dvander@27: #define HANDLED_ELSE 4 /* bit field in "#if" stack */ dvander@27: #define SKIPPING (skiplevel>0 && (ifstack[skiplevel-1] & SKIPMODE)==SKIPMODE) dvander@27: dvander@27: static short icomment; /* currently in multiline comment? */ dvander@27: static char ifstack[sCOMP_STACK]; /* "#if" stack */ dvander@27: static short iflevel; /* nesting level if #if/#else/#endif */ dvander@27: static short skiplevel; /* level at which we started skipping (including nested #if .. #endif) */ dvander@27: static unsigned char term_expr[] = ""; dvander@27: static int listline=-1; /* "current line" for the list file */ dvander@27: dvander@27: dvander@27: /* pushstk & popstk dvander@27: * dvander@27: * Uses a LIFO stack to store information. The stack is used by doinclude(), dvander@27: * doswitch() (to hold the state of "swactive") and some other routines. dvander@27: * dvander@27: * Porting note: I made the bold assumption that an integer will not be dvander@27: * larger than a pointer (it may be smaller). That is, the stack element dvander@27: * is typedef'ed as a pointer type, but I also store integers on it. See dvander@27: * SC.H for "stkitem" dvander@27: * dvander@27: * Global references: stack,stkidx,stktop (private to pushstk(), popstk() dvander@27: * and clearstk()) dvander@27: */ dvander@27: static stkitem *stack=NULL; dvander@27: static int stkidx=0,stktop=0; dvander@27: dvander@27: SC_FUNC void pushstk(stkitem val) dvander@27: { dvander@27: assert(stkidx<=stktop); dvander@27: if (stkidx==stktop) { dvander@27: stkitem *newstack; dvander@27: int newsize= (stktop==0) ? 16 : 2*stktop; dvander@27: /* try to resize the stack */ dvander@27: assert(newsize>stktop); dvander@27: newstack=(stkitem*)malloc(newsize*sizeof(stkitem)); dvander@27: if (newstack==NULL) dvander@27: error(102,"parser stack"); /* stack overflow (recursive include?) */ dvander@27: /* swap the stacks */ dvander@27: memcpy(newstack,stack,stkidx*sizeof(stkitem)); dvander@27: if (stack!=NULL) dvander@27: free(stack); dvander@27: stack=newstack; dvander@27: stktop=newsize; dvander@27: } /* if */ dvander@27: assert(stkidx'); /* termination character */ dvander@27: lptr++; dvander@27: while (*lptr<=' ' && *lptr!='\0') /* skip whitespace after quote */ dvander@27: lptr++; dvander@27: } else { dvander@27: c='\0'; dvander@27: } /* if */ dvander@27: dvander@27: i=0; dvander@27: while (*lptr!=c && *lptr!='\0' && i0 && name[i-1]<=' ') dvander@27: i--; /* strip trailing whitespace */ dvander@27: assert(i>=0 && i are only read from the list of include directories. dvander@27: */ dvander@27: result=plungefile(name,(c!='>'),TRUE); dvander@27: if (result) dvander@27: add_constant(symname,1,sGLOBAL,0); dvander@27: else if (!silent) dvander@27: error(100,name); /* cannot read from ... (fatal error) */ dvander@27: } /* if */ dvander@27: } dvander@27: dvander@27: /* readline dvander@27: * dvander@27: * Reads in a new line from the input file pointed to by "inpf". readline() dvander@27: * concatenates lines that end with a \ with the next line. If no more data dvander@27: * can be read from the file, readline() attempts to pop off the previous file dvander@27: * from the stack. If that fails too, it sets "freading" to 0. dvander@27: * dvander@27: * Global references: inpf,fline,inpfname,freading,icomment (altered) dvander@27: */ dvander@27: static void readline(unsigned char *line) dvander@27: { dvander@27: int i,num,cont; dvander@27: unsigned char *ptr; dvander@27: dvander@27: if (lptr==term_expr) dvander@27: return; dvander@27: num=sLINEMAX; dvander@27: cont=FALSE; dvander@27: do { dvander@27: if (inpf==NULL || pc_eofsrc(inpf)) { dvander@27: if (cont) dvander@27: error(49); /* invalid line continuation */ dvander@27: if (inpf!=NULL && inpf!=inpf_org) dvander@27: pc_closesrc(inpf); dvander@27: i=POPSTK_I(); dvander@27: if (i==-1) { /* All's done; popstk() returns "stack is empty" */ dvander@27: freading=FALSE; dvander@27: *line='\0'; dvander@27: /* when there is nothing more to read, the #if/#else stack should dvander@27: * be empty and we should not be in a comment dvander@27: */ dvander@27: assert(iflevel>=0); dvander@27: if (iflevel>0) dvander@27: error(1,"#endif","-end of file-"); dvander@27: else if (icomment!=0) dvander@27: error(1,"*/","-end of file-"); dvander@27: return; dvander@27: } /* if */ dvander@27: fline=i; dvander@27: fcurrent=(short)POPSTK_I(); dvander@27: icomment=(short)POPSTK_I(); dvander@27: sc_is_utf8=(short)POPSTK_I(); dvander@27: iflevel=(short)POPSTK_I(); dvander@27: skiplevel=iflevel; /* this condition held before including the file */ dvander@27: assert(!SKIPPING); /* idem ditto */ dvander@27: curlibrary=(constvalue *)POPSTK_P(); dvander@27: free(inpfname); /* return memory allocated for the include file name */ dvander@27: inpfname=(char *)POPSTK_P(); dvander@27: inpf=(FILE *)POPSTK_P(); dvander@27: insert_dbgfile(inpfname); dvander@27: setfiledirect(inpfname); dvander@27: listline=-1; /* force a #line directive when changing the file */ dvander@27: } /* if */ dvander@27: dvander@27: if (pc_readsrc(inpf,line,num)==NULL) { dvander@27: *line='\0'; /* delete line */ dvander@27: cont=FALSE; dvander@27: } else { dvander@27: /* check whether to erase leading spaces */ dvander@27: if (cont) { dvander@27: unsigned char *ptr=line; dvander@27: while (*ptr<=' ' && *ptr!='\0') dvander@27: ptr++; dvander@27: if (ptr!=line) dvander@27: memmove(line,ptr,strlen((char*)ptr)+1); dvander@27: } /* if */ dvander@27: cont=FALSE; dvander@27: /* check whether a full line was read */ dvander@27: if (strchr((char*)line,'\n')==NULL && !pc_eofsrc(inpf)) dvander@27: error(75); /* line too long */ dvander@27: /* check if the next line must be concatenated to this line */ dvander@27: if ((ptr=(unsigned char*)strchr((char*)line,'\n'))==NULL) dvander@27: ptr=(unsigned char*)strchr((char*)line,'\r'); dvander@27: if (ptr!=NULL && ptr>line) { dvander@27: assert(*(ptr+1)=='\0'); /* '\n' or '\r' should be last in the string */ dvander@27: while (ptr>line && *ptr<=' ') dvander@27: ptr--; /* skip trailing whitespace */ dvander@27: if (*ptr=='\\') { dvander@27: cont=TRUE; dvander@27: /* set '\a' at the position of '\\' to make it possible to check dvander@27: * for a line continuation in a single line comment (error 49) dvander@27: */ dvander@27: *ptr++='\a'; dvander@27: *ptr='\0'; /* erase '\n' (and any trailing whitespace) */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: num-=strlen((char*)line); dvander@27: line+=strlen((char*)line); dvander@27: } /* if */ dvander@27: fline+=1; dvander@27: } while (num>=0 && cont); dvander@27: } dvander@27: dvander@27: /* stripcom dvander@27: * dvander@27: * Replaces all comments from the line by space characters. It updates dvander@27: * a global variable ("icomment") for multiline comments. dvander@27: * dvander@27: * This routine also supports the C++ extension for single line comments. dvander@27: * These comments are started with "//" and end at the end of the line. dvander@27: * dvander@27: * The function also detects (and manages) "documentation comments". The dvander@27: * global variable "icomment" is set to 2 for documentation comments. dvander@27: * dvander@27: * Global references: icomment (private to "stripcom") dvander@27: */ dvander@27: static void stripcom(unsigned char *line) dvander@27: { dvander@27: char c; dvander@27: #if !defined SC_LIGHT dvander@27: #define COMMENT_LIMIT 100 dvander@27: #define COMMENT_MARGIN 40 /* length of the longest word */ dvander@27: char comment[COMMENT_LIMIT+COMMENT_MARGIN]; dvander@27: int commentidx=0; dvander@27: int skipstar=TRUE; dvander@27: static int prev_singleline=FALSE; dvander@27: int singleline=prev_singleline; dvander@27: dvander@27: prev_singleline=FALSE; /* preset */ dvander@27: #endif dvander@27: dvander@27: while (*line){ dvander@27: if (icomment!=0) { dvander@27: if (*line=='*' && *(line+1)=='/') { dvander@27: #if !defined SC_LIGHT dvander@27: if (icomment==2) { dvander@27: assert(commentidx0) dvander@27: insert_docstring(comment); dvander@27: } /* if */ dvander@27: #endif dvander@27: icomment=0; /* comment has ended */ dvander@27: *line=' '; /* replace '*' and '/' characters by spaces */ dvander@27: *(line+1)=' '; dvander@27: line+=2; dvander@27: } else { dvander@27: if (*line=='/' && *(line+1)=='*') dvander@27: error(216); /* nested comment */ dvander@27: #if !defined SC_LIGHT dvander@27: /* collect the comment characters in a string */ dvander@27: if (icomment==2) { dvander@27: if (skipstar && (*line!='\0' && *line<=' ' || *line=='*')) { dvander@27: /* ignore leading whitespace and '*' characters */ dvander@27: } else if (commentidxCOMMENT_LIMIT && *line!='\0' && *line<=' ') { dvander@27: comment[commentidx]='\0'; dvander@27: insert_docstring(comment); dvander@27: commentidx=0; dvander@27: } /* if */ dvander@27: skipstar=FALSE; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: #endif dvander@27: *line=' '; /* replace comments by spaces */ dvander@27: line+=1; dvander@27: } /* if */ dvander@27: } else { dvander@27: if (*line=='/' && *(line+1)=='*'){ dvander@27: icomment=1; /* start comment */ dvander@27: #if !defined SC_LIGHT dvander@27: /* there must be two "*" behind the slash and then white space */ dvander@27: if (*(line+2)=='*' && *(line+3)<=' ') { dvander@27: /* if we are not in a function, we must attach the previous block dvander@27: * to the global documentation dvander@27: */ dvander@27: if (curfunc==NULL && get_docstring(0)!=NULL) dvander@27: sc_attachdocumentation(NULL); dvander@27: icomment=2; /* documentation comment */ dvander@27: } /* if */ dvander@27: commentidx=0; dvander@27: skipstar=TRUE; dvander@27: #endif dvander@27: *line=' '; /* replace '/' and '*' characters by spaces */ dvander@27: *(line+1)=' '; dvander@27: line+=2; dvander@27: if (icomment==2) dvander@27: *line++=' '; dvander@27: } else if (*line=='/' && *(line+1)=='/'){ /* comment to end of line */ dvander@27: if (strchr((char*)line,'\a')!=NULL) dvander@27: error(49); /* invalid line continuation */ dvander@27: #if !defined SC_LIGHT dvander@27: if (*(line+2)=='/' && *(line+3)<=' ') { dvander@27: /* documentation comment */ dvander@27: char *str=(char*)line+3; dvander@27: char *end; dvander@27: while (*str<=' ' && *str!='\0') dvander@27: str++; /* skip leading whitespace */ dvander@27: if ((end=strrchr(str,'\n'))!=NULL) dvander@27: *end='\0';/* erase trailing '\n' */ dvander@27: /* if there is a disjunct block, we may need to attach the previous dvander@27: * block to the global documentation dvander@27: */ dvander@27: if (!singleline && curfunc==NULL && get_docstring(0)!=NULL) dvander@27: sc_attachdocumentation(NULL); dvander@27: insert_docstring(str); dvander@27: prev_singleline=TRUE; dvander@27: } /* if */ dvander@27: #endif dvander@27: *line++='\n'; /* put "newline" at first slash */ dvander@27: *line='\0'; /* put "zero-terminator" at second slash */ dvander@27: } else { dvander@27: if (*line=='\"' || *line=='\''){ /* leave literals unaltered */ dvander@27: c=*line; /* ending quote, single or double */ dvander@27: line+=1; dvander@27: while ((*line!=c || *(line-1)==sc_ctrlchar) && *line!='\0') dvander@27: line+=1; dvander@27: line+=1; /* skip final quote */ dvander@27: } else { dvander@27: line+=1; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } /* while */ dvander@27: #if !defined SC_LIGHT dvander@27: if (icomment==2) { dvander@27: assert(commentidx0) dvander@27: insert_docstring(comment); dvander@27: } /* if */ dvander@27: #endif dvander@27: } dvander@27: dvander@27: /* btoi dvander@27: * dvander@27: * Attempts to interpret a numeric symbol as a boolean value. On success dvander@27: * it returns the number of characters processed (so the line pointer can be dvander@27: * adjusted) and the value is stored in "val". Otherwise it returns 0 and dvander@27: * "val" is garbage. dvander@27: * dvander@27: * A boolean value must start with "0b" dvander@27: */ dvander@27: static int btoi(cell *val,const unsigned char *curptr) dvander@27: { dvander@27: const unsigned char *ptr; dvander@27: dvander@27: *val=0; dvander@27: ptr=curptr; dvander@27: if (*ptr=='0' && *(ptr+1)=='b') { dvander@27: ptr+=2; dvander@27: while (*ptr=='0' || *ptr=='1' || *ptr=='_') { dvander@27: if (*ptr!='_') dvander@27: *val=(*val<<1) | (*ptr-'0'); dvander@27: ptr++; dvander@27: } /* while */ dvander@27: } else { dvander@27: return 0; dvander@27: } /* if */ dvander@27: if (alphanum(*ptr)) /* number must be delimited by non-alphanumeric char */ dvander@27: return 0; dvander@27: else dvander@27: return (int)(ptr-curptr); dvander@27: } dvander@27: dvander@27: /* dtoi dvander@27: * dvander@27: * Attempts to interpret a numeric symbol as a decimal value. On success dvander@27: * it returns the number of characters processed and the value is stored in dvander@27: * "val". Otherwise it returns 0 and "val" is garbage. dvander@27: */ dvander@27: static int dtoi(cell *val,const unsigned char *curptr) dvander@27: { dvander@27: const unsigned char *ptr; dvander@27: dvander@27: *val=0; dvander@27: ptr=curptr; dvander@27: if (!isdigit(*ptr)) /* should start with digit */ dvander@27: return 0; dvander@27: while (isdigit(*ptr) || *ptr=='_') { dvander@27: if (*ptr!='_') dvander@27: *val=(*val*10)+(*ptr-'0'); dvander@27: ptr++; dvander@27: } /* while */ dvander@27: if (alphanum(*ptr)) /* number must be delimited by non-alphanumerical */ dvander@27: return 0; dvander@27: if (*ptr=='.' && isdigit(*(ptr+1))) dvander@27: return 0; /* but a fractional part must not be present */ dvander@27: return (int)(ptr-curptr); dvander@27: } dvander@27: dvander@27: /* htoi dvander@27: * dvander@27: * Attempts to interpret a numeric symbol as a hexadecimal value. On dvander@27: * success it returns the number of characters processed and the value is dvander@27: * stored in "val". Otherwise it return 0 and "val" is garbage. dvander@27: */ dvander@27: static int htoi(cell *val,const unsigned char *curptr) dvander@27: { dvander@27: const unsigned char *ptr; dvander@27: dvander@27: *val=0; dvander@27: ptr=curptr; dvander@27: if (!isdigit(*ptr)) /* should start with digit */ dvander@27: return 0; dvander@27: if (*ptr=='0' && *(ptr+1)=='x') { /* C style hexadecimal notation */ dvander@27: ptr+=2; dvander@27: while (ishex(*ptr) || *ptr=='_') { dvander@27: if (*ptr!='_') { dvander@27: assert(ishex(*ptr)); dvander@27: *val= *val<<4; dvander@27: if (isdigit(*ptr)) dvander@27: *val+= (*ptr-'0'); dvander@27: else dvander@27: *val+= (tolower(*ptr)-'a'+10); dvander@27: } /* if */ dvander@27: ptr++; dvander@27: } /* while */ dvander@27: } else { dvander@27: return 0; dvander@27: } /* if */ dvander@27: if (alphanum(*ptr)) dvander@27: return 0; dvander@27: else dvander@27: return (int)(ptr-curptr); dvander@27: } dvander@27: dvander@27: #if defined __GNUC__ dvander@27: static double pow10(int value) dvander@27: { dvander@27: double res=1.0; dvander@27: while (value>=4) { dvander@27: res*=10000.0; dvander@27: value-=5; dvander@27: } /* while */ dvander@27: while (value>=2) { dvander@27: res*=100.0; dvander@27: value-=2; dvander@27: } /* while */ dvander@27: while (value>=1) { dvander@27: res*=10.0; dvander@27: value-=1; dvander@27: } /* while */ dvander@27: return res; dvander@27: } dvander@27: #endif dvander@27: dvander@27: /* ftoi dvander@27: * dvander@27: * Attempts to interpret a numeric symbol as a rational number, either as dvander@27: * IEEE 754 single/double precision floating point or as a fixed point integer. dvander@27: * On success it returns the number of characters processed and the value is dvander@27: * stored in "val". Otherwise it returns 0 and "val" is unchanged. dvander@27: * dvander@27: * Pawn has stricter definition for rational numbers than most: dvander@27: * o the value must start with a digit; ".5" is not a valid number, you dvander@27: * should write "0.5" dvander@27: * o a period must appear in the value, even if an exponent is given; "2e3" dvander@27: * is not a valid number, you should write "2.0e3" dvander@27: * o at least one digit must follow the period; "6." is not a valid number, dvander@27: * you should write "6.0" dvander@27: */ dvander@27: static int ftoi(cell *val,const unsigned char *curptr) dvander@27: { dvander@27: const unsigned char *ptr; dvander@27: double fnum,ffrac,fmult; dvander@27: unsigned long dnum,dbase; dvander@27: int i, ignore; dvander@27: dvander@27: assert(rational_digits>=0 && rational_digits<9); dvander@27: for (i=0,dbase=1; i0 && !ignore) { dvander@27: error(222); /* number of digits exceeds rational number precision */ dvander@27: ignore=TRUE; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: ptr++; dvander@27: } /* while */ dvander@27: fnum += ffrac*fmult; /* form the number so far */ dvander@27: if (*ptr=='e') { /* optional fractional part */ dvander@27: int exp,sign; dvander@27: ptr++; dvander@27: if (*ptr=='-') { dvander@27: sign=-1; dvander@27: ptr++; dvander@27: } else { dvander@27: sign=1; dvander@27: } /* if */ dvander@27: if (!isdigit(*ptr)) /* 'e' should be followed by a digit */ dvander@27: return 0; dvander@27: exp=0; dvander@27: while (isdigit(*ptr)) { dvander@27: exp=(exp*10)+(*ptr-'0'); dvander@27: ptr++; dvander@27: } /* while */ dvander@27: #if defined __GNUC__ dvander@27: fmult=pow10(exp*sign); dvander@27: #else dvander@27: fmult=pow(10,exp*sign); dvander@27: #endif dvander@27: fnum *= fmult; dvander@27: dnum *= (unsigned long)(fmult+0.5); dvander@27: } /* if */ dvander@27: dvander@27: /* decide how to store the number */ dvander@27: if (sc_rationaltag==0) { dvander@27: error(70); /* rational number support was not enabled */ dvander@27: *val=0; dvander@27: } else if (rational_digits==0) { dvander@27: /* floating point */ dvander@27: #if PAWN_CELL_SIZE==32 dvander@27: float value=(float)fnum; dvander@27: *val=*((cell *)&value); dvander@27: #if 0 /* SourceMod - not needed */ dvander@27: /* I assume that the C/C++ compiler stores "float" values in IEEE 754 dvander@27: * format (as mandated in the ANSI standard). Test this assumption dvander@27: * anyway. dvander@27: * Note: problems have been reported with GCC 3.2.x, version 3.3.x works. dvander@27: */ dvander@27: { float test1 = 0.0, test2 = 50.0, test3 = -50.0; dvander@27: uint32_t bit = 1; dvander@27: /* test 0.0 == all bits 0 */ dvander@27: assert(*(uint32_t*)&test1==0x00000000L); dvander@27: /* test sign & magnitude format */ dvander@27: assert(((*(uint32_t*)&test2) ^ (*(uint32_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1))); dvander@27: /* test a known value */ dvander@27: assert(*(uint32_t*)&test2==0x42480000L); dvander@27: } dvander@27: #endif dvander@27: #elif PAWN_CELL_SIZE==64 dvander@27: *val=*((cell *)&fnum); dvander@27: #if 0 /* SourceMod - not needed */ dvander@27: /* I assume that the C/C++ compiler stores "double" values in IEEE 754 dvander@27: * format (as mandated in the ANSI standard). dvander@27: */ dvander@27: { float test1 = 0.0, test2 = 50.0, test3 = -50.0; dvander@27: uint64_t bit = 1; dvander@27: /* test 0.0 == all bits 0 */ dvander@27: assert(*(uint64_t*)&test1==0x00000000L); dvander@27: /* test sign & magnitude format */ dvander@27: assert(((*(uint64_t*)&test2) ^ (*(uint64_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1))); dvander@27: } dvander@27: #endif dvander@27: #else dvander@27: #error Unsupported cell size dvander@27: #endif dvander@27: } else { dvander@27: /* fixed point */ dvander@27: *val=(cell)dnum; dvander@27: } /* if */ dvander@27: dvander@27: return (int)(ptr-curptr); dvander@27: } dvander@27: dvander@27: /* number dvander@27: * dvander@27: * Reads in a number (binary, decimal or hexadecimal). It returns the number dvander@27: * of characters processed or 0 if the symbol couldn't be interpreted as a dvander@27: * number (in this case the argument "val" remains unchanged). This routine dvander@27: * relies on the 'early dropout' implementation of the logical or (||) dvander@27: * operator. dvander@27: * dvander@27: * Note: the routine doesn't check for a sign (+ or -). The - is checked dvander@27: * for at "hier2()" (in fact, it is viewed as an operator, not as a dvander@27: * sign) and the + is invalid (as in K&R C, and unlike ANSI C). dvander@27: */ dvander@27: static int number(cell *val,const unsigned char *curptr) dvander@27: { dvander@27: int i; dvander@27: cell value; dvander@27: dvander@27: if ((i=btoi(&value,curptr))!=0 /* binary? */ dvander@27: || (i=htoi(&value,curptr))!=0 /* hexadecimal? */ dvander@27: || (i=dtoi(&value,curptr))!=0) /* decimal? */ dvander@27: { dvander@27: *val=value; dvander@27: return i; dvander@27: } else { dvander@27: return 0; /* else not a number */ dvander@27: } /* if */ dvander@27: } dvander@27: dvander@27: static void chrcat(char *str,char chr) dvander@27: { dvander@27: str=strchr(str,'\0'); dvander@27: *str++=chr; dvander@27: *str='\0'; dvander@27: } dvander@27: dvander@27: static int preproc_expr(cell *val,int *tag) dvander@27: { dvander@27: int result; dvander@27: int index; dvander@27: cell code_index; dvander@27: char *term; dvander@27: dvander@27: /* Disable staging; it should be disabled already because dvander@27: * expressions may not be cut off half-way between conditional dvander@27: * compilations. Reset the staging index, but keep the code dvander@27: * index. dvander@27: */ dvander@27: if (stgget(&index,&code_index)) { dvander@27: error(57); /* unfinished expression */ dvander@27: stgdel(0,code_index); dvander@27: stgset(FALSE); dvander@27: } /* if */ dvander@27: assert((lptr-pline)<(int)strlen((char*)pline)); /* lptr must point inside the string */ dvander@27: #if !defined NO_DEFINE dvander@27: /* preprocess the string */ dvander@27: substallpatterns(pline,sLINEMAX); dvander@27: assert((lptr-pline)<(int)strlen((char*)pline)); /* lptr must STILL point inside the string */ dvander@27: #endif dvander@27: /* append a special symbol to the string, so the expression dvander@27: * analyzer won't try to read a next line when it encounters dvander@27: * an end-of-line dvander@27: */ dvander@27: assert(strlen((char*)pline)=0); dvander@27: if (iflevel>=sCOMP_STACK) dvander@27: error(102,"Conditional compilation stack"); /* table overflow */ dvander@27: iflevel++; dvander@27: if (SKIPPING) dvander@27: break; /* break out of switch */ dvander@27: skiplevel=iflevel; dvander@27: preproc_expr(&val,NULL); /* get value (or 0 on error) */ dvander@27: ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE); dvander@27: check_empty(lptr); dvander@27: break; dvander@27: case tpELSE: dvander@27: case tpELSEIF: dvander@27: ret=CMD_IF; dvander@27: assert(iflevel>=0); dvander@27: if (iflevel==0) { dvander@27: error(26); /* no matching #if */ dvander@27: errorset(sRESET,0); dvander@27: } else { dvander@27: /* check for earlier #else */ dvander@27: if ((ifstack[iflevel-1] & HANDLED_ELSE)==HANDLED_ELSE) { dvander@27: if (tok==tpELSEIF) dvander@27: error(61); /* #elseif directive may not follow an #else */ dvander@27: else dvander@27: error(60); /* multiple #else directives between #if ... #endif */ dvander@27: errorset(sRESET,0); dvander@27: } else { dvander@27: assert(iflevel>0); dvander@27: /* if there has been a "parse mode" on this level, set "skip mode", dvander@27: * otherwise, clear "skip mode" dvander@27: */ dvander@27: if ((ifstack[iflevel-1] & PARSEMODE)==PARSEMODE) { dvander@27: /* there has been a parse mode already on this level, so skip the rest */ dvander@27: ifstack[iflevel-1] |= (char)SKIPMODE; faluco@62: /* if we were already skipping this section, allow expressions with faluco@62: * undefined symbols; otherwise check the expression to catch errors faluco@62: */ faluco@62: if (tok==tpELSEIF) { faluco@62: if (skiplevel==iflevel) faluco@62: preproc_expr(&val,NULL); /* get, but ignore the expression */ faluco@62: else faluco@62: lptr=strchr(lptr,'\0'); faluco@62: } /* if */ dvander@27: } else { dvander@27: /* previous conditions were all FALSE */ dvander@27: if (tok==tpELSEIF) { faluco@62: /* if we were already skipping this section, allow expressions with faluco@62: * undefined symbols; otherwise check the expression to catch errors faluco@62: */ faluco@62: if (skiplevel==iflevel) { faluco@62: preproc_expr(&val,NULL); /* get value (or 0 on error) */ faluco@62: } else { faluco@62: lptr=strchr(lptr,'\0'); faluco@62: val=0; faluco@62: } /* if */ dvander@27: ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE); dvander@27: } else { dvander@27: /* a simple #else, clear skip mode */ dvander@27: ifstack[iflevel-1] &= (char)~SKIPMODE; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: check_empty(lptr); dvander@27: break; dvander@27: case tpENDIF: dvander@27: ret=CMD_IF; dvander@27: if (iflevel==0){ dvander@27: error(26); /* no matching "#if" */ dvander@27: errorset(sRESET,0); dvander@27: } else { dvander@27: iflevel--; dvander@27: if (iflevel0) { dvander@27: free(inpfname); dvander@27: inpfname=duplicatestring(pathname); dvander@27: if (inpfname==NULL) dvander@27: error(103); /* insufficient memory */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: check_empty(lptr); dvander@27: break; dvander@27: case tpLINE: dvander@27: if (!SKIPPING) { dvander@27: if (lex(&val,&str)!=tNUMBER) dvander@27: error(8); /* invalid/non-constant expression */ dvander@27: fline=(int)val; dvander@27: } /* if */ dvander@27: check_empty(lptr); dvander@27: break; dvander@27: case tpASSERT: dvander@27: if (!SKIPPING && (sc_debug & sCHKBOUNDS)!=0) { dvander@27: for (str=(char*)lptr; *str<=' ' && *str!='\0'; str++) dvander@27: /* nothing */; /* save start of expression */ dvander@27: preproc_expr(&val,NULL); /* get constant expression (or 0 on error) */ dvander@27: if (!val) dvander@27: error(110,str); /* assertion failed */ dvander@27: check_empty(lptr); dvander@27: } /* if */ dvander@27: break; dvander@27: case tpPRAGMA: dvander@27: if (!SKIPPING) { dvander@27: if (lex(&val,&str)==tSYMBOL) { dvander@27: if (strcmp(str,"amxlimit")==0) { dvander@27: preproc_expr(&pc_amxlimit,NULL); dvander@27: } else if (strcmp(str,"amxram")==0) { dvander@27: preproc_expr(&pc_amxram,NULL); dvander@27: } else if (strcmp(str,"codepage")==0) { dvander@27: char name[sNAMEMAX+1]; dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: if (*lptr=='"') { dvander@27: lptr=getstring((unsigned char*)name,sizeof name,lptr); dvander@27: } else { dvander@27: int i; dvander@27: for (i=0; i9) { dvander@27: error(68); /* invalid rational number precision */ dvander@27: digits=0; dvander@27: } /* if */ dvander@27: if (*lptr==')') dvander@27: lptr++; dvander@27: } /* if */ dvander@27: /* add the tag (make it public) and check the values */ dvander@27: i=pc_addtag(name); dvander@27: exporttag(i); dvander@27: if (sc_rationaltag==0 || (sc_rationaltag==i && rational_digits==(int)digits)) { dvander@27: sc_rationaltag=i; dvander@27: rational_digits=(int)digits; dvander@27: } else { dvander@27: error(69); /* rational number format already set, can only be set once */ dvander@27: } /* if */ dvander@27: } else if (strcmp(str,"semicolon")==0) { dvander@27: cell val; dvander@27: preproc_expr(&val,NULL); dvander@27: sc_needsemicolon=(int)val; dvander@27: } else if (strcmp(str,"tabsize")==0) { dvander@27: cell val; dvander@27: preproc_expr(&val,NULL); dvander@27: sc_tabsize=(int)val; dvander@27: } else if (strcmp(str,"align")==0) { dvander@27: sc_alignnext=TRUE; dvander@27: } else if (strcmp(str,"unused")==0) { dvander@27: char name[sNAMEMAX+1]; dvander@27: int i,comma; dvander@27: symbol *sym; dvander@27: do { dvander@27: /* get the name */ dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: for (i=0; iusage |= uREAD; dvander@27: if (sym->ident==iVARIABLE || sym->ident==iREFERENCE dvander@27: || sym->ident==iARRAY || sym->ident==iREFARRAY) dvander@27: sym->usage |= uWRITTEN; dvander@27: } else { dvander@27: error(17,name); /* undefined symbol */ dvander@27: } /* if */ dvander@27: /* see if a comma follows the name */ dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: comma= (*lptr==','); dvander@27: if (comma) dvander@27: lptr++; dvander@27: } while (comma); dvander@27: } else { dvander@27: error(207); /* unknown #pragma */ dvander@27: } /* if */ dvander@27: } else { dvander@27: error(207); /* unknown #pragma */ dvander@27: } /* if */ dvander@27: check_empty(lptr); dvander@27: } /* if */ dvander@27: break; dvander@27: case tpENDINPUT: dvander@27: case tpENDSCRPT: dvander@27: if (!SKIPPING) { dvander@27: check_empty(lptr); dvander@27: assert(inpf!=NULL); dvander@27: if (inpf!=inpf_org) dvander@27: pc_closesrc(inpf); dvander@27: inpf=NULL; dvander@27: } /* if */ dvander@27: break; dvander@27: #if !defined NOEMIT dvander@27: case tpEMIT: { dvander@27: /* write opcode to output file */ dvander@27: char name[40]; dvander@27: int i; dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: for (i=0; i<40 && (isalpha(*lptr) || *lptr=='.'); i++,lptr++) dvander@27: name[i]=(char)tolower(*lptr); dvander@27: name[i]='\0'; dvander@27: stgwrite("\t"); dvander@27: stgwrite(name); dvander@27: stgwrite(" "); dvander@27: code_idx+=opcodes(1); dvander@27: /* write parameter (if any) */ dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: if (*lptr!='\0') { dvander@27: symbol *sym; dvander@27: tok=lex(&val,&str); dvander@27: switch (tok) { dvander@27: case tNUMBER: dvander@27: case tRATIONAL: dvander@27: outval(val,FALSE); dvander@27: code_idx+=opargs(1); dvander@27: break; dvander@27: case tSYMBOL: dvander@27: sym=findloc(str); dvander@27: if (sym==NULL) dvander@27: sym=findglb(str,sSTATEVAR); dvander@27: if (sym==NULL || sym->ident!=iFUNCTN && sym->ident!=iREFFUNC && (sym->usage & uDEFINE)==0) { dvander@27: error(17,str); /* undefined symbol */ dvander@27: } else { dvander@27: outval(sym->addr,FALSE); dvander@27: /* mark symbol as "used", unknown whether for read or write */ dvander@27: markusage(sym,uREAD | uWRITTEN); dvander@27: code_idx+=opargs(1); dvander@27: } /* if */ dvander@27: break; dvander@27: default: { dvander@27: char s2[20]; dvander@27: extern char *sc_tokens[];/* forward declaration */ dvander@27: if (tok<256) dvander@27: sprintf(s2,"%c",(char)tok); dvander@27: else dvander@27: strcpy(s2,sc_tokens[tok-tFIRST]); dvander@27: error(1,sc_tokens[tSYMBOL-tFIRST],s2); dvander@27: break; dvander@27: } /* case */ dvander@27: } /* switch */ dvander@27: } /* if */ dvander@27: stgwrite("\n"); dvander@27: check_empty(lptr); dvander@27: break; dvander@27: } /* case */ dvander@27: #endif dvander@27: #if !defined NO_DEFINE dvander@27: case tpDEFINE: { dvander@27: ret=CMD_DEFINE; dvander@27: if (!SKIPPING) { dvander@27: char *pattern,*substitution; dvander@27: const unsigned char *start,*end; dvander@27: int count,prefixlen; dvander@27: stringpair *def; dvander@27: /* find the pattern to match */ dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: start=lptr; /* save starting point of the match pattern */ dvander@27: count=0; dvander@27: while (*lptr>' ' && *lptr!='\0') { dvander@27: litchar(&lptr,0); /* litchar() advances "lptr" and handles escape characters */ dvander@27: count++; dvander@27: } /* while */ dvander@27: end=lptr; dvander@27: /* check pattern to match */ dvander@27: if (!alpha(*start)) { dvander@27: error(74); /* pattern must start with an alphabetic character */ dvander@27: break; dvander@27: } /* if */ dvander@27: /* store matched pattern */ dvander@27: pattern=(char*)malloc(count+1); dvander@27: if (pattern==NULL) dvander@27: error(103); /* insufficient memory */ dvander@27: lptr=start; dvander@27: count=0; dvander@27: while (lptr!=end) { dvander@27: assert(lptr=2 && isdigit(pattern[count-1]) && pattern[count-2]=='%') dvander@27: pattern[count-2]='\0'; dvander@27: /* find substitution string */ dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: start=lptr; /* save starting point of the match pattern */ dvander@27: count=0; dvander@27: end=NULL; dvander@27: while (*lptr!='\0') { dvander@27: /* keep position of the start of trailing whitespace */ dvander@27: if (*lptr<=' ') { dvander@27: if (end==NULL) dvander@27: end=lptr; dvander@27: } else { dvander@27: end=NULL; dvander@27: } /* if */ dvander@27: count++; dvander@27: lptr++; dvander@27: } /* while */ dvander@27: if (end==NULL) dvander@27: end=lptr; dvander@27: /* store matched substitution */ dvander@27: substitution=(char*)malloc(count+1); /* +1 for '\0' */ dvander@27: if (substitution==NULL) dvander@27: error(103); /* insufficient memory */ dvander@27: lptr=start; dvander@27: count=0; dvander@27: while (lptr!=end) { dvander@27: assert(lptr0); dvander@27: if ((def=find_subst(pattern,prefixlen))!=NULL) { dvander@27: if (strcmp(def->first,pattern)!=0 || strcmp(def->second,substitution)!=0) dvander@27: error(201,pattern); /* redefinition of macro (non-identical) */ dvander@27: delete_subst(pattern,prefixlen); dvander@27: } /* if */ dvander@27: /* add the pattern/substitution pair to the list */ dvander@27: assert(strlen(pattern)>0); dvander@27: insert_subst(pattern,substitution,prefixlen); dvander@27: free(pattern); dvander@27: free(substitution); dvander@27: } /* if */ dvander@27: break; dvander@27: } /* case */ dvander@27: case tpUNDEF: dvander@27: if (!SKIPPING) { dvander@27: if (lex(&val,&str)==tSYMBOL) { dvander@27: ret=delete_subst(str,strlen(str)); dvander@27: if (!ret) { dvander@27: /* also undefine normal constants */ dvander@27: symbol *sym=findconst(str,NULL); dvander@27: if (sym!=NULL && (sym->usage & (uENUMROOT | uENUMFIELD))==0) { dvander@27: delete_symbol(&glbtab,sym); dvander@27: ret=TRUE; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: if (!ret) dvander@27: error(17,str); /* undefined symbol */ dvander@27: } else { dvander@27: error(20,str); /* invalid symbol name */ dvander@27: } /* if */ dvander@27: check_empty(lptr); dvander@27: } /* if */ dvander@27: break; dvander@27: #endif dvander@27: case tpERROR: dvander@27: while (*lptr<=' ' && *lptr!='\0') dvander@27: lptr++; dvander@27: if (!SKIPPING) dvander@27: error(111,lptr); /* user error */ dvander@27: break; dvander@27: default: dvander@27: error(31); /* unknown compiler directive */ dvander@27: ret=SKIPPING ? CMD_CONDFALSE : CMD_NONE; /* process as normal line */ dvander@27: } /* switch */ dvander@27: return ret; dvander@27: } dvander@27: dvander@27: #if !defined NO_DEFINE dvander@27: static int is_startstring(const unsigned char *string) dvander@27: { dvander@27: if (*string=='\"' || *string=='\'') dvander@27: return TRUE; /* "..." */ dvander@27: dvander@27: if (*string=='!') { dvander@27: string++; dvander@27: if (*string=='\"' || *string=='\'') dvander@27: return TRUE; /* !"..." */ dvander@27: if (*string==sc_ctrlchar) { dvander@27: string++; dvander@27: if (*string=='\"' || *string=='\'') dvander@27: return TRUE; /* !\"..." */ dvander@27: } /* if */ dvander@27: } else if (*string==sc_ctrlchar) { dvander@27: string++; dvander@27: if (*string=='\"' || *string=='\'') dvander@27: return TRUE; /* \"..." */ dvander@27: if (*string=='!') { dvander@27: string++; dvander@27: if (*string=='\"' || *string=='\'') dvander@27: return TRUE; /* \!"..." */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: dvander@27: return FALSE; dvander@27: } dvander@27: dvander@27: static const unsigned char *skipstring(const unsigned char *string) dvander@27: { dvander@27: char endquote; dvander@27: int flags=0; dvander@27: dvander@27: while (*string=='!' || *string==sc_ctrlchar) { dvander@27: if (*string==sc_ctrlchar) dvander@27: flags=RAWMODE; dvander@27: string++; dvander@27: } /* while */ dvander@27: dvander@27: endquote=*string; dvander@27: assert(endquote=='"' || endquote=='\''); dvander@27: string++; /* skip open quote */ dvander@27: while (*string!=endquote && *string!='\0') dvander@27: litchar(&string,flags); dvander@27: return string; dvander@27: } dvander@27: dvander@27: static const unsigned char *skippgroup(const unsigned char *string) dvander@27: { dvander@27: int nest=0; dvander@27: char open=*string; dvander@27: char close; dvander@27: dvander@27: switch (open) { dvander@27: case '(': dvander@27: close=')'; dvander@27: break; dvander@27: case '{': dvander@27: close='}'; dvander@27: break; dvander@27: case '[': dvander@27: close=']'; dvander@27: break; dvander@27: case '<': dvander@27: close='>'; dvander@27: break; dvander@27: default: dvander@27: assert(0); dvander@27: close='\0'; /* only to avoid a compiler warning */ dvander@27: }/* switch */ dvander@27: dvander@27: string++; dvander@27: while (*string!=close || nest>0) { dvander@27: if (*string==open) dvander@27: nest++; dvander@27: else if (*string==close) dvander@27: nest--; dvander@27: else if (is_startstring(string)) dvander@27: string=skipstring(string); dvander@27: if (*string=='\0') dvander@27: break; dvander@27: string++; dvander@27: } /* while */ dvander@27: return string; dvander@27: } dvander@27: dvander@27: static char *strdel(char *str,size_t len) dvander@27: { dvander@27: size_t length=strlen(str); dvander@27: if (len>length) dvander@27: len=length; dvander@27: memmove(str, str+len, length-len+1); /* include EOS byte */ dvander@27: return str; dvander@27: } dvander@27: dvander@27: static char *strins(char *dest,char *src,size_t srclen) dvander@27: { dvander@27: size_t destlen=strlen(dest); dvander@27: assert(srclen<=strlen(src)); dvander@27: memmove(dest+srclen, dest, destlen+1);/* include EOS byte */ dvander@27: memcpy(dest, src, srclen); dvander@27: return dest; dvander@27: } dvander@27: dvander@27: static int substpattern(unsigned char *line,size_t buffersize,char *pattern,char *substitution) dvander@27: { dvander@27: int prefixlen; dvander@27: const unsigned char *p,*s,*e; dvander@27: unsigned char *args[10]; dvander@27: int match,arg,len,argsnum=0; dvander@27: dvander@27: memset(args,0,sizeof args); dvander@27: dvander@27: /* check the length of the prefix */ dvander@27: for (prefixlen=0,s=(unsigned char*)pattern; alphanum(*s); prefixlen++,s++) dvander@27: /* nothing */; dvander@27: assert(prefixlen>0); dvander@27: assert(strncmp((char*)line,pattern,prefixlen)==0); dvander@27: dvander@27: /* pattern prefix matches; match the rest of the pattern, gather dvander@27: * the parameters dvander@27: */ dvander@27: s=line+prefixlen; dvander@27: p=(unsigned char*)pattern+prefixlen; dvander@27: match=TRUE; /* so far, pattern matches */ dvander@27: while (match && *s!='\0' && *p!='\0') { dvander@27: if (*p=='%') { dvander@27: p++; /* skip '%' */ dvander@27: if (isdigit(*p)) { dvander@27: arg=*p-'0'; dvander@27: assert(arg>=0 && arg<=9); dvander@27: p++; /* skip parameter id */ dvander@27: assert(*p!='\0'); dvander@27: /* match the source string up to the character after the digit dvander@27: * (skipping strings in the process dvander@27: */ dvander@27: e=s; dvander@27: while (*e!=*p && *e!='\0' && *e!='\n') { dvander@27: if (is_startstring(e)) /* skip strings */ dvander@27: e=skipstring(e); dvander@27: else if (strchr("({[",*e)!=NULL) /* skip parenthized groups */ dvander@27: e=skippgroup(e); dvander@27: if (*e!='\0') dvander@27: e++; /* skip non-alphapetic character (or closing quote of dvander@27: * a string, or the closing paranthese of a group) */ dvander@27: } /* while */ dvander@27: /* store the parameter (overrule any earlier) */ dvander@27: if (args[arg]!=NULL) dvander@27: free(args[arg]); dvander@27: else dvander@27: argsnum++; dvander@27: len=(int)(e-s); dvander@27: args[arg]=(unsigned char*)malloc(len+1); dvander@27: if (args[arg]==NULL) dvander@27: error(103); /* insufficient memory */ dvander@27: strlcpy((char*)args[arg],(char*)s,len+1); dvander@27: /* character behind the pattern was matched too */ dvander@27: if (*e==*p) { dvander@27: s=e+1; dvander@27: } else if (*e=='\n' && *p==';' && *(p+1)=='\0' && !sc_needsemicolon) { dvander@27: s=e; /* allow a trailing ; in the pattern match to end of line */ dvander@27: } else { dvander@27: assert(*e=='\0' || *e=='\n'); dvander@27: match=FALSE; dvander@27: s=e; dvander@27: } /* if */ dvander@27: p++; dvander@27: } else { dvander@27: match=FALSE; dvander@27: } /* if */ dvander@27: } else if (*p==';' && *(p+1)=='\0' && !sc_needsemicolon) { dvander@27: /* source may be ';' or end of the line */ dvander@27: while (*s<=' ' && *s!='\0') dvander@27: s++; /* skip white space */ dvander@27: if (*s!=';' && *s!='\0') dvander@27: match=FALSE; dvander@27: p++; /* skip the semicolon in the pattern */ dvander@27: } else { dvander@27: cell ch; dvander@27: /* skip whitespace between two non-alphanumeric characters, except dvander@27: * for two identical symbols dvander@27: */ dvander@27: assert((char*)p>pattern); dvander@27: if (!alphanum(*p) && *(p-1)!=*p) dvander@27: while (*s<=' ' && *s!='\0') dvander@27: s++; /* skip white space */ dvander@27: ch=litchar(&p,0); /* this increments "p" */ dvander@27: if (*s!=ch) dvander@27: match=FALSE; dvander@27: else dvander@27: s++; /* this character matches */ dvander@27: } /* if */ dvander@27: } /* while */ dvander@27: dvander@27: if (match && *p=='\0') { dvander@27: /* if the last character to match is an alphanumeric character, the dvander@27: * current character in the source may not be alphanumeric dvander@27: */ dvander@27: assert(p>(unsigned char*)pattern); dvander@27: if (alphanum(*(p-1)) && alphanum(*s)) dvander@27: match=FALSE; dvander@27: } /* if */ dvander@27: dvander@27: if (match) { dvander@27: /* calculate the length of the substituted string */ dvander@27: for (e=(unsigned char*)substitution,len=0; *e!='\0'; e++) { dvander@27: if (*e=='%' && isdigit(*(e+1)) && argsnum) { dvander@27: arg=*(e+1)-'0'; dvander@27: assert(arg>=0 && arg<=9); dvander@27: if (args[arg]!=NULL) { dvander@27: len+=strlen((char*)args[arg]); dvander@27: e++; dvander@27: } else { dvander@27: len++; dvander@27: } dvander@27: } else { dvander@27: len++; dvander@27: } /* if */ dvander@27: } /* for */ dvander@27: /* check length of the string after substitution */ dvander@27: if (strlen((char*)line) + len - (int)(s-line) > buffersize) { dvander@27: error(75); /* line too long */ dvander@27: } else { dvander@27: /* substitute pattern */ dvander@27: strdel((char*)line,(int)(s-line)); dvander@27: for (e=(unsigned char*)substitution,s=line; *e!='\0'; e++) { dvander@27: if (*e=='%' && isdigit(*(e+1))) { dvander@27: arg=*(e+1)-'0'; dvander@27: assert(arg>=0 && arg<=9); dvander@27: if (args[arg]!=NULL) { dvander@27: strins((char*)s,(char*)args[arg],strlen((char*)args[arg])); dvander@27: s+=strlen((char*)args[arg]); dvander@27: e++; dvander@27: } else { dvander@27: error(236); /* parameter does not exist, incorrect #define pattern */ dvander@27: strins((char*)s,(char*)e,2); dvander@27: s+=2; dvander@27: } /* if */ dvander@27: e++; /* skip %, digit is skipped later */ dvander@27: } else if (*e == '"') { dvander@27: p=e; dvander@27: if (is_startstring(e)) { dvander@27: e=skipstring(e); dvander@27: strins((char*)s,(char *)p,(e-p+1)); dvander@27: s+=(e-p+1); dvander@27: } else { dvander@27: strins((char*)s,(char*)e,1); dvander@27: s++; dvander@27: } dvander@27: } else { dvander@27: strins((char*)s,(char*)e,1); dvander@27: s++; dvander@27: } /* if */ dvander@27: } /* for */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: dvander@27: for (arg=0; arg<10; arg++) dvander@27: if (args[arg]!=NULL) dvander@27: free(args[arg]); dvander@27: dvander@27: return match; dvander@27: } dvander@27: dvander@27: static void substallpatterns(unsigned char *line,int buffersize) dvander@27: { dvander@27: unsigned char *start, *end; dvander@27: int prefixlen; dvander@27: stringpair *subst; dvander@27: dvander@27: start=line; dvander@27: while (*start!='\0') { dvander@27: /* find the start of a prefix (skip all non-alphabetic characters), dvander@27: * also skip strings dvander@27: */ dvander@27: while (!alpha(*start) && *start!='\0') { dvander@27: /* skip strings */ dvander@27: if (is_startstring(start)) { dvander@27: start=(unsigned char *)skipstring(start); dvander@27: if (*start=='\0') dvander@27: break; /* abort loop on error */ dvander@27: } /* if */ dvander@27: start++; /* skip non-alphapetic character (or closing quote of a string) */ dvander@27: } /* while */ dvander@27: if (*start=='\0') dvander@27: break; /* abort loop on error */ dvander@27: /* if matching the operator "defined", skip it plus the symbol behind it */ dvander@27: if (strncmp((char*)start,"defined",7)==0 && !isalpha((char)*(start+7))) { dvander@27: start+=7; /* skip "defined" */ dvander@27: /* skip white space & parantheses */ dvander@27: while (*start<=' ' && *start!='\0' || *start=='(') dvander@27: start++; dvander@27: /* skip the symbol behind it */ dvander@27: while (alphanum(*start)) dvander@27: start++; dvander@27: /* drop back into the main loop */ dvander@27: continue; dvander@27: } /* if */ dvander@27: /* get the prefix (length), look for a matching definition */ dvander@27: prefixlen=0; dvander@27: end=start; dvander@27: while (alphanum(*end)) { dvander@27: prefixlen++; dvander@27: end++; dvander@27: } /* while */ dvander@27: assert(prefixlen>0); dvander@27: subst=find_subst((char*)start,prefixlen); dvander@27: if (subst!=NULL) { dvander@27: /* properly match the pattern and substitute */ dvander@27: if (!substpattern(start,buffersize-(int)(start-line),subst->first,subst->second)) dvander@27: start=end; /* match failed, skip this prefix */ dvander@27: /* match succeeded: do not update "start", because the substitution text dvander@27: * may be matched by other macros dvander@27: */ dvander@27: } else { dvander@27: start=end; /* no macro with this prefix, skip this prefix */ dvander@27: } /* if */ dvander@27: } /* while */ dvander@27: } dvander@27: #endif dvander@27: dvander@27: /* preprocess dvander@27: * dvander@27: * Reads a line by readline() into "pline" and performs basic preprocessing: dvander@27: * deleting comments, skipping lines with false "#if.." code and recognizing dvander@27: * other compiler directives. There is an indirect recursion: lex() calls dvander@27: * preprocess() if a new line must be read, preprocess() calls command(), dvander@27: * which at his turn calls lex() to identify the token. dvander@27: * dvander@27: * Global references: lptr (altered) dvander@27: * pline (altered) dvander@27: * freading (referred to only) dvander@27: */ dvander@27: SC_FUNC void preprocess(void) dvander@27: { dvander@27: int iscommand; dvander@27: dvander@27: if (!freading) dvander@27: return; dvander@27: do { dvander@27: readline(pline); dvander@27: stripcom(pline); /* ??? no need for this when reading back from list file (in the second pass) */ dvander@27: lptr=pline; /* set "line pointer" to start of the parsing buffer */ dvander@27: iscommand=command(); dvander@27: if (iscommand!=CMD_NONE) dvander@27: errorset(sRESET,0); /* reset error flag ("panic mode") on empty line or directive */ dvander@27: #if !defined NO_DEFINE dvander@27: if (iscommand==CMD_NONE) { dvander@27: assert(lptr!=term_expr); dvander@27: substallpatterns(pline,sLINEMAX); dvander@27: lptr=pline; /* reset "line pointer" to start of the parsing buffer */ dvander@27: } /* if */ dvander@27: #endif dvander@27: if (sc_status==statFIRST && sc_listing && freading dvander@27: && (iscommand==CMD_NONE || iscommand==CMD_EMPTYLINE || iscommand==CMD_DIRECTIVE)) dvander@27: { dvander@27: listline++; dvander@27: if (fline!=listline) { dvander@27: listline=fline; dvander@27: setlinedirect(fline); dvander@27: } /* if */ dvander@27: if (iscommand==CMD_EMPTYLINE) dvander@27: pc_writeasm(outf,"\n"); dvander@27: else dvander@27: pc_writeasm(outf,(char*)pline); dvander@27: } /* if */ dvander@27: } while (iscommand!=CMD_NONE && iscommand!=CMD_TERM && freading); /* enddo */ dvander@27: } dvander@27: dvander@27: static const unsigned char *unpackedstring(const unsigned char *lptr,int flags) dvander@27: { dvander@27: while (*lptr!='\"' && *lptr!='\0') { dvander@27: if (*lptr=='\a') { /* ignore '\a' (which was inserted at a line concatenation) */ dvander@27: lptr++; dvander@27: continue; dvander@27: } /* if */ dvander@27: litadd(litchar(&lptr,flags | UTF8MODE)); /* litchar() alters "lptr" */ dvander@27: } /* while */ dvander@27: litadd(0); /* terminate string */ dvander@27: return lptr; dvander@27: } dvander@27: dvander@27: static const unsigned char *packedstring(const unsigned char *lptr,int flags) dvander@27: { dvander@27: int i; dvander@27: ucell val,c; dvander@27: dvander@151: i=0; /* start at least significant byte */ dvander@27: val=0; dvander@27: while (*lptr!='\"' && *lptr!='\0') { dvander@27: if (*lptr=='\a') { /* ignore '\a' (which was inserted at a line concatenation) */ dvander@27: lptr++; dvander@27: continue; dvander@27: } /* if */ dvander@27: c=litchar(&lptr,flags); /* litchar() alters "lptr" */ dvander@27: if (c>=(ucell)(1 << sCHARBITS)) dvander@27: error(43); /* character constant exceeds range */ dvander@27: val |= (c << 8*i); dvander@151: if (i==sizeof(ucell)-(sCHARBITS/8)) { dvander@27: litadd(val); dvander@27: val=0; dvander@151: i=0; dvander@151: } else { dvander@151: i=i+1; dvander@151: } dvander@27: } /* if */ dvander@27: /* save last code; make sure there is at least one terminating zero character */ dvander@151: if (i!=0) dvander@27: litadd(val); /* at least one zero character in "val" */ dvander@27: else dvander@27: litadd(0); /* add full cell of zeros */ dvander@27: return lptr; dvander@27: } dvander@27: dvander@27: /* lex(lexvalue,lexsym) Lexical Analysis dvander@27: * dvander@27: * lex() first deletes leading white space, then checks for multi-character dvander@27: * operators, keywords (including most compiler directives), numbers, dvander@27: * labels, symbols and literals (literal characters are converted to a number dvander@27: * and are returned as such). If every check fails, the line must contain dvander@27: * a single-character operator. So, lex() returns this character. In the other dvander@27: * case (something did match), lex() returns the number of the token. All dvander@27: * these tokens have been assigned numbers above 255. dvander@27: * dvander@27: * Some tokens have "attributes": dvander@27: * tNUMBER the value of the number is return in "lexvalue". dvander@27: * tRATIONAL the value is in IEEE 754 encoding or in fixed point dvander@27: * encoding in "lexvalue". dvander@27: * tSYMBOL the first sNAMEMAX characters of the symbol are dvander@27: * stored in a buffer, a pointer to this buffer is dvander@27: * returned in "lexsym". dvander@27: * tLABEL the first sNAMEMAX characters of the label are dvander@27: * stored in a buffer, a pointer to this buffer is dvander@27: * returned in "lexsym". dvander@27: * tSTRING the string is stored in the literal pool, the index dvander@27: * in the literal pool to this string is stored in dvander@27: * "lexvalue". dvander@27: * dvander@27: * lex() stores all information (the token found and possibly its attribute) dvander@27: * in global variables. This allows a token to be examined twice. If "_pushed" dvander@27: * is true, this information is returned. dvander@27: * dvander@27: * Global references: lptr (altered) dvander@27: * fline (referred to only) dvander@27: * litidx (referred to only) dvander@27: * _lextok, _lexval, _lexstr dvander@27: * _pushed dvander@27: */ dvander@27: dvander@27: static int _pushed; dvander@27: static int _lextok; dvander@27: static cell _lexval; dvander@27: static char _lexstr[sLINEMAX+1]; dvander@27: static int _lexnewline; dvander@27: dvander@27: SC_FUNC void lexinit(void) dvander@27: { dvander@27: stkidx=0; /* index for pushstk() and popstk() */ dvander@27: iflevel=0; /* preprocessor: nesting of "#if" is currently 0 */ dvander@27: skiplevel=0; /* preprocessor: not currently skipping */ dvander@27: icomment=0; /* currently not in a multiline comment */ dvander@27: _pushed=FALSE; /* no token pushed back into lex */ dvander@27: _lexnewline=FALSE; dvander@27: } dvander@27: dvander@27: char *sc_tokens[] = { dvander@27: "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=", dvander@27: "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--", dvander@27: "...", "..", "::", dvander@286: "assert", "*begin", "break", "case", "cellsof", "chars", "const", "continue", "default", dvander@338: "defined", "do", "else", "*end", "enum", "exit", "for", "forward", "funcenum", "functag", "goto", dvander@27: "if", "native", "new", "decl", "operator", "public", "return", "sizeof", dvander@167: "sleep", "state", "static", "stock", "struct", "switch", "tagof", "*then", "while", dvander@27: "#assert", "#define", "#else", "#elseif", "#emit", "#endif", "#endinput", dvander@27: "#endscript", "#error", "#file", "#if", "#include", "#line", "#pragma", dvander@27: "#tryinclude", "#undef", dvander@27: ";", ";", "-integer value-", "-rational value-", "-identifier-", dvander@27: "-label-", "-string-" dvander@27: }; dvander@27: dvander@27: SC_FUNC int lex(cell *lexvalue,char **lexsym) dvander@27: { dvander@27: int i,toolong,newline,stringflags; dvander@27: char **tokptr; dvander@27: const unsigned char *starttoken; dvander@27: dvander@27: if (_pushed) { dvander@27: _pushed=FALSE; /* reset "_pushed" flag */ dvander@27: *lexvalue=_lexval; dvander@27: *lexsym=_lexstr; dvander@27: return _lextok; dvander@27: } /* if */ dvander@27: dvander@27: _lextok=0; /* preset all values */ dvander@27: _lexval=0; dvander@27: _lexstr[0]='\0'; dvander@27: *lexvalue=_lexval; dvander@27: *lexsym=_lexstr; dvander@27: _lexnewline=FALSE; dvander@27: if (!freading) dvander@27: return 0; dvander@27: dvander@27: newline= (lptr==pline); /* does lptr point to start of line buffer */ dvander@27: while (*lptr<=' ') { /* delete leading white space */ dvander@27: if (*lptr=='\0') { dvander@27: preprocess(); /* preprocess resets "lptr" */ dvander@27: if (!freading) dvander@27: return 0; dvander@27: if (lptr==term_expr) /* special sequence to terminate a pending expression */ dvander@27: return (_lextok=tENDEXPR); dvander@27: _lexnewline=TRUE; /* set this after preprocess(), because dvander@27: * preprocess() calls lex() recursively */ dvander@27: newline=TRUE; dvander@27: } else { dvander@27: lptr+=1; dvander@27: } /* if */ dvander@27: } /* while */ dvander@27: if (newline) { dvander@27: stmtindent=0; dvander@27: for (i=0; i<(int)(lptr-pline); i++) dvander@27: if (pline[i]=='\t' && sc_tabsize>0) dvander@27: stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize); dvander@27: else dvander@27: stmtindent++; dvander@27: } /* if */ dvander@27: dvander@27: i=tFIRST; dvander@27: tokptr=sc_tokens; dvander@27: while (i<=tMIDDLE) { /* match multi-character operators */ dvander@27: if (*lptr==**tokptr && match(*tokptr,FALSE)) { dvander@27: _lextok=i; dvander@27: if (pc_docexpr) /* optionally concatenate to documentation string */ dvander@27: insert_autolist(*tokptr); dvander@27: return _lextok; dvander@27: } /* if */ dvander@27: i+=1; dvander@27: tokptr+=1; dvander@27: } /* while */ dvander@27: while (i<=tLAST) { /* match reserved words and compiler directives */ dvander@27: if (*lptr==**tokptr && match(*tokptr,TRUE)) { dvander@27: _lextok=i; dvander@27: errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/ dvander@27: if (pc_docexpr) /* optionally concatenate to documentation string */ dvander@27: insert_autolist(*tokptr); dvander@27: return _lextok; dvander@27: } /* if */ dvander@27: i+=1; dvander@27: tokptr+=1; dvander@27: } /* while */ dvander@27: dvander@27: starttoken=lptr; /* save start pointer (for concatenating to documentation string) */ dvander@27: if ((i=number(&_lexval,lptr))!=0) { /* number */ dvander@27: _lextok=tNUMBER; dvander@27: *lexvalue=_lexval; dvander@27: lptr+=i; dvander@27: } else if ((i=ftoi(&_lexval,lptr))!=0) { dvander@27: _lextok=tRATIONAL; dvander@27: *lexvalue=_lexval; dvander@27: lptr+=i; dvander@27: } else if (alpha(*lptr)) { /* symbol or label */ dvander@27: /* Note: only sNAMEMAX characters are significant. The compiler dvander@27: * generates a warning if a symbol exceeds this length. dvander@27: */ dvander@27: _lextok=tSYMBOL; dvander@27: i=0; dvander@27: toolong=0; dvander@27: while (alphanum(*lptr)){ dvander@27: _lexstr[i]=*lptr; dvander@27: lptr+=1; dvander@27: if (i=litmax) { dvander@27: cell *p; dvander@27: dvander@27: litmax+=sDEF_LITMAX; dvander@27: p=(cell *)realloc(litq,litmax*sizeof(cell)); dvander@27: if (p==NULL) dvander@27: error(102,"literal table"); /* literal table overflow (fatal error) */ dvander@27: litq=p; dvander@27: } /* if */ dvander@27: } dvander@27: dvander@27: /* litadd dvander@27: * dvander@27: * Adds a value at the end of the literal queue. The literal queue is used dvander@27: * for literal strings used in functions and for initializing array variables. dvander@27: * dvander@27: * Global references: litidx (altered) dvander@27: * litq (altered) dvander@27: */ dvander@27: SC_FUNC void litadd(cell value) dvander@27: { dvander@27: chk_grow_litq(); dvander@27: assert(litidx=0 && pos<=litidx); dvander@27: memmove(litq+(pos+1),litq+pos,(litidx-pos)*sizeof(cell)); dvander@27: litidx++; dvander@27: litq[pos]=value; dvander@27: } dvander@27: dvander@27: /* litchar dvander@27: * dvander@27: * Return current literal character and increase the pointer to point dvander@27: * just behind this literal character. dvander@27: * dvander@27: * Note: standard "escape sequences" are suported, but the backslash may be dvander@27: * replaced by another character; the syntax '\ddd' is supported, dvander@27: * but ddd must be decimal! dvander@27: */ dvander@27: static cell litchar(const unsigned char **lptr,int flags) dvander@27: { dvander@27: cell c=0; dvander@27: const unsigned char *cptr; dvander@27: dvander@27: cptr=*lptr; dvander@27: if ((flags & RAWMODE)!=0 || *cptr!=sc_ctrlchar) { /* no escape character */ dvander@27: #if !defined NO_UTF8 dvander@27: if (sc_is_utf8 && (flags & UTF8MODE)!=0) { dvander@27: c=get_utf8_char(cptr,&cptr); dvander@27: assert(c>=0); /* file was already scanned for conformance to UTF-8 */ dvander@27: } else { dvander@27: #endif dvander@27: #if !defined NO_CODEPAGE dvander@27: c=cp_translate(cptr,&cptr); dvander@27: #else dvander@27: c=*cptr; dvander@27: cptr+=1; dvander@27: #endif dvander@27: #if !defined NO_UTF8 dvander@27: } /* if */ dvander@27: #endif dvander@27: } else { dvander@27: cptr+=1; dvander@27: if (*cptr==sc_ctrlchar) { dvander@27: c=*cptr; /* \\ == \ (the escape character itself) */ dvander@27: cptr+=1; dvander@27: } else { dvander@27: switch (*cptr) { dvander@27: case 'a': /* \a == audible alarm */ dvander@27: c=7; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'b': /* \b == backspace */ dvander@27: c=8; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'e': /* \e == escape */ dvander@27: c=27; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'f': /* \f == form feed */ dvander@27: c=12; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'n': /* \n == NewLine character */ dvander@27: c=10; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'r': /* \r == carriage return */ dvander@27: c=13; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 't': /* \t == horizontal TAB */ dvander@27: c=9; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'v': /* \v == vertical TAB */ dvander@27: c=11; dvander@27: cptr+=1; dvander@27: break; dvander@27: case 'x': dvander@27: cptr+=1; dvander@27: c=0; dvander@27: while (ishex(*cptr)) { dvander@27: if (isdigit(*cptr)) dvander@27: c=(c<<4)+(*cptr-'0'); dvander@27: else dvander@27: c=(c<<4)+(tolower(*cptr)-'a'+10); dvander@27: cptr++; dvander@27: } /* while */ dvander@27: if (*cptr==';') dvander@27: cptr++; /* swallow a trailing ';' */ dvander@27: break; dvander@27: case '\'': /* \' == ' (single quote) */ dvander@27: case '"': /* \" == " (single quote) */ dvander@27: case '%': /* \% == % (percent) */ dvander@27: c=*cptr; dvander@27: cptr+=1; dvander@27: break; dvander@27: default: dvander@27: if (isdigit(*cptr)) { /* \ddd */ dvander@27: c=0; dvander@27: while (*cptr>='0' && *cptr<='9') /* decimal! */ dvander@27: c=c*10 + *cptr++ - '0'; dvander@27: if (*cptr==';') dvander@27: cptr++; /* swallow a trailing ';' */ dvander@27: } else { dvander@27: error(27); /* invalid character constant */ dvander@27: } /* if */ dvander@27: } /* switch */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: *lptr=cptr; dvander@27: assert(c>=0); dvander@27: return c; dvander@27: } dvander@27: dvander@27: /* alpha dvander@27: * dvander@27: * Test if character "c" is alphabetic ("a".."z"), an underscore ("_") dvander@27: * or an "at" sign ("@"). The "@" is an extension to standard C. dvander@27: */ dvander@27: static int alpha(char c) dvander@27: { dvander@27: return (isalpha(c) || c=='_' || c==PUBLIC_CHAR); dvander@27: } dvander@27: dvander@27: /* alphanum dvander@27: * dvander@27: * Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@") dvander@27: */ dvander@27: SC_FUNC int alphanum(char c) dvander@27: { dvander@27: return (alpha(c) || isdigit(c)); dvander@27: } dvander@27: dvander@27: /* ishex dvander@27: * dvander@27: * Test if character "c" is a hexadecimal digit ("0".."9" or "a".."f"). dvander@27: */ dvander@27: SC_FUNC int ishex(char c) dvander@27: { dvander@27: return (c>='0' && c<='9') || (c>='a' && c<='f') || (c>='A' && c<='F'); dvander@27: } dvander@27: dvander@27: /* The local variable table must be searched backwards, so that the deepest dvander@27: * nesting of local variables is searched first. The simplest way to do dvander@27: * this is to insert all new items at the head of the list. dvander@27: * In the global list, the symbols are kept in sorted order, so that the dvander@27: * public functions are written in sorted order. dvander@27: */ dvander@27: static symbol *add_symbol(symbol *root,symbol *entry,int sort) dvander@27: { dvander@27: symbol *newsym; dvander@27: dvander@27: if (sort) dvander@27: while (root->next!=NULL && strcmp(entry->name,root->next->name)>0) dvander@27: root=root->next; dvander@27: dvander@27: if ((newsym=(symbol *)malloc(sizeof(symbol)))==NULL) { dvander@27: error(103); dvander@27: return NULL; dvander@27: } /* if */ dvander@27: memcpy(newsym,entry,sizeof(symbol)); dvander@27: newsym->next=root->next; dvander@27: root->next=newsym; dvander@27: return newsym; dvander@27: } dvander@27: dvander@27: static void free_symbol(symbol *sym) dvander@27: { dvander@27: arginfo *arg; dvander@27: dvander@27: /* free all sub-symbol allocated memory blocks, depending on the dvander@27: * kind of the symbol dvander@27: */ dvander@27: assert(sym!=NULL); dvander@27: if (sym->ident==iFUNCTN) { dvander@27: /* run through the argument list; "default array" arguments dvander@27: * must be freed explicitly; the tag list must also be freed */ dvander@27: assert(sym->dim.arglist!=NULL); dvander@27: for (arg=sym->dim.arglist; arg->ident!=0; arg++) { dvander@27: if (arg->ident==iREFARRAY && arg->hasdefault) dvander@27: free(arg->defvalue.array.data); dvander@27: else if (arg->ident==iVARIABLE dvander@27: && ((arg->hasdefault & uSIZEOF)!=0 || (arg->hasdefault & uTAGOF)!=0)) dvander@27: free(arg->defvalue.size.symname); dvander@27: assert(arg->tags!=NULL); dvander@27: free(arg->tags); dvander@27: } /* for */ dvander@27: free(sym->dim.arglist); dvander@27: if (sym->states!=NULL) { dvander@27: delete_consttable(sym->states); dvander@27: free(sym->states); dvander@27: } /* if */ dvander@27: } else if (sym->ident==iVARIABLE || sym->ident==iARRAY) { dvander@27: if (sym->states!=NULL) { dvander@27: delete_consttable(sym->states); dvander@27: free(sym->states); dvander@27: } /* if */ dvander@27: } else if (sym->ident==iCONSTEXPR && (sym->usage & uENUMROOT)==uENUMROOT) { dvander@27: /* free the constant list of an enum root */ dvander@27: assert(sym->dim.enumlist!=NULL); dvander@27: delete_consttable(sym->dim.enumlist); dvander@27: free(sym->dim.enumlist); dvander@27: } /* if */ dvander@27: assert(sym->refer!=NULL); dvander@27: free(sym->refer); dvander@27: if (sym->documentation!=NULL) dvander@27: free(sym->documentation); dvander@27: free(sym); dvander@27: } dvander@27: dvander@27: SC_FUNC void delete_symbol(symbol *root,symbol *sym) dvander@27: { dvander@27: /* find the symbol and its predecessor dvander@27: * (this function assumes that you will never delete a symbol that is not dvander@27: * in the table pointed at by "root") dvander@27: */ dvander@27: assert(root!=sym); dvander@27: while (root->next!=sym) { dvander@27: root=root->next; dvander@27: assert(root!=NULL); dvander@27: } /* while */ dvander@27: dvander@27: /* unlink it, then free it */ dvander@27: root->next=sym->next; dvander@27: free_symbol(sym); dvander@27: } dvander@27: dvander@27: SC_FUNC void delete_symbols(symbol *root,int level,int delete_labels,int delete_functions) dvander@27: { dvander@27: symbol *sym,*parent_sym; dvander@27: constvalue *stateptr; dvander@27: int mustdelete; dvander@27: dvander@27: /* erase only the symbols with a deeper nesting level than the dvander@27: * specified nesting level */ dvander@27: while (root->next!=NULL) { dvander@27: sym=root->next; dvander@27: if (sym->compoundident) { dvander@27: case iLABEL: dvander@27: mustdelete=delete_labels; dvander@27: break; dvander@27: case iVARIABLE: dvander@27: case iARRAY: dvander@27: /* do not delete global variables if functions are preserved */ dvander@27: mustdelete=delete_functions; dvander@27: break; dvander@27: case iREFERENCE: dvander@27: /* always delete references (only exist as function parameters) */ dvander@27: mustdelete=TRUE; dvander@27: break; dvander@27: case iREFARRAY: dvander@27: /* a global iREFARRAY symbol is the return value of a function: delete dvander@27: * this only if "globals" must be deleted; other iREFARRAY instances dvander@27: * (locals) are also deleted dvander@27: */ dvander@27: mustdelete=delete_functions; dvander@27: for (parent_sym=sym->parent; parent_sym!=NULL && parent_sym->ident!=iFUNCTN; parent_sym=parent_sym->parent) dvander@27: assert(parent_sym->ident==iREFARRAY); dvander@27: assert(parent_sym==NULL || (parent_sym->ident==iFUNCTN && parent_sym->parent==NULL)); dvander@27: if (parent_sym==NULL || parent_sym->ident!=iFUNCTN) dvander@27: mustdelete=TRUE; dvander@27: break; dvander@27: case iCONSTEXPR: dvander@27: /* delete constants, except predefined constants */ dvander@27: mustdelete=delete_functions || (sym->usage & uPREDEF)==0; dvander@27: break; dvander@27: case iFUNCTN: dvander@27: /* optionally preserve globals (variables & functions), but dvander@27: * NOT native functions dvander@27: */ dvander@27: mustdelete=delete_functions || (sym->usage & uNATIVE)!=0; dvander@27: assert(sym->parent==NULL); dvander@27: break; dvander@27: case iARRAYCELL: dvander@27: case iARRAYCHAR: dvander@27: case iEXPRESSION: dvander@27: case iVARARGS: dvander@27: default: dvander@27: assert(0); dvander@27: break; dvander@27: } /* switch */ dvander@27: if (mustdelete) { dvander@27: root->next=sym->next; dvander@27: free_symbol(sym); dvander@27: } else { dvander@27: /* if the function was prototyped, but not implemented in this source, dvander@27: * mark it as such, so that its use can be flagged dvander@27: */ dvander@27: if (sym->ident==iFUNCTN && (sym->usage & uDEFINE)==0) dvander@27: sym->usage |= uMISSING; dvander@27: if (sym->ident==iFUNCTN || sym->ident==iVARIABLE || sym->ident==iARRAY) dvander@27: sym->usage &= ~uDEFINE; /* clear "defined" flag */ dvander@27: /* set all states as "undefined" too */ dvander@27: if (sym->states!=NULL) dvander@27: for (stateptr=sym->states->next; stateptr!=NULL; stateptr=stateptr->next) dvander@27: stateptr->value=0; dvander@27: /* for user defined operators, also remove the "prototyped" flag, as dvander@27: * user-defined operators *must* be declared before use dvander@27: */ dvander@27: if (sym->ident==iFUNCTN && !alpha(*sym->name)) dvander@27: sym->usage &= ~uPROTOTYPED; dvander@27: root=sym; /* skip the symbol */ dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } dvander@27: dvander@27: /* The purpose of the hash is to reduce the frequency of a "name" dvander@27: * comparison (which is costly). There is little interest in avoiding dvander@27: * clusters in similar names, which is why this function is plain simple. dvander@27: */ dvander@27: SC_FUNC uint32_t namehash(const char *name) dvander@27: { dvander@27: const unsigned char *ptr=(const unsigned char *)name; dvander@27: int len=strlen(name); dvander@27: if (len==0) dvander@27: return 0L; dvander@27: assert(len<256); dvander@27: return (len<<24Lu) + (ptr[0]<<16Lu) + (ptr[len-1]<<8Lu) + (ptr[len>>1Lu]); dvander@27: } dvander@27: dvander@27: static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag) dvander@27: { dvander@27: symbol *firstmatch=NULL; dvander@27: symbol *sym=root->next; dvander@27: int count=0; dvander@27: unsigned long hash=namehash(name); dvander@27: while (sym!=NULL) { dvander@27: if (hash==sym->hash && strcmp(name,sym->name)==0 /* check name */ dvander@27: && (sym->parent==NULL || sym->ident==iCONSTEXPR) /* sub-types (hierarchical types) are skipped, except for enum fields */ dvander@27: && (sym->fnumber<0 || sym->fnumber==fnumber)) /* check file number for scope */ dvander@27: { dvander@27: assert(sym->states==NULL || sym->states->next!=NULL); /* first element of the state list is the "root" */ dvander@27: if (sym->ident==iFUNCTN dvander@27: || automaton<0 && sym->states==NULL dvander@27: || automaton>=0 && sym->states!=NULL && state_getfsa(sym->states->next->index)==automaton) dvander@27: { dvander@27: if (cmptag==NULL) dvander@27: return sym; /* return first match */ dvander@27: /* return closest match or first match; count number of matches */ dvander@27: if (firstmatch==NULL) dvander@27: firstmatch=sym; dvander@27: assert(cmptag!=NULL); dvander@27: if (*cmptag==0) dvander@27: count++; dvander@27: if (*cmptag==sym->tag) { dvander@27: *cmptag=1; /* good match found, set number of matches to 1 */ dvander@27: return sym; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } /* */ dvander@27: sym=sym->next; dvander@27: } /* while */ dvander@27: if (cmptag!=NULL && firstmatch!=NULL) dvander@27: *cmptag=count; dvander@27: return firstmatch; dvander@27: } dvander@27: dvander@27: static symbol *find_symbol_child(const symbol *root,const symbol *sym) dvander@27: { dvander@27: symbol *ptr=root->next; dvander@27: while (ptr!=NULL) { dvander@27: if (ptr->parent==sym) dvander@27: return ptr; dvander@27: ptr=ptr->next; dvander@27: } /* while */ dvander@27: return NULL; dvander@27: } dvander@27: dvander@27: /* Adds "bywhom" to the list of referrers of "entry". Typically, dvander@27: * bywhom will be the function that uses a variable or that calls dvander@27: * the function. dvander@27: */ dvander@27: SC_FUNC int refer_symbol(symbol *entry,symbol *bywhom) dvander@27: { dvander@27: int count; dvander@27: dvander@27: assert(bywhom!=NULL); /* it makes no sense to add a "void" referrer */ dvander@27: assert(entry!=NULL); dvander@27: assert(entry->refer!=NULL); dvander@27: dvander@27: /* see if it is already there */ dvander@27: for (count=0; countnumrefers && entry->refer[count]!=bywhom; count++) dvander@27: /* nothing */; dvander@27: if (countnumrefers) { dvander@27: assert(entry->refer[count]==bywhom); dvander@27: return TRUE; dvander@27: } /* if */ dvander@27: dvander@27: /* see if there is an empty spot in the referrer list */ dvander@27: for (count=0; countnumrefers && entry->refer[count]!=NULL; count++) dvander@27: /* nothing */; dvander@27: assert(count <= entry->numrefers); dvander@27: if (count==entry->numrefers) { dvander@27: symbol **refer; dvander@27: int newsize=2*entry->numrefers; dvander@27: assert(newsize>0); dvander@27: /* grow the referrer list */ dvander@27: refer=(symbol**)realloc(entry->refer,newsize*sizeof(symbol*)); dvander@27: if (refer==NULL) dvander@27: return FALSE; /* insufficient memory */ dvander@27: /* initialize the new entries */ dvander@27: entry->refer=refer; dvander@27: for (count=entry->numrefers; countrefer[count]=NULL; dvander@27: count=entry->numrefers; /* first empty spot */ dvander@27: entry->numrefers=newsize; dvander@27: } /* if */ dvander@27: dvander@27: /* add the referrer */ dvander@27: assert(entry->refer[count]==NULL); dvander@27: entry->refer[count]=bywhom; dvander@27: return TRUE; dvander@27: } dvander@27: dvander@27: SC_FUNC void markusage(symbol *sym,int usage) dvander@27: { dvander@27: assert(sym!=NULL); dvander@27: sym->usage |= (char)usage; dvander@27: if ((usage & uWRITTEN)!=0) dvander@27: sym->lnumber=fline; dvander@27: /* check if (global) reference must be added to the symbol */ dvander@27: if ((usage & (uREAD | uWRITTEN))!=0) { dvander@27: /* only do this for global symbols */ dvander@27: if (sym->vclass==sGLOBAL) { dvander@27: /* "curfunc" should always be valid, since statements may not occurs dvander@27: * outside functions; in the case of syntax errors, however, the dvander@27: * compiler may arrive through this function dvander@27: */ dvander@27: if (curfunc!=NULL) dvander@27: refer_symbol(sym,curfunc); dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: } dvander@27: dvander@27: dvander@27: /* findglb dvander@27: * dvander@27: * Returns a pointer to the global symbol (if found) or NULL (if not found) dvander@27: */ dvander@27: SC_FUNC symbol *findglb(const char *name,int filter) dvander@27: { dvander@27: /* find a symbol with a matching automaton first */ dvander@27: symbol *sym=NULL; dvander@27: dvander@27: if (filter>sGLOBAL && sc_curstates>0) { dvander@27: /* find a symbol whose state list matches the current fsa */ dvander@27: sym=find_symbol(&glbtab,name,fcurrent,state_getfsa(sc_curstates),NULL); dvander@27: if (sym!=NULL && sym->ident!=iFUNCTN) { dvander@27: /* if sym!=NULL, we found a variable in the automaton; now we should dvander@27: * also verify whether there is an intersection between the symbol's dvander@27: * state list and the current state list dvander@27: */ dvander@27: assert(sym->states!=NULL && sym->states->next!=NULL); dvander@27: if (!state_conflict_id(sc_curstates,sym->states->next->index)) dvander@27: sym=NULL; dvander@27: } /* if */ dvander@27: } /* if */ dvander@27: dvander@27: /* if no symbol with a matching automaton exists, find a variable/function dvander@27: * that has no state(s) attached to it dvander@27: */ dvander@27: if (sym==NULL) dvander@27: sym=find_symbol(&glbtab,name,fcurrent,-1,NULL); dvander@27: return sym; dvander@27: } dvander@27: dvander@27: /* findloc dvander@27: * dvander@27: * Returns a pointer to the local symbol (if found) or NULL (if not found). dvander@27: * See add_symbol() how the deepest nesting level is searched first. dvander@27: */ dvander@27: SC_FUNC symbol *findloc(const char *name) dvander@27: { dvander@27: return find_symbol(&loctab,name,-1,-1,NULL); dvander@27: } dvander@27: dvander@27: SC_FUNC symbol *findconst(const char *name,int *cmptag) dvander@27: { dvander@27: symbol *sym; dvander@27: dvander@27: sym=find_symbol(&loctab,name,-1,-1,cmptag); /* try local symbols first */ dvander@27: if (sym==NULL || sym->ident!=iCONSTEXPR) /* not found, or not a constant */ dvander@27: sym=find_symbol(&glbtab,name,fcurrent,-1,cmptag); dvander@27: if (sym==NULL || sym->ident!=iCONSTEXPR) dvander@27: return NULL; dvander@27: assert(sym->parent==NULL || (sym->usage & uENUMFIELD)!=0); dvander@27: /* ^^^ constants have no hierarchy, but enumeration fields may have a parent */ dvander@27: return sym; dvander@27: } dvander@27: dvander@27: SC_FUNC symbol *finddepend(const symbol *parent) dvander@27: { dvander@27: symbol *sym; dvander@27: dvander@27: sym=find_symbol_child(&loctab,parent); /* try local symbols first */ dvander@27: if (sym==NULL) /* not found */ dvander@27: sym=find_symbol_child(&glbtab,parent); dvander@27: return sym; dvander@27: } dvander@27: dvander@27: /* addsym dvander@27: * dvander@27: * Adds a symbol to the symbol table (either global or local variables, dvander@27: * or global and local constants). dvander@27: */ dvander@27: SC_FUNC symbol *addsym(const char *name,cell addr,int ident,int vclass,int tag,int usage) dvander@27: { dvander@27: symbol entry, **refer; dvander@27: dvander@27: /* labels may only be defined once */ dvander@27: assert(ident!=iLABEL || findloc(name)==NULL); dvander@27: dvander@27: /* create an empty referrer list */ dvander@27: if ((refer=(symbol**)malloc(sizeof(symbol*)))==NULL) { dvander@27: error(103); /* insufficient memory */ dvander@27: return NULL; dvander@27: } /* if */ dvander@27: *refer=NULL; dvander@27: dvander@27: /* first fill in the entry */ dvander@27: memset(&entry,0,sizeof entry); dvander@27: strcpy(entry.name,name); dvander@27: entry.hash=namehash(name); dvander@27: entry.addr=addr; dvander@27: entry.codeaddr=code_idx; dvander@27: entry.vclass=(char)vclass; dvander@27: entry.ident=(char)ident; dvander@27: entry.tag=tag; dvander@27: entry.usage=(char)usage; dvander@27: entry.fnumber=-1; /* assume global visibility (ignored for local symbols) */ dvander@27: entry.lnumber=fline; dvander@27: entry.numrefers=1; dvander@27: entry.refer=refer; dvander@27: dvander@27: /* then insert it in the list */ dvander@27: if (vclass==sGLOBAL) dvander@27: return add_symbol(&glbtab,&entry,TRUE); dvander@27: else dvander@27: return add_symbol(&loctab,&entry,FALSE); dvander@27: } dvander@27: dvander@27: SC_FUNC symbol *addvariable(const char *name,cell addr,int ident,int vclass,int tag, dvander@27: int dim[],int numdim,int idxtag[]) dvander@27: { dvander@286: return addvariable2(name,addr,ident,vclass,tag,dim,numdim,idxtag,0); dvander@286: } dvander@286: dvander@286: SC_FUNC symbol *addvariable2(const char *name,cell addr,int ident,int vclass,int tag, dvander@286: int dim[],int numdim,int idxtag[],int slength) dvander@286: { dvander@27: symbol *sym; dvander@27: dvander@27: /* global variables may only be defined once dvander@27: * One complication is that functions returning arrays declare an array dvander@27: * with the same name as the function, so the assertion must allow for dvander@27: * this special case. Another complication is that variables may be dvander@27: * "redeclared" if they are local to an automaton (and findglb() will find dvander@27: * the symbol without states if no symbol with states exists). dvander@27: */ dvander@27: assert(vclass!=sGLOBAL || (sym=findglb(name,sGLOBAL))==NULL || (sym->usage & uDEFINE)==0 dvander@27: || sym->ident==iFUNCTN && sym==curfunc dvander@27: || sym->states==NULL && sc_curstates>0); dvander@27: dvander@27: if (ident==iARRAY || ident==iREFARRAY) { dvander@27: symbol *parent=NULL,*top; dvander@27: int level; dvander@27: sym=NULL; /* to avoid a compiler warning */ dvander@27: for (level=0; leveldim.array.length=dim[level]; dvander@286: if (tag == pc_tag_string && level == numdim - 1) dvander@286: top->dim.array.slength=slength; dvander@286: else dvander@286: top->dim.array.slength=0; dvander@27: top->dim.array.level=(short)(numdim-level-1); dvander@27: top->x.tags.index=idxtag[level]; dvander@27: top->parent=parent; dvander@27: parent=top; dvander@27: if (level==0) dvander@27: sym=top; dvander@27: } /* for */ dvander@27: } else { dvander@27: sym=addsym(name,addr,ident,vclass,tag,uDEFINE); dvander@27: } /* if */ dvander@27: return sym; dvander@27: } dvander@27: dvander@27: /* getlabel dvander@27: * dvander@27: * Returns te next internal label number. The global variable sc_labnum is dvander@27: * initialized to zero. dvander@27: */ dvander@27: SC_FUNC int getlabel(void) dvander@27: { dvander@27: return sc_labnum++; dvander@27: } dvander@27: dvander@27: /* itoh dvander@27: * dvander@27: * Converts a number to a hexadecimal string and returns a pointer to that dvander@27: * string. This function is NOT re-entrant. dvander@27: */ dvander@27: SC_FUNC char *itoh(ucell val) dvander@27: { dvander@27: static char itohstr[30]; dvander@27: char *ptr; dvander@27: int i,nibble[16]; /* a 64-bit hexadecimal cell has 16 nibbles */ dvander@27: int max; dvander@27: dvander@27: #if PAWN_CELL_SIZE==16 dvander@27: max=4; dvander@27: #elif PAWN_CELL_SIZE==32 dvander@27: max=8; dvander@27: #elif PAWN_CELL_SIZE==64 dvander@27: max=16; dvander@27: #else dvander@27: #error Unsupported cell size dvander@27: #endif dvander@27: ptr=itohstr; dvander@27: for (i=0; i>=4; dvander@27: } /* endfor */ dvander@27: i=max-1; dvander@27: while (nibble[i]==0 && i>0) /* search for highest non-zero nibble */ dvander@27: i-=1; dvander@27: while (i>=0){ dvander@27: if (nibble[i]>=10) dvander@27: *ptr++=(char)('a'+(nibble[i]-10)); dvander@27: else dvander@27: *ptr++=(char)('0'+nibble[i]); dvander@27: i-=1; dvander@27: } /* while */ dvander@27: *ptr='\0'; /* and a zero-terminator */ dvander@27: return itohstr; dvander@27: } dvander@27: