API tools faq
paste
Advertisement
Guest User

Untitled

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