sourcepawn/compiler/sc2.c
author David Anderson <dvander@alliedmods.net>
Mon Mar 17 01:09:28 2008 +0000 (2008-03-17)
changeset 1941 54539fa4e51f
parent 1051 978fad727f69
permissions -rw-r--r--
bumped versions
     1 /*  Pawn compiler - File input, preprocessing and lexical analysis functions
     2  *
     3  *  Copyright (c) ITB CompuPhase, 1997-2006
     4  *
     5  *  This software is provided "as-is", without any express or implied warranty.
     6  *  In no event will the authors be held liable for any damages arising from
     7  *  the use of this software.
     8  *
     9  *  Permission is granted to anyone to use this software for any purpose,
    10  *  including commercial applications, and to alter it and redistribute it
    11  *  freely, subject to the following restrictions:
    12  *
    13  *  1.  The origin of this software must not be misrepresented; you must not
    14  *      claim that you wrote the original software. If you use this software in
    15  *      a product, an acknowledgment in the product documentation would be
    16  *      appreciated but is not required.
    17  *  2.  Altered source versions must be plainly marked as such, and must not be
    18  *      misrepresented as being the original software.
    19  *  3.  This notice may not be removed or altered from any source distribution.
    20  *
    21  *  Version: $Id$
    22  */
    23 #include <assert.h>
    24 #include <stdio.h>
    25 #include <stdlib.h>
    26 #include <string.h>
    27 #include <ctype.h>
    28 #include <math.h>
    29 #include "lstring.h"
    30 #include "sc.h"
    31 #if defined LINUX || defined __FreeBSD__ || defined __OpenBSD__
    32   #include <sclinux.h>
    33 #endif
    34 
    35 #if defined FORTIFY
    36   #include <alloc/fortify.h>
    37 #endif
    38 
    39 /* flags for litchar() */
    40 #define RAWMODE         1
    41 #define UTF8MODE        2
    42 static cell litchar(const unsigned char **lptr,int flags);
    43 static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag);
    44 
    45 static void substallpatterns(unsigned char *line,int buffersize);
    46 static int match(char *st,int end);
    47 static int alpha(char c);
    48 
    49 #define SKIPMODE      1 /* bit field in "#if" stack */
    50 #define PARSEMODE     2 /* bit field in "#if" stack */
    51 #define HANDLED_ELSE  4 /* bit field in "#if" stack */
    52 #define SKIPPING      (skiplevel>0 && (ifstack[skiplevel-1] & SKIPMODE)==SKIPMODE)
    53 
    54 static short icomment;  /* currently in multiline comment? */
    55 static char ifstack[sCOMP_STACK]; /* "#if" stack */
    56 static short iflevel;   /* nesting level if #if/#else/#endif */
    57 static short skiplevel; /* level at which we started skipping (including nested #if .. #endif) */
    58 static unsigned char term_expr[] = "";
    59 static int listline=-1; /* "current line" for the list file */
    60 
    61 
    62 /*  pushstk & popstk
    63  *
    64  *  Uses a LIFO stack to store information. The stack is used by doinclude(),
    65  *  doswitch() (to hold the state of "swactive") and some other routines.
    66  *
    67  *  Porting note: I made the bold assumption that an integer will not be
    68  *  larger than a pointer (it may be smaller). That is, the stack element
    69  *  is typedef'ed as a pointer type, but I also store integers on it. See
    70  *  SC.H for "stkitem"
    71  *
    72  *  Global references: stack,stkidx,stktop (private to pushstk(), popstk()
    73  *                     and clearstk())
    74  */
    75 static stkitem *stack=NULL;
    76 static int stkidx=0,stktop=0;
    77 
    78 SC_FUNC void pushstk(stkitem val)
    79 {
    80   assert(stkidx<=stktop);
    81   if (stkidx==stktop) {
    82     stkitem *newstack;
    83     int newsize= (stktop==0) ? 16 : 2*stktop;
    84     /* try to resize the stack */
    85     assert(newsize>stktop);
    86     newstack=(stkitem*)malloc(newsize*sizeof(stkitem));
    87     if (newstack==NULL)
    88       error(122,"parser stack");  /* stack overflow (recursive include?) */
    89     /* swap the stacks */
    90     memcpy(newstack,stack,stkidx*sizeof(stkitem));
    91     if (stack!=NULL)
    92       free(stack);
    93     stack=newstack;
    94     stktop=newsize;
    95   } /* if */
    96   assert(stkidx<stktop);
    97   stack[stkidx]=val;
    98   stkidx+=1;
    99 }
   100 
   101 SC_FUNC stkitem popstk(void)
   102 {
   103   if (stkidx==0) {
   104     stkitem s;
   105     s.i=-1;             /* stack is empty */
   106     return s;
   107   } /* if */
   108   stkidx--;
   109   assert(stack!=NULL);
   110   return stack[stkidx];
   111 }
   112 
   113 SC_FUNC void clearstk(void)
   114 {
   115   assert(stack!=NULL || stktop==0);
   116   if (stack!=NULL) {
   117     free(stack);
   118     stack=NULL;
   119     stktop=0;
   120   } /* if */
   121   assert(stktop==0);
   122 }
   123 
   124 SC_FUNC int plungequalifiedfile(char *name)
   125 {
   126 static char *extensions[] = { ".inc", ".p", ".pawn" };
   127   FILE *fp;
   128   char *ext;
   129   int ext_idx;
   130 
   131   ext_idx=0;
   132   do {
   133     fp=(FILE*)pc_opensrc(name);
   134     ext=strchr(name,'\0');      /* save position */
   135     if (fp==NULL) {
   136       /* try to append an extension */
   137       strcpy(ext,extensions[ext_idx]);
   138       fp=(FILE*)pc_opensrc(name);
   139       if (fp==NULL)
   140         *ext='\0';              /* on failure, restore filename */
   141     } /* if */
   142     ext_idx++;
   143   } while (fp==NULL && ext_idx<(sizeof extensions / sizeof extensions[0]));
   144   if (fp==NULL) {
   145     *ext='\0';                  /* restore filename */
   146     return FALSE;
   147   } /* if */
   148   PUSHSTK_P(inpf);
   149   PUSHSTK_P(inpfname);          /* pointer to current file name */
   150   PUSHSTK_P(curlibrary);
   151   PUSHSTK_I(iflevel);
   152   assert(!SKIPPING);
   153   assert(skiplevel==iflevel);   /* these two are always the same when "parsing" */
   154   PUSHSTK_I(sc_is_utf8);
   155   PUSHSTK_I(icomment);
   156   PUSHSTK_I(fcurrent);
   157   PUSHSTK_I(fline);
   158   inpfname=duplicatestring(name);/* set name of include file */
   159   if (inpfname==NULL)
   160     error(123);             /* insufficient memory */
   161   inpf=fp;                  /* set input file pointer to include file */
   162   fnumber++;
   163   fline=0;                  /* set current line number to 0 */
   164   fcurrent=fnumber;
   165   icomment=0;               /* not in a comment */
   166   insert_dbgfile(inpfname);
   167   setfiledirect(inpfname);
   168   listline=-1;              /* force a #line directive when changing the file */
   169   sc_is_utf8=(short)scan_utf8(inpf,name);
   170   return TRUE;
   171 }
   172 
   173 SC_FUNC int plungefile(char *name,int try_currentpath,int try_includepaths)
   174 {
   175   int result=FALSE;
   176 
   177   if (try_currentpath) {
   178     result=plungequalifiedfile(name);
   179     if (!result) {
   180       /* failed to open the file in the active directory, try to open the file
   181        * in the same directory as the current file --but first check whether
   182        * there is a (relative) path for the current file
   183        */
   184       char *ptr;
   185       if ((ptr=strrchr(inpfname,DIRSEP_CHAR))!=0) {
   186         int len=(int)(ptr-inpfname)+1;
   187         if (len+strlen(name)<_MAX_PATH) {
   188           char path[_MAX_PATH];
   189           strlcpy(path,inpfname,len+1);
   190           strlcat(path,name,sizeof path);
   191           result=plungequalifiedfile(path);
   192         } /* if */
   193       } /* if */
   194     } /* if */
   195   } /* if */
   196 
   197   if (try_includepaths && name[0]!=DIRSEP_CHAR) {
   198     int i;
   199     char *ptr;
   200     for (i=0; !result && (ptr=get_path(i))!=NULL; i++) {
   201       char path[_MAX_PATH];
   202       strlcpy(path,ptr,sizeof path);
   203       strlcat(path,name,sizeof path);
   204       result=plungequalifiedfile(path);
   205     } /* while */
   206   } /* if */
   207   return result;
   208 }
   209 
   210 static void check_empty(const unsigned char *lptr)
   211 {
   212   /* verifies that the string contains only whitespace */
   213   while (*lptr<=' ' && *lptr!='\0')
   214     lptr++;
   215   if (*lptr!='\0')
   216     error(38);          /* extra characters on line */
   217 }
   218 
   219 /*  doinclude
   220  *
   221  *  Gets the name of an include file, pushes the old file on the stack and
   222  *  sets some options. This routine doesn't use lex(), since lex() doesn't
   223  *  recognize file names (and directories).
   224  *
   225  *  Global references: inpf     (altered)
   226  *                     inpfname (altered)
   227  *                     fline    (altered)
   228  *                     lptr     (altered)
   229  */
   230 static void doinclude(int silent)
   231 {
   232   char name[_MAX_PATH];
   233   char symname[sNAMEMAX];
   234   char *ptr;
   235   char c;
   236   int i, result;
   237 
   238   while (*lptr<=' ' && *lptr!='\0')         /* skip leading whitespace */
   239     lptr++;
   240   if (*lptr=='<' || *lptr=='\"'){
   241     c=(char)((*lptr=='\"') ? '\"' : '>');   /* termination character */
   242     lptr++;
   243     while (*lptr<=' ' && *lptr!='\0')       /* skip whitespace after quote */
   244       lptr++;
   245   } else {
   246     c='\0';
   247   } /* if */
   248 
   249   i=0;
   250   while (*lptr!=c && *lptr!='\0' && i<sizeof name - 1)  /* find the end of the string */
   251     name[i++]=*lptr++;
   252   while (i>0 && name[i-1]<=' ')
   253     i--;                        /* strip trailing whitespace */
   254   assert(i>=0 && i<sizeof name);
   255   name[i]='\0';                 /* zero-terminate the string */
   256 
   257   if (*lptr!=c) {               /* verify correct string termination */
   258     error(37);                  /* invalid string */
   259     return;
   260   } /* if */
   261   if (c!='\0')
   262     check_empty(lptr+1);        /* verify that the rest of the line is whitespace */
   263 
   264   /* create a symbol from the name of the include file; this allows the system
   265    * to test for multiple inclusions
   266    */
   267   strcpy(symname,"_inc_");
   268   if ((ptr=strrchr(name,DIRSEP_CHAR))!=NULL)
   269     strlcat(symname,ptr+1,sizeof symname);
   270   else
   271     strlcat(symname,name,sizeof symname);
   272   if (find_symbol(&glbtab,symname,fcurrent,-1,NULL)==NULL) {
   273     /* constant is not present, so this file has not been included yet */
   274 
   275     /* Include files between "..." or without quotes are read from the current
   276      * directory, or from a list of "include directories". Include files
   277      * between <...> are only read from the list of include directories.
   278      */
   279     result=plungefile(name,(c!='>'),TRUE);
   280     if (result)
   281       add_constant(symname,1,sGLOBAL,0);
   282     else if (!silent)
   283       error(120,name);            /* cannot read from ... (fatal error) */
   284   } /* if */
   285 }
   286 
   287 /*  readline
   288  *
   289  *  Reads in a new line from the input file pointed to by "inpf". readline()
   290  *  concatenates lines that end with a \ with the next line. If no more data
   291  *  can be read from the file, readline() attempts to pop off the previous file
   292  *  from the stack. If that fails too, it sets "freading" to 0.
   293  *
   294  *  Global references: inpf,fline,inpfname,freading,icomment (altered)
   295  */
   296 static void readline(unsigned char *line)
   297 {
   298   int i,num,cont;
   299   unsigned char *ptr;
   300 
   301   if (lptr==term_expr)
   302     return;
   303   num=sLINEMAX;
   304   cont=FALSE;
   305   do {
   306     if (inpf==NULL || pc_eofsrc(inpf)) {
   307       if (cont)
   308         error(49);        /* invalid line continuation */
   309       if (inpf!=NULL && inpf!=inpf_org)
   310         pc_closesrc(inpf);
   311       i=POPSTK_I();
   312       if (i==-1) {        /* All's done; popstk() returns "stack is empty" */
   313         freading=FALSE;
   314         *line='\0';
   315         /* when there is nothing more to read, the #if/#else stack should
   316          * be empty and we should not be in a comment
   317          */
   318         assert(iflevel>=0);
   319         if (iflevel>0)
   320           error(1,"#endif","-end of file-");
   321         else if (icomment!=0)
   322           error(1,"*/","-end of file-");
   323         return;
   324       } /* if */
   325       fline=i;
   326       fcurrent=(short)POPSTK_I();
   327       icomment=(short)POPSTK_I();
   328       sc_is_utf8=(short)POPSTK_I();
   329       iflevel=(short)POPSTK_I();
   330       skiplevel=iflevel;        /* this condition held before including the file */
   331       assert(!SKIPPING);        /* idem ditto */
   332       curlibrary=(constvalue *)POPSTK_P();
   333       free(inpfname);           /* return memory allocated for the include file name */
   334       inpfname=(char *)POPSTK_P();
   335       inpf=(FILE *)POPSTK_P();
   336       insert_dbgfile(inpfname);
   337       setfiledirect(inpfname);
   338       listline=-1;              /* force a #line directive when changing the file */
   339     } /* if */
   340 
   341     if (pc_readsrc(inpf,line,num)==NULL) {
   342       *line='\0';     /* delete line */
   343       cont=FALSE;
   344     } else {
   345       /* check whether to erase leading spaces */
   346       if (cont) {
   347         unsigned char *ptr=line;
   348         while (*ptr<=' ' && *ptr!='\0')
   349           ptr++;
   350         if (ptr!=line)
   351           memmove(line,ptr,strlen((char*)ptr)+1);
   352       } /* if */
   353       cont=FALSE;
   354       /* check whether a full line was read */
   355       if (strchr((char*)line,'\n')==NULL && !pc_eofsrc(inpf))
   356         error(75);      /* line too long */
   357       /* check if the next line must be concatenated to this line */
   358       if ((ptr=(unsigned char*)strchr((char*)line,'\n'))==NULL)
   359         ptr=(unsigned char*)strchr((char*)line,'\r');
   360       if (ptr!=NULL && ptr>line) {
   361         assert(*(ptr+1)=='\0'); /* '\n' or '\r' should be last in the string */
   362         while (ptr>line && *ptr<=' ')
   363           ptr--;        /* skip trailing whitespace */
   364         if (*ptr=='\\') {
   365           cont=TRUE;
   366           /* set '\a' at the position of '\\' to make it possible to check
   367            * for a line continuation in a single line comment (error 49)
   368            */
   369           *ptr++='\a';
   370           *ptr='\0';    /* erase '\n' (and any trailing whitespace) */
   371         } /* if */
   372       } /* if */
   373       num-=strlen((char*)line);
   374       line+=strlen((char*)line);
   375     } /* if */
   376     fline+=1;
   377   } while (num>=0 && cont);
   378 }
   379 
   380 /*  stripcom
   381  *
   382  *  Replaces all comments from the line by space characters. It updates
   383  *  a global variable ("icomment") for multiline comments.
   384  *
   385  *  This routine also supports the C++ extension for single line comments.
   386  *  These comments are started with "//" and end at the end of the line.
   387  *
   388  *  The function also detects (and manages) "documentation comments". The
   389  *  global variable "icomment" is set to 2 for documentation comments.
   390  *
   391  *  Global references: icomment  (private to "stripcom")
   392  */
   393 static void stripcom(unsigned char *line)
   394 {
   395   char c;
   396   #if !defined SC_LIGHT
   397     #define COMMENT_LIMIT 100
   398     #define COMMENT_MARGIN 40   /* length of the longest word */
   399     char comment[COMMENT_LIMIT+COMMENT_MARGIN];
   400     int commentidx=0;
   401     int skipstar=TRUE;
   402     static int prev_singleline=FALSE;
   403     int singleline=prev_singleline;
   404 
   405     prev_singleline=FALSE;  /* preset */
   406   #endif
   407 
   408   while (*line){
   409     if (icomment!=0) {
   410       if (*line=='*' && *(line+1)=='/') {
   411         #if !defined SC_LIGHT
   412           if (icomment==2) {
   413             assert(commentidx<COMMENT_LIMIT+COMMENT_MARGIN);
   414             comment[commentidx]='\0';
   415             if (strlen(comment)>0)
   416               insert_docstring(comment);
   417           } /* if */
   418         #endif
   419         icomment=0;     /* comment has ended */
   420         *line=' ';      /* replace '*' and '/' characters by spaces */
   421         *(line+1)=' ';
   422         line+=2;
   423       } else {
   424         if (*line=='/' && *(line+1)=='*')
   425           error(216);   /* nested comment */
   426         #if !defined SC_LIGHT
   427           /* collect the comment characters in a string */
   428           if (icomment==2) {
   429             if (skipstar && (*line!='\0' && *line<=' ' || *line=='*')) {
   430               /* ignore leading whitespace and '*' characters */
   431             } else if (commentidx<COMMENT_LIMIT+COMMENT_MARGIN-1) {
   432               comment[commentidx++]=(char)((*line!='\n') ? *line : ' ');
   433               if (commentidx>COMMENT_LIMIT && *line!='\0' && *line<=' ') {
   434                 comment[commentidx]='\0';
   435                 insert_docstring(comment);
   436                 commentidx=0;
   437               } /* if */
   438               skipstar=FALSE;
   439             } /* if */
   440           } /* if */
   441         #endif
   442         *line=' ';      /* replace comments by spaces */
   443         line+=1;
   444       } /* if */
   445     } else {
   446       if (*line=='/' && *(line+1)=='*'){
   447         icomment=1;     /* start comment */
   448         #if !defined SC_LIGHT
   449           /* there must be two "*" behind the slash and then white space */
   450           if (*(line+2)=='*' && *(line+3)<=' ') {
   451             /* if we are not in a function, we must attach the previous block
   452              * to the global documentation
   453              */
   454             if (curfunc==NULL && get_docstring(0)!=NULL)
   455               sc_attachdocumentation(NULL);
   456             icomment=2; /* documentation comment */
   457           } /* if */
   458           commentidx=0;
   459           skipstar=TRUE;
   460         #endif
   461         *line=' ';      /* replace '/' and '*' characters by spaces */
   462         *(line+1)=' ';
   463         line+=2;
   464         if (icomment==2)
   465           *line++=' ';
   466       } else if (*line=='/' && *(line+1)=='/'){  /* comment to end of line */
   467         if (strchr((char*)line,'\a')!=NULL)
   468           error(49);    /* invalid line continuation */
   469         #if !defined SC_LIGHT
   470           if (*(line+2)=='/' && *(line+3)<=' ') {
   471             /* documentation comment */
   472             char *str=(char*)line+3;
   473             char *end;
   474             while (*str<=' ' && *str!='\0')
   475               str++;    /* skip leading whitespace */
   476             if ((end=strrchr(str,'\n'))!=NULL)
   477               *end='\0';/* erase trailing '\n' */
   478             /* if there is a disjunct block, we may need to attach the previous
   479              * block to the global documentation
   480              */
   481             if (!singleline && curfunc==NULL && get_docstring(0)!=NULL)
   482               sc_attachdocumentation(NULL);
   483             insert_docstring(str);
   484             prev_singleline=TRUE;
   485           } /* if */
   486         #endif
   487         *line++='\n';   /* put "newline" at first slash */
   488         *line='\0';     /* put "zero-terminator" at second slash */
   489       } else {
   490         if (*line=='\"' || *line=='\''){        /* leave literals unaltered */
   491           c=*line;      /* ending quote, single or double */
   492           line+=1;
   493           while ((*line!=c || *(line-1)==sc_ctrlchar) && *line!='\0')
   494             line+=1;
   495           line+=1;      /* skip final quote */
   496         } else {
   497           line+=1;
   498         } /* if */
   499       } /* if */
   500     } /* if */
   501   } /* while */
   502   #if !defined SC_LIGHT
   503     if (icomment==2) {
   504       assert(commentidx<COMMENT_LIMIT+COMMENT_MARGIN);
   505       comment[commentidx]='\0';
   506       if (strlen(comment)>0)
   507         insert_docstring(comment);
   508     } /* if */
   509   #endif
   510 }
   511 
   512 /*  btoi
   513  *
   514  *  Attempts to interpret a numeric symbol as a boolean value. On success
   515  *  it returns the number of characters processed (so the line pointer can be
   516  *  adjusted) and the value is stored in "val". Otherwise it returns 0 and
   517  *  "val" is garbage.
   518  *
   519  *  A boolean value must start with "0b"
   520  */
   521 static int btoi(cell *val,const unsigned char *curptr)
   522 {
   523   const unsigned char *ptr;
   524 
   525   *val=0;
   526   ptr=curptr;
   527   if (*ptr=='0' && *(ptr+1)=='b') {
   528     ptr+=2;
   529     while (*ptr=='0' || *ptr=='1' || *ptr=='_') {
   530       if (*ptr!='_')
   531         *val=(*val<<1) | (*ptr-'0');
   532       ptr++;
   533     } /* while */
   534   } else {
   535     return 0;
   536   } /* if */
   537   if (alphanum(*ptr))   /* number must be delimited by non-alphanumeric char */
   538     return 0;
   539   else
   540     return (int)(ptr-curptr);
   541 }
   542 
   543 /*  dtoi
   544  *
   545  *  Attempts to interpret a numeric symbol as a decimal value. On success
   546  *  it returns the number of characters processed and the value is stored in
   547  *  "val". Otherwise it returns 0 and "val" is garbage.
   548  */
   549 static int dtoi(cell *val,const unsigned char *curptr)
   550 {
   551   const unsigned char *ptr;
   552 
   553   *val=0;
   554   ptr=curptr;
   555   if (!isdigit(*ptr))   /* should start with digit */
   556     return 0;
   557   while (isdigit(*ptr) || *ptr=='_') {
   558     if (*ptr!='_')
   559       *val=(*val*10)+(*ptr-'0');
   560     ptr++;
   561   } /* while */
   562   if (alphanum(*ptr))   /* number must be delimited by non-alphanumerical */
   563     return 0;
   564   if (*ptr=='.' && isdigit(*(ptr+1)))
   565     return 0;           /* but a fractional part must not be present */
   566   return (int)(ptr-curptr);
   567 }
   568 
   569 /*  htoi
   570  *
   571  *  Attempts to interpret a numeric symbol as a hexadecimal value. On
   572  *  success it returns the number of characters processed and the value is
   573  *  stored in "val". Otherwise it return 0 and "val" is garbage.
   574  */
   575 static int htoi(cell *val,const unsigned char *curptr)
   576 {
   577   const unsigned char *ptr;
   578 
   579   *val=0;
   580   ptr=curptr;
   581   if (!isdigit(*ptr))   /* should start with digit */
   582     return 0;
   583   if (*ptr=='0' && *(ptr+1)=='x') {     /* C style hexadecimal notation */
   584     ptr+=2;
   585     while (ishex(*ptr) || *ptr=='_') {
   586       if (*ptr!='_') {
   587         assert(ishex(*ptr));
   588         *val= *val<<4;
   589         if (isdigit(*ptr))
   590           *val+= (*ptr-'0');
   591         else
   592           *val+= (tolower(*ptr)-'a'+10);
   593       } /* if */
   594       ptr++;
   595     } /* while */
   596   } else {
   597     return 0;
   598   } /* if */
   599   if (alphanum(*ptr))
   600     return 0;
   601   else
   602     return (int)(ptr-curptr);
   603 }
   604 
   605 #if defined __GNUC__
   606 static double pow10(int value)
   607 {
   608   double res=1.0;
   609   while (value>=4) {
   610     res*=10000.0;
   611     value-=5;
   612   } /* while */
   613   while (value>=2) {
   614     res*=100.0;
   615     value-=2;
   616   } /* while */
   617   while (value>=1) {
   618     res*=10.0;
   619     value-=1;
   620   } /* while */
   621   return res;
   622 }
   623 #endif
   624 
   625 /*  ftoi
   626  *
   627  *  Attempts to interpret a numeric symbol as a rational number, either as
   628  *  IEEE 754 single/double precision floating point or as a fixed point integer.
   629  *  On success it returns the number of characters processed and the value is
   630  *  stored in "val". Otherwise it returns 0 and "val" is unchanged.
   631  *
   632  *  Pawn has stricter definition for rational numbers than most:
   633  *  o  the value must start with a digit; ".5" is not a valid number, you
   634  *     should write "0.5"
   635  *  o  a period must appear in the value, even if an exponent is given; "2e3"
   636  *     is not a valid number, you should write "2.0e3"
   637  *  o  at least one digit must follow the period; "6." is not a valid number,
   638  *     you should write "6.0"
   639  */
   640 static int ftoi(cell *val,const unsigned char *curptr)
   641 {
   642   const unsigned char *ptr;
   643   double fnum,ffrac,fmult;
   644   unsigned long dnum,dbase;
   645   int i, ignore;
   646 
   647   assert(rational_digits>=0 && rational_digits<9);
   648   for (i=0,dbase=1; i<rational_digits; i++)
   649     dbase*=10;
   650   fnum=0.0;
   651   dnum=0L;
   652   ptr=curptr;
   653   if (!isdigit(*ptr))   /* should start with digit */
   654     return 0;
   655   while (isdigit(*ptr) || *ptr=='_') {
   656     if (*ptr!='_') {
   657       fnum=(fnum*10.0)+(*ptr-'0');
   658       dnum=(dnum*10L)+(*ptr-'0')*dbase;
   659     } /* if */
   660     ptr++;
   661   } /* while */
   662   if (*ptr!='.')
   663     return 0;           /* there must be a period */
   664   ptr++;
   665   if (!isdigit(*ptr))   /* there must be at least one digit after the dot */
   666     return 0;
   667   ffrac=0.0;
   668   fmult=1.0;
   669   ignore=FALSE;
   670   while (isdigit(*ptr) || *ptr=='_') {
   671     if (*ptr!='_') {
   672       ffrac=(ffrac*10.0)+(*ptr-'0');
   673       fmult=fmult/10.0;
   674       dbase /= 10L;
   675       dnum += (*ptr-'0')*dbase;
   676       if (dbase==0L && sc_rationaltag && rational_digits>0 && !ignore) {
   677         error(222);     /* number of digits exceeds rational number precision */
   678         ignore=TRUE;
   679       } /* if */
   680     } /* if */
   681     ptr++;
   682   } /* while */
   683   fnum += ffrac*fmult;  /* form the number so far */
   684   if (*ptr=='e') {      /* optional fractional part */
   685     int exp,sign;
   686     ptr++;
   687     if (*ptr=='-') {
   688       sign=-1;
   689       ptr++;
   690     } else {
   691       sign=1;
   692     } /* if */
   693     if (!isdigit(*ptr)) /* 'e' should be followed by a digit */
   694       return 0;
   695     exp=0;
   696     while (isdigit(*ptr)) {
   697       exp=(exp*10)+(*ptr-'0');
   698       ptr++;
   699     } /* while */
   700     #if defined __GNUC__
   701       fmult=pow10(exp*sign);
   702     #else
   703       fmult=pow(10,exp*sign);
   704     #endif
   705     fnum *= fmult;
   706     dnum *= (unsigned long)(fmult+0.5);
   707   } /* if */
   708 
   709   /* decide how to store the number */
   710   if (sc_rationaltag==0) {
   711     error(70);          /* rational number support was not enabled */
   712     *val=0;
   713   } else if (rational_digits==0) {
   714     /* floating point */
   715     #if PAWN_CELL_SIZE==32
   716       float value=(float)fnum;
   717       *val=*((cell *)&value);
   718       #if 0 /* SourceMod - not needed */
   719         /* I assume that the C/C++ compiler stores "float" values in IEEE 754
   720          * format (as mandated in the ANSI standard). Test this assumption
   721          * anyway.
   722          * Note: problems have been reported with GCC 3.2.x, version 3.3.x works.
   723          */
   724         { float test1 = 0.0, test2 = 50.0, test3 = -50.0;
   725           uint32_t bit = 1;
   726           /* test 0.0 == all bits 0 */
   727           assert(*(uint32_t*)&test1==0x00000000L);
   728           /* test sign & magnitude format */
   729           assert(((*(uint32_t*)&test2) ^ (*(uint32_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1)));
   730           /* test a known value */
   731           assert(*(uint32_t*)&test2==0x42480000L);
   732         }
   733       #endif
   734     #elif PAWN_CELL_SIZE==64
   735       *val=*((cell *)&fnum);
   736       #if 0 /* SourceMod - not needed */
   737         /* I assume that the C/C++ compiler stores "double" values in IEEE 754
   738          * format (as mandated in the ANSI standard).
   739          */
   740         { float test1 = 0.0, test2 = 50.0, test3 = -50.0;
   741           uint64_t bit = 1;
   742           /* test 0.0 == all bits 0 */
   743           assert(*(uint64_t*)&test1==0x00000000L);
   744           /* test sign & magnitude format */
   745           assert(((*(uint64_t*)&test2) ^ (*(uint64_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1)));
   746         }
   747       #endif
   748     #else
   749       #error Unsupported cell size
   750     #endif
   751   } else {
   752     /* fixed point */
   753     *val=(cell)dnum;
   754   } /* if */
   755 
   756   return (int)(ptr-curptr);
   757 }
   758 
   759 /*  number
   760  *
   761  *  Reads in a number (binary, decimal or hexadecimal). It returns the number
   762  *  of characters processed or 0 if the symbol couldn't be interpreted as a
   763  *  number (in this case the argument "val" remains unchanged). This routine
   764  *  relies on the 'early dropout' implementation of the logical or (||)
   765  *  operator.
   766  *
   767  *  Note: the routine doesn't check for a sign (+ or -). The - is checked
   768  *        for at "hier2()" (in fact, it is viewed as an operator, not as a
   769  *        sign) and the + is invalid (as in K&R C, and unlike ANSI C).
   770  */
   771 static int number(cell *val,const unsigned char *curptr)
   772 {
   773   int i;
   774   cell value;
   775 
   776   if ((i=btoi(&value,curptr))!=0      /* binary? */
   777       || (i=htoi(&value,curptr))!=0   /* hexadecimal? */
   778       || (i=dtoi(&value,curptr))!=0)  /* decimal? */
   779   {
   780     *val=value;
   781     return i;
   782   } else {
   783     return 0;                      /* else not a number */
   784   } /* if */
   785 }
   786 
   787 static void chrcat(char *str,char chr)
   788 {
   789   str=strchr(str,'\0');
   790   *str++=chr;
   791   *str='\0';
   792 }
   793 
   794 static int preproc_expr(cell *val,int *tag)
   795 {
   796   int result;
   797   int index;
   798   cell code_index;
   799   char *term;
   800 
   801   /* Disable staging; it should be disabled already because
   802    * expressions may not be cut off half-way between conditional
   803    * compilations. Reset the staging index, but keep the code
   804    * index.
   805    */
   806   if (stgget(&index,&code_index)) {
   807     error(57);                          /* unfinished expression */
   808     stgdel(0,code_index);
   809     stgset(FALSE);
   810   } /* if */
   811   assert((lptr-pline)<(int)strlen((char*)pline));   /* lptr must point inside the string */
   812   #if !defined NO_DEFINE
   813     /* preprocess the string */
   814     substallpatterns(pline,sLINEMAX);
   815     assert((lptr-pline)<(int)strlen((char*)pline)); /* lptr must STILL point inside the string */
   816   #endif
   817   /* append a special symbol to the string, so the expression
   818    * analyzer won't try to read a next line when it encounters
   819    * an end-of-line
   820    */
   821   assert(strlen((char*)pline)<sLINEMAX);
   822   term=strchr((char*)pline,'\0');
   823   assert(term!=NULL);
   824   chrcat((char*)pline,PREPROC_TERM);    /* the "DEL" code (see SC.H) */
   825   result=constexpr(val,tag,NULL);       /* get value (or 0 on error) */
   826   *term='\0';                           /* erase the token (if still present) */
   827   lexclr(FALSE);                        /* clear any "pushed" tokens */
   828   return result;
   829 }
   830 
   831 /* getstring
   832  * Returns returns a pointer behind the closing quote or to the other
   833  * character that caused the input to be ended.
   834  */
   835 static const unsigned char *getstring(unsigned char *dest,int max,const unsigned char *line)
   836 {
   837   assert(dest!=NULL && line!=NULL);
   838   *dest='\0';
   839   while (*line<=' ' && *line!='\0')
   840     line++;             /* skip whitespace */
   841   if (*line=='"') {
   842     int len=0;
   843     line++;             /* skip " */
   844     while (*line!='"' && *line!='\0') {
   845       if (len<max-1)
   846         dest[len++]=*line;
   847       line++;
   848     } /* if */
   849     dest[len]='\0';
   850     if (*line=='"')
   851       line++;           /* skip closing " */
   852     else
   853       error(37);        /* invalid string */
   854   } else {
   855     error(37);          /* invalid string */
   856   } /* if */
   857   return line;
   858 }
   859 
   860 enum {
   861   CMD_NONE,
   862   CMD_TERM,
   863   CMD_EMPTYLINE,
   864   CMD_CONDFALSE,
   865   CMD_INCLUDE,
   866   CMD_DEFINE,
   867   CMD_IF,
   868   CMD_DIRECTIVE,
   869 };
   870 
   871 /*  command
   872  *
   873  *  Recognizes the compiler directives. The function returns:
   874  *     CMD_NONE         the line must be processed
   875  *     CMD_TERM         a pending expression must be completed before processing further lines
   876  *     Other value: the line must be skipped, because:
   877  *     CMD_CONDFALSE    false "#if.." code
   878  *     CMD_EMPTYLINE    line is empty
   879  *     CMD_INCLUDE      the line contains a #include directive
   880  *     CMD_DEFINE       the line contains a #subst directive
   881  *     CMD_IF           the line contains a #if/#else/#endif directive
   882  *     CMD_DIRECTIVE    the line contains some other compiler directive
   883  *
   884  *  Global variables: iflevel, ifstack (altered)
   885  *                    lptr      (altered)
   886  */
   887 static int command(void)
   888 {
   889   int tok,ret;
   890   cell val;
   891   char *str;
   892   int index;
   893   cell code_index;
   894 
   895   while (*lptr<=' ' && *lptr!='\0')
   896     lptr+=1;
   897   if (*lptr=='\0')
   898     return CMD_EMPTYLINE;       /* empty line */
   899   if (*lptr!='#')
   900     return SKIPPING ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */
   901   /* compiler directive found */
   902   indent_nowarn=TRUE;           /* allow loose indentation" */
   903   lexclr(FALSE);                /* clear any "pushed" tokens */
   904   /* on a pending expression, force to return a silent ';' token and force to
   905    * re-read the line
   906    */
   907   if (!sc_needsemicolon && stgget(&index,&code_index)) {
   908     lptr=term_expr;
   909     return CMD_TERM;
   910   } /* if */
   911   tok=lex(&val,&str);
   912   ret=SKIPPING ? CMD_CONDFALSE : CMD_DIRECTIVE;  /* preset 'ret' to CMD_DIRECTIVE (most common case) */
   913   switch (tok) {
   914   case tpIF:                    /* conditional compilation */
   915     ret=CMD_IF;
   916     assert(iflevel>=0);
   917     if (iflevel>=sCOMP_STACK)
   918       error(122,"Conditional compilation stack"); /* table overflow */
   919     iflevel++;
   920     if (SKIPPING)
   921       break;                    /* break out of switch */
   922     skiplevel=iflevel;
   923     preproc_expr(&val,NULL);    /* get value (or 0 on error) */
   924     ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE);
   925     check_empty(lptr);
   926     break;
   927   case tpELSE:
   928   case tpELSEIF:
   929     ret=CMD_IF;
   930     assert(iflevel>=0);
   931     if (iflevel==0) {
   932       error(26);                /* no matching #if */
   933       errorset(sRESET,0);
   934     } else {
   935       /* check for earlier #else */
   936       if ((ifstack[iflevel-1] & HANDLED_ELSE)==HANDLED_ELSE) {
   937         if (tok==tpELSEIF)
   938           error(61);            /* #elseif directive may not follow an #else */
   939         else
   940           error(60);            /* multiple #else directives between #if ... #endif */
   941         errorset(sRESET,0);
   942       } else {
   943         assert(iflevel>0);
   944         /* if there has been a "parse mode" on this level, set "skip mode",
   945          * otherwise, clear "skip mode"
   946          */
   947         if ((ifstack[iflevel-1] & PARSEMODE)==PARSEMODE) {
   948           /* there has been a parse mode already on this level, so skip the rest */
   949           ifstack[iflevel-1] |= (char)SKIPMODE;
   950           /* if we were already skipping this section, allow expressions with
   951            * undefined symbols; otherwise check the expression to catch errors
   952            */
   953           if (tok==tpELSEIF) {
   954             if (skiplevel==iflevel)
   955               preproc_expr(&val,NULL);  /* get, but ignore the expression */
   956             else
   957               lptr=strchr(lptr,'\0');
   958           } /* if */
   959         } else {
   960           /* previous conditions were all FALSE */
   961           if (tok==tpELSEIF) {
   962             /* if we were already skipping this section, allow expressions with
   963              * undefined symbols; otherwise check the expression to catch errors
   964              */
   965             if (skiplevel==iflevel) {
   966               preproc_expr(&val,NULL);  /* get value (or 0 on error) */
   967             } else {
   968               lptr=strchr(lptr,'\0');
   969               val=0;
   970             } /* if */
   971             ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE);
   972           } else {
   973             /* a simple #else, clear skip mode */
   974             ifstack[iflevel-1] &= (char)~SKIPMODE;
   975           } /* if */
   976         } /* if */
   977       } /* if */
   978     } /* if */
   979     check_empty(lptr);
   980     break;
   981   case tpENDIF:
   982     ret=CMD_IF;
   983     if (iflevel==0){
   984       error(26);        /* no matching "#if" */
   985       errorset(sRESET,0);
   986     } else {
   987       iflevel--;
   988       if (iflevel<skiplevel)
   989         skiplevel=iflevel;
   990     } /* if */
   991     check_empty(lptr);
   992     break;
   993   case tINCLUDE:                /* #include directive */
   994   case tpTRYINCLUDE:
   995     ret=CMD_INCLUDE;
   996     if (!SKIPPING)
   997       doinclude(tok==tpTRYINCLUDE);
   998     break;
   999   case tpFILE:
  1000     if (!SKIPPING) {
  1001       char pathname[_MAX_PATH];
  1002       lptr=getstring((unsigned char*)pathname,sizeof pathname,lptr);
  1003       if (strlen(pathname)>0) {
  1004         free(inpfname);
  1005         inpfname=duplicatestring(pathname);
  1006         if (inpfname==NULL)
  1007           error(123);           /* insufficient memory */
  1008         fline=0;
  1009       } /* if */
  1010     } /* if */
  1011     check_empty(lptr);
  1012     break;
  1013   case tpLINE:
  1014     if (!SKIPPING) {
  1015       if (lex(&val,&str)!=tNUMBER)
  1016         error(8);               /* invalid/non-constant expression */
  1017       fline=(int)val;
  1018     } /* if */
  1019     check_empty(lptr);
  1020     break;
  1021   case tpASSERT:
  1022     if (!SKIPPING && (sc_debug & sCHKBOUNDS)!=0) {
  1023       for (str=(char*)lptr; *str<=' ' && *str!='\0'; str++)
  1024         /* nothing */;          /* save start of expression */
  1025       preproc_expr(&val,NULL);  /* get constant expression (or 0 on error) */
  1026       if (!val)
  1027         error(130,str);         /* assertion failed */
  1028       check_empty(lptr);
  1029     } /* if */
  1030     break;
  1031   case tpPRAGMA:
  1032     if (!SKIPPING) {
  1033       if (lex(&val,&str)==tSYMBOL) {
  1034         if (strcmp(str,"amxlimit")==0) {
  1035           preproc_expr(&pc_amxlimit,NULL);
  1036         } else if (strcmp(str,"amxram")==0) {
  1037           preproc_expr(&pc_amxram,NULL);
  1038         } else if (strcmp(str,"codepage")==0) {
  1039           char name[sNAMEMAX+1];
  1040           while (*lptr<=' ' && *lptr!='\0')
  1041             lptr++;
  1042           if (*lptr=='"') {
  1043             lptr=getstring((unsigned char*)name,sizeof name,lptr);
  1044           } else {
  1045             int i;
  1046             for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)
  1047               name[i]=*lptr;
  1048             name[i]='\0';
  1049           } /* if */
  1050           if (!cp_set(name))
  1051             error(128);         /* codepage mapping file not found */
  1052         } else if (strcmp(str,"compress")==0) {
  1053           cell val;
  1054           preproc_expr(&val,NULL);
  1055           sc_compress=(int)val; /* switch code packing on/off */
  1056         } else if (strcmp(str,"ctrlchar")==0) {
  1057           while (*lptr<=' ' && *lptr!='\0')
  1058             lptr++;
  1059           if (*lptr=='\0') {
  1060             sc_ctrlchar=sc_ctrlchar_org;
  1061           } else {
  1062             if (lex(&val,&str)!=tNUMBER)
  1063               error(27);          /* invalid character constant */
  1064             sc_ctrlchar=(char)val;
  1065           } /* if */
  1066         } else if (strcmp(str,"deprecated")==0) {
  1067           while (*lptr<=' ' && *lptr!='\0')
  1068             lptr++;
  1069           pc_deprecate=(char*)malloc(strlen((char*)lptr)+1);
  1070           if (pc_deprecate!=NULL)
  1071             strcpy(pc_deprecate,(char*)lptr);
  1072           lptr=(unsigned char*)strchr((char*)lptr,'\0'); /* skip to end (ignore "extra characters on line") */
  1073         } else if (strcmp(str,"dynamic")==0) {
  1074           preproc_expr(&pc_stksize,NULL);
  1075         } else if (!strcmp(str,"library")
  1076           ||!strcmp(str,"reqclass")
  1077           ||!strcmp(str,"loadlib")
  1078           ||!strcmp(str,"explib")
  1079           ||!strcmp(str,"expclass")
  1080           ||!strcmp(str,"defclasslib")) {
  1081           char name[sNAMEMAX+1],sname[sNAMEMAX+1];
  1082            const char *prefix="";
  1083           sname[0]='\0';
  1084           sname[1]='\0';
  1085           if (!strcmp(str,"library"))
  1086             prefix="??li_";
  1087           else if (!strcmp(str,"reqclass"))
  1088             prefix="??rc_";
  1089           else if (!strcmp(str,"loadlib"))
  1090             prefix="??f_";
  1091           else if (!strcmp(str,"explib"))
  1092             prefix="??el_";
  1093           else if (!strcmp(str,"expclass"))
  1094             prefix="??ec_";
  1095           else if (!strcmp(str,"defclasslib"))
  1096             prefix="??d_";
  1097           while (*lptr<=' ' && *lptr!='\0')
  1098             lptr++;
  1099           if (*lptr=='"') {
  1100             lptr=getstring((unsigned char*)name,sizeof name,lptr);
  1101           } else {
  1102             int i;
  1103             for (i=0; i<sizeof name && (alphanum(*lptr) || *lptr=='-'); i++,lptr++)
  1104               name[i]=*lptr;
  1105             name[i]='\0';
  1106             if (!strncmp(str,"exp",3) || !strncmp(str,"def",3)) {
  1107               while (*lptr && isspace(*lptr))
  1108                 lptr++;
  1109               for (i=1; i<sizeof sname && alphanum(*lptr); i++,lptr++)
  1110                 sname[i]=*lptr;
  1111               sname[i]='\0';
  1112               if (!sname[1]) {
  1113                 error(45);
  1114               } else {
  1115                 sname[0]='_';
  1116               }
  1117             }
  1118           } /* if */
  1119           if (strlen(name)==0) {
  1120             curlibrary=NULL;
  1121           } else if (strcmp(name,"-")==0) {
  1122             pc_addlibtable=FALSE;
  1123           } else {
  1124             /* add the name if it does not yet exist in the table */
  1125             char newname[sNAMEMAX+1];
  1126             if (strlen(name)+strlen(prefix)+strlen(sname)<=sNAMEMAX) {
  1127               strcpy(newname,prefix);
  1128               strcat(newname,name);
  1129               strcat(newname,sname);
  1130               if (find_constval(&libname_tab,newname,0)==NULL) {
  1131                 if (!strcmp(str,"library") || !strcmp(str,"reqclass")) {
  1132                   curlibrary=append_constval(&libname_tab,newname,1,0);
  1133                 } else {
  1134                   append_constval(&libname_tab,newname,1,0);
  1135                 }
  1136               }
  1137             }
  1138           } /* if */
  1139 #if 0	/* more unused */
  1140         } else if (strcmp(str,"pack")==0) {
  1141           cell val;
  1142           preproc_expr(&val,NULL);      /* default = packed/unpacked */
  1143           sc_packstr=(int)val;
  1144 #endif
  1145         } else if (strcmp(str,"rational")==0) {
  1146           char name[sNAMEMAX+1];
  1147           cell digits=0;
  1148           int i;
  1149           /* first gather all information, start with the tag name */
  1150           while (*lptr<=' ' && *lptr!='\0')
  1151             lptr++;
  1152           for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)
  1153             name[i]=*lptr;
  1154           name[i]='\0';
  1155           /* then the precision (for fixed point arithmetic) */
  1156           while (*lptr<=' ' && *lptr!='\0')
  1157             lptr++;
  1158           if (*lptr=='(') {
  1159             preproc_expr(&digits,NULL);
  1160             if (digits<=0 || digits>9) {
  1161               error(68);        /* invalid rational number precision */
  1162               digits=0;
  1163             } /* if */
  1164             if (*lptr==')')
  1165               lptr++;
  1166           } /* if */
  1167           /* add the tag (make it public) and check the values */
  1168           i=pc_addtag(name);
  1169           exporttag(i);
  1170           if (sc_rationaltag==0 || (sc_rationaltag==i && rational_digits==(int)digits)) {
  1171             sc_rationaltag=i;
  1172             rational_digits=(int)digits;
  1173           } else {
  1174             error(69);          /* rational number format already set, can only be set once */
  1175           } /* if */
  1176         } else if (strcmp(str,"semicolon")==0) {
  1177           cell val;
  1178           preproc_expr(&val,NULL);
  1179           sc_needsemicolon=(int)val;
  1180         } else if (strcmp(str,"tabsize")==0) {
  1181           cell val;
  1182           preproc_expr(&val,NULL);
  1183           sc_tabsize=(int)val;
  1184         } else if (strcmp(str,"align")==0) {
  1185           sc_alignnext=TRUE;
  1186         } else if (strcmp(str,"unused")==0) {
  1187           char name[sNAMEMAX+1];
  1188           int i,comma;
  1189           symbol *sym;
  1190           do {
  1191             /* get the name */
  1192             while (*lptr<=' ' && *lptr!='\0')
  1193               lptr++;
  1194             for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)
  1195               name[i]=*lptr;
  1196             name[i]='\0';
  1197             /* get the symbol */
  1198             sym=findloc(name);
  1199             if (sym==NULL)
  1200               sym=findglb(name,sSTATEVAR);
  1201             if (sym!=NULL) {
  1202               sym->usage |= uREAD;
  1203               if (sym->ident==iVARIABLE || sym->ident==iREFERENCE
  1204                   || sym->ident==iARRAY || sym->ident==iREFARRAY)
  1205                 sym->usage |= uWRITTEN;
  1206             } else {
  1207               error(17,name);     /* undefined symbol */
  1208             } /* if */
  1209             /* see if a comma follows the name */
  1210             while (*lptr<=' ' && *lptr!='\0')
  1211               lptr++;
  1212             comma= (*lptr==',');
  1213             if (comma)
  1214               lptr++;
  1215           } while (comma);
  1216         } else {
  1217           error(207);           /* unknown #pragma */
  1218         } /* if */
  1219       } else {
  1220         error(207);             /* unknown #pragma */
  1221       } /* if */
  1222       check_empty(lptr);
  1223     } /* if */
  1224     break;
  1225   case tpENDINPUT:
  1226   case tpENDSCRPT:
  1227     if (!SKIPPING) {
  1228       check_empty(lptr);
  1229       assert(inpf!=NULL);
  1230       if (inpf!=inpf_org)
  1231         pc_closesrc(inpf);
  1232       inpf=NULL;
  1233     } /* if */
  1234     break;
  1235 #if !defined NOEMIT
  1236   case tpEMIT: {
  1237     /* write opcode to output file */
  1238     char name[40];
  1239     int i;
  1240     while (*lptr<=' ' && *lptr!='\0')
  1241       lptr++;
  1242     for (i=0; i<40 && (isalpha(*lptr) || *lptr=='.'); i++,lptr++)
  1243       name[i]=(char)tolower(*lptr);
  1244     name[i]='\0';
  1245     stgwrite("\t");
  1246     stgwrite(name);
  1247     stgwrite(" ");
  1248     code_idx+=opcodes(1);
  1249     /* write parameter (if any) */
  1250     while (*lptr<=' ' && *lptr!='\0')
  1251       lptr++;
  1252     if (*lptr!='\0') {
  1253       symbol *sym;
  1254       tok=lex(&val,&str);
  1255       switch (tok) {
  1256       case tNUMBER:
  1257       case tRATIONAL:
  1258         outval(val,FALSE);
  1259         code_idx+=opargs(1);
  1260         break;
  1261       case tSYMBOL:
  1262         sym=findloc(str);
  1263         if (sym==NULL)
  1264           sym=findglb(str,sSTATEVAR);
  1265         if (sym==NULL || sym->ident!=iFUNCTN && sym->ident!=iREFFUNC && (sym->usage & uDEFINE)==0) {
  1266           error(17,str);        /* undefined symbol */
  1267         } else {
  1268           outval(sym->addr,FALSE);
  1269           /* mark symbol as "used", unknown whether for read or write */
  1270           markusage(sym,uREAD | uWRITTEN);
  1271           code_idx+=opargs(1);
  1272         } /* if */
  1273         break;
  1274       default: {
  1275         char s2[20];
  1276         extern char *sc_tokens[];/* forward declaration */
  1277         if (tok<256)
  1278           sprintf(s2,"%c",(char)tok);
  1279         else
  1280           strcpy(s2,sc_tokens[tok-tFIRST]);
  1281         error(1,sc_tokens[tSYMBOL-tFIRST],s2);
  1282         break;
  1283       } /* case */
  1284       } /* switch */
  1285     } /* if */
  1286     stgwrite("\n");
  1287     check_empty(lptr);
  1288     break;
  1289   } /* case */
  1290 #endif
  1291 #if !defined NO_DEFINE
  1292   case tpDEFINE: {
  1293     ret=CMD_DEFINE;
  1294     if (!SKIPPING) {
  1295       char *pattern,*substitution;
  1296       const unsigned char *start,*end;
  1297       int count,prefixlen;
  1298       stringpair *def;
  1299       /* find the pattern to match */
  1300       while (*lptr<=' ' && *lptr!='\0')
  1301         lptr++;
  1302       start=lptr;       /* save starting point of the match pattern */
  1303       count=0;
  1304       while (*lptr>' ' && *lptr!='\0') {
  1305         litchar(&lptr,0); /* litchar() advances "lptr" and handles escape characters */
  1306         count++;
  1307       } /* while */
  1308       end=lptr;
  1309       /* check pattern to match */
  1310       if (!alpha(*start)) {
  1311         error(74);      /* pattern must start with an alphabetic character */
  1312         break;
  1313       } /* if */
  1314       /* store matched pattern */
  1315       pattern=(char*)malloc(count+1);
  1316       if (pattern==NULL)
  1317         error(123);     /* insufficient memory */
  1318       lptr=start;
  1319       count=0;
  1320       while (lptr!=end) {
  1321         assert(lptr<end);
  1322         assert(*lptr!='\0');
  1323         pattern[count++]=(char)litchar(&lptr,0);
  1324       } /* while */
  1325       pattern[count]='\0';
  1326       /* special case, erase trailing variable, because it could match anything */
  1327       if (count>=2 && isdigit(pattern[count-1]) && pattern[count-2]=='%')
  1328         pattern[count-2]='\0';
  1329       /* find substitution string */
  1330       while (*lptr<=' ' && *lptr!='\0')
  1331         lptr++;
  1332       start=lptr;       /* save starting point of the match pattern */
  1333       count=0;
  1334       end=NULL;
  1335       while (*lptr!='\0') {
  1336         /* keep position of the start of trailing whitespace */
  1337         if (*lptr<=' ') {
  1338           if (end==NULL)
  1339             end=lptr;
  1340         } else {
  1341           end=NULL;
  1342         } /* if */
  1343         count++;
  1344         lptr++;
  1345       } /* while */
  1346       if (end==NULL)
  1347         end=lptr;
  1348       /* store matched substitution */
  1349       substitution=(char*)malloc(count+1);  /* +1 for '\0' */
  1350       if (substitution==NULL)
  1351         error(123);     /* insufficient memory */
  1352       lptr=start;
  1353       count=0;
  1354       while (lptr!=end) {
  1355         assert(lptr<end);
  1356         assert(*lptr!='\0');
  1357         substitution[count++]=*lptr++;
  1358       } /* while */
  1359       substitution[count]='\0';
  1360       /* check whether the definition already exists */
  1361       for (prefixlen=0,start=(unsigned char*)pattern; alphanum(*start); prefixlen++,start++)
  1362         /* nothing */;
  1363       assert(prefixlen>0);
  1364       if ((def=find_subst(pattern,prefixlen))!=NULL) {
  1365         if (strcmp(def->first,pattern)!=0 || strcmp(def->second,substitution)!=0)
  1366           error(201,pattern);   /* redefinition of macro (non-identical) */
  1367         delete_subst(pattern,prefixlen);
  1368       } /* if */
  1369       /* add the pattern/substitution pair to the list */
  1370       assert(strlen(pattern)>0);
  1371       insert_subst(pattern,substitution,prefixlen);
  1372       free(pattern);
  1373       free(substitution);
  1374     } /* if */
  1375     break;
  1376   } /* case */
  1377   case tpUNDEF:
  1378     if (!SKIPPING) {
  1379       if (lex(&val,&str)==tSYMBOL) {
  1380         ret=delete_subst(str,strlen(str));
  1381         if (!ret) {
  1382           /* also undefine normal constants */
  1383           symbol *sym=findconst(str,NULL);
  1384           if (sym!=NULL && (sym->usage & (uENUMROOT | uENUMFIELD))==0) {
  1385             delete_symbol(&glbtab,sym);
  1386             ret=TRUE;
  1387           } /* if */
  1388         } /* if */
  1389         if (!ret)
  1390           error(17,str);        /* undefined symbol */
  1391       } else {
  1392         error(20,str);          /* invalid symbol name */
  1393       } /* if */
  1394       check_empty(lptr);
  1395     } /* if */
  1396     break;
  1397 #endif
  1398   case tpERROR:
  1399     while (*lptr<=' ' && *lptr!='\0')
  1400       lptr++;
  1401     if (!SKIPPING)
  1402       error(131,lptr);  /* user error */
  1403     break;
  1404   default:
  1405     error(31);          /* unknown compiler directive */
  1406     ret=SKIPPING ? CMD_CONDFALSE : CMD_NONE;  /* process as normal line */
  1407   } /* switch */
  1408   return ret;
  1409 }
  1410 
  1411 #if !defined NO_DEFINE
  1412 static int is_startstring(const unsigned char *string)
  1413 {
  1414   if (*string=='\"' || *string=='\'')
  1415     return TRUE;                        /* "..." */
  1416 
  1417   if (*string=='!') {
  1418     string++;
  1419     if (*string=='\"' || *string=='\'')
  1420       return TRUE;                      /* !"..." */
  1421     if (*string==sc_ctrlchar) {
  1422       string++;
  1423       if (*string=='\"' || *string=='\'')
  1424         return TRUE;                    /* !\"..." */
  1425     } /* if */
  1426   } else if (*string==sc_ctrlchar) {
  1427     string++;
  1428     if (*string=='\"' || *string=='\'')
  1429       return TRUE;                      /* \"..." */
  1430     if (*string=='!') {
  1431       string++;
  1432       if (*string=='\"' || *string=='\'')
  1433         return TRUE;                    /* \!"..." */
  1434     } /* if */
  1435   } /* if */
  1436 
  1437   return FALSE;
  1438 }
  1439 
  1440 static const unsigned char *skipstring(const unsigned char *string)
  1441 {
  1442   char endquote;
  1443   int flags=0;
  1444 
  1445   while (*string=='!' || *string==sc_ctrlchar) {
  1446     if (*string==sc_ctrlchar)
  1447       flags=RAWMODE;
  1448     string++;
  1449   } /* while */
  1450 
  1451   endquote=*string;
  1452   assert(endquote=='"' || endquote=='\'');
  1453   string++;             /* skip open quote */
  1454   while (*string!=endquote && *string!='\0')
  1455     litchar(&string,flags);
  1456   return string;
  1457 }
  1458 
  1459 static const unsigned char *skippgroup(const unsigned char *string)
  1460 {
  1461   int nest=0;
  1462   char open=*string;
  1463   char close;
  1464 
  1465   switch (open) {
  1466   case '(':
  1467     close=')';
  1468     break;
  1469   case '{':
  1470     close='}';
  1471     break;
  1472   case '[':
  1473     close=']';
  1474     break;
  1475   case '<':
  1476     close='>';
  1477     break;
  1478   default:
  1479     assert(0);
  1480 	close='\0';         /* only to avoid a compiler warning */
  1481   }/* switch */
  1482 
  1483   string++;
  1484   while (*string!=close || nest>0) {
  1485     if (*string==open)
  1486       nest++;
  1487     else if (*string==close)
  1488       nest--;
  1489     else if (is_startstring(string))
  1490       string=skipstring(string);
  1491     if (*string=='\0')
  1492       break;
  1493     string++;
  1494   } /* while */
  1495   return string;
  1496 }
  1497 
  1498 static char *strdel(char *str,size_t len)
  1499 {
  1500   size_t length=strlen(str);
  1501   if (len>length)
  1502     len=length;
  1503   memmove(str, str+len, length-len+1);  /* include EOS byte */
  1504   return str;
  1505 }
  1506 
  1507 static char *strins(char *dest,char *src,size_t srclen)
  1508 {
  1509   size_t destlen=strlen(dest);
  1510   assert(srclen<=strlen(src));
  1511   memmove(dest+srclen, dest, destlen+1);/* include EOS byte */
  1512   memcpy(dest, src, srclen);
  1513   return dest;
  1514 }
  1515 
  1516 static int substpattern(unsigned char *line,size_t buffersize,char *pattern,char *substitution)
  1517 {
  1518   int prefixlen;
  1519   const unsigned char *p,*s,*e;
  1520   unsigned char *args[10];
  1521   int match,arg,len,argsnum=0;
  1522 
  1523   memset(args,0,sizeof args);
  1524 
  1525   /* check the length of the prefix */
  1526   for (prefixlen=0,s=(unsigned char*)pattern; alphanum(*s); prefixlen++,s++)
  1527     /* nothing */;
  1528   assert(prefixlen>0);
  1529   assert(strncmp((char*)line,pattern,prefixlen)==0);
  1530 
  1531   /* pattern prefix matches; match the rest of the pattern, gather
  1532    * the parameters
  1533    */
  1534   s=line+prefixlen;
  1535   p=(unsigned char*)pattern+prefixlen;
  1536   match=TRUE;         /* so far, pattern matches */
  1537   while (match && *s!='\0' && *p!='\0') {
  1538     if (*p=='%') {
  1539       p++;            /* skip '%' */
  1540       if (isdigit(*p)) {
  1541         arg=*p-'0';
  1542         assert(arg>=0 && arg<=9);
  1543         p++;          /* skip parameter id */
  1544         assert(*p!='\0');
  1545         /* match the source string up to the character after the digit
  1546          * (skipping strings in the process
  1547          */
  1548         e=s;
  1549         while (*e!=*p && *e!='\0' && *e!='\n') {
  1550           if (is_startstring(e))              /* skip strings */
  1551             e=skipstring(e);
  1552           else if (strchr("({[",*e)!=NULL)    /* skip parenthized groups */
  1553             e=skippgroup(e);
  1554           if (*e!='\0')
  1555             e++;      /* skip non-alphapetic character (or closing quote of
  1556                        * a string, or the closing paranthese of a group) */
  1557         } /* while */
  1558         /* store the parameter (overrule any earlier) */
  1559         if (args[arg]!=NULL)
  1560           free(args[arg]);
  1561 		else
  1562           argsnum++;
  1563         len=(int)(e-s);
  1564         args[arg]=(unsigned char*)malloc(len+1);
  1565         if (args[arg]==NULL)
  1566           error(123); /* insufficient memory */
  1567         strlcpy((char*)args[arg],(char*)s,len+1);
  1568         /* character behind the pattern was matched too */
  1569         if (*e==*p) {
  1570           s=e+1;
  1571         } else if (*e=='\n' && *p==';' && *(p+1)=='\0' && !sc_needsemicolon) {
  1572           s=e;    /* allow a trailing ; in the pattern match to end of line */
  1573         } else {
  1574           assert(*e=='\0' || *e=='\n');
  1575           match=FALSE;
  1576           s=e;
  1577         } /* if */
  1578         p++;
  1579       } else {
  1580         match=FALSE;
  1581       } /* if */
  1582     } else if (*p==';' && *(p+1)=='\0' && !sc_needsemicolon) {
  1583       /* source may be ';' or end of the line */
  1584       while (*s<=' ' && *s!='\0')
  1585         s++;          /* skip white space */
  1586       if (*s!=';' && *s!='\0')
  1587         match=FALSE;
  1588       p++;            /* skip the semicolon in the pattern */
  1589     } else {
  1590       cell ch;
  1591       /* skip whitespace between two non-alphanumeric characters, except
  1592        * for two identical symbols
  1593        */
  1594       assert((char*)p>pattern);
  1595       if (!alphanum(*p) && *(p-1)!=*p)
  1596         while (*s<=' ' && *s!='\0')
  1597           s++;                  /* skip white space */
  1598       ch=litchar(&p,0);         /* this increments "p" */
  1599       if (*s!=ch)
  1600         match=FALSE;
  1601       else
  1602         s++;                    /* this character matches */
  1603     } /* if */
  1604   } /* while */
  1605 
  1606   if (match && *p=='\0') {
  1607     /* if the last character to match is an alphanumeric character, the
  1608      * current character in the source may not be alphanumeric
  1609      */
  1610     assert(p>(unsigned char*)pattern);
  1611     if (alphanum(*(p-1)) && alphanum(*s))
  1612       match=FALSE;
  1613   } /* if */
  1614 
  1615   if (match) {
  1616     /* calculate the length of the substituted string */
  1617     for (e=(unsigned char*)substitution,len=0; *e!='\0'; e++) {
  1618       if (*e=='%' && isdigit(*(e+1)) && argsnum) {
  1619         arg=*(e+1)-'0';
  1620         assert(arg>=0 && arg<=9);
  1621         if (args[arg]!=NULL) {
  1622           len+=strlen((char*)args[arg]);
  1623           e++;
  1624         } else {
  1625           len++;
  1626         }
  1627       } else {
  1628         len++;
  1629       } /* if */
  1630     } /* for */
  1631     /* check length of the string after substitution */
  1632     if (strlen((char*)line) + len - (int)(s-line) > buffersize) {
  1633       error(75);      /* line too long */
  1634     } else {
  1635       /* substitute pattern */
  1636       strdel((char*)line,(int)(s-line));
  1637       for (e=(unsigned char*)substitution,s=line; *e!='\0'; e++) {
  1638         if (*e=='%' && isdigit(*(e+1))) {
  1639           arg=*(e+1)-'0';
  1640           assert(arg>=0 && arg<=9);
  1641           if (args[arg]!=NULL) {
  1642             strins((char*)s,(char*)args[arg],strlen((char*)args[arg]));
  1643             s+=strlen((char*)args[arg]);
  1644             e++;
  1645           } else {
  1646             error(236); /* parameter does not exist, incorrect #define pattern */
  1647             strins((char*)s,(char*)e,2);
  1648             s+=2;
  1649           } /* if */
  1650           e++;          /* skip %, digit is skipped later */
  1651         } else if (*e == '"') {
  1652           p=e;
  1653           if (is_startstring(e)) {
  1654             e=skipstring(e);
  1655             strins((char*)s,(char *)p,(e-p+1));
  1656             s+=(e-p+1);
  1657           } else {
  1658             strins((char*)s,(char*)e,1);
  1659             s++;
  1660           }
  1661         } else {
  1662           strins((char*)s,(char*)e,1);
  1663           s++;
  1664         } /* if */
  1665       } /* for */
  1666     } /* if */
  1667   } /* if */
  1668 
  1669   for (arg=0; arg<10; arg++)
  1670     if (args[arg]!=NULL)
  1671       free(args[arg]);
  1672 
  1673   return match;
  1674 }
  1675 
  1676 static void substallpatterns(unsigned char *line,int buffersize)
  1677 {
  1678   unsigned char *start, *end;
  1679   int prefixlen;
  1680   stringpair *subst;
  1681 
  1682   start=line;
  1683   while (*start!='\0') {
  1684     /* find the start of a prefix (skip all non-alphabetic characters),
  1685      * also skip strings
  1686      */
  1687     while (!alpha(*start) && *start!='\0') {
  1688       /* skip strings */
  1689       if (is_startstring(start)) {
  1690         start=(unsigned char *)skipstring(start);
  1691         if (*start=='\0')
  1692           break;        /* abort loop on error */
  1693       } /* if */
  1694       start++;          /* skip non-alphapetic character (or closing quote of a string) */
  1695     } /* while */
  1696     if (*start=='\0')
  1697       break;            /* abort loop on error */
  1698     /* if matching the operator "defined", skip it plus the symbol behind it */
  1699 	if (strncmp((char*)start,"defined",7)==0 && !isalpha((char)*(start+7))) {
  1700       start+=7;         /* skip "defined" */
  1701       /* skip white space & parantheses */
  1702       while (*start<=' ' && *start!='\0' || *start=='(')
  1703         start++;
  1704       /* skip the symbol behind it */
  1705       while (alphanum(*start))
  1706         start++;
  1707       /* drop back into the main loop */
  1708       continue;
  1709     } /* if */
  1710     /* get the prefix (length), look for a matching definition */
  1711     prefixlen=0;
  1712     end=start;
  1713     while (alphanum(*end)) {
  1714       prefixlen++;
  1715       end++;
  1716     } /* while */
  1717     assert(prefixlen>0);
  1718     subst=find_subst((char*)start,prefixlen);
  1719     if (subst!=NULL) {
  1720       /* properly match the pattern and substitute */
  1721       if (!substpattern(start,buffersize-(int)(start-line),subst->first,subst->second))
  1722         start=end;      /* match failed, skip this prefix */
  1723       /* match succeeded: do not update "start", because the substitution text
  1724        * may be matched by other macros
  1725        */
  1726     } else {
  1727       start=end;        /* no macro with this prefix, skip this prefix */
  1728     } /* if */
  1729   } /* while */
  1730 }
  1731 #endif
  1732 
  1733 /*  preprocess
  1734  *
  1735  *  Reads a line by readline() into "pline" and performs basic preprocessing:
  1736  *  deleting comments, skipping lines with false "#if.." code and recognizing
  1737  *  other compiler directives. There is an indirect recursion: lex() calls
  1738  *  preprocess() if a new line must be read, preprocess() calls command(),
  1739  *  which at his turn calls lex() to identify the token.
  1740  *
  1741  *  Global references: lptr     (altered)
  1742  *                     pline    (altered)
  1743  *                     freading (referred to only)
  1744  */
  1745 SC_FUNC void preprocess(void)
  1746 {
  1747   int iscommand;
  1748 
  1749   if (!freading)
  1750     return;
  1751   do {
  1752     readline(pline);
  1753     stripcom(pline);    /* ??? no need for this when reading back from list file (in the second pass) */
  1754     lptr=pline;         /* set "line pointer" to start of the parsing buffer */
  1755     iscommand=command();
  1756     if (iscommand!=CMD_NONE)
  1757       errorset(sRESET,0); /* reset error flag ("panic mode") on empty line or directive */
  1758     #if !defined NO_DEFINE
  1759       if (iscommand==CMD_NONE) {
  1760         assert(lptr!=term_expr);
  1761         substallpatterns(pline,sLINEMAX);
  1762         lptr=pline;       /* reset "line pointer" to start of the parsing buffer */
  1763       } /* if */
  1764     #endif
  1765     if (sc_status==statFIRST && sc_listing && freading
  1766         && (iscommand==CMD_NONE || iscommand==CMD_EMPTYLINE || iscommand==CMD_DIRECTIVE))
  1767     {
  1768       listline++;
  1769       if (fline!=listline) {
  1770         listline=fline;
  1771         setlinedirect(fline);
  1772       } /* if */
  1773       if (iscommand==CMD_EMPTYLINE)
  1774         pc_writeasm(outf,"\n");
  1775       else
  1776         pc_writeasm(outf,(char*)pline);
  1777     } /* if */
  1778   } while (iscommand!=CMD_NONE && iscommand!=CMD_TERM && freading); /* enddo */
  1779 }
  1780 
  1781 static const unsigned char *unpackedstring(const unsigned char *lptr,int flags)
  1782 {
  1783   while (*lptr!='\"' && *lptr!='\0') {
  1784     if (*lptr=='\a') {          /* ignore '\a' (which was inserted at a line concatenation) */
  1785       lptr++;
  1786       continue;
  1787     } /* if */
  1788     litadd(litchar(&lptr,flags | UTF8MODE));  /* litchar() alters "lptr" */
  1789   } /* while */
  1790   litadd(0);                    /* terminate string */
  1791   return lptr;
  1792 }
  1793 
  1794 static const unsigned char *packedstring(const unsigned char *lptr,int flags)
  1795 {
  1796   int i;
  1797   ucell val,c;
  1798 
  1799   i=0; /* start at least significant byte */
  1800   val=0;
  1801   glbstringread=1;
  1802   while (*lptr!='\"' && *lptr!='\0') {
  1803     if (*lptr=='\a') {          /* ignore '\a' (which was inserted at a line concatenation) */
  1804       lptr++;
  1805       continue;
  1806     } /* if */
  1807     c=litchar(&lptr,flags);     /* litchar() alters "lptr" */
  1808     if (c>=(ucell)(1 << sCHARBITS))
  1809       error(43);                /* character constant exceeds range */
  1810     val |= (c << 8*i);
  1811     glbstringread++;
  1812     if (i==sizeof(ucell)-(sCHARBITS/8)) {
  1813       litadd(val);
  1814       val=0;
  1815       i=0;
  1816     } else {
  1817       i=i+1;
  1818     }
  1819   } /* if */
  1820   /* save last code; make sure there is at least one terminating zero character */
  1821   if (i!=0)
  1822     litadd(val);        /* at least one zero character in "val" */
  1823   else
  1824     litadd(0);          /* add full cell of zeros */
  1825   return lptr;
  1826 }
  1827 
  1828 /*  lex(lexvalue,lexsym)        Lexical Analysis
  1829  *
  1830  *  lex() first deletes leading white space, then checks for multi-character
  1831  *  operators, keywords (including most compiler directives), numbers,
  1832  *  labels, symbols and literals (literal characters are converted to a number
  1833  *  and are returned as such). If every check fails, the line must contain
  1834  *  a single-character operator. So, lex() returns this character. In the other
  1835  *  case (something did match), lex() returns the number of the token. All
  1836  *  these tokens have been assigned numbers above 255.
  1837  *
  1838  *  Some tokens have "attributes":
  1839  *     tNUMBER        the value of the number is return in "lexvalue".
  1840  *     tRATIONAL      the value is in IEEE 754 encoding or in fixed point
  1841  *                    encoding in "lexvalue".
  1842  *     tSYMBOL        the first sNAMEMAX characters of the symbol are
  1843  *                    stored in a buffer, a pointer to this buffer is
  1844  *                    returned in "lexsym".
  1845  *     tLABEL         the first sNAMEMAX characters of the label are
  1846  *                    stored in a buffer, a pointer to this buffer is
  1847  *                    returned in "lexsym".
  1848  *     tSTRING        the string is stored in the literal pool, the index
  1849  *                    in the literal pool to this string is stored in
  1850  *                    "lexvalue".
  1851  *
  1852  *  lex() stores all information (the token found and possibly its attribute)
  1853  *  in global variables. This allows a token to be examined twice. If "_pushed"
  1854  *  is true, this information is returned.
  1855  *
  1856  *  Global references: lptr          (altered)
  1857  *                     fline         (referred to only)
  1858  *                     litidx        (referred to only)
  1859  *                     _lextok, _lexval, _lexstr
  1860  *                     _pushed
  1861  */
  1862 
  1863 static int _pushed;
  1864 static int _lextok;
  1865 static cell _lexval;
  1866 static char _lexstr[sLINEMAX+1];
  1867 static int _lexnewline;
  1868 
  1869 SC_FUNC void lexinit(void)
  1870 {
  1871   stkidx=0;             /* index for pushstk() and popstk() */
  1872   iflevel=0;            /* preprocessor: nesting of "#if" is currently 0 */
  1873   skiplevel=0;          /* preprocessor: not currently skipping */
  1874   icomment=0;           /* currently not in a multiline comment */
  1875   _pushed=FALSE;        /* no token pushed back into lex */
  1876   _lexnewline=FALSE;
  1877 }
  1878 
  1879 char *sc_tokens[] = {
  1880          "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
  1881          "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
  1882          "...", "..", "::",
  1883          "assert", "*begin", "break", "case", "cellsof", "chars", "const", "continue", "default",
  1884          "defined", "do", "else", "*end", "enum", "exit", "for", "forward", "funcenum", "functag", "goto",
  1885          "if", "native", "new", "decl", "operator", "public", "return", "sizeof",
  1886          "sleep", "state", "static", "stock", "struct", "switch", "tagof", "*then", "while",
  1887          "#assert", "#define", "#else", "#elseif", "#emit", "#endif", "#endinput",
  1888          "#endscript", "#error", "#file", "#if", "#include", "#line", "#pragma",
  1889          "#tryinclude", "#undef",
  1890          ";", ";", "-integer value-", "-rational value-", "-identifier-",
  1891          "-label-", "-string-"
  1892        };
  1893 
  1894 SC_FUNC int lex(cell *lexvalue,char **lexsym)
  1895 {
  1896   int i,toolong,newline,stringflags;
  1897   char **tokptr;
  1898   const unsigned char *starttoken;
  1899 
  1900   if (_pushed) {
  1901     _pushed=FALSE;      /* reset "_pushed" flag */
  1902     *lexvalue=_lexval;
  1903     *lexsym=_lexstr;
  1904     return _lextok;
  1905   } /* if */
  1906 
  1907   _lextok=0;            /* preset all values */
  1908   _lexval=0;
  1909   _lexstr[0]='\0';
  1910   *lexvalue=_lexval;
  1911   *lexsym=_lexstr;
  1912   _lexnewline=FALSE;
  1913   if (!freading)
  1914     return 0;
  1915 
  1916   newline= (lptr==pline);       /* does lptr point to start of line buffer */
  1917   while (*lptr<=' ') {          /* delete leading white space */
  1918     if (*lptr=='\0') {
  1919       preprocess();             /* preprocess resets "lptr" */
  1920       if (!freading)
  1921         return 0;
  1922       if (lptr==term_expr)      /* special sequence to terminate a pending expression */
  1923         return (_lextok=tENDEXPR);
  1924       _lexnewline=TRUE;         /* set this after preprocess(), because
  1925                                  * preprocess() calls lex() recursively */
  1926       newline=TRUE;
  1927     } else {
  1928       lptr+=1;
  1929     } /* if */
  1930   } /* while */
  1931   if (newline) {
  1932     stmtindent=0;
  1933     for (i=0; i<(int)(lptr-pline); i++)
  1934       if (pline[i]=='\t' && sc_tabsize>0)
  1935         stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize);
  1936       else
  1937         stmtindent++;
  1938   } /* if */
  1939 
  1940   i=tFIRST;
  1941   tokptr=sc_tokens;
  1942   while (i<=tMIDDLE) {  /* match multi-character operators */
  1943     if (*lptr==**tokptr && match(*tokptr,FALSE)) {
  1944       _lextok=i;
  1945       if (pc_docexpr)   /* optionally concatenate to documentation string */
  1946         insert_autolist(*tokptr);
  1947       return _lextok;
  1948     } /* if */
  1949     i+=1;
  1950     tokptr+=1;
  1951   } /* while */
  1952   while (i<=tLAST) {    /* match reserved words and compiler directives */
  1953     if (*lptr==**tokptr && match(*tokptr,TRUE)) {
  1954       _lextok=i;
  1955       errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/
  1956       if (pc_docexpr)   /* optionally concatenate to documentation string */
  1957         insert_autolist(*tokptr);
  1958       return _lextok;
  1959     } /* if */
  1960     i+=1;
  1961     tokptr+=1;
  1962   } /* while */
  1963 
  1964   starttoken=lptr;      /* save start pointer (for concatenating to documentation string) */
  1965   if ((i=number(&_lexval,lptr))!=0) {   /* number */
  1966     _lextok=tNUMBER;
  1967     *lexvalue=_lexval;
  1968     lptr+=i;
  1969   } else if ((i=ftoi(&_lexval,lptr))!=0) {
  1970     _lextok=tRATIONAL;
  1971     *lexvalue=_lexval;
  1972     lptr+=i;
  1973   } else if (alpha(*lptr)) {            /* symbol or label */
  1974     /*  Note: only sNAMEMAX characters are significant. The compiler
  1975      *        generates a warning if a symbol exceeds this length.
  1976      */
  1977     _lextok=tSYMBOL;
  1978     i=0;
  1979     toolong=0;
  1980     while (alphanum(*lptr)){
  1981       _lexstr[i]=*lptr;
  1982       lptr+=1;
  1983       if (i<sNAMEMAX)
  1984         i+=1;
  1985       else
  1986         toolong=1;
  1987     } /* while */
  1988     _lexstr[i]='\0';
  1989     if (toolong)
  1990       error(200,_lexstr,sNAMEMAX);  /* symbol too long, truncated to sNAMEMAX chars */
  1991     if (_lexstr[0]==PUBLIC_CHAR && _lexstr[1]=='\0') {
  1992       _lextok=PUBLIC_CHAR;  /* '@' all alone is not a symbol, it is an operator */
  1993     } else if (_lexstr[0]=='_' && _lexstr[1]=='\0') {
  1994       _lextok='_';      /* '_' by itself is not a symbol, it is a placeholder */
  1995     } /* if */
  1996     if (*lptr==':' && *(lptr+1)!=':' && _lextok!=PUBLIC_CHAR) {
  1997       if (sc_allowtags) {
  1998         _lextok=tLABEL; /* it wasn't a normal symbol, it was a label/tagname */
  1999         lptr+=1;        /* skip colon */
  2000       } else if (find_constval(&tagname_tab,_lexstr,0)!=NULL) {
  2001         /* this looks like a tag override (because a tag with this name
  2002          * exists), but tags are not allowed right now, so it is probably an
  2003          * error
  2004          */
  2005         error(220);
  2006       } /* if */
  2007     } /* if */
  2008   } else if (*lptr=='\"' || *lptr==sc_ctrlchar && *(lptr+1)=='\"')
  2009   {                                     /* unpacked string literal */
  2010     _lextok=tSTRING;
  2011     stringflags= (*lptr==sc_ctrlchar) ? RAWMODE : 0;
  2012     *lexvalue=_lexval=litidx;
  2013     lptr+=1;            /* skip double quote */
  2014     if ((stringflags & RAWMODE)!=0)
  2015       lptr+=1;          /* skip "escape" character too */
  2016     /* Note that this should always be packedstring() for SourcePawn */
  2017     lptr=sc_packstr ? packedstring(lptr,stringflags) : unpackedstring(lptr,stringflags);
  2018     if (*lptr=='\"')
  2019       lptr+=1;          /* skip final quote */
  2020     else
  2021       error(37);        /* invalid (non-terminated) string */
  2022   } else if (*lptr=='!' && *(lptr+1)=='\"'
  2023              || *lptr=='!' && *(lptr+1)==sc_ctrlchar && *(lptr+2)=='\"'
  2024              || *lptr==sc_ctrlchar && *(lptr+1)=='!' && *(lptr+2)=='\"')
  2025   {                                     /* packed string literal */
  2026     _lextok=tSTRING;
  2027     stringflags= (*lptr==sc_ctrlchar || *(lptr+1)==sc_ctrlchar) ? RAWMODE : 0;
  2028     *lexvalue=_lexval=litidx;
  2029     lptr+=2;            /* skip exclamation point and double quote */
  2030     if ((stringflags & RAWMODE)!=0)
  2031       lptr+=1;          /* skip "escape" character too */
  2032     lptr=sc_packstr ? unpackedstring(lptr,stringflags) : packedstring(lptr,stringflags);
  2033     if (*lptr=='\"')
  2034       lptr+=1;          /* skip final quote */
  2035     else
  2036       error(37);        /* invalid (non-terminated) string */
  2037   } else if (*lptr=='\'') {             /* character literal */
  2038     lptr+=1;            /* skip quote */
  2039     _lextok=tNUMBER;
  2040     *lexvalue=_lexval=litchar(&lptr,UTF8MODE);
  2041     if (*lptr=='\'')
  2042       lptr+=1;          /* skip final quote */
  2043     else
  2044       error(27);        /* invalid character constant (must be one character) */
  2045   } else if (*lptr==';') {      /* semicolumn resets "error" flag */
  2046     _lextok=';';
  2047     lptr+=1;
  2048     errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/
  2049   } else {
  2050     _lextok=*lptr;      /* if every match fails, return the character */
  2051     lptr+=1;            /* increase the "lptr" pointer */
  2052   } /* if */
  2053 
  2054   if (pc_docexpr) {     /* optionally concatenate to documentation string */
  2055     char *docstr=(char*)malloc(((int)(lptr-starttoken)+1)*sizeof(char));
  2056     if (docstr!=NULL) {
  2057       strlcpy(docstr,(char*)starttoken,(int)(lptr-starttoken)+1);
  2058       insert_autolist(docstr);
  2059       free(docstr);
  2060     } /* if */
  2061   } /* if */
  2062   return _lextok;
  2063 }
  2064 
  2065 /*  lexpush
  2066  *
  2067  *  Pushes a token back, so the next call to lex() will return the token
  2068  *  last examined, instead of a new token.
  2069  *
  2070  *  Only one token can be pushed back.
  2071  *
  2072  *  In fact, lex() already stores the information it finds into global
  2073  *  variables, so all that is to be done is set a flag that informs lex()
  2074  *  to read and return the information from these variables, rather than
  2075  *  to read in a new token from the input file.
  2076  */
  2077 SC_FUNC void lexpush(void)
  2078 {
  2079   assert(_pushed==FALSE);
  2080   _pushed=TRUE;
  2081 }
  2082 
  2083 /*  lexclr
  2084  *
  2085  *  Sets the variable "_pushed" to 0 to make sure lex() will read in a new
  2086  *  symbol (a not continue with some old one). This is required upon return
  2087  *  from Assembler mode, and in a few cases after detecting an syntax error.
  2088  */
  2089 SC_FUNC void lexclr(int clreol)
  2090 {
  2091   _pushed=FALSE;
  2092   if (clreol) {
  2093     lptr=(unsigned char*)strchr((char*)pline,'\0');
  2094     assert(lptr!=NULL);
  2095   } /* if */
  2096 }
  2097 
  2098 /*  matchtoken
  2099  *
  2100  *  This routine is useful if only a simple check is needed. If the token
  2101  *  differs from the one expected, it is pushed back.
  2102  *  This function returns 1 for "token found" and 2 for "implied statement
  2103  *  termination token" found --the statement termination is an end of line in
  2104  *  an expression where there is no pending operation. Such an implied token
  2105  *  (i.e. not present in the source code) should not be pushed back, which is
  2106  *  why it is sometimes important to distinguish the two.
  2107  */
  2108 SC_FUNC int matchtoken(int token)
  2109 {
  2110   cell val;
  2111   char *str;
  2112   int tok;
  2113 
  2114   tok=lex(&val,&str);
  2115   if (tok==token || token==tTERM && (tok==';' || tok==tENDEXPR)) {
  2116     return 1;
  2117   } else if (!sc_needsemicolon && token==tTERM && (_lexnewline || !freading)) {
  2118     /* Push "tok" back, because it is the token following the implicit statement
  2119      * termination (newline) token.
  2120      */
  2121     lexpush();
  2122     return 2;
  2123   } else {
  2124     lexpush();
  2125     return 0;
  2126   } /* if */
  2127 }
  2128 
  2129 /*  tokeninfo
  2130  *
  2131  *  Returns additional information of a token after using "matchtoken()"
  2132  *  or needtoken(). It does no harm using this routine after a call to
  2133  *  "lex()", but lex() already returns the same information.
  2134  *
  2135  *  The token itself is the return value. Normally, this one is already known.
  2136  */
  2137 SC_FUNC int tokeninfo(cell *val,char **str)
  2138 {
  2139   /* if the token was pushed back, tokeninfo() returns the token and
  2140    * parameters of the *next* token, not of the *current* token.
  2141    */
  2142   assert(!_pushed);
  2143   *val=_lexval;
  2144   *str=_lexstr;
  2145   return _lextok;
  2146 }
  2147 
  2148 /*  needtoken
  2149  *
  2150  *  This routine checks for a required token and gives an error message if
  2151  *  it isn't there (and returns 0/FALSE in that case). Like function matchtoken(),
  2152  *  this function returns 1 for "token found" and 2 for "statement termination
  2153  *  token" found; see function matchtoken() for details.
  2154  *
  2155  *  Global references: _lextok;
  2156  */
  2157 SC_FUNC int needtoken(int token)
  2158 {
  2159   char s1[20],s2[20];
  2160   int t;
  2161 
  2162   if ((t=matchtoken(token))!=0) {
  2163     return t;
  2164   } else {
  2165     /* token already pushed back */
  2166     assert(_pushed);
  2167     if (token<256)
  2168       sprintf(s1,"%c",(char)token);        /* single character token */
  2169     else
  2170       strcpy(s1,sc_tokens[token-tFIRST]);  /* multi-character symbol */
  2171     if (!freading)
  2172       strcpy(s2,"-end of file-");
  2173     else if (_lextok<256)
  2174       sprintf(s2,"%c",(char)_lextok);
  2175     else
  2176       strcpy(s2,sc_tokens[_lextok-tFIRST]);
  2177     error(1,s1,s2);     /* expected ..., but found ... */
  2178     return FALSE;
  2179   } /* if */
  2180 }
  2181 
  2182 /*  match
  2183  *
  2184  *  Compares a series of characters from the input file with the characters
  2185  *  in "st" (that contains a token). If the token on the input file matches
  2186  *  "st", the input file pointer "lptr" is adjusted to point to the next
  2187  *  token, otherwise "lptr" remains unaltered.
  2188  *
  2189  *  If the parameter "end: is true, match() requires that the first character
  2190  *  behind the recognized token is non-alphanumeric.
  2191  *
  2192  *  Global references: lptr   (altered)
  2193  */
  2194 static int match(char *st,int end)
  2195 {
  2196   int k;
  2197   const unsigned char *ptr;
  2198 
  2199   k=0;
  2200   ptr=lptr;
  2201   while (st[k]) {
  2202     if ((unsigned char)st[k]!=*ptr)
  2203       return 0;
  2204     k+=1;
  2205     ptr+=1;
  2206   } /* while */
  2207   if (end) {            /* symbol must terminate with non-alphanumeric char */
  2208     if (alphanum(*ptr))
  2209       return 0;
  2210   } /* if */
  2211   lptr=ptr;     /* match found, skip symbol */
  2212   return 1;
  2213 }
  2214 
  2215 static void chk_grow_litq(void)
  2216 {
  2217   if (litidx>=litmax) {
  2218     cell *p;
  2219 
  2220     litmax+=sDEF_LITMAX;
  2221     p=(cell *)realloc(litq,litmax*sizeof(cell));
  2222     if (p==NULL)
  2223       error(122,"literal table");   /* literal table overflow (fatal error) */
  2224     litq=p;
  2225   } /* if */
  2226 }
  2227 
  2228 /*  litadd
  2229  *
  2230  *  Adds a value at the end of the literal queue. The literal queue is used
  2231  *  for literal strings used in functions and for initializing array variables.
  2232  *
  2233  *  Global references: litidx  (altered)
  2234  *                     litq    (altered)
  2235  */
  2236 SC_FUNC void litadd(cell value)
  2237 {
  2238   chk_grow_litq();
  2239   assert(litidx<litmax);
  2240   litq[litidx++]=value;
  2241 }
  2242 
  2243 /*  litinsert
  2244  *
  2245  *  Inserts a value into the literal queue. This is sometimes necessary for
  2246  *  initializing multi-dimensional arrays.
  2247  *
  2248  *  Global references: litidx  (altered)
  2249  *                     litq    (altered)
  2250  */
  2251 SC_FUNC void litinsert(cell value,int pos)
  2252 {
  2253   chk_grow_litq();
  2254   assert(litidx<litmax);
  2255   assert(pos>=0 && pos<=litidx);
  2256   memmove(litq+(pos+1),litq+pos,(litidx-pos)*sizeof(cell));
  2257   litidx++;
  2258   litq[pos]=value;
  2259 }
  2260 
  2261 /*  litchar
  2262  *
  2263  *  Return current literal character and increase the pointer to point
  2264  *  just behind this literal character.
  2265  *
  2266  *  Note: standard "escape sequences" are suported, but the backslash may be
  2267  *        replaced by another character; the syntax '\ddd' is supported,
  2268  *        but ddd must be decimal!
  2269  */
  2270 static cell litchar(const unsigned char **lptr,int flags)
  2271 {
  2272   cell c=0;
  2273   const unsigned char *cptr;
  2274 
  2275   cptr=*lptr;
  2276   if ((flags & RAWMODE)!=0 || *cptr!=sc_ctrlchar) {  /* no escape character */
  2277     #if !defined NO_UTF8
  2278       if (sc_is_utf8 && (flags & UTF8MODE)!=0) {
  2279         c=get_utf8_char(cptr,&cptr);
  2280         assert(c>=0);   /* file was already scanned for conformance to UTF-8 */
  2281       } else {
  2282     #endif
  2283       #if !defined NO_CODEPAGE
  2284         c=cp_translate(cptr,&cptr);
  2285       #else
  2286         c=*cptr;
  2287         cptr+=1;
  2288       #endif
  2289     #if !defined NO_UTF8
  2290       } /* if */
  2291     #endif
  2292   } else {
  2293     cptr+=1;
  2294     if (*cptr==sc_ctrlchar) {
  2295       c=*cptr;          /* \\ == \ (the escape character itself) */
  2296       cptr+=1;
  2297     } else {
  2298       switch (*cptr) {
  2299       case 'a':         /* \a == audible alarm */
  2300         c=7;
  2301         cptr+=1;
  2302         break;
  2303       case 'b':         /* \b == backspace */
  2304         c=8;
  2305         cptr+=1;
  2306         break;
  2307       case 'e':         /* \e == escape */
  2308         c=27;
  2309         cptr+=1;
  2310         break;
  2311       case 'f':         /* \f == form feed */
  2312         c=12;
  2313         cptr+=1;
  2314         break;
  2315       case 'n':         /* \n == NewLine character */
  2316         c=10;
  2317         cptr+=1;
  2318         break;
  2319       case 'r':         /* \r == carriage return */
  2320         c=13;
  2321         cptr+=1;
  2322         break;
  2323       case 't':         /* \t == horizontal TAB */
  2324         c=9;
  2325         cptr+=1;
  2326         break;
  2327       case 'v':         /* \v == vertical TAB */
  2328         c=11;
  2329         cptr+=1;
  2330         break;
  2331       case 'x':
  2332       {
  2333         int digits = 0;
  2334         cptr+=1;
  2335         c=0;
  2336         while (ishex(*cptr) && digits < 2) {
  2337           if (isdigit(*cptr))
  2338             c=(c<<4)+(*cptr-'0');
  2339           else
  2340             c=(c<<4)+(tolower(*cptr)-'a'+10);
  2341           cptr++;
  2342           digits++;
  2343         } /* while */
  2344         if (*cptr==';')
  2345           cptr++;       /* swallow a trailing ';' */
  2346         break;
  2347       }
  2348       case '\'':        /* \' == ' (single quote) */
  2349       case '"':         /* \" == " (single quote) */
  2350       case '%':         /* \% == % (percent) */
  2351         c=*cptr;
  2352         cptr+=1;
  2353         break;
  2354       default:
  2355         if (isdigit(*cptr)) {   /* \ddd */
  2356           c=0;
  2357           while (*cptr>='0' && *cptr<='9')  /* decimal! */
  2358             c=c*10 + *cptr++ - '0';
  2359           if (*cptr==';')
  2360             cptr++;     /* swallow a trailing ';' */
  2361         } else {
  2362           error(27);    /* invalid character constant */
  2363         } /* if */
  2364       } /* switch */
  2365     } /* if */
  2366   } /* if */
  2367   *lptr=cptr;
  2368   assert(c>=0);
  2369   return c;
  2370 }
  2371 
  2372 /*  alpha
  2373  *
  2374  *  Test if character "c" is alphabetic ("a".."z"), an underscore ("_")
  2375  *  or an "at" sign ("@"). The "@" is an extension to standard C.
  2376  */
  2377 static int alpha(char c)
  2378 {
  2379   return (isalpha(c) || c=='_' || c==PUBLIC_CHAR);
  2380 }
  2381 
  2382 /*  alphanum
  2383  *
  2384  *  Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")
  2385  */
  2386 SC_FUNC int alphanum(char c)
  2387 {
  2388   return (alpha(c) || isdigit(c));
  2389 }
  2390 
  2391 /*  ishex
  2392  *
  2393  *  Test if character "c" is a hexadecimal digit ("0".."9" or "a".."f").
  2394  */
  2395 SC_FUNC int ishex(char c)
  2396 {
  2397   return (c>='0' && c<='9') || (c>='a' && c<='f') || (c>='A' && c<='F');
  2398 }
  2399 
  2400 /* The local variable table must be searched backwards, so that the deepest
  2401  * nesting of local variables is searched first. The simplest way to do
  2402  * this is to insert all new items at the head of the list.
  2403  * In the global list, the symbols are kept in sorted order, so that the
  2404  * public functions are written in sorted order.
  2405  */
  2406 static symbol *add_symbol(symbol *root,symbol *entry,int sort)
  2407 {
  2408   symbol *newsym;
  2409 
  2410   if (sort)
  2411     while (root->next!=NULL && strcmp(entry->name,root->next->name)>0)
  2412       root=root->next;
  2413 
  2414   if ((newsym=(symbol *)malloc(sizeof(symbol)))==NULL) {
  2415     error(123);
  2416     return NULL;
  2417   } /* if */
  2418   memcpy(newsym,entry,sizeof(symbol));
  2419   newsym->next=root->next;
  2420   root->next=newsym;
  2421   return newsym;
  2422 }
  2423 
  2424 static void free_symbol(symbol *sym)
  2425 {
  2426   arginfo *arg;
  2427 
  2428   /* free all sub-symbol allocated memory blocks, depending on the
  2429    * kind of the symbol
  2430    */
  2431   assert(sym!=NULL);
  2432   if (sym->ident==iFUNCTN) {
  2433     /* run through the argument list; "default array" arguments
  2434      * must be freed explicitly; the tag list must also be freed */
  2435     assert(sym->dim.arglist!=NULL);
  2436     for (arg=sym->dim.arglist; arg->ident!=0; arg++) {
  2437       if (arg->ident==iREFARRAY && arg->hasdefault)
  2438         free(arg->defvalue.array.data);
  2439       else if (arg->ident==iVARIABLE
  2440                && ((arg->hasdefault & uSIZEOF)!=0 || (arg->hasdefault & uTAGOF)!=0))
  2441         free(arg->defvalue.size.symname);
  2442       assert(arg->tags!=NULL);
  2443       free(arg->tags);
  2444     } /* for */
  2445     free(sym->dim.arglist);
  2446     if (sym->states!=NULL) {
  2447       delete_consttable(sym->states);
  2448       free(sym->states);
  2449     } /* if */
  2450   } else if (sym->ident==iVARIABLE || sym->ident==iARRAY) {
  2451     if (sym->states!=NULL) {
  2452       delete_consttable(sym->states);
  2453       free(sym->states);
  2454     } /* if */
  2455   } else if (sym->ident==iCONSTEXPR && (sym->usage & uENUMROOT)==uENUMROOT) {
  2456     /* free the constant list of an enum root */
  2457     assert(sym->dim.enumlist!=NULL);
  2458     delete_consttable(sym->dim.enumlist);
  2459     free(sym->dim.enumlist);
  2460   } /* if */
  2461   assert(sym->refer!=NULL);
  2462   free(sym->refer);
  2463   if (sym->documentation!=NULL)
  2464     free(sym->documentation);
  2465   free(sym);
  2466 }
  2467 
  2468 SC_FUNC void delete_symbol(symbol *root,symbol *sym)
  2469 {
  2470   /* find the symbol and its predecessor
  2471    * (this function assumes that you will never delete a symbol that is not
  2472    * in the table pointed at by "root")
  2473    */
  2474   assert(root!=sym);
  2475   while (root->next!=sym) {
  2476     root=root->next;
  2477     assert(root!=NULL);
  2478   } /* while */
  2479 
  2480   /* unlink it, then free it */
  2481   root->next=sym->next;
  2482   free_symbol(sym);
  2483 }
  2484 
  2485 SC_FUNC void delete_symbols(symbol *root,int level,int delete_labels,int delete_functions)
  2486 {
  2487   symbol *sym,*parent_sym;
  2488   constvalue *stateptr;
  2489   int mustdelete;
  2490 
  2491   /* erase only the symbols with a deeper nesting level than the
  2492    * specified nesting level */
  2493   while (root->next!=NULL) {
  2494     sym=root->next;
  2495     if (sym->compound<level)
  2496       break;
  2497     switch (sym->ident) {
  2498     case iLABEL:
  2499       mustdelete=delete_labels;
  2500       break;
  2501     case iVARIABLE:
  2502     case iARRAY:
  2503       /* do not delete global variables if functions are preserved */
  2504       mustdelete=delete_functions;
  2505       break;
  2506     case iREFERENCE:
  2507       /* always delete references (only exist as function parameters) */
  2508       mustdelete=TRUE;
  2509       break;
  2510     case iREFARRAY:
  2511       /* a global iREFARRAY symbol is the return value of a function: delete
  2512        * this only if "globals" must be deleted; other iREFARRAY instances
  2513        * (locals) are also deleted
  2514        */
  2515       mustdelete=delete_functions;
  2516       for (parent_sym=sym->parent; parent_sym!=NULL && parent_sym->ident!=iFUNCTN; parent_sym=parent_sym->parent)
  2517         assert(parent_sym->ident==iREFARRAY);
  2518       assert(parent_sym==NULL || (parent_sym->ident==iFUNCTN && parent_sym->parent==NULL));
  2519       if (parent_sym==NULL || parent_sym->ident!=iFUNCTN)
  2520         mustdelete=TRUE;
  2521       break;
  2522     case iCONSTEXPR:
  2523       /* delete constants, except predefined constants */
  2524       mustdelete=delete_functions || (sym->usage & uPREDEF)==0;
  2525       break;
  2526     case iFUNCTN:
  2527       /* optionally preserve globals (variables & functions), but
  2528        * NOT native functions
  2529        */
  2530       mustdelete=delete_functions || (sym->usage & uNATIVE)!=0;
  2531       assert(sym->parent==NULL);
  2532       break;
  2533     case iARRAYCELL:
  2534     case iARRAYCHAR:
  2535     case iEXPRESSION:
  2536     case iVARARGS:
  2537     default:
  2538       assert(0);
  2539       break;
  2540     } /* switch */
  2541     if (mustdelete) {
  2542       root->next=sym->next;
  2543       free_symbol(sym);
  2544     } else {
  2545       /* if the function was prototyped, but not implemented in this source,
  2546        * mark it as such, so that its use can be flagged
  2547        */
  2548       if (sym->ident==iFUNCTN && (sym->usage & uDEFINE)==0)
  2549         sym->usage |= uMISSING;
  2550       if (sym->ident==iFUNCTN || sym->ident==iVARIABLE || sym->ident==iARRAY)
  2551         sym->usage &= ~uDEFINE; /* clear "defined" flag */
  2552       /* set all states as "undefined" too */
  2553       if (sym->states!=NULL)
  2554         for (stateptr=sym->states->next; stateptr!=NULL; stateptr=stateptr->next)
  2555           stateptr->value=0;
  2556       /* for user defined operators, also remove the "prototyped" flag, as
  2557        * user-defined operators *must* be declared before use
  2558        */
  2559       if (sym->ident==iFUNCTN && !alpha(*sym->name))
  2560         sym->usage &= ~uPROTOTYPED;
  2561       root=sym;                 /* skip the symbol */
  2562     } /* if */
  2563   } /* if */
  2564 }
  2565 
  2566 /* The purpose of the hash is to reduce the frequency of a "name"
  2567  * comparison (which is costly). There is little interest in avoiding
  2568  * clusters in similar names, which is why this function is plain simple.
  2569  */
  2570 SC_FUNC uint32_t namehash(const char *name)
  2571 {
  2572   const unsigned char *ptr=(const unsigned char *)name;
  2573   int len=strlen(name);
  2574   if (len==0)
  2575     return 0L;
  2576   assert(len<256);
  2577   return (len<<24Lu) + (ptr[0]<<16Lu) + (ptr[len-1]<<8Lu) + (ptr[len>>1Lu]);
  2578 }
  2579 
  2580 static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag)
  2581 {
  2582   symbol *firstmatch=NULL;
  2583   symbol *sym=root->next;
  2584   int count=0;
  2585   unsigned long hash=namehash(name);
  2586   while (sym!=NULL) {
  2587     if (hash==sym->hash && strcmp(name,sym->name)==0        /* check name */
  2588         && (sym->parent==NULL || sym->ident==iCONSTEXPR)    /* sub-types (hierarchical types) are skipped, except for enum fields */
  2589         && (sym->fnumber<0 || sym->fnumber==fnumber))       /* check file number for scope */
  2590     {
  2591       assert(sym->states==NULL || sym->states->next!=NULL); /* first element of the state list is the "root" */
  2592       if (sym->ident==iFUNCTN
  2593           || automaton<0 && sym->states==NULL
  2594           || automaton>=0 && sym->states!=NULL && state_getfsa(sym->states->next->index)==automaton)
  2595       {
  2596         if (cmptag==NULL)
  2597           return sym;   /* return first match */
  2598         /* return closest match or first match; count number of matches */
  2599         if (firstmatch==NULL)
  2600           firstmatch=sym;
  2601         assert(cmptag!=NULL);
  2602         if (*cmptag==0)
  2603           count++;
  2604         if (*cmptag==sym->tag) {
  2605           *cmptag=1;    /* good match found, set number of matches to 1 */
  2606           return sym;
  2607         } /* if */
  2608       } /* if */
  2609     } /*  */
  2610     sym=sym->next;
  2611   } /* while */
  2612   if (cmptag!=NULL && firstmatch!=NULL)
  2613     *cmptag=count;
  2614   return firstmatch;
  2615 }
  2616 
  2617 static symbol *find_symbol_child(const symbol *root,const symbol *sym)
  2618 {
  2619   symbol *ptr=root->next;
  2620   while (ptr!=NULL) {
  2621     if (ptr->parent==sym)
  2622       return ptr;
  2623     ptr=ptr->next;
  2624   } /* while */
  2625   return NULL;
  2626 }
  2627 
  2628 /* Adds "bywhom" to the list of referrers of "entry". Typically,
  2629  * bywhom will be the function that uses a variable or that calls
  2630  * the function.
  2631  */
  2632 SC_FUNC int refer_symbol(symbol *entry,symbol *bywhom)
  2633 {
  2634   int count;
  2635 
  2636   assert(bywhom!=NULL);         /* it makes no sense to add a "void" referrer */
  2637   assert(entry!=NULL);
  2638   assert(entry->refer!=NULL);
  2639 
  2640   /* see if it is already there */
  2641   for (count=0; count<entry->numrefers && entry->refer[count]!=bywhom; count++)
  2642     /* nothing */;
  2643   if (count<entry->numrefers) {
  2644     assert(entry->refer[count]==bywhom);
  2645     return TRUE;
  2646   } /* if */
  2647 
  2648   /* see if there is an empty spot in the referrer list */
  2649   for (count=0; count<entry->numrefers && entry->refer[count]!=NULL; count++)
  2650     /* nothing */;
  2651   assert(count <= entry->numrefers);
  2652   if (count==entry->numrefers) {
  2653     symbol **refer;
  2654     int newsize=2*entry->numrefers;
  2655     assert(newsize>0);
  2656     /* grow the referrer list */
  2657     refer=(symbol**)realloc(entry->refer,newsize*sizeof(symbol*));
  2658     if (refer==NULL)
  2659       return FALSE;             /* insufficient memory */
  2660     /* initialize the new entries */
  2661     entry->refer=refer;
  2662     for (count=entry->numrefers; count<newsize; count++)
  2663       entry->refer[count]=NULL;
  2664     count=entry->numrefers;     /* first empty spot */
  2665     entry->numrefers=newsize;
  2666   } /* if */
  2667 
  2668   /* add the referrer */
  2669   assert(entry->refer[count]==NULL);
  2670   entry->refer[count]=bywhom;
  2671   return TRUE;
  2672 }
  2673 
  2674 SC_FUNC void markusage(symbol *sym,int usage)
  2675 {
  2676   assert(sym!=NULL);
  2677   sym->usage |= (char)usage;
  2678   if ((usage & uWRITTEN)!=0)
  2679     sym->lnumber=fline;
  2680   /* check if (global) reference must be added to the symbol */
  2681   if ((usage & (uREAD | uWRITTEN))!=0) {
  2682     /* only do this for global symbols */
  2683     if (sym->vclass==sGLOBAL) {
  2684       /* "curfunc" should always be valid, since statements may not occurs
  2685        * outside functions; in the case of syntax errors, however, the
  2686        * compiler may arrive through this function
  2687        */
  2688       if (curfunc!=NULL)
  2689         refer_symbol(sym,curfunc);
  2690     } /* if */
  2691   } /* if */
  2692 }
  2693 
  2694 
  2695 /*  findglb
  2696  *
  2697  *  Returns a pointer to the global symbol (if found) or NULL (if not found)
  2698  */
  2699 SC_FUNC symbol *findglb(const char *name,int filter)
  2700 {
  2701   /* find a symbol with a matching automaton first */
  2702   symbol *sym=NULL;
  2703 
  2704   if (filter>sGLOBAL && sc_curstates>0) {
  2705     /* find a symbol whose state list matches the current fsa */
  2706     sym=find_symbol(&glbtab,name,fcurrent,state_getfsa(sc_curstates),NULL);
  2707     if (sym!=NULL && sym->ident!=iFUNCTN) {
  2708       /* if sym!=NULL, we found a variable in the automaton; now we should
  2709        * also verify whether there is an intersection between the symbol's
  2710        * state list and the current state list
  2711        */
  2712       assert(sym->states!=NULL && sym->states->next!=NULL);
  2713       if (!state_conflict_id(sc_curstates,sym->states->next->index))
  2714         sym=NULL;
  2715     } /* if */
  2716   } /* if */
  2717 
  2718   /* if no symbol with a matching automaton exists, find a variable/function
  2719    * that has no state(s) attached to it
  2720    */
  2721   if (sym==NULL)
  2722     sym=find_symbol(&glbtab,name,fcurrent,-1,NULL);
  2723   return sym;
  2724 }
  2725 
  2726 /*  findloc
  2727  *
  2728  *  Returns a pointer to the local symbol (if found) or NULL (if not found).
  2729  *  See add_symbol() how the deepest nesting level is searched first.
  2730  */
  2731 SC_FUNC symbol *findloc(const char *name)
  2732 {
  2733   return find_symbol(&loctab,name,-1,-1,NULL);
  2734 }
  2735 
  2736 SC_FUNC symbol *findconst(const char *name,int *cmptag)
  2737 {
  2738   symbol *sym;
  2739 
  2740   sym=find_symbol(&loctab,name,-1,-1,cmptag);  /* try local symbols first */
  2741   if (sym==NULL || sym->ident!=iCONSTEXPR)     /* not found, or not a constant */
  2742     sym=find_symbol(&glbtab,name,fcurrent,-1,cmptag);
  2743   if (sym==NULL || sym->ident!=iCONSTEXPR)
  2744     return NULL;
  2745   assert(sym->parent==NULL || (sym->usage & uENUMFIELD)!=0);
  2746   /* ^^^ constants have no hierarchy, but enumeration fields may have a parent */
  2747   return sym;
  2748 }
  2749 
  2750 SC_FUNC symbol *finddepend(const symbol *parent)
  2751 {
  2752   symbol *sym;
  2753 
  2754   sym=find_symbol_child(&loctab,parent);    /* try local symbols first */
  2755   if (sym==NULL)                            /* not found */
  2756     sym=find_symbol_child(&glbtab,parent);
  2757   return sym;
  2758 }
  2759 
  2760 /*  addsym
  2761  *
  2762  *  Adds a symbol to the symbol table (either global or local variables,
  2763  *  or global and local constants).
  2764  */
  2765 SC_FUNC symbol *addsym(const char *name,cell addr,int ident,int vclass,int tag,int usage)
  2766 {
  2767   symbol entry, **refer;
  2768 
  2769   /* labels may only be defined once */
  2770   assert(ident!=iLABEL || findloc(name)==NULL);
  2771 
  2772   /* create an empty referrer list */
  2773   if ((refer=(symbol**)malloc(sizeof(symbol*)))==NULL) {
  2774     error(123);         /* insufficient memory */
  2775     return NULL;
  2776   } /* if */
  2777   *refer=NULL;
  2778 
  2779   /* first fill in the entry */
  2780   memset(&entry,0,sizeof entry);
  2781   strcpy(entry.name,name);
  2782   entry.hash=namehash(name);
  2783   entry.addr=addr;
  2784   entry.codeaddr=code_idx;
  2785   entry.vclass=(char)vclass;
  2786   entry.ident=(char)ident;
  2787   entry.tag=tag;
  2788   entry.usage=(char)usage;
  2789   entry.fnumber=-1;     /* assume global visibility (ignored for local symbols) */
  2790   entry.lnumber=fline;
  2791   entry.numrefers=1;
  2792   entry.refer=refer;
  2793 
  2794   /* then insert it in the list */
  2795   if (vclass==sGLOBAL)
  2796     return add_symbol(&glbtab,&entry,TRUE);
  2797   else
  2798     return add_symbol(&loctab,&entry,FALSE);
  2799 }
  2800 
  2801 SC_FUNC symbol *addvariable(const char *name,cell addr,int ident,int vclass,int tag,
  2802                             int dim[],int numdim,int idxtag[])
  2803 {
  2804   return addvariable2(name,addr,ident,vclass,tag,dim,numdim,idxtag,0);
  2805 }
  2806 
  2807 SC_FUNC symbol *addvariable2(const char *name,cell addr,int ident,int vclass,int tag,
  2808                             int dim[],int numdim,int idxtag[],int slength)
  2809 {
  2810   symbol *sym;
  2811 
  2812   /* global variables may only be defined once
  2813    * One complication is that functions returning arrays declare an array
  2814    * with the same name as the function, so the assertion must allow for
  2815    * this special case. Another complication is that variables may be
  2816    * "redeclared" if they are local to an automaton (and findglb() will find
  2817    * the symbol without states if no symbol with states exists).
  2818    */
  2819   assert(vclass!=sGLOBAL || (sym=findglb(name,sGLOBAL))==NULL || (sym->usage & uDEFINE)==0
  2820          || sym->ident==iFUNCTN && sym==curfunc
  2821          || sym->states==NULL && sc_curstates>0);
  2822 
  2823   if (ident==iARRAY || ident==iREFARRAY) {
  2824     symbol *parent=NULL,*top;
  2825     int level;
  2826     sym=NULL;                   /* to avoid a compiler warning */
  2827     for (level=0; level<numdim; level++) {
  2828       top=addsym(name,addr,ident,vclass,tag,uDEFINE);
  2829       top->dim.array.length=dim[level];
  2830       if (tag == pc_tag_string && level == numdim - 1) {
  2831         if (slength == 0)
  2832           top->dim.array.length=dim[level] * sizeof(cell);
  2833         else
  2834           top->dim.array.slength=slength;
  2835       } else {
  2836         top->dim.array.slength=0;
  2837       }
  2838       top->dim.array.level=(short)(numdim-level-1);
  2839       top->x.tags.index=idxtag[level];
  2840       top->parent=parent;
  2841       parent=top;
  2842       if (level==0)
  2843         sym=top;
  2844     } /* for */
  2845   } else {
  2846     sym=addsym(name,addr,ident,vclass,tag,uDEFINE);
  2847   } /* if */
  2848   return sym;
  2849 }
  2850 
  2851 /*  getlabel
  2852  *
  2853  *  Returns te next internal label number. The global variable sc_labnum is
  2854  *  initialized to zero.
  2855  */
  2856 SC_FUNC int getlabel(void)
  2857 {
  2858   return sc_labnum++;
  2859 }
  2860 
  2861 /*  itoh
  2862  *
  2863  *  Converts a number to a hexadecimal string and returns a pointer to that
  2864  *  string. This function is NOT re-entrant.
  2865  */
  2866 SC_FUNC char *itoh(ucell val)
  2867 {
  2868 static char itohstr[30];
  2869   char *ptr;
  2870   int i,nibble[16];             /* a 64-bit hexadecimal cell has 16 nibbles */
  2871   int max;
  2872 
  2873   #if PAWN_CELL_SIZE==16
  2874     max=4;
  2875   #elif PAWN_CELL_SIZE==32
  2876     max=8;
  2877   #elif PAWN_CELL_SIZE==64
  2878     max=16;
  2879   #else
  2880     #error Unsupported cell size
  2881   #endif
  2882   ptr=itohstr;
  2883   for (i=0; i<max; i+=1){
  2884     nibble[i]=(int)(val & 0x0f);        /* nibble 0 is lowest nibble */
  2885     val>>=4;
  2886   } /* endfor */
  2887   i=max-1;
  2888   while (nibble[i]==0 && i>0)   /* search for highest non-zero nibble */
  2889     i-=1;
  2890   while (i>=0){
  2891     if (nibble[i]>=10)
  2892       *ptr++=(char)('a'+(nibble[i]-10));
  2893     else
  2894       *ptr++=(char)('0'+nibble[i]);
  2895     i-=1;
  2896   } /* while */
  2897   *ptr='\0';            /* and a zero-terminator */
  2898   return itohstr;
  2899 }
  2900