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