sourcemod-central: sourcepawn/compiler/sc2.c@6908e80a69af

     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 #include "sp_symhash.h"

    36 #if defined FORTIFY

    37   #include <alloc/fortify.h>

    38 #endif

    40 /* flags for litchar() */

    41 #define RAWMODE         1

    42 #define UTF8MODE        2

    43 static cell litchar(const unsigned char **lptr,int flags);

    44 static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag);

    46 static void substallpatterns(unsigned char *line,int buffersize);

    47 static int match(char *st,int end);

    48 static int alpha(char c);

    50 #define SKIPMODE      1 /* bit field in "#if" stack */

    51 #define PARSEMODE     2 /* bit field in "#if" stack */

    52 #define HANDLED_ELSE  4 /* bit field in "#if" stack */

    53 #define SKIPPING      (skiplevel>0 && (ifstack[skiplevel-1] & SKIPMODE)==SKIPMODE)

    55 static short icomment;  /* currently in multiline comment? */

    56 static char ifstack[sCOMP_STACK]; /* "#if" stack */

    57 static short iflevel;   /* nesting level if #if/#else/#endif */

    58 static short skiplevel; /* level at which we started skipping (including nested #if .. #endif) */

    59 static unsigned char term_expr[] = "";

    60 static int listline=-1; /* "current line" for the list file */

    62 #if defined DARWIN

    63 static double pow10(double d)

    64 {

    65   return pow(10, d);

    66 }

    67 #endif

    70 /*  pushstk & popstk

    71  *

    72  *  Uses a LIFO stack to store information. The stack is used by doinclude(),

    73  *  doswitch() (to hold the state of "swactive") and some other routines.

    74  *

    75  *  Porting note: I made the bold assumption that an integer will not be

    76  *  larger than a pointer (it may be smaller). That is, the stack element

    77  *  is typedef'ed as a pointer type, but I also store integers on it. See

    78  *  SC.H for "stkitem"

    79  *

    80  *  Global references: stack,stkidx,stktop (private to pushstk(), popstk()

    81  *                     and clearstk())

    82  */

    83 static stkitem *stack=NULL;

    84 static int stkidx=0,stktop=0;

    86 SC_FUNC void pushstk(stkitem val)

    87 {

    88   assert(stkidx<=stktop);

    89   if (stkidx==stktop) {

    90     stkitem *newstack;

    91     int newsize= (stktop==0) ? 16 : 2*stktop;

    92     /* try to resize the stack */

    93     assert(newsize>stktop);

    94     newstack=(stkitem*)malloc(newsize*sizeof(stkitem));

    95     if (newstack==NULL)

    96       error(122,"parser stack");  /* stack overflow (recursive include?) */

    97     /* swap the stacks */

    98     memcpy(newstack,stack,stkidx*sizeof(stkitem));

    99     if (stack!=NULL)

   100       free(stack);

   101     stack=newstack;

   102     stktop=newsize;

   103   } /* if */

   104   assert(stkidx<stktop);

   105   stack[stkidx]=val;

   106   stkidx+=1;

   107 }

   109 SC_FUNC stkitem popstk(void)

   110 {

   111   if (stkidx==0) {

   112     stkitem s;

   113     s.i=-1;             /* stack is empty */

   114     return s;

   115   } /* if */

   116   stkidx--;

   117   assert(stack!=NULL);

   118   return stack[stkidx];

   119 }

   121 SC_FUNC void clearstk(void)

   122 {

   123   assert(stack!=NULL || stktop==0);

   124   if (stack!=NULL) {

   125     free(stack);

   126     stack=NULL;

   127     stktop=0;

   128   } /* if */

   129   assert(stktop==0);

   130 }

   132 SC_FUNC int plungequalifiedfile(char *name)

   133 {

   134 static char *extensions[] = { ".inc", ".p", ".pawn" };

   135   FILE *fp;

   136   char *ext;

   137   int ext_idx;

   139   ext_idx=0;

   140   do {

   141     fp=(FILE*)pc_opensrc(name);

   142     ext=strchr(name,'\0');      /* save position */

   143     if (fp==NULL) {

   144       /* try to append an extension */

   145       strcpy(ext,extensions[ext_idx]);

   146       fp=(FILE*)pc_opensrc(name);

   147       if (fp==NULL)

   148         *ext='\0';              /* on failure, restore filename */

   149     } /* if */

   150     ext_idx++;

   151   } while (fp==NULL && ext_idx<(sizeof extensions / sizeof extensions[0]));

   152   if (fp==NULL) {

   153     *ext='\0';                  /* restore filename */

   154     return FALSE;

   155   } /* if */

   156   PUSHSTK_P(inpf);

   157   PUSHSTK_P(inpfname);          /* pointer to current file name */

   158   PUSHSTK_P(curlibrary);

   159   PUSHSTK_I(iflevel);

   160   assert(!SKIPPING);

   161   assert(skiplevel==iflevel);   /* these two are always the same when "parsing" */

   162   PUSHSTK_I(sc_is_utf8);

   163   PUSHSTK_I(icomment);

   164   PUSHSTK_I(fcurrent);

   165   PUSHSTK_I(fline);

   166   inpfname=duplicatestring(name);/* set name of include file */

   167   if (inpfname==NULL)

   168     error(123);             /* insufficient memory */

   169   inpf=fp;                  /* set input file pointer to include file */

   170   fnumber++;

   171   fline=0;                  /* set current line number to 0 */

   172   fcurrent=fnumber;

   173   icomment=0;               /* not in a comment */

   174   insert_dbgfile(inpfname);

   175   setfiledirect(inpfname);

   176   listline=-1;              /* force a #line directive when changing the file */

   177   sc_is_utf8=(short)scan_utf8(inpf,name);

   178   return TRUE;

   179 }

   181 SC_FUNC int plungefile(char *name,int try_currentpath,int try_includepaths)

   182 {

   183   int result=FALSE;

   185   if (try_currentpath) {

   186     result=plungequalifiedfile(name);

   187     if (!result) {

   188       /* failed to open the file in the active directory, try to open the file

   189        * in the same directory as the current file --but first check whether

   190        * there is a (relative) path for the current file

   191        */

   192       char *ptr;

   193       if ((ptr=strrchr(inpfname,DIRSEP_CHAR))!=0) {

   194         int len=(int)(ptr-inpfname)+1;

   195         if (len+strlen(name)<_MAX_PATH) {

   196           char path[_MAX_PATH];

   197           strlcpy(path,inpfname,len+1);

   198           strlcat(path,name,sizeof path);

   199           result=plungequalifiedfile(path);

   200         } /* if */

   201       } /* if */

   202     } /* if */

   203   } /* if */

   205   if (try_includepaths && name[0]!=DIRSEP_CHAR) {

   206     int i;

   207     char *ptr;

   208     for (i=0; !result && (ptr=get_path(i))!=NULL; i++) {

   209       char path[_MAX_PATH];

   210       strlcpy(path,ptr,sizeof path);

   211       strlcat(path,name,sizeof path);

   212       result=plungequalifiedfile(path);

   213     } /* while */

   214   } /* if */

   215   return result;

   216 }

   218 static void check_empty(const unsigned char *lptr)

   219 {

   220   /* verifies that the string contains only whitespace */

   221   while (*lptr<=' ' && *lptr!='\0')

   222     lptr++;

   223   if (*lptr!='\0')

   224     error(38);          /* extra characters on line */

   225 }

   227 /*  doinclude

   228  *

   229  *  Gets the name of an include file, pushes the old file on the stack and

   230  *  sets some options. This routine doesn't use lex(), since lex() doesn't

   231  *  recognize file names (and directories).

   232  *

   233  *  Global references: inpf     (altered)

   234  *                     inpfname (altered)

   235  *                     fline    (altered)

   236  *                     lptr     (altered)

   237  */

   238 static void doinclude(int silent)

   239 {

   240   char name[_MAX_PATH];

   241   char symname[sNAMEMAX+1];

   242   char *ptr;

   243   char c;

   244   int i, result;

   246   while (*lptr<=' ' && *lptr!='\0')         /* skip leading whitespace */

   247     lptr++;

   248   if (*lptr=='<' || *lptr=='\"'){

   249     c=(char)((*lptr=='\"') ? '\"' : '>');   /* termination character */

   250     lptr++;

   251     while (*lptr<=' ' && *lptr!='\0')       /* skip whitespace after quote */

   252       lptr++;

   253   } else {

   254     c='\0';

   255   } /* if */

   257   i=0;

   258   while (*lptr!=c && *lptr!='\0' && i<sizeof name - 1)  /* find the end of the string */

   259     name[i++]=*lptr++;

   260   while (i>0 && name[i-1]<=' ')

   261     i--;                        /* strip trailing whitespace */

   262   assert(i>=0 && i<sizeof name);

   263   name[i]='\0';                 /* zero-terminate the string */

   265   if (*lptr!=c) {               /* verify correct string termination */

   266     error(37);                  /* invalid string */

   267     return;

   268   } /* if */

   269   if (c!='\0')

   270     check_empty(lptr+1);        /* verify that the rest of the line is whitespace */

   272   result=plungefile(name,(c!='>'),TRUE);

   273   if (!result && !silent)

   274     error(120,name);            /* cannot read from ... (fatal error) */

   275 }

   277 /*  readline

   278  *

   279  *  Reads in a new line from the input file pointed to by "inpf". readline()

   280  *  concatenates lines that end with a \ with the next line. If no more data

   281  *  can be read from the file, readline() attempts to pop off the previous file

   282  *  from the stack. If that fails too, it sets "freading" to 0.

   283  *

   284  *  Global references: inpf,fline,inpfname,freading,icomment (altered)

   285  */

   286 static void readline(unsigned char *line)

   287 {

   288   int i,num,cont;

   289   unsigned char *ptr;

   291   if (lptr==term_expr)

   292     return;

   293   num=sLINEMAX;

   294   cont=FALSE;

   295   do {

   296     if (inpf==NULL || pc_eofsrc(inpf)) {

   297       if (cont)

   298         error(49);        /* invalid line continuation */

   299       if (inpf!=NULL && inpf!=inpf_org)

   300         pc_closesrc(inpf);

   301       i=POPSTK_I();

   302       if (i==-1) {        /* All's done; popstk() returns "stack is empty" */

   303         freading=FALSE;

   304         *line='\0';

   305         /* when there is nothing more to read, the #if/#else stack should

   306          * be empty and we should not be in a comment

   307          */

   308         assert(iflevel>=0);

   309         if (iflevel>0)

   310           error(1,"#endif","-end of file-");

   311         else if (icomment!=0)

   312           error(1,"*/","-end of file-");

   313         return;

   314       } /* if */

   315       fline=i;

   316       fcurrent=(short)POPSTK_I();

   317       icomment=(short)POPSTK_I();

   318       sc_is_utf8=(short)POPSTK_I();

   319       iflevel=(short)POPSTK_I();

   320       skiplevel=iflevel;        /* this condition held before including the file */

   321       assert(!SKIPPING);        /* idem ditto */

   322       curlibrary=(constvalue *)POPSTK_P();

   323       free(inpfname);           /* return memory allocated for the include file name */

   324       inpfname=(char *)POPSTK_P();

   325       inpf=(FILE *)POPSTK_P();

   326       insert_dbgfile(inpfname);

   327       setfiledirect(inpfname);

   328       listline=-1;              /* force a #line directive when changing the file */

   329     } /* if */

   331     if (pc_readsrc(inpf,line,num)==NULL) {

   332       *line='\0';     /* delete line */

   333       cont=FALSE;

   334     } else {

   335       /* check whether to erase leading spaces */

   336       if (cont) {

   337         unsigned char *ptr=line;

   338         while (*ptr<=' ' && *ptr!='\0')

   339           ptr++;

   340         if (ptr!=line)

   341           memmove(line,ptr,strlen((char*)ptr)+1);

   342       } /* if */

   343       cont=FALSE;

   344       /* check whether a full line was read */

   345       if (strchr((char*)line,'\n')==NULL && !pc_eofsrc(inpf))

   346         error(75);      /* line too long */

   347       /* check if the next line must be concatenated to this line */

   348       if ((ptr=(unsigned char*)strchr((char*)line,'\n'))==NULL)

   349         ptr=(unsigned char*)strchr((char*)line,'\r');

   350       if (ptr!=NULL && ptr>line) {

   351         assert(*(ptr+1)=='\0'); /* '\n' or '\r' should be last in the string */

   352         while (ptr>line && *ptr<=' ')

   353           ptr--;        /* skip trailing whitespace */

   354         if (*ptr=='\\') {

   355           cont=TRUE;

   356           /* set '\a' at the position of '\\' to make it possible to check

   357            * for a line continuation in a single line comment (error 49)

   358            */

   359           *ptr++='\a';

   360           *ptr='\0';    /* erase '\n' (and any trailing whitespace) */

   361         } /* if */

   362       } /* if */

   363       num-=strlen((char*)line);

   364       line+=strlen((char*)line);

   365     } /* if */

   366     fline+=1;

   367   } while (num>=0 && cont);

   368 }

   370 /*  stripcom

   371  *

   372  *  Replaces all comments from the line by space characters. It updates

   373  *  a global variable ("icomment") for multiline comments.

   374  *

   375  *  This routine also supports the C++ extension for single line comments.

   376  *  These comments are started with "//" and end at the end of the line.

   377  *

   378  *  The function also detects (and manages) "documentation comments". The

   379  *  global variable "icomment" is set to 2 for documentation comments.

   380  *

   381  *  Global references: icomment  (private to "stripcom")

   382  */

   383 static void stripcom(unsigned char *line)

   384 {

   385   char c;

   386   #if !defined SC_LIGHT

   387     #define COMMENT_LIMIT 100

   388     #define COMMENT_MARGIN 40   /* length of the longest word */

   389     char comment[COMMENT_LIMIT+COMMENT_MARGIN];

   390     int commentidx=0;

   391     int skipstar=TRUE;

   392     static int prev_singleline=FALSE;

   393     int singleline=prev_singleline;

   395     prev_singleline=FALSE;  /* preset */

   396   #endif

   398   while (*line){

   399     if (icomment!=0) {

   400       if (*line=='*' && *(line+1)=='/') {

   401         #if !defined SC_LIGHT

   402           if (icomment==2) {

   403             assert(commentidx<COMMENT_LIMIT+COMMENT_MARGIN);

   404             comment[commentidx]='\0';

   405             if (strlen(comment)>0)

   406               insert_docstring(comment);

   407           } /* if */

   408         #endif

   409         icomment=0;     /* comment has ended */

   410         *line=' ';      /* replace '*' and '/' characters by spaces */

   411         *(line+1)=' ';

   412         line+=2;

   413       } else {

   414         if (*line=='/' && *(line+1)=='*')

   415           error(216);   /* nested comment */

   416         #if !defined SC_LIGHT

   417           /* collect the comment characters in a string */

   418           if (icomment==2) {

   419             if (skipstar && (*line!='\0' && *line<=' ' || *line=='*')) {

   420               /* ignore leading whitespace and '*' characters */

   421             } else if (commentidx<COMMENT_LIMIT+COMMENT_MARGIN-1) {

   422               comment[commentidx++]=(char)((*line!='\n') ? *line : ' ');

   423               if (commentidx>COMMENT_LIMIT && *line!='\0' && *line<=' ') {

   424                 comment[commentidx]='\0';

   425                 insert_docstring(comment);

   426                 commentidx=0;

   427               } /* if */

   428               skipstar=FALSE;

   429             } /* if */

   430           } /* if */

   431         #endif

   432         *line=' ';      /* replace comments by spaces */

   433         line+=1;

   434       } /* if */

   435     } else {

   436       if (*line=='/' && *(line+1)=='*'){

   437         icomment=1;     /* start comment */

   438         #if !defined SC_LIGHT

   439           /* there must be two "*" behind the slash and then white space */

   440           if (*(line+2)=='*' && *(line+3)<=' ') {

   441             /* if we are not in a function, we must attach the previous block

   442              * to the global documentation

   443              */

   444             if (curfunc==NULL && get_docstring(0)!=NULL)

   445               sc_attachdocumentation(NULL);

   446             icomment=2; /* documentation comment */

   447           } /* if */

   448           commentidx=0;

   449           skipstar=TRUE;

   450         #endif

   451         *line=' ';      /* replace '/' and '*' characters by spaces */

   452         *(line+1)=' ';

   453         line+=2;

   454         if (icomment==2)

   455           *line++=' ';

   456       } else if (*line=='/' && *(line+1)=='/'){  /* comment to end of line */

   457         if (strchr((char*)line,'\a')!=NULL)

   458           error(49);    /* invalid line continuation */

   459         #if !defined SC_LIGHT

   460           if (*(line+2)=='/' && *(line+3)<=' ') {

   461             /* documentation comment */

   462             char *str=(char*)line+3;

   463             char *end;

   464             while (*str<=' ' && *str!='\0')

   465               str++;    /* skip leading whitespace */

   466             if ((end=strrchr(str,'\n'))!=NULL)

   467               *end='\0';/* erase trailing '\n' */

   468             /* if there is a disjunct block, we may need to attach the previous

   469              * block to the global documentation

   470              */

   471             if (!singleline && curfunc==NULL && get_docstring(0)!=NULL)

   472               sc_attachdocumentation(NULL);

   473             insert_docstring(str);

   474             prev_singleline=TRUE;

   475           } /* if */

   476         #endif

   477         *line++='\n';   /* put "newline" at first slash */

   478         *line='\0';     /* put "zero-terminator" at second slash */

   479       } else {

   480         if (*line=='\"' || *line=='\''){        /* leave literals unaltered */

   481           c=*line;      /* ending quote, single or double */

   482           line+=1;

   483           while ((*line!=c || *(line-1)==sc_ctrlchar) && *line!='\0')

   484             line+=1;

   485           line+=1;      /* skip final quote */

   486         } else {

   487           line+=1;

   488         } /* if */

   489       } /* if */

   490     } /* if */

   491   } /* while */

   492   #if !defined SC_LIGHT

   493     if (icomment==2) {

   494       assert(commentidx<COMMENT_LIMIT+COMMENT_MARGIN);

   495       comment[commentidx]='\0';

   496       if (strlen(comment)>0)

   497         insert_docstring(comment);

   498     } /* if */

   499   #endif

   500 }

   502 /*  btoi

   503  *

   504  *  Attempts to interpret a numeric symbol as a boolean value. On success

   505  *  it returns the number of characters processed (so the line pointer can be

   506  *  adjusted) and the value is stored in "val". Otherwise it returns 0 and

   507  *  "val" is garbage.

   508  *

   509  *  A boolean value must start with "0b"

   510  */

   511 static int btoi(cell *val,const unsigned char *curptr)

   512 {

   513   const unsigned char *ptr;

   515   *val=0;

   516   ptr=curptr;

   517   if (*ptr=='0' && *(ptr+1)=='b') {

   518     ptr+=2;

   519     while (*ptr=='0' || *ptr=='1' || *ptr=='_') {

   520       if (*ptr!='_')

   521         *val=(*val<<1) | (*ptr-'0');

   522       ptr++;

   523     } /* while */

   524   } else {

   525     return 0;

   526   } /* if */

   527   if (alphanum(*ptr))   /* number must be delimited by non-alphanumeric char */

   528     return 0;

   529   else

   530     return (int)(ptr-curptr);

   531 }

   533 /*  dtoi

   534  *

   535  *  Attempts to interpret a numeric symbol as a decimal value. On success

   536  *  it returns the number of characters processed and the value is stored in

   537  *  "val". Otherwise it returns 0 and "val" is garbage.

   538  */

   539 static int dtoi(cell *val,const unsigned char *curptr)

   540 {

   541   const unsigned char *ptr;

   543   *val=0;

   544   ptr=curptr;

   545   if (!isdigit(*ptr))   /* should start with digit */

   546     return 0;

   547   while (isdigit(*ptr) || *ptr=='_') {

   548     if (*ptr!='_')

   549       *val=(*val*10)+(*ptr-'0');

   550     ptr++;

   551   } /* while */

   552   if (alphanum(*ptr))   /* number must be delimited by non-alphanumerical */

   553     return 0;

   554   if (*ptr=='.' && isdigit(*(ptr+1)))

   555     return 0;           /* but a fractional part must not be present */

   556   return (int)(ptr-curptr);

   557 }

   559 /*  htoi

   560  *

   561  *  Attempts to interpret a numeric symbol as a hexadecimal value. On

   562  *  success it returns the number of characters processed and the value is

   563  *  stored in "val". Otherwise it return 0 and "val" is garbage.

   564  */

   565 static int htoi(cell *val,const unsigned char *curptr)

   566 {

   567   const unsigned char *ptr;

   569   *val=0;

   570   ptr=curptr;

   571   if (!isdigit(*ptr))   /* should start with digit */

   572     return 0;

   573   if (*ptr=='0' && *(ptr+1)=='x') {     /* C style hexadecimal notation */

   574     ptr+=2;

   575     while (ishex(*ptr) || *ptr=='_') {

   576       if (*ptr!='_') {

   577         assert(ishex(*ptr));

   578         *val= *val<<4;

   579         if (isdigit(*ptr))

   580           *val+= (*ptr-'0');

   581         else

   582           *val+= (tolower(*ptr)-'a'+10);

   583       } /* if */

   584       ptr++;

   585     } /* while */

   586   } else {

   587     return 0;

   588   } /* if */

   589   if (alphanum(*ptr))

   590     return 0;

   591   else

   592     return (int)(ptr-curptr);

   593 }

   595 /*  ftoi

   596  *

   597  *  Attempts to interpret a numeric symbol as a rational number, either as

   598  *  IEEE 754 single/double precision floating point or as a fixed point integer.

   599  *  On success it returns the number of characters processed and the value is

   600  *  stored in "val". Otherwise it returns 0 and "val" is unchanged.

   601  *

   602  *  Pawn has stricter definition for rational numbers than most:

   603  *  o  the value must start with a digit; ".5" is not a valid number, you

   604  *     should write "0.5"

   605  *  o  a period must appear in the value, even if an exponent is given; "2e3"

   606  *     is not a valid number, you should write "2.0e3"

   607  *  o  at least one digit must follow the period; "6." is not a valid number,

   608  *     you should write "6.0"

   609  */

   610 static int ftoi(cell *val,const unsigned char *curptr)

   611 {

   612   const unsigned char *ptr;

   613   double fnum,ffrac,fmult;

   614   unsigned long dnum,dbase;

   615   int i, ignore;

   617   assert(rational_digits>=0 && rational_digits<9);

   618   for (i=0,dbase=1; i<rational_digits; i++)

   619     dbase*=10;

   620   fnum=0.0;

   621   dnum=0L;

   622   ptr=curptr;

   623   if (!isdigit(*ptr))   /* should start with digit */

   624     return 0;

   625   while (isdigit(*ptr) || *ptr=='_') {

   626     if (*ptr!='_') {

   627       fnum=(fnum*10.0)+(*ptr-'0');

   628       dnum=(dnum*10L)+(*ptr-'0')*dbase;

   629     } /* if */

   630     ptr++;

   631   } /* while */

   632   if (*ptr!='.')

   633     return 0;           /* there must be a period */

   634   ptr++;

   635   if (!isdigit(*ptr))   /* there must be at least one digit after the dot */

   636     return 0;

   637   ffrac=0.0;

   638   fmult=1.0;

   639   ignore=FALSE;

   640   while (isdigit(*ptr) || *ptr=='_') {

   641     if (*ptr!='_') {

   642       ffrac=(ffrac*10.0)+(*ptr-'0');

   643       fmult=fmult/10.0;

   644       dbase /= 10L;

   645       dnum += (*ptr-'0')*dbase;

   646       if (dbase==0L && sc_rationaltag && rational_digits>0 && !ignore) {

   647         error(222);     /* number of digits exceeds rational number precision */

   648         ignore=TRUE;

   649       } /* if */

   650     } /* if */

   651     ptr++;

   652   } /* while */

   653   fnum += ffrac*fmult;  /* form the number so far */

   654   if (*ptr=='e') {      /* optional fractional part */

   655     int exp,sign;

   656     ptr++;

   657     if (*ptr=='-') {

   658       sign=-1;

   659       ptr++;

   660     } else {

   661       sign=1;

   662     } /* if */

   663     if (!isdigit(*ptr)) /* 'e' should be followed by a digit */

   664       return 0;

   665     exp=0;

   666     while (isdigit(*ptr)) {

   667       exp=(exp*10)+(*ptr-'0');

   668       ptr++;

   669     } /* while */

   670     #if defined __GNUC__

   671       fmult=pow10(exp*sign);

   672     #else

   673       fmult=pow(10,exp*sign);

   674     #endif

   675     fnum *= fmult;

   676     dnum *= (unsigned long)(fmult+0.5);

   677   } /* if */

   679   /* decide how to store the number */

   680   if (sc_rationaltag==0) {

   681     error(70);          /* rational number support was not enabled */

   682     *val=0;

   683   } else if (rational_digits==0) {

   684     /* floating point */

   685     #if PAWN_CELL_SIZE==32

   686       float value=(float)fnum;

   687       *val=*((cell *)&value);

   688       #if 0 /* SourceMod - not needed */

   689         /* I assume that the C/C++ compiler stores "float" values in IEEE 754

   690          * format (as mandated in the ANSI standard). Test this assumption

   691          * anyway.

   692          * Note: problems have been reported with GCC 3.2.x, version 3.3.x works.

   693          */

   694         { float test1 = 0.0, test2 = 50.0, test3 = -50.0;

   695           uint32_t bit = 1;

   696           /* test 0.0 == all bits 0 */

   697           assert(*(uint32_t*)&test1==0x00000000L);

   698           /* test sign & magnitude format */

   699           assert(((*(uint32_t*)&test2) ^ (*(uint32_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1)));

   700           /* test a known value */

   701           assert(*(uint32_t*)&test2==0x42480000L);

   702         }

   703       #endif

   704     #elif PAWN_CELL_SIZE==64

   705       *val=*((cell *)&fnum);

   706       #if 0 /* SourceMod - not needed */

   707         /* I assume that the C/C++ compiler stores "double" values in IEEE 754

   708          * format (as mandated in the ANSI standard).

   709          */

   710         { float test1 = 0.0, test2 = 50.0, test3 = -50.0;

   711           uint64_t bit = 1;

   712           /* test 0.0 == all bits 0 */

   713           assert(*(uint64_t*)&test1==0x00000000L);

   714           /* test sign & magnitude format */

   715           assert(((*(uint64_t*)&test2) ^ (*(uint64_t*)&test3)) == (bit << (PAWN_CELL_SIZE-1)));

   716         }

   717       #endif

   718     #else

   719       #error Unsupported cell size

   720     #endif

   721   } else {

   722     /* fixed point */

   723     *val=(cell)dnum;

   724   } /* if */

   726   return (int)(ptr-curptr);

   727 }

   729 /*  number

   730  *

   731  *  Reads in a number (binary, decimal or hexadecimal). It returns the number

   732  *  of characters processed or 0 if the symbol couldn't be interpreted as a

   733  *  number (in this case the argument "val" remains unchanged). This routine

   734  *  relies on the 'early dropout' implementation of the logical or (||)

   735  *  operator.

   736  *

   737  *  Note: the routine doesn't check for a sign (+ or -). The - is checked

   738  *        for at "hier2()" (in fact, it is viewed as an operator, not as a

   739  *        sign) and the + is invalid (as in K&R C, and unlike ANSI C).

   740  */

   741 static int number(cell *val,const unsigned char *curptr)

   742 {

   743   int i;

   744   cell value;

   746   if ((i=btoi(&value,curptr))!=0      /* binary? */

   747       || (i=htoi(&value,curptr))!=0   /* hexadecimal? */

   748       || (i=dtoi(&value,curptr))!=0)  /* decimal? */

   749   {

   750     *val=value;

   751     return i;

   752   } else {

   753     return 0;                      /* else not a number */

   754   } /* if */

   755 }

   757 static void chrcat(char *str,char chr)

   758 {

   759   str=strchr(str,'\0');

   760   *str++=chr;

   761   *str='\0';

   762 }

   764 static int preproc_expr(cell *val,int *tag)

   765 {

   766   int result;

   767   int index;

   768   cell code_index;

   769   char *term;

   771   /* Disable staging; it should be disabled already because

   772    * expressions may not be cut off half-way between conditional

   773    * compilations. Reset the staging index, but keep the code

   774    * index.

   775    */

   776   if (stgget(&index,&code_index)) {

   777     error(57);                          /* unfinished expression */

   778     stgdel(0,code_index);

   779     stgset(FALSE);

   780   } /* if */

   781   assert((lptr-pline)<(int)strlen((char*)pline));   /* lptr must point inside the string */

   782   #if !defined NO_DEFINE

   783     /* preprocess the string */

   784     substallpatterns(pline,sLINEMAX);

   785     assert((lptr-pline)<(int)strlen((char*)pline)); /* lptr must STILL point inside the string */

   786   #endif

   787   /* append a special symbol to the string, so the expression

   788    * analyzer won't try to read a next line when it encounters

   789    * an end-of-line

   790    */

   791   assert(strlen((char*)pline)<sLINEMAX);

   792   term=strchr((char*)pline,'\0');

   793   assert(term!=NULL);

   794   chrcat((char*)pline,PREPROC_TERM);    /* the "DEL" code (see SC.H) */

   795   result=constexpr(val,tag,NULL);       /* get value (or 0 on error) */

   796   *term='\0';                           /* erase the token (if still present) */

   797   lexclr(FALSE);                        /* clear any "pushed" tokens */

   798   return result;

   799 }

   801 /* getstring

   802  * Returns returns a pointer behind the closing quote or to the other

   803  * character that caused the input to be ended.

   804  */

   805 static const unsigned char *getstring(unsigned char *dest,int max,const unsigned char *line)

   806 {

   807   assert(dest!=NULL && line!=NULL);

   808   *dest='\0';

   809   while (*line<=' ' && *line!='\0')

   810     line++;             /* skip whitespace */

   811   if (*line=='"') {

   812     int len=0;

   813     line++;             /* skip " */

   814     while (*line!='"' && *line!='\0') {

   815       if (len<max-1)

   816         dest[len++]=*line;

   817       line++;

   818     } /* if */

   819     dest[len]='\0';

   820     if (*line=='"')

   821       line++;           /* skip closing " */

   822     else

   823       error(37);        /* invalid string */

   824   } else {

   825     error(37);          /* invalid string */

   826   } /* if */

   827   return line;

   828 }

   830 enum {

   831   CMD_NONE,

   832   CMD_TERM,

   833   CMD_EMPTYLINE,

   834   CMD_CONDFALSE,

   835   CMD_INCLUDE,

   836   CMD_DEFINE,

   837   CMD_IF,

   838   CMD_DIRECTIVE,

   839 };

   841 /*  command

   842  *

   843  *  Recognizes the compiler directives. The function returns:

   844  *     CMD_NONE         the line must be processed

   845  *     CMD_TERM         a pending expression must be completed before processing further lines

   846  *     Other value: the line must be skipped, because:

   847  *     CMD_CONDFALSE    false "#if.." code

   848  *     CMD_EMPTYLINE    line is empty

   849  *     CMD_INCLUDE      the line contains a #include directive

   850  *     CMD_DEFINE       the line contains a #subst directive

   851  *     CMD_IF           the line contains a #if/#else/#endif directive

   852  *     CMD_DIRECTIVE    the line contains some other compiler directive

   853  *

   854  *  Global variables: iflevel, ifstack (altered)

   855  *                    lptr      (altered)

   856  */

   857 static int command(void)

   858 {

   859   int tok,ret;

   860   cell val;

   861   char *str;

   862   int index;

   863   cell code_index;

   865   while (*lptr<=' ' && *lptr!='\0')

   866     lptr+=1;

   867   if (*lptr=='\0')

   868     return CMD_EMPTYLINE;       /* empty line */

   869   if (*lptr!='#')

   870     return SKIPPING ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */

   871   /* compiler directive found */

   872   indent_nowarn=TRUE;           /* allow loose indentation" */

   873   lexclr(FALSE);                /* clear any "pushed" tokens */

   874   /* on a pending expression, force to return a silent ';' token and force to

   875    * re-read the line

   876    */

   877   if (!sc_needsemicolon && stgget(&index,&code_index)) {

   878     lptr=term_expr;

   879     return CMD_TERM;

   880   } /* if */

   881   tok=lex(&val,&str);

   882   ret=SKIPPING ? CMD_CONDFALSE : CMD_DIRECTIVE;  /* preset 'ret' to CMD_DIRECTIVE (most common case) */

   883   switch (tok) {

   884   case tpIF:                    /* conditional compilation */

   885     ret=CMD_IF;

   886     assert(iflevel>=0);

   887     if (iflevel>=sCOMP_STACK)

   888       error(122,"Conditional compilation stack"); /* table overflow */

   889     iflevel++;

   890     if (SKIPPING)

   891       break;                    /* break out of switch */

   892     skiplevel=iflevel;

   893     preproc_expr(&val,NULL);    /* get value (or 0 on error) */

   894     ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE);

   895     check_empty(lptr);

   896     break;

   897   case tpELSE:

   898   case tpELSEIF:

   899     ret=CMD_IF;

   900     assert(iflevel>=0);

   901     if (iflevel==0) {

   902       error(26);                /* no matching #if */

   903       errorset(sRESET,0);

   904     } else {

   905       /* check for earlier #else */

   906       if ((ifstack[iflevel-1] & HANDLED_ELSE)==HANDLED_ELSE) {

   907         if (tok==tpELSEIF)

   908           error(61);            /* #elseif directive may not follow an #else */

   909         else

   910           error(60);            /* multiple #else directives between #if ... #endif */

   911         errorset(sRESET,0);

   912       } else {

   913         assert(iflevel>0);

   914         /* if there has been a "parse mode" on this level, set "skip mode",

   915          * otherwise, clear "skip mode"

   916          */

   917         if ((ifstack[iflevel-1] & PARSEMODE)==PARSEMODE) {

   918           /* there has been a parse mode already on this level, so skip the rest */

   919           ifstack[iflevel-1] |= (char)SKIPMODE;

   920           /* if we were already skipping this section, allow expressions with

   921            * undefined symbols; otherwise check the expression to catch errors

   922            */

   923           if (tok==tpELSEIF) {

   924             if (skiplevel==iflevel)

   925               preproc_expr(&val,NULL);  /* get, but ignore the expression */

   926             else

   927               lptr=(unsigned char*)strchr((char*)lptr,'\0');

   928           } /* if */

   929         } else {

   930           /* previous conditions were all FALSE */

   931           if (tok==tpELSEIF) {

   932             /* if we were already skipping this section, allow expressions with

   933              * undefined symbols; otherwise check the expression to catch errors

   934              */

   935             if (skiplevel==iflevel) {

   936               preproc_expr(&val,NULL);  /* get value (or 0 on error) */

   937             } else {

   938               lptr=(unsigned char*)strchr((char*)lptr,'\0');

   939               val=0;

   940             } /* if */

   941             ifstack[iflevel-1]=(char)(val ? PARSEMODE : SKIPMODE);

   942           } else {

   943             /* a simple #else, clear skip mode */

   944             ifstack[iflevel-1] &= (char)~SKIPMODE;

   945           } /* if */

   946         } /* if */

   947       } /* if */

   948     } /* if */

   949     check_empty(lptr);

   950     break;

   951   case tpENDIF:

   952     ret=CMD_IF;

   953     if (iflevel==0){

   954       error(26);        /* no matching "#if" */

   955       errorset(sRESET,0);

   956     } else {

   957       iflevel--;

   958       if (iflevel<skiplevel)

   959         skiplevel=iflevel;

   960     } /* if */

   961     check_empty(lptr);

   962     break;

   963   case tINCLUDE:                /* #include directive */

   964   case tpTRYINCLUDE:

   965     ret=CMD_INCLUDE;

   966     if (!SKIPPING)

   967       doinclude(tok==tpTRYINCLUDE);

   968     break;

   969   case tpFILE:

   970     if (!SKIPPING) {

   971       char pathname[_MAX_PATH];

   972       lptr=getstring((unsigned char*)pathname,sizeof pathname,lptr);

   973       if (strlen(pathname)>0) {

   974         free(inpfname);

   975         inpfname=duplicatestring(pathname);

   976         if (inpfname==NULL)

   977           error(123);           /* insufficient memory */

   978         fline=0;

   979       } /* if */

   980     } /* if */

   981     check_empty(lptr);

   982     break;

   983   case tpLINE:

   984     if (!SKIPPING) {

   985       if (lex(&val,&str)!=tNUMBER)

   986         error(8);               /* invalid/non-constant expression */

   987       fline=(int)val;

   988     } /* if */

   989     check_empty(lptr);

   990     break;

   991   case tpASSERT:

   992     if (!SKIPPING && (sc_debug & sCHKBOUNDS)!=0) {

   993       for (str=(char*)lptr; *str<=' ' && *str!='\0'; str++)

   994         /* nothing */;          /* save start of expression */

   995       preproc_expr(&val,NULL);  /* get constant expression (or 0 on error) */

   996       if (!val)

   997         error(130,str);         /* assertion failed */

   998       check_empty(lptr);

   999     } /* if */

  1000     break;

  1001   case tpPRAGMA:

  1002     if (!SKIPPING) {

  1003       if (lex(&val,&str)==tSYMBOL) {

  1004         if (strcmp(str,"amxlimit")==0) {

  1005           preproc_expr(&pc_amxlimit,NULL);

  1006         } else if (strcmp(str,"amxram")==0) {

  1007           preproc_expr(&pc_amxram,NULL);

  1008         } else if (strcmp(str,"codepage")==0) {

  1009           char name[sNAMEMAX+1];

  1010           while (*lptr<=' ' && *lptr!='\0')

  1011             lptr++;

  1012           if (*lptr=='"') {

  1013             lptr=getstring((unsigned char*)name,sizeof name,lptr);

  1014           } else {

  1015             int i;

  1016             for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)

  1017               name[i]=*lptr;

  1018             name[i]='\0';

  1019           } /* if */

  1020           if (!cp_set(name))

  1021             error(128);         /* codepage mapping file not found */

  1022         } else if (strcmp(str,"compress")==0) {

  1023           cell val;

  1024           preproc_expr(&val,NULL);

  1025           sc_compress=(int)val; /* switch code packing on/off */

  1026         } else if (strcmp(str,"ctrlchar")==0) {

  1027           while (*lptr<=' ' && *lptr!='\0')

  1028             lptr++;

  1029           if (*lptr=='\0') {

  1030             sc_ctrlchar=sc_ctrlchar_org;

  1031           } else {

  1032             if (lex(&val,&str)!=tNUMBER)

  1033               error(27);          /* invalid character constant */

  1034             sc_ctrlchar=(char)val;

  1035           } /* if */

  1036         } else if (strcmp(str,"deprecated")==0) {

  1037           while (*lptr<=' ' && *lptr!='\0')

  1038             lptr++;

  1039           pc_deprecate=(char*)malloc(strlen((char*)lptr)+1);

  1040           if (pc_deprecate!=NULL)

  1041             strcpy(pc_deprecate,(char*)lptr);

  1042           lptr=(unsigned char*)strchr((char*)lptr,'\0'); /* skip to end (ignore "extra characters on line") */

  1043         } else if (strcmp(str,"dynamic")==0) {

  1044           preproc_expr(&pc_stksize,NULL);

  1045         } else if (!strcmp(str,"library")

  1046           ||!strcmp(str,"reqclass")

  1047           ||!strcmp(str,"loadlib")

  1048           ||!strcmp(str,"explib")

  1049           ||!strcmp(str,"expclass")

  1050           ||!strcmp(str,"defclasslib")) {

  1051           char name[sNAMEMAX+1],sname[sNAMEMAX+1];

  1052            const char *prefix="";

  1053           sname[0]='\0';

  1054           sname[1]='\0';

  1055           if (!strcmp(str,"library"))

  1056             prefix="??li_";

  1057           else if (!strcmp(str,"reqclass"))

  1058             prefix="??rc_";

  1059           else if (!strcmp(str,"loadlib"))

  1060             prefix="??f_";

  1061           else if (!strcmp(str,"explib"))

  1062             prefix="??el_";

  1063           else if (!strcmp(str,"expclass"))

  1064             prefix="??ec_";

  1065           else if (!strcmp(str,"defclasslib"))

  1066             prefix="??d_";

  1067           while (*lptr<=' ' && *lptr!='\0')

  1068             lptr++;

  1069           if (*lptr=='"') {

  1070             lptr=getstring((unsigned char*)name,sizeof name,lptr);

  1071           } else {

  1072             int i;

  1073             for (i=0; i<sizeof name && (alphanum(*lptr) || *lptr=='-'); i++,lptr++)

  1074               name[i]=*lptr;

  1075             name[i]='\0';

  1076             if (!strncmp(str,"exp",3) || !strncmp(str,"def",3)) {

  1077               while (*lptr && isspace(*lptr))

  1078                 lptr++;

  1079               for (i=1; i<sizeof sname && alphanum(*lptr); i++,lptr++)

  1080                 sname[i]=*lptr;

  1081               sname[i]='\0';

  1082               if (!sname[1]) {

  1083                 error(45);

  1084               } else {

  1085                 sname[0]='_';

  1086               }

  1087             }

  1088           } /* if */

  1089           if (strlen(name)==0) {

  1090             curlibrary=NULL;

  1091           } else if (strcmp(name,"-")==0) {

  1092             pc_addlibtable=FALSE;

  1093           } else {

  1094             /* add the name if it does not yet exist in the table */

  1095             char newname[sNAMEMAX+1];

  1096             if (strlen(name)+strlen(prefix)+strlen(sname)<=sNAMEMAX) {

  1097               strcpy(newname,prefix);

  1098               strcat(newname,name);

  1099               strcat(newname,sname);

  1100               if (find_constval(&libname_tab,newname,0)==NULL) {

  1101                 if (!strcmp(str,"library") || !strcmp(str,"reqclass")) {

  1102                   curlibrary=append_constval(&libname_tab,newname,1,0);

  1103                 } else {

  1104                   append_constval(&libname_tab,newname,1,0);

  1105                 }

  1106               }

  1107             }

  1108           } /* if */

  1109 #if 0	/* more unused */

  1110         } else if (strcmp(str,"pack")==0) {

  1111           cell val;

  1112           preproc_expr(&val,NULL);      /* default = packed/unpacked */

  1113           sc_packstr=(int)val;

  1114 #endif

  1115         } else if (strcmp(str,"rational")==0) {

  1116           char name[sNAMEMAX+1];

  1117           cell digits=0;

  1118           int i;

  1119           /* first gather all information, start with the tag name */

  1120           while (*lptr<=' ' && *lptr!='\0')

  1121             lptr++;

  1122           for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)

  1123             name[i]=*lptr;

  1124           name[i]='\0';

  1125           /* then the precision (for fixed point arithmetic) */

  1126           while (*lptr<=' ' && *lptr!='\0')

  1127             lptr++;

  1128           if (*lptr=='(') {

  1129             preproc_expr(&digits,NULL);

  1130             if (digits<=0 || digits>9) {

  1131               error(68);        /* invalid rational number precision */

  1132               digits=0;

  1133             } /* if */

  1134             if (*lptr==')')

  1135               lptr++;

  1136           } /* if */

  1137           /* add the tag (make it public) and check the values */

  1138           i=pc_addtag(name);

  1139           exporttag(i);

  1140           if (sc_rationaltag==0 || (sc_rationaltag==i && rational_digits==(int)digits)) {

  1141             sc_rationaltag=i;

  1142             rational_digits=(int)digits;

  1143           } else {

  1144             error(69);          /* rational number format already set, can only be set once */

  1145           } /* if */

  1146         } else if (strcmp(str,"semicolon")==0) {

  1147           cell val;

  1148           preproc_expr(&val,NULL);

  1149           sc_needsemicolon=(int)val;

  1150         } else if (strcmp(str,"tabsize")==0) {

  1151           cell val;

  1152           preproc_expr(&val,NULL);

  1153           sc_tabsize=(int)val;

  1154         } else if (strcmp(str,"align")==0) {

  1155           sc_alignnext=TRUE;

  1156         } else if (strcmp(str,"unused")==0) {

  1157           char name[sNAMEMAX+1];

  1158           int i,comma;

  1159           symbol *sym;

  1160           do {

  1161             /* get the name */

  1162             while (*lptr<=' ' && *lptr!='\0')

  1163               lptr++;

  1164             for (i=0; i<sizeof name && alphanum(*lptr); i++,lptr++)

  1165               name[i]=*lptr;

  1166             name[i]='\0';

  1167             /* get the symbol */

  1168             sym=findloc(name);

  1169             if (sym==NULL)

  1170               sym=findglb(name,sSTATEVAR);

  1171             if (sym!=NULL) {

  1172               sym->usage |= uREAD;

  1173               if (sym->ident==iVARIABLE || sym->ident==iREFERENCE

  1174                   || sym->ident==iARRAY || sym->ident==iREFARRAY)

  1175                 sym->usage |= uWRITTEN;

  1176             } else {

  1177               error(17,name);     /* undefined symbol */

  1178             } /* if */

  1179             /* see if a comma follows the name */

  1180             while (*lptr<=' ' && *lptr!='\0')

  1181               lptr++;

  1182             comma= (*lptr==',');

  1183             if (comma)

  1184               lptr++;

  1185           } while (comma);

  1186         } else {

  1187           error(207);           /* unknown #pragma */

  1188         } /* if */

  1189       } else {

  1190         error(207);             /* unknown #pragma */

  1191       } /* if */

  1192       check_empty(lptr);

  1193     } /* if */

  1194     break;

  1195   case tpENDINPUT:

  1196   case tpENDSCRPT:

  1197     if (!SKIPPING) {

  1198       check_empty(lptr);

  1199       assert(inpf!=NULL);

  1200       if (inpf!=inpf_org)

  1201         pc_closesrc(inpf);

  1202       inpf=NULL;

  1203     } /* if */

  1204     break;

  1205 #if !defined NOEMIT

  1206   case tpEMIT: {

  1207     /* write opcode to output file */

  1208     char name[40];

  1209     int i;

  1210     while (*lptr<=' ' && *lptr!='\0')

  1211       lptr++;

  1212     for (i=0; i<40 && (isalpha(*lptr) || *lptr=='.'); i++,lptr++)

  1213       name[i]=(char)tolower(*lptr);

  1214     name[i]='\0';

  1215     stgwrite("\t");

  1216     stgwrite(name);

  1217     stgwrite(" ");

  1218     code_idx+=opcodes(1);

  1219     /* write parameter (if any) */

  1220     while (*lptr<=' ' && *lptr!='\0')

  1221       lptr++;

  1222     if (*lptr!='\0') {

  1223       symbol *sym;

  1224       tok=lex(&val,&str);

  1225       switch (tok) {

  1226       case tNUMBER:

  1227       case tRATIONAL:

  1228         outval(val,FALSE);

  1229         code_idx+=opargs(1);

  1230         break;

  1231       case tSYMBOL:

  1232         sym=findloc(str);

  1233         if (sym==NULL)

  1234           sym=findglb(str,sSTATEVAR);

  1235         if (sym==NULL || sym->ident!=iFUNCTN && sym->ident!=iREFFUNC && (sym->usage & uDEFINE)==0) {

  1236           error(17,str);        /* undefined symbol */

  1237         } else {

  1238           outval(sym->addr,FALSE);

  1239           /* mark symbol as "used", unknown whether for read or write */

  1240           markusage(sym,uREAD | uWRITTEN);

  1241           code_idx+=opargs(1);

  1242         } /* if */

  1243         break;

  1244       default: {

  1245         char s2[20];

  1246         extern char *sc_tokens[];/* forward declaration */

  1247         if (tok<256)

  1248           sprintf(s2,"%c",(char)tok);

  1249         else

  1250           strcpy(s2,sc_tokens[tok-tFIRST]);

  1251         error(1,sc_tokens[tSYMBOL-tFIRST],s2);

  1252         break;

  1253       } /* case */

  1254       } /* switch */

  1255     } /* if */

  1256     stgwrite("\n");

  1257     check_empty(lptr);

  1258     break;

  1259   } /* case */

  1260 #endif

  1261 #if !defined NO_DEFINE

  1262   case tpDEFINE: {

  1263     ret=CMD_DEFINE;

  1264     if (!SKIPPING) {

  1265       char *pattern,*substitution;

  1266       const unsigned char *start,*end;

  1267       int count,prefixlen;

  1268       stringpair *def;

  1269       /* find the pattern to match */

  1270       while (*lptr<=' ' && *lptr!='\0')

  1271         lptr++;

  1272       start=lptr;       /* save starting point of the match pattern */

  1273       count=0;

  1274       while (*lptr>' ' && *lptr!='\0') {

  1275         litchar(&lptr,0); /* litchar() advances "lptr" and handles escape characters */

  1276         count++;

  1277       } /* while */

  1278       end=lptr;

  1279       /* check pattern to match */

  1280       if (!alpha(*start)) {

  1281         error(74);      /* pattern must start with an alphabetic character */

  1282         break;

  1283       } /* if */

  1284       /* store matched pattern */

  1285       pattern=(char*)malloc(count+1);

  1286       if (pattern==NULL)

  1287         error(123);     /* insufficient memory */

  1288       lptr=start;

  1289       count=0;

  1290       while (lptr!=end) {

  1291         assert(lptr<end);

  1292         assert(*lptr!='\0');

  1293         pattern[count++]=(char)litchar(&lptr,0);

  1294       } /* while */

  1295       pattern[count]='\0';

  1296       /* special case, erase trailing variable, because it could match anything */

  1297       if (count>=2 && isdigit(pattern[count-1]) && pattern[count-2]=='%')

  1298         pattern[count-2]='\0';

  1299       /* find substitution string */

  1300       while (*lptr<=' ' && *lptr!='\0')

  1301         lptr++;

  1302       start=lptr;       /* save starting point of the match pattern */

  1303       count=0;

  1304       end=NULL;

  1305       while (*lptr!='\0') {

  1306         /* keep position of the start of trailing whitespace */

  1307         if (*lptr<=' ') {

  1308           if (end==NULL)

  1309             end=lptr;

  1310         } else {

  1311           end=NULL;

  1312         } /* if */

  1313         count++;

  1314         lptr++;

  1315       } /* while */

  1316       if (end==NULL)

  1317         end=lptr;

  1318       /* store matched substitution */

  1319       substitution=(char*)malloc(count+1);  /* +1 for '\0' */

  1320       if (substitution==NULL)

  1321         error(123);     /* insufficient memory */

  1322       lptr=start;

  1323       count=0;

  1324       while (lptr!=end) {

  1325         assert(lptr<end);

  1326         assert(*lptr!='\0');

  1327         substitution[count++]=*lptr++;

  1328       } /* while */

  1329       substitution[count]='\0';

  1330       /* check whether the definition already exists */

  1331       for (prefixlen=0,start=(unsigned char*)pattern; alphanum(*start); prefixlen++,start++)

  1332         /* nothing */;

  1333       assert(prefixlen>0);

  1334       if ((def=find_subst(pattern,prefixlen))!=NULL) {

  1335         if (strcmp(def->first,pattern)!=0 || strcmp(def->second,substitution)!=0)

  1336           error(201,pattern);   /* redefinition of macro (non-identical) */

  1337         delete_subst(pattern,prefixlen);

  1338       } /* if */

  1339       /* add the pattern/substitution pair to the list */

  1340       assert(strlen(pattern)>0);

  1341       insert_subst(pattern,substitution,prefixlen);

  1342       free(pattern);

  1343       free(substitution);

  1344     } /* if */

  1345     break;

  1346   } /* case */

  1347   case tpUNDEF:

  1348     if (!SKIPPING) {

  1349       if (lex(&val,&str)==tSYMBOL) {

  1350         ret=delete_subst(str,strlen(str));

  1351         if (!ret) {

  1352           /* also undefine normal constants */

  1353           symbol *sym=findconst(str,NULL);

  1354           if (sym!=NULL && (sym->usage & (uENUMROOT | uENUMFIELD))==0) {

  1355             delete_symbol(&glbtab,sym);

  1356             ret=TRUE;

  1357           } /* if */

  1358         } /* if */

  1359         if (!ret)

  1360           error(17,str);        /* undefined symbol */

  1361       } else {

  1362         error(20,str);          /* invalid symbol name */

  1363       } /* if */

  1364       check_empty(lptr);

  1365     } /* if */

  1366     break;

  1367 #endif

  1368   case tpERROR:

  1369     while (*lptr<=' ' && *lptr!='\0')

  1370       lptr++;

  1371     if (!SKIPPING)

  1372       error(131,lptr);  /* user error */

  1373     break;

  1374   default:

  1375     error(31);          /* unknown compiler directive */

  1376     ret=SKIPPING ? CMD_CONDFALSE : CMD_NONE;  /* process as normal line */

  1377   } /* switch */

  1378   return ret;

  1379 }

  1381 #if !defined NO_DEFINE

  1382 static int is_startstring(const unsigned char *string)

  1383 {

  1384   if (*string=='\"' || *string=='\'')

  1385     return TRUE;                        /* "..." */

  1387   if (*string=='!') {

  1388     string++;

  1389     if (*string=='\"' || *string=='\'')

  1390       return TRUE;                      /* !"..." */

  1391     if (*string==sc_ctrlchar) {

  1392       string++;

  1393       if (*string=='\"' || *string=='\'')

  1394         return TRUE;                    /* !\"..." */

  1395     } /* if */

  1396   } else if (*string==sc_ctrlchar) {

  1397     string++;

  1398     if (*string=='\"' || *string=='\'')

  1399       return TRUE;                      /* \"..." */

  1400     if (*string=='!') {

  1401       string++;

  1402       if (*string=='\"' || *string=='\'')

  1403         return TRUE;                    /* \!"..." */

  1404     } /* if */

  1405   } /* if */

  1407   return FALSE;

  1408 }

  1410 static const unsigned char *skipstring(const unsigned char *string)

  1411 {

  1412   char endquote;

  1413   int flags=0;

  1415   while (*string=='!' || *string==sc_ctrlchar) {

  1416     if (*string==sc_ctrlchar)

  1417       flags=RAWMODE;

  1418     string++;

  1419   } /* while */

  1421   endquote=*string;

  1422   assert(endquote=='"' || endquote=='\'');

  1423   string++;             /* skip open quote */

  1424   while (*string!=endquote && *string!='\0')

  1425     litchar(&string,flags);

  1426   return string;

  1427 }

  1429 static const unsigned char *skippgroup(const unsigned char *string)

  1430 {

  1431   int nest=0;

  1432   char open=*string;

  1433   char close;

  1435   switch (open) {

  1436   case '(':

  1437     close=')';

  1438     break;

  1439   case '{':

  1440     close='}';

  1441     break;

  1442   case '[':

  1443     close=']';

  1444     break;

  1445   case '<':

  1446     close='>';

  1447     break;

  1448   default:

  1449     assert(0);

  1450 	close='\0';         /* only to avoid a compiler warning */

  1451   }/* switch */

  1453   string++;

  1454   while (*string!=close || nest>0) {

  1455     if (*string==open)

  1456       nest++;

  1457     else if (*string==close)

  1458       nest--;

  1459     else if (is_startstring(string))

  1460       string=skipstring(string);

  1461     if (*string=='\0')

  1462       break;

  1463     string++;

  1464   } /* while */

  1465   return string;

  1466 }

  1468 static char *strdel(char *str,size_t len)

  1469 {

  1470   size_t length=strlen(str);

  1471   if (len>length)

  1472     len=length;

  1473   memmove(str, str+len, length-len+1);  /* include EOS byte */

  1474   return str;

  1475 }

  1477 static char *strins(char *dest,char *src,size_t srclen)

  1478 {

  1479   size_t destlen=strlen(dest);

  1480   assert(srclen<=strlen(src));

  1481   memmove(dest+srclen, dest, destlen+1);/* include EOS byte */

  1482   memcpy(dest, src, srclen);

  1483   return dest;

  1484 }

  1486 static int substpattern(unsigned char *line,size_t buffersize,char *pattern,char *substitution)

  1487 {

  1488   int prefixlen;

  1489   const unsigned char *p,*s,*e;

  1490   unsigned char *args[10];

  1491   int match,arg,len,argsnum=0;

  1493   memset(args,0,sizeof args);

  1495   /* check the length of the prefix */

  1496   for (prefixlen=0,s=(unsigned char*)pattern; alphanum(*s); prefixlen++,s++)

  1497     /* nothing */;

  1498   assert(prefixlen>0);

  1499   assert(strncmp((char*)line,pattern,prefixlen)==0);

  1501   /* pattern prefix matches; match the rest of the pattern, gather

  1502    * the parameters

  1503    */

  1504   s=line+prefixlen;

  1505   p=(unsigned char*)pattern+prefixlen;

  1506   match=TRUE;         /* so far, pattern matches */

  1507   while (match && *s!='\0' && *p!='\0') {

  1508     if (*p=='%') {

  1509       p++;            /* skip '%' */

  1510       if (isdigit(*p)) {

  1511         arg=*p-'0';

  1512         assert(arg>=0 && arg<=9);

  1513         p++;          /* skip parameter id */

  1514         assert(*p!='\0');

  1515         /* match the source string up to the character after the digit

  1516          * (skipping strings in the process

  1517          */

  1518         e=s;

  1519         while (*e!=*p && *e!='\0' && *e!='\n') {

  1520           if (is_startstring(e))              /* skip strings */

  1521             e=skipstring(e);

  1522           else if (strchr("({[",*e)!=NULL)    /* skip parenthized groups */

  1523             e=skippgroup(e);

  1524           if (*e!='\0')

  1525             e++;      /* skip non-alphapetic character (or closing quote of

  1526                        * a string, or the closing paranthese of a group) */

  1527         } /* while */

  1528         /* store the parameter (overrule any earlier) */

  1529         if (args[arg]!=NULL)

  1530           free(args[arg]);

  1531 		else

  1532           argsnum++;

  1533         len=(int)(e-s);

  1534         args[arg]=(unsigned char*)malloc(len+1);

  1535         if (args[arg]==NULL)

  1536           error(123); /* insufficient memory */

  1537         strlcpy((char*)args[arg],(char*)s,len+1);

  1538         /* character behind the pattern was matched too */

  1539         if (*e==*p) {

  1540           s=e+1;

  1541         } else if (*e=='\n' && *p==';' && *(p+1)=='\0' && !sc_needsemicolon) {

  1542           s=e;    /* allow a trailing ; in the pattern match to end of line */

  1543         } else {

  1544           assert(*e=='\0' || *e=='\n');

  1545           match=FALSE;

  1546           s=e;

  1547         } /* if */

  1548         p++;

  1549       } else {

  1550         match=FALSE;

  1551       } /* if */

  1552     } else if (*p==';' && *(p+1)=='\0' && !sc_needsemicolon) {

  1553       /* source may be ';' or end of the line */

  1554       while (*s<=' ' && *s!='\0')

  1555         s++;          /* skip white space */

  1556       if (*s!=';' && *s!='\0')

  1557         match=FALSE;

  1558       p++;            /* skip the semicolon in the pattern */

  1559     } else {

  1560       cell ch;

  1561       /* skip whitespace between two non-alphanumeric characters, except

  1562        * for two identical symbols

  1563        */

  1564       assert((char*)p>pattern);

  1565       if (!alphanum(*p) && *(p-1)!=*p)

  1566         while (*s<=' ' && *s!='\0')

  1567           s++;                  /* skip white space */

  1568       ch=litchar(&p,0);         /* this increments "p" */

  1569       if (*s!=ch)

  1570         match=FALSE;

  1571       else

  1572         s++;                    /* this character matches */

  1573     } /* if */

  1574   } /* while */

  1576   if (match && *p=='\0') {

  1577     /* if the last character to match is an alphanumeric character, the

  1578      * current character in the source may not be alphanumeric

  1579      */

  1580     assert(p>(unsigned char*)pattern);

  1581     if (alphanum(*(p-1)) && alphanum(*s))

  1582       match=FALSE;

  1583   } /* if */

  1585   if (match) {

  1586     /* calculate the length of the substituted string */

  1587     for (e=(unsigned char*)substitution,len=0; *e!='\0'; e++) {

  1588       if (*e=='%' && isdigit(*(e+1)) && argsnum) {

  1589         arg=*(e+1)-'0';

  1590         assert(arg>=0 && arg<=9);

  1591         if (args[arg]!=NULL) {

  1592           len+=strlen((char*)args[arg]);

  1593           e++;

  1594         } else {

  1595           len++;

  1596         }

  1597       } else {

  1598         len++;

  1599       } /* if */

  1600     } /* for */

  1601     /* check length of the string after substitution */

  1602     if (strlen((char*)line) + len - (int)(s-line) > buffersize) {

  1603       error(75);      /* line too long */

  1604     } else {

  1605       /* substitute pattern */

  1606       strdel((char*)line,(int)(s-line));

  1607       for (e=(unsigned char*)substitution,s=line; *e!='\0'; e++) {

  1608         if (*e=='%' && isdigit(*(e+1))) {

  1609           arg=*(e+1)-'0';

  1610           assert(arg>=0 && arg<=9);

  1611           if (args[arg]!=NULL) {

  1612             strins((char*)s,(char*)args[arg],strlen((char*)args[arg]));

  1613             s+=strlen((char*)args[arg]);

  1614           } else {

  1615             error(236); /* parameter does not exist, incorrect #define pattern */

  1616             strins((char*)s,(char*)e,2);

  1617             s+=2;

  1618           } /* if */

  1619           e++;          /* skip %, digit is skipped later */

  1620         } else if (*e == '"') {

  1621           p=e;

  1622           if (is_startstring(e)) {

  1623             e=skipstring(e);

  1624             strins((char*)s,(char *)p,(e-p+1));

  1625             s+=(e-p+1);

  1626           } else {

  1627             strins((char*)s,(char*)e,1);

  1628             s++;

  1629           }

  1630         } else {

  1631           strins((char*)s,(char*)e,1);

  1632           s++;

  1633         } /* if */

  1634       } /* for */

  1635     } /* if */

  1636   } /* if */

  1638   for (arg=0; arg<10; arg++)

  1639     if (args[arg]!=NULL)

  1640       free(args[arg]);

  1642   return match;

  1643 }

  1645 static void substallpatterns(unsigned char *line,int buffersize)

  1646 {

  1647   unsigned char *start, *end;

  1648   int prefixlen;

  1649   stringpair *subst;

  1651   start=line;

  1652   while (*start!='\0') {

  1653     /* find the start of a prefix (skip all non-alphabetic characters),

  1654      * also skip strings

  1655      */

  1656     while (!alpha(*start) && *start!='\0') {

  1657       /* skip strings */

  1658       if (is_startstring(start)) {

  1659         start=(unsigned char *)skipstring(start);

  1660         if (*start=='\0')

  1661           break;        /* abort loop on error */

  1662       } /* if */

  1663       start++;          /* skip non-alphapetic character (or closing quote of a string) */

  1664     } /* while */

  1665     if (*start=='\0')

  1666       break;            /* abort loop on error */

  1667     /* if matching the operator "defined", skip it plus the symbol behind it */

  1668 	if (strncmp((char*)start,"defined",7)==0 && !isalpha((char)*(start+7))) {

  1669       start+=7;         /* skip "defined" */

  1670       /* skip white space & parantheses */

  1671       while (*start<=' ' && *start!='\0' || *start=='(')

  1672         start++;

  1673       /* skip the symbol behind it */

  1674       while (alphanum(*start))

  1675         start++;

  1676       /* drop back into the main loop */

  1677       continue;

  1678     } /* if */

  1679     /* get the prefix (length), look for a matching definition */

  1680     prefixlen=0;

  1681     end=start;

  1682     while (alphanum(*end)) {

  1683       prefixlen++;

  1684       end++;

  1685     } /* while */

  1686     assert(prefixlen>0);

  1687     subst=find_subst((char*)start,prefixlen);

  1688     if (subst!=NULL) {

  1689       /* properly match the pattern and substitute */

  1690       if (!substpattern(start,buffersize-(int)(start-line),subst->first,subst->second))

  1691         start=end;      /* match failed, skip this prefix */

  1692       /* match succeeded: do not update "start", because the substitution text

  1693        * may be matched by other macros

  1694        */

  1695     } else {

  1696       start=end;        /* no macro with this prefix, skip this prefix */

  1697     } /* if */

  1698   } /* while */

  1699 }

  1700 #endif

  1702 /*  preprocess

  1703  *

  1704  *  Reads a line by readline() into "pline" and performs basic preprocessing:

  1705  *  deleting comments, skipping lines with false "#if.." code and recognizing

  1706  *  other compiler directives. There is an indirect recursion: lex() calls

  1707  *  preprocess() if a new line must be read, preprocess() calls command(),

  1708  *  which at his turn calls lex() to identify the token.

  1709  *

  1710  *  Global references: lptr     (altered)

  1711  *                     pline    (altered)

  1712  *                     freading (referred to only)

  1713  */

  1714 SC_FUNC void preprocess(void)

  1715 {

  1716   int iscommand;

  1718   if (!freading)

  1719     return;

  1720   do {

  1721     readline(pline);

  1722     stripcom(pline);    /* ??? no need for this when reading back from list file (in the second pass) */

  1723     lptr=pline;         /* set "line pointer" to start of the parsing buffer */

  1724     iscommand=command();

  1725     if (iscommand!=CMD_NONE)

  1726       errorset(sRESET,0); /* reset error flag ("panic mode") on empty line or directive */

  1727     #if !defined NO_DEFINE

  1728       if (iscommand==CMD_NONE) {

  1729         assert(lptr!=term_expr);

  1730         substallpatterns(pline,sLINEMAX);

  1731         lptr=pline;       /* reset "line pointer" to start of the parsing buffer */

  1732       } /* if */

  1733     #endif

  1734     if (sc_status==statFIRST && sc_listing && freading

  1735         && (iscommand==CMD_NONE || iscommand==CMD_EMPTYLINE || iscommand==CMD_DIRECTIVE))

  1736     {

  1737       listline++;

  1738       if (fline!=listline) {

  1739         listline=fline;

  1740         setlinedirect(fline);

  1741       } /* if */

  1742       if (iscommand==CMD_EMPTYLINE)

  1743         pc_writeasm(outf,"\n");

  1744       else

  1745         pc_writeasm(outf,(char*)pline);

  1746     } /* if */

  1747   } while (iscommand!=CMD_NONE && iscommand!=CMD_TERM && freading); /* enddo */

  1748 }

  1750 static const unsigned char *unpackedstring(const unsigned char *lptr,int flags)

  1751 {

  1752   while (*lptr!='\"' && *lptr!='\0') {

  1753     if (*lptr=='\a') {          /* ignore '\a' (which was inserted at a line concatenation) */

  1754       lptr++;

  1755       continue;

  1756     } /* if */

  1757     litadd(litchar(&lptr,flags | UTF8MODE));  /* litchar() alters "lptr" */

  1758   } /* while */

  1759   litadd(0);                    /* terminate string */

  1760   return lptr;

  1761 }

  1763 static const unsigned char *packedstring(const unsigned char *lptr,int flags)

  1764 {

  1765   int i;

  1766   ucell val,c;

  1768   i=0; /* start at least significant byte */

  1769   val=0;

  1770   glbstringread=1;

  1771   while (*lptr!='\"' && *lptr!='\0') {

  1772     if (*lptr=='\a') {          /* ignore '\a' (which was inserted at a line concatenation) */

  1773       lptr++;

  1774       continue;

  1775     } /* if */

  1776     c=litchar(&lptr,flags);     /* litchar() alters "lptr" */

  1777     if (c>=(ucell)(1 << sCHARBITS))

  1778       error(43);                /* character constant exceeds range */

  1779     val |= (c << 8*i);

  1780     glbstringread++;

  1781     if (i==sizeof(ucell)-(sCHARBITS/8)) {

  1782       litadd(val);

  1783       val=0;

  1784       i=0;

  1785     } else {

  1786       i=i+1;

  1787     }

  1788   } /* if */

  1789   /* save last code; make sure there is at least one terminating zero character */

  1790   if (i!=0)

  1791     litadd(val);        /* at least one zero character in "val" */

  1792   else

  1793     litadd(0);          /* add full cell of zeros */

  1794   return lptr;

  1795 }

  1797 /*  lex(lexvalue,lexsym)        Lexical Analysis

  1798  *

  1799  *  lex() first deletes leading white space, then checks for multi-character

  1800  *  operators, keywords (including most compiler directives), numbers,

  1801  *  labels, symbols and literals (literal characters are converted to a number

  1802  *  and are returned as such). If every check fails, the line must contain

  1803  *  a single-character operator. So, lex() returns this character. In the other

  1804  *  case (something did match), lex() returns the number of the token. All

  1805  *  these tokens have been assigned numbers above 255.

  1806  *

  1807  *  Some tokens have "attributes":

  1808  *     tNUMBER        the value of the number is return in "lexvalue".

  1809  *     tRATIONAL      the value is in IEEE 754 encoding or in fixed point

  1810  *                    encoding in "lexvalue".

  1811  *     tSYMBOL        the first sNAMEMAX characters of the symbol are

  1812  *                    stored in a buffer, a pointer to this buffer is

  1813  *                    returned in "lexsym".

  1814  *     tLABEL         the first sNAMEMAX characters of the label are

  1815  *                    stored in a buffer, a pointer to this buffer is

  1816  *                    returned in "lexsym".

  1817  *     tSTRING        the string is stored in the literal pool, the index

  1818  *                    in the literal pool to this string is stored in

  1819  *                    "lexvalue".

  1820  *

  1821  *  lex() stores all information (the token found and possibly its attribute)

  1822  *  in global variables. This allows a token to be examined twice. If "_pushed"

  1823  *  is true, this information is returned.

  1824  *

  1825  *  Global references: lptr          (altered)

  1826  *                     fline         (referred to only)

  1827  *                     litidx        (referred to only)

  1828  *                     _lextok, _lexval, _lexstr

  1829  *                     _pushed

  1830  */

  1832 static int _pushed;

  1833 static int _lextok;

  1834 static cell _lexval;

  1835 static char _lexstr[sLINEMAX+1];

  1836 static int _lexnewline;

  1838 SC_FUNC void lexinit(void)

  1839 {

  1840   stkidx=0;             /* index for pushstk() and popstk() */

  1841   iflevel=0;            /* preprocessor: nesting of "#if" is currently 0 */

  1842   skiplevel=0;          /* preprocessor: not currently skipping */

  1843   icomment=0;           /* currently not in a multiline comment */

  1844   _pushed=FALSE;        /* no token pushed back into lex */

  1845   _lexnewline=FALSE;

  1846 }

  1848 char *sc_tokens[] = {

  1849          "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",

  1850          "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",

  1851          "...", "..", "::",

  1852          "assert", "*begin", "break", "case", "cellsof", "chars", "const", "continue", "default",

  1853          "defined", "do", "else", "*end", "enum", "exit", "for", "forward", "funcenum", "functag", "goto",

  1854          "if", "native", "new", "decl", "operator", "public", "return", "sizeof",

  1855          "sleep", "state", "static", "stock", "struct", "switch", "tagof", "*then", "while",

  1856          "#assert", "#define", "#else", "#elseif", "#emit", "#endif", "#endinput",

  1857          "#endscript", "#error", "#file", "#if", "#include", "#line", "#pragma",

  1858          "#tryinclude", "#undef",

  1859          ";", ";", "-integer value-", "-rational value-", "-identifier-",

  1860          "-label-", "-string-"

  1861        };

  1863 SC_FUNC int lex(cell *lexvalue,char **lexsym)

  1864 {

  1865   int i,toolong,newline,stringflags;

  1866   char **tokptr;

  1867   const unsigned char *starttoken;

  1869   if (_pushed) {

  1870     _pushed=FALSE;      /* reset "_pushed" flag */

  1871     *lexvalue=_lexval;

  1872     *lexsym=_lexstr;

  1873     return _lextok;

  1874   } /* if */

  1876   _lextok=0;            /* preset all values */

  1877   _lexval=0;

  1878   _lexstr[0]='\0';

  1879   *lexvalue=_lexval;

  1880   *lexsym=_lexstr;

  1881   _lexnewline=FALSE;

  1882   if (!freading)

  1883     return 0;

  1885   newline= (lptr==pline);       /* does lptr point to start of line buffer */

  1886   while (*lptr<=' ') {          /* delete leading white space */

  1887     if (*lptr=='\0') {

  1888       preprocess();             /* preprocess resets "lptr" */

  1889       if (!freading)

  1890         return 0;

  1891       if (lptr==term_expr)      /* special sequence to terminate a pending expression */

  1892         return (_lextok=tENDEXPR);

  1893       _lexnewline=TRUE;         /* set this after preprocess(), because

  1894                                  * preprocess() calls lex() recursively */

  1895       newline=TRUE;

  1896     } else {

  1897       lptr+=1;

  1898     } /* if */

  1899   } /* while */

  1900   if (newline) {

  1901     stmtindent=0;

  1902     for (i=0; i<(int)(lptr-pline); i++)

  1903       if (pline[i]=='\t' && sc_tabsize>0)

  1904         stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize);

  1905       else

  1906         stmtindent++;

  1907   } /* if */

  1909   i=tFIRST;

  1910   tokptr=sc_tokens;

  1911   while (i<=tMIDDLE) {  /* match multi-character operators */

  1912     if (*lptr==**tokptr && match(*tokptr,FALSE)) {

  1913       _lextok=i;

  1914       if (pc_docexpr)   /* optionally concatenate to documentation string */

  1915         insert_autolist(*tokptr);

  1916       return _lextok;

  1917     } /* if */

  1918     i+=1;

  1919     tokptr+=1;

  1920   } /* while */

  1921   while (i<=tLAST) {    /* match reserved words and compiler directives */

  1922     if (*lptr==**tokptr && match(*tokptr,TRUE)) {

  1923       _lextok=i;

  1924       errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/

  1925       if (pc_docexpr)   /* optionally concatenate to documentation string */

  1926         insert_autolist(*tokptr);

  1927       return _lextok;

  1928     } /* if */

  1929     i+=1;

  1930     tokptr+=1;

  1931   } /* while */

  1933   starttoken=lptr;      /* save start pointer (for concatenating to documentation string) */

  1934   if ((i=number(&_lexval,lptr))!=0) {   /* number */

  1935     _lextok=tNUMBER;

  1936     *lexvalue=_lexval;

  1937     lptr+=i;

  1938   } else if ((i=ftoi(&_lexval,lptr))!=0) {

  1939     _lextok=tRATIONAL;

  1940     *lexvalue=_lexval;

  1941     lptr+=i;

  1942   } else if (alpha(*lptr)) {            /* symbol or label */

  1943     /*  Note: only sNAMEMAX characters are significant. The compiler

  1944      *        generates a warning if a symbol exceeds this length.

  1945      */

  1946     _lextok=tSYMBOL;

  1947     i=0;

  1948     toolong=0;

  1949     while (alphanum(*lptr)){

  1950       _lexstr[i]=*lptr;

  1951       lptr+=1;

  1952       if (i<sNAMEMAX)

  1953         i+=1;

  1954       else

  1955         toolong=1;

  1956     } /* while */

  1957     _lexstr[i]='\0';

  1958     if (toolong)

  1959       error(200,_lexstr,sNAMEMAX);  /* symbol too long, truncated to sNAMEMAX chars */

  1960     if (_lexstr[0]==PUBLIC_CHAR && _lexstr[1]=='\0') {

  1961       _lextok=PUBLIC_CHAR;  /* '@' all alone is not a symbol, it is an operator */

  1962     } else if (_lexstr[0]=='_' && _lexstr[1]=='\0') {

  1963       _lextok='_';      /* '_' by itself is not a symbol, it is a placeholder */

  1964     } /* if */

  1965     if (*lptr==':' && *(lptr+1)!=':' && _lextok!=PUBLIC_CHAR) {

  1966       if (sc_allowtags) {

  1967         _lextok=tLABEL; /* it wasn't a normal symbol, it was a label/tagname */

  1968         lptr+=1;        /* skip colon */

  1969       } else if (find_constval(&tagname_tab,_lexstr,0)!=NULL) {

  1970         /* this looks like a tag override (because a tag with this name

  1971          * exists), but tags are not allowed right now, so it is probably an

  1972          * error

  1973          */

  1974         error(220);

  1975       } /* if */

  1976     } /* if */

  1977   } else if (*lptr=='\"' || *lptr==sc_ctrlchar && *(lptr+1)=='\"')

  1978   {                                     /* unpacked string literal */

  1979     _lextok=tSTRING;

  1980     stringflags= (*lptr==sc_ctrlchar) ? RAWMODE : 0;

  1981     *lexvalue=_lexval=litidx;

  1982     lptr+=1;            /* skip double quote */

  1983     if ((stringflags & RAWMODE)!=0)

  1984       lptr+=1;          /* skip "escape" character too */

  1985     /* Note that this should always be packedstring() for SourcePawn */

  1986     lptr=sc_packstr ? packedstring(lptr,stringflags) : unpackedstring(lptr,stringflags);

  1987     if (*lptr=='\"')

  1988       lptr+=1;          /* skip final quote */

  1989     else

  1990       error(37);        /* invalid (non-terminated) string */

  1991   } else if (*lptr=='!' && *(lptr+1)=='\"'

  1992              || *lptr=='!' && *(lptr+1)==sc_ctrlchar && *(lptr+2)=='\"'

  1993              || *lptr==sc_ctrlchar && *(lptr+1)=='!' && *(lptr+2)=='\"')

  1994   {                                     /* packed string literal */

  1995     _lextok=tSTRING;

  1996     stringflags= (*lptr==sc_ctrlchar || *(lptr+1)==sc_ctrlchar) ? RAWMODE : 0;

  1997     *lexvalue=_lexval=litidx;

  1998     lptr+=2;            /* skip exclamation point and double quote */

  1999     if ((stringflags & RAWMODE)!=0)

  2000       lptr+=1;          /* skip "escape" character too */

  2001     lptr=sc_packstr ? unpackedstring(lptr,stringflags) : packedstring(lptr,stringflags);

  2002     if (*lptr=='\"')

  2003       lptr+=1;          /* skip final quote */

  2004     else

  2005       error(37);        /* invalid (non-terminated) string */

  2006   } else if (*lptr=='\'') {             /* character literal */

  2007     lptr+=1;            /* skip quote */

  2008     _lextok=tNUMBER;

  2009     *lexvalue=_lexval=litchar(&lptr,UTF8MODE);

  2010     if (*lptr=='\'')

  2011       lptr+=1;          /* skip final quote */

  2012     else

  2013       error(27);        /* invalid character constant (must be one character) */

  2014   } else if (*lptr==';') {      /* semicolumn resets "error" flag */

  2015     _lextok=';';

  2016     lptr+=1;

  2017     errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/

  2018   } else {

  2019     _lextok=*lptr;      /* if every match fails, return the character */

  2020     lptr+=1;            /* increase the "lptr" pointer */

  2021   } /* if */

  2023   if (pc_docexpr) {     /* optionally concatenate to documentation string */

  2024     char *docstr=(char*)malloc(((int)(lptr-starttoken)+1)*sizeof(char));

  2025     if (docstr!=NULL) {

  2026       strlcpy(docstr,(char*)starttoken,(int)(lptr-starttoken)+1);

  2027       insert_autolist(docstr);

  2028       free(docstr);

  2029     } /* if */

  2030   } /* if */

  2031   return _lextok;

  2032 }

  2034 /*  lexpush

  2035  *

  2036  *  Pushes a token back, so the next call to lex() will return the token

  2037  *  last examined, instead of a new token.

  2038  *

  2039  *  Only one token can be pushed back.

  2040  *

  2041  *  In fact, lex() already stores the information it finds into global

  2042  *  variables, so all that is to be done is set a flag that informs lex()

  2043  *  to read and return the information from these variables, rather than

  2044  *  to read in a new token from the input file.

  2045  */

  2046 SC_FUNC void lexpush(void)

  2047 {

  2048   assert(_pushed==FALSE);

  2049   _pushed=TRUE;

  2050 }

  2052 /*  lexclr

  2053  *

  2054  *  Sets the variable "_pushed" to 0 to make sure lex() will read in a new

  2055  *  symbol (a not continue with some old one). This is required upon return

  2056  *  from Assembler mode, and in a few cases after detecting an syntax error.

  2057  */

  2058 SC_FUNC void lexclr(int clreol)

  2059 {

  2060   _pushed=FALSE;

  2061   if (clreol) {

  2062     lptr=(unsigned char*)strchr((char*)pline,'\0');

  2063     assert(lptr!=NULL);

  2064   } /* if */

  2065 }

  2067 /*  matchtoken

  2068  *

  2069  *  This routine is useful if only a simple check is needed. If the token

  2070  *  differs from the one expected, it is pushed back.

  2071  *  This function returns 1 for "token found" and 2 for "implied statement

  2072  *  termination token" found --the statement termination is an end of line in

  2073  *  an expression where there is no pending operation. Such an implied token

  2074  *  (i.e. not present in the source code) should not be pushed back, which is

  2075  *  why it is sometimes important to distinguish the two.

  2076  */

  2077 SC_FUNC int matchtoken(int token)

  2078 {

  2079   cell val;

  2080   char *str;

  2081   int tok;

  2083   tok=lex(&val,&str);

  2084   if (tok==token || token==tTERM && (tok==';' || tok==tENDEXPR)) {

  2085     return 1;

  2086   } else if (!sc_needsemicolon && token==tTERM && (_lexnewline || !freading)) {

  2087     /* Push "tok" back, because it is the token following the implicit statement

  2088      * termination (newline) token.

  2089      */

  2090     lexpush();

  2091     return 2;

  2092   } else {

  2093     lexpush();

  2094     return 0;

  2095   } /* if */

  2096 }

  2098 /*  tokeninfo

  2099  *

  2100  *  Returns additional information of a token after using "matchtoken()"

  2101  *  or needtoken(). It does no harm using this routine after a call to

  2102  *  "lex()", but lex() already returns the same information.

  2103  *

  2104  *  The token itself is the return value. Normally, this one is already known.

  2105  */

  2106 SC_FUNC int tokeninfo(cell *val,char **str)

  2107 {

  2108   /* if the token was pushed back, tokeninfo() returns the token and

  2109    * parameters of the *next* token, not of the *current* token.

  2110    */

  2111   assert(!_pushed);

  2112   *val=_lexval;

  2113   *str=_lexstr;

  2114   return _lextok;

  2115 }

  2117 /*  needtoken

  2118  *

  2119  *  This routine checks for a required token and gives an error message if

  2120  *  it isn't there (and returns 0/FALSE in that case). Like function matchtoken(),

  2121  *  this function returns 1 for "token found" and 2 for "statement termination

  2122  *  token" found; see function matchtoken() for details.

  2123  *

  2124  *  Global references: _lextok;

  2125  */

  2126 SC_FUNC int needtoken(int token)

  2127 {

  2128   char s1[20],s2[20];

  2129   int t;

  2131   if ((t=matchtoken(token))!=0) {

  2132     return t;

  2133   } else {

  2134     /* token already pushed back */

  2135     assert(_pushed);

  2136     if (token<256)

  2137       sprintf(s1,"%c",(char)token);        /* single character token */

  2138     else

  2139       strcpy(s1,sc_tokens[token-tFIRST]);  /* multi-character symbol */

  2140     if (!freading)

  2141       strcpy(s2,"-end of file-");

  2142     else if (_lextok<256)

  2143       sprintf(s2,"%c",(char)_lextok);

  2144     else

  2145       strcpy(s2,sc_tokens[_lextok-tFIRST]);

  2146     error(1,s1,s2);     /* expected ..., but found ... */

  2147     return FALSE;

  2148   } /* if */

  2149 }

  2151 /*  match

  2152  *

  2153  *  Compares a series of characters from the input file with the characters

  2154  *  in "st" (that contains a token). If the token on the input file matches

  2155  *  "st", the input file pointer "lptr" is adjusted to point to the next

  2156  *  token, otherwise "lptr" remains unaltered.

  2157  *

  2158  *  If the parameter "end: is true, match() requires that the first character

  2159  *  behind the recognized token is non-alphanumeric.

  2160  *

  2161  *  Global references: lptr   (altered)

  2162  */

  2163 static int match(char *st,int end)

  2164 {

  2165   int k;

  2166   const unsigned char *ptr;

  2168   k=0;

  2169   ptr=lptr;

  2170   while (st[k]) {

  2171     if ((unsigned char)st[k]!=*ptr)

  2172       return 0;

  2173     k+=1;

  2174     ptr+=1;

  2175   } /* while */

  2176   if (end) {            /* symbol must terminate with non-alphanumeric char */

  2177     if (alphanum(*ptr))

  2178       return 0;

  2179   } /* if */

  2180   lptr=ptr;     /* match found, skip symbol */

  2181   return 1;

  2182 }

  2184 static void chk_grow_litq(void)

  2185 {

  2186   if (litidx>=litmax) {

  2187     cell *p;

  2189     litmax+=sDEF_LITMAX;

  2190     p=(cell *)realloc(litq,litmax*sizeof(cell));

  2191     if (p==NULL)

  2192       error(122,"literal table");   /* literal table overflow (fatal error) */

  2193     litq=p;

  2194   } /* if */

  2195 }

  2197 /*  litadd

  2198  *

  2199  *  Adds a value at the end of the literal queue. The literal queue is used

  2200  *  for literal strings used in functions and for initializing array variables.

  2201  *

  2202  *  Global references: litidx  (altered)

  2203  *                     litq    (altered)

  2204  */

  2205 SC_FUNC void litadd(cell value)

  2206 {

  2207   chk_grow_litq();

  2208   assert(litidx<litmax);

  2209   litq[litidx++]=value;

  2210 }

  2212 /*  litinsert

  2213  *

  2214  *  Inserts a value into the literal queue. This is sometimes necessary for

  2215  *  initializing multi-dimensional arrays.

  2216  *

  2217  *  Global references: litidx  (altered)

  2218  *                     litq    (altered)

  2219  */

  2220 SC_FUNC void litinsert(cell value,int pos)

  2221 {

  2222   chk_grow_litq();

  2223   assert(litidx<litmax);

  2224   assert(pos>=0 && pos<=litidx);

  2225   memmove(litq+(pos+1),litq+pos,(litidx-pos)*sizeof(cell));

  2226   litidx++;

  2227   litq[pos]=value;

  2228 }

  2230 /*  litchar

  2231  *

  2232  *  Return current literal character and increase the pointer to point

  2233  *  just behind this literal character.

  2234  *

  2235  *  Note: standard "escape sequences" are suported, but the backslash may be

  2236  *        replaced by another character; the syntax '\ddd' is supported,

  2237  *        but ddd must be decimal!

  2238  */

  2239 static cell litchar(const unsigned char **lptr,int flags)

  2240 {

  2241   cell c=0;

  2242   const unsigned char *cptr;

  2244   cptr=*lptr;

  2245   if ((flags & RAWMODE)!=0 || *cptr!=sc_ctrlchar) {  /* no escape character */

  2246     #if !defined NO_UTF8

  2247       if (sc_is_utf8 && (flags & UTF8MODE)!=0) {

  2248         c=get_utf8_char(cptr,&cptr);

  2249         assert(c>=0);   /* file was already scanned for conformance to UTF-8 */

  2250       } else {

  2251     #endif

  2252       #if !defined NO_CODEPAGE

  2253         c=cp_translate(cptr,&cptr);

  2254       #else

  2255         c=*cptr;

  2256         cptr+=1;

  2257       #endif

  2258     #if !defined NO_UTF8

  2259       } /* if */

  2260     #endif

  2261   } else {

  2262     cptr+=1;

  2263     if (*cptr==sc_ctrlchar) {

  2264       c=*cptr;          /* \\ == \ (the escape character itself) */

  2265       cptr+=1;

  2266     } else {

  2267       switch (*cptr) {

  2268       case 'a':         /* \a == audible alarm */

  2269         c=7;

  2270         cptr+=1;

  2271         break;

  2272       case 'b':         /* \b == backspace */

  2273         c=8;

  2274         cptr+=1;

  2275         break;

  2276       case 'e':         /* \e == escape */

  2277         c=27;

  2278         cptr+=1;

  2279         break;

  2280       case 'f':         /* \f == form feed */

  2281         c=12;

  2282         cptr+=1;

  2283         break;

  2284       case 'n':         /* \n == NewLine character */

  2285         c=10;

  2286         cptr+=1;

  2287         break;

  2288       case 'r':         /* \r == carriage return */

  2289         c=13;

  2290         cptr+=1;

  2291         break;

  2292       case 't':         /* \t == horizontal TAB */

  2293         c=9;

  2294         cptr+=1;

  2295         break;

  2296       case 'v':         /* \v == vertical TAB */

  2297         c=11;

  2298         cptr+=1;

  2299         break;

  2300       case 'x':

  2301       {

  2302         int digits = 0;

  2303         cptr+=1;

  2304         c=0;

  2305         while (ishex(*cptr) && digits < 2) {

  2306           if (isdigit(*cptr))

  2307             c=(c<<4)+(*cptr-'0');

  2308           else

  2309             c=(c<<4)+(tolower(*cptr)-'a'+10);

  2310           cptr++;

  2311           digits++;

  2312         } /* while */

  2313         if (*cptr==';')

  2314           cptr++;       /* swallow a trailing ';' */

  2315         break;

  2316       }

  2317       case '\'':        /* \' == ' (single quote) */

  2318       case '"':         /* \" == " (single quote) */

  2319       case '%':         /* \% == % (percent) */

  2320         c=*cptr;

  2321         cptr+=1;

  2322         break;

  2323       default:

  2324         if (isdigit(*cptr)) {   /* \ddd */

  2325           c=0;

  2326           while (*cptr>='0' && *cptr<='9')  /* decimal! */

  2327             c=c*10 + *cptr++ - '0';

  2328           if (*cptr==';')

  2329             cptr++;     /* swallow a trailing ';' */

  2330         } else {

  2331           error(27);    /* invalid character constant */

  2332         } /* if */

  2333       } /* switch */

  2334     } /* if */

  2335   } /* if */

  2336   *lptr=cptr;

  2337   assert(c>=0);

  2338   return c;

  2339 }

  2341 /*  alpha

  2342  *

  2343  *  Test if character "c" is alphabetic ("a".."z"), an underscore ("_")

  2344  *  or an "at" sign ("@"). The "@" is an extension to standard C.

  2345  */

  2346 static int alpha(char c)

  2347 {

  2348   return (isalpha(c) || c=='_' || c==PUBLIC_CHAR);

  2349 }

  2351 /*  alphanum

  2352  *

  2353  *  Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")

  2354  */

  2355 SC_FUNC int alphanum(char c)

  2356 {

  2357   return (alpha(c) || isdigit(c));

  2358 }

  2360 /*  ishex

  2361  *

  2362  *  Test if character "c" is a hexadecimal digit ("0".."9" or "a".."f").

  2363  */

  2364 SC_FUNC int ishex(char c)

  2365 {

  2366   return (c>='0' && c<='9') || (c>='a' && c<='f') || (c>='A' && c<='F');

  2367 }

  2369 /* The local variable table must be searched backwards, so that the deepest

  2370  * nesting of local variables is searched first. The simplest way to do

  2371  * this is to insert all new items at the head of the list.

  2372  * In the global list, the symbols are kept in sorted order, so that the

  2373  * public functions are written in sorted order.

  2374  */

  2375 static symbol *add_symbol(symbol *root,symbol *entry,int sort)

  2376 {

  2377   symbol *newsym;

  2378   int global = root==&glbtab;

  2380   if (sort)

  2381     while (root->next!=NULL && strcmp(entry->name,root->next->name)>0)

  2382       root=root->next;

  2384   if ((newsym=(symbol *)malloc(sizeof(symbol)))==NULL) {

  2385     error(123);

  2386     return NULL;

  2387   } /* if */

  2388   memcpy(newsym,entry,sizeof(symbol));

  2389   newsym->next=root->next;

  2390   root->next=newsym;

  2391   if (global)

  2392     AddToHashTable(sp_Globals, newsym);

  2393   return newsym;

  2394 }

  2396 static void free_symbol(symbol *sym)

  2397 {

  2398   arginfo *arg;

  2400   /* free all sub-symbol allocated memory blocks, depending on the

  2401    * kind of the symbol

  2402    */

  2403   assert(sym!=NULL);

  2404   if (sym->ident==iFUNCTN) {

  2405     /* run through the argument list; "default array" arguments

  2406      * must be freed explicitly; the tag list must also be freed */

  2407     assert(sym->dim.arglist!=NULL);

  2408     for (arg=sym->dim.arglist; arg->ident!=0; arg++) {

  2409       if (arg->ident==iREFARRAY && arg->hasdefault)

  2410         free(arg->defvalue.array.data);

  2411       else if (arg->ident==iVARIABLE

  2412                && ((arg->hasdefault & uSIZEOF)!=0 || (arg->hasdefault & uTAGOF)!=0))

  2413         free(arg->defvalue.size.symname);

  2414       assert(arg->tags!=NULL);

  2415       free(arg->tags);

  2416     } /* for */

  2417     free(sym->dim.arglist);

  2418     if (sym->states!=NULL) {

  2419       delete_consttable(sym->states);

  2420       free(sym->states);

  2421     } /* if */

  2422   } else if (sym->ident==iVARIABLE || sym->ident==iARRAY) {

  2423     if (sym->states!=NULL) {

  2424       delete_consttable(sym->states);

  2425       free(sym->states);

  2426     } /* if */

  2427   } else if (sym->ident==iCONSTEXPR && (sym->usage & uENUMROOT)==uENUMROOT) {

  2428     /* free the constant list of an enum root */

  2429     assert(sym->dim.enumlist!=NULL);

  2430     delete_consttable(sym->dim.enumlist);

  2431     free(sym->dim.enumlist);

  2432   } /* if */

  2433   assert(sym->refer!=NULL);

  2434   free(sym->refer);

  2435   if (sym->documentation!=NULL)

  2436     free(sym->documentation);

  2437   free(sym);

  2438 }

  2440 SC_FUNC void delete_symbol(symbol *root,symbol *sym)

  2441 {

  2442   symbol *origRoot=root;

  2443   /* find the symbol and its predecessor

  2444    * (this function assumes that you will never delete a symbol that is not

  2445    * in the table pointed at by "root")

  2446    */

  2447   assert(root!=sym);

  2448   while (root->next!=sym) {

  2449     root=root->next;

  2450     assert(root!=NULL);

  2451   } /* while */

  2453   if (origRoot==&glbtab)

  2454     RemoveFromHashTable(sp_Globals, sym);

  2456   /* unlink it, then free it */

  2457   root->next=sym->next;

  2458   free_symbol(sym);

  2459 }

  2461 SC_FUNC void delete_symbols(symbol *root,int level,int delete_labels,int delete_functions)

  2462 {

  2463   symbol *origRoot=root;

  2464   symbol *sym,*parent_sym;

  2465   constvalue *stateptr;

  2466   int mustdelete;

  2468   /* erase only the symbols with a deeper nesting level than the

  2469    * specified nesting level */

  2470   while (root->next!=NULL) {

  2471     sym=root->next;

  2472     if (sym->compound<level)

  2473       break;

  2474     switch (sym->ident) {

  2475     case iLABEL:

  2476       mustdelete=delete_labels;

  2477       break;

  2478     case iVARIABLE:

  2479     case iARRAY:

  2480       /* do not delete global variables if functions are preserved */

  2481       mustdelete=delete_functions;

  2482       break;

  2483     case iREFERENCE:

  2484       /* always delete references (only exist as function parameters) */

  2485       mustdelete=TRUE;

  2486       break;

  2487     case iREFARRAY:

  2488       /* a global iREFARRAY symbol is the return value of a function: delete

  2489        * this only if "globals" must be deleted; other iREFARRAY instances

  2490        * (locals) are also deleted

  2491        */

  2492       mustdelete=delete_functions;

  2493       for (parent_sym=sym->parent; parent_sym!=NULL && parent_sym->ident!=iFUNCTN; parent_sym=parent_sym->parent)

  2494         assert(parent_sym->ident==iREFARRAY);

  2495       assert(parent_sym==NULL || (parent_sym->ident==iFUNCTN && parent_sym->parent==NULL));

  2496       if (parent_sym==NULL || parent_sym->ident!=iFUNCTN)

  2497         mustdelete=TRUE;

  2498       break;

  2499     case iCONSTEXPR:

  2500       /* delete constants, except predefined constants */

  2501       mustdelete=delete_functions || (sym->usage & uPREDEF)==0;

  2502       break;

  2503     case iFUNCTN:

  2504       /* optionally preserve globals (variables & functions), but

  2505        * NOT native functions

  2506        */

  2507       mustdelete=delete_functions || (sym->usage & uNATIVE)!=0;

  2508       assert(sym->parent==NULL);

  2509       break;

  2510     case iARRAYCELL:

  2511     case iARRAYCHAR:

  2512     case iEXPRESSION:

  2513     case iVARARGS:

  2514     default:

  2515       assert(0);

  2516       break;

  2517     } /* switch */

  2518     if (mustdelete) {

  2519       if (origRoot == &glbtab)

  2520         RemoveFromHashTable(sp_Globals, sym);

  2521       root->next=sym->next;

  2522       free_symbol(sym);

  2523     } else {

  2524       /* if the function was prototyped, but not implemented in this source,

  2525        * mark it as such, so that its use can be flagged

  2526        */

  2527       if (sym->ident==iFUNCTN && (sym->usage & uDEFINE)==0)

  2528         sym->usage |= uMISSING;

  2529       if (sym->ident==iFUNCTN || sym->ident==iVARIABLE || sym->ident==iARRAY)

  2530         sym->usage &= ~uDEFINE; /* clear "defined" flag */

  2531       /* set all states as "undefined" too */

  2532       if (sym->states!=NULL)

  2533         for (stateptr=sym->states->next; stateptr!=NULL; stateptr=stateptr->next)

  2534           stateptr->value=0;

  2535       /* for user defined operators, also remove the "prototyped" flag, as

  2536        * user-defined operators *must* be declared before use

  2537        */

  2538       if (sym->ident==iFUNCTN && !alpha(*sym->name))

  2539         sym->usage &= ~uPROTOTYPED;

  2540       root=sym;                 /* skip the symbol */

  2541     } /* if */

  2542   } /* if */

  2543 }

  2545 static symbol *find_symbol(const symbol *root,const char *name,int fnumber,int automaton,int *cmptag)

  2546 {

  2547   symbol *firstmatch=NULL;

  2548   symbol *sym=root->next;

  2549   int count=0;

  2550   unsigned long hash=NameHash(name);

  2551   while (sym!=NULL) {

  2552     if (hash==sym->hash && strcmp(name,sym->name)==0        /* check name */

  2553         && (sym->parent==NULL || sym->ident==iCONSTEXPR)    /* sub-types (hierarchical types) are skipped, except for enum fields */

  2554         && (sym->fnumber<0 || sym->fnumber==fnumber))       /* check file number for scope */

  2555     {

  2556       assert(sym->states==NULL || sym->states->next!=NULL); /* first element of the state list is the "root" */

  2557       if (sym->ident==iFUNCTN

  2558           || automaton<0 && sym->states==NULL

  2559           || automaton>=0 && sym->states!=NULL && state_getfsa(sym->states->next->index)==automaton)

  2560       {

  2561         if (cmptag==NULL)

  2562           return sym;   /* return first match */

  2563         /* return closest match or first match; count number of matches */

  2564         if (firstmatch==NULL)

  2565           firstmatch=sym;

  2566         assert(cmptag!=NULL);

  2567         if (*cmptag==0)

  2568           count++;

  2569         if (*cmptag==sym->tag) {

  2570           *cmptag=1;    /* good match found, set number of matches to 1 */

  2571           return sym;

  2572         } /* if */

  2573       } /* if */

  2574     } /*  */

  2575     sym=sym->next;

  2576   } /* while */

  2577   if (cmptag!=NULL && firstmatch!=NULL)

  2578     *cmptag=count;

  2579   return firstmatch;

  2580 }

  2582 static symbol *find_symbol_child(const symbol *root,const symbol *sym)

  2583 {

  2584   symbol *ptr=root->next;

  2585   while (ptr!=NULL) {

  2586     if (ptr->parent==sym)

  2587       return ptr;

  2588     ptr=ptr->next;

  2589   } /* while */

  2590   return NULL;

  2591 }

  2593 /* Adds "bywhom" to the list of referrers of "entry". Typically,

  2594  * bywhom will be the function that uses a variable or that calls

  2595  * the function.

  2596  */

  2597 SC_FUNC int refer_symbol(symbol *entry,symbol *bywhom)

  2598 {

  2599   int count;

  2601   assert(bywhom!=NULL);         /* it makes no sense to add a "void" referrer */

  2602   assert(entry!=NULL);

  2603   assert(entry->refer!=NULL);

  2605   /* see if it is already there */

  2606   for (count=0; count<entry->numrefers && entry->refer[count]!=bywhom; count++)

  2607     /* nothing */;

  2608   if (count<entry->numrefers) {

  2609     assert(entry->refer[count]==bywhom);

  2610     return TRUE;

  2611   } /* if */

  2613   /* see if there is an empty spot in the referrer list */

  2614   for (count=0; count<entry->numrefers && entry->refer[count]!=NULL; count++)

  2615     /* nothing */;

  2616   assert(count <= entry->numrefers);

  2617   if (count==entry->numrefers) {

  2618     symbol **refer;

  2619     int newsize=2*entry->numrefers;

  2620     assert(newsize>0);

  2621     /* grow the referrer list */

  2622     refer=(symbol**)realloc(entry->refer,newsize*sizeof(symbol*));

  2623     if (refer==NULL)

  2624       return FALSE;             /* insufficient memory */

  2625     /* initialize the new entries */

  2626     entry->refer=refer;

  2627     for (count=entry->numrefers; count<newsize; count++)

  2628       entry->refer[count]=NULL;

  2629     count=entry->numrefers;     /* first empty spot */

  2630     entry->numrefers=newsize;

  2631   } /* if */

  2633   /* add the referrer */

  2634   assert(entry->refer[count]==NULL);

  2635   entry->refer[count]=bywhom;

  2636   return TRUE;

  2637 }

  2639 SC_FUNC void markusage(symbol *sym,int usage)

  2640 {

  2641   assert(sym!=NULL);

  2642   sym->usage |= (char)usage;

  2643   if ((usage & uWRITTEN)!=0)

  2644     sym->lnumber=fline;

  2645   /* check if (global) reference must be added to the symbol */

  2646   if ((usage & (uREAD | uWRITTEN))!=0) {

  2647     /* only do this for global symbols */

  2648     if (sym->vclass==sGLOBAL) {

  2649       /* "curfunc" should always be valid, since statements may not occurs

  2650        * outside functions; in the case of syntax errors, however, the

  2651        * compiler may arrive through this function

  2652        */

  2653       if (curfunc!=NULL)

  2654         refer_symbol(sym,curfunc);

  2655     } /* if */

  2656   } /* if */

  2657 }

  2660 /*  findglb

  2661  *

  2662  *  Returns a pointer to the global symbol (if found) or NULL (if not found)

  2663  */

  2664 SC_FUNC symbol *findglb(const char *name,int filter)

  2665 {

  2666   /* find a symbol with a matching automaton first */

  2667   symbol *sym=NULL;

  2669   if (filter>sGLOBAL && sc_curstates>0) {

  2670     /* find a symbol whose state list matches the current fsa */

  2671     sym=find_symbol(&glbtab,name,fcurrent,state_getfsa(sc_curstates),NULL);

  2672     if (sym!=NULL && sym->ident!=iFUNCTN) {

  2673       /* if sym!=NULL, we found a variable in the automaton; now we should

  2674        * also verify whether there is an intersection between the symbol's

  2675        * state list and the current state list

  2676        */

  2677       assert(sym->states!=NULL && sym->states->next!=NULL);

  2678       if (!state_conflict_id(sc_curstates,sym->states->next->index))

  2679         sym=NULL;

  2680     } /* if */

  2681   } /* if */

  2683   /* if no symbol with a matching automaton exists, find a variable/function

  2684    * that has no state(s) attached to it

  2685    */

  2686   if (sym==NULL)

  2687     sym=FindInHashTable(sp_Globals,name,fcurrent);

  2688   return sym;

  2689 }

  2691 /*  findloc

  2692  *

  2693  *  Returns a pointer to the local symbol (if found) or NULL (if not found).

  2694  *  See add_symbol() how the deepest nesting level is searched first.

  2695  */

  2696 SC_FUNC symbol *findloc(const char *name)

  2697 {

  2698   return find_symbol(&loctab,name,-1,-1,NULL);

  2699 }

  2701 SC_FUNC symbol *findconst(const char *name,int *cmptag)

  2702 {

  2703   symbol *sym;

  2705   sym=find_symbol(&loctab,name,-1,-1,cmptag);  /* try local symbols first */

  2706   if (sym==NULL || sym->ident!=iCONSTEXPR) {   /* not found, or not a constant */

  2707     if (cmptag)

  2708       sym=FindTaggedInHashTable(sp_Globals,name,fcurrent,cmptag);

  2709     else

  2710       sym=FindInHashTable(sp_Globals,name,fcurrent);

  2711   }

  2712   if (sym==NULL || sym->ident!=iCONSTEXPR)

  2713     return NULL;

  2714   assert(sym->parent==NULL || (sym->usage & uENUMFIELD)!=0);

  2715   /* ^^^ constants have no hierarchy, but enumeration fields may have a parent */

  2716   return sym;

  2717 }

  2719 SC_FUNC symbol *finddepend(const symbol *parent)

  2720 {

  2721   symbol *sym;

  2723   sym=find_symbol_child(&loctab,parent);    /* try local symbols first */

  2724   if (sym==NULL)                            /* not found */

  2725     sym=find_symbol_child(&glbtab,parent);

  2726   return sym;

  2727 }

  2729 /*  addsym

  2730  *

  2731  *  Adds a symbol to the symbol table (either global or local variables,

  2732  *  or global and local constants).

  2733  */

  2734 SC_FUNC symbol *addsym(const char *name,cell addr,int ident,int vclass,int tag,int usage)

  2735 {

  2736   symbol entry, **refer;

  2738   /* labels may only be defined once */

  2739   assert(ident!=iLABEL || findloc(name)==NULL);

  2741   /* create an empty referrer list */

  2742   if ((refer=(symbol**)malloc(sizeof(symbol*)))==NULL) {

  2743     error(123);         /* insufficient memory */

  2744     return NULL;

  2745   } /* if */

  2746   *refer=NULL;

  2748   /* first fill in the entry */

  2749   memset(&entry,0,sizeof entry);

  2750   strcpy(entry.name,name);

  2751   entry.hash=NameHash(name);

  2752   entry.addr=addr;

  2753   entry.codeaddr=code_idx;

  2754   entry.vclass=(char)vclass;

  2755   entry.ident=(char)ident;

  2756   entry.tag=tag;

  2757   entry.usage=(char)usage;

  2758   entry.fnumber=-1;     /* assume global visibility (ignored for local symbols) */

  2759   entry.lnumber=fline;

  2760   entry.numrefers=1;

  2761   entry.refer=refer;

  2763   /* then insert it in the list */

  2764   if (vclass==sGLOBAL)

  2765     return add_symbol(&glbtab,&entry,TRUE);

  2766   return add_symbol(&loctab,&entry,FALSE);

  2767 }

  2769 SC_FUNC symbol *addvariable(const char *name,cell addr,int ident,int vclass,int tag,

  2770                             int dim[],int numdim,int idxtag[])

  2771 {

  2772   return addvariable2(name,addr,ident,vclass,tag,dim,numdim,idxtag,0);

  2773 }

  2775 SC_FUNC symbol *addvariable2(const char *name,cell addr,int ident,int vclass,int tag,

  2776                             int dim[],int numdim,int idxtag[],int slength)

  2777 {

  2778   symbol *sym;

  2780   /* global variables may only be defined once

  2781    * One complication is that functions returning arrays declare an array

  2782    * with the same name as the function, so the assertion must allow for

  2783    * this special case. Another complication is that variables may be

  2784    * "redeclared" if they are local to an automaton (and findglb() will find

  2785    * the symbol without states if no symbol with states exists).

  2786    */

  2787   assert(vclass!=sGLOBAL || (sym=findglb(name,sGLOBAL))==NULL || (sym->usage & uDEFINE)==0

  2788          || sym->ident==iFUNCTN && sym==curfunc

  2789          || sym->states==NULL && sc_curstates>0);

  2791   if (ident==iARRAY || ident==iREFARRAY) {

  2792     symbol *parent=NULL,*top;

  2793     int level;

  2794     sym=NULL;                   /* to avoid a compiler warning */

  2795     for (level=0; level<numdim; level++) {

  2796       top=addsym(name,addr,ident,vclass,tag,uDEFINE);

  2797       top->dim.array.length=dim[level];

  2798       if (tag == pc_tag_string && level == numdim - 1) {

  2799         if (slength == 0)

  2800           top->dim.array.length=dim[level] * sizeof(cell);

  2801         else

  2802           top->dim.array.slength=slength;

  2803       } else {

  2804         top->dim.array.slength=0;

  2805       }

  2806       top->dim.array.level=(short)(numdim-level-1);

  2807       top->x.tags.index=idxtag[level];

  2808       top->parent=parent;

  2809       parent=top;

  2810       if (level==0)

  2811         sym=top;

  2812     } /* for */

  2813   } else {

  2814     sym=addsym(name,addr,ident,vclass,tag,uDEFINE);

  2815   } /* if */

  2816   return sym;

  2817 }

  2819 /*  getlabel

  2820  *

  2821  *  Returns te next internal label number. The global variable sc_labnum is

  2822  *  initialized to zero.

  2823  */

  2824 SC_FUNC int getlabel(void)

  2825 {

  2826   return sc_labnum++;

  2827 }

  2829 /*  itoh

  2830  *

  2831  *  Converts a number to a hexadecimal string and returns a pointer to that

  2832  *  string. This function is NOT re-entrant.

  2833  */

  2834 SC_FUNC char *itoh(ucell val)

  2835 {

  2836 static char itohstr[30];

  2837   char *ptr;

  2838   int i,nibble[16];             /* a 64-bit hexadecimal cell has 16 nibbles */

  2839   int max;

  2841   #if PAWN_CELL_SIZE==16

  2842     max=4;

  2843   #elif PAWN_CELL_SIZE==32

  2844     max=8;

  2845   #elif PAWN_CELL_SIZE==64

  2846     max=16;

  2847   #else

  2848     #error Unsupported cell size

  2849   #endif

  2850   ptr=itohstr;

  2851   for (i=0; i<max; i+=1){

  2852     nibble[i]=(int)(val & 0x0f);        /* nibble 0 is lowest nibble */

  2853     val>>=4;

  2854   } /* endfor */

  2855   i=max-1;

  2856   while (nibble[i]==0 && i>0)   /* search for highest non-zero nibble */

  2857     i-=1;

  2858   while (i>=0){

  2859     if (nibble[i]>=10)

  2860       *ptr++=(char)('a'+(nibble[i]-10));

  2861     else

  2862       *ptr++=(char)('0'+nibble[i]);

  2863     i-=1;

  2864   } /* while */

  2865   *ptr='\0';            /* and a zero-terminator */

  2866   return itohstr;

  2867 }

author	Asher Baker <asherkin@gmail.com>
	Sun Jul 29 02:51:50 2012 +0100 (2012-07-29)
changeset 3590	6908e80a69af
parent 3446	a24e57e5f704
child 3951	c3f26df2183f
permissions	-rw-r--r--