sourcepawn/compiler/sc1.c
author David Anderson <dvander@alliedmods.net>
Thu Mar 15 20:44:23 2007 +0000 (2007-03-15)
changeset 619 6934bf39171e
parent 563 2425eed806b8
child 632 5fd3bbbf2dc0
permissions -rw-r--r--
random touchups that might not be so great
     1 /*  Pawn compiler
     2  *
     3  *  Function and variable definition and declaration, statement parser.
     4  *
     5  *  Copyright (c) ITB CompuPhase, 1997-2006
     6  *
     7  *  This software is provided "as-is", without any express or implied warranty.
     8  *  In no event will the authors be held liable for any damages arising from
     9  *  the use of this software.
    10  *
    11  *  Permission is granted to anyone to use this software for any purpose,
    12  *  including commercial applications, and to alter it and redistribute it
    13  *  freely, subject to the following restrictions:
    14  *
    15  *  1.  The origin of this software must not be misrepresented; you must not
    16  *      claim that you wrote the original software. If you use this software in
    17  *      a product, an acknowledgment in the product documentation would be
    18  *      appreciated but is not required.
    19  *  2.  Altered source versions must be plainly marked as such, and must not be
    20  *      misrepresented as being the original software.
    21  *  3.  This notice may not be removed or altered from any source distribution.
    22  *
    23  *  Version: $Id$
    24  */
    25 #include <assert.h>
    26 #include <ctype.h>
    27 #include <limits.h>
    28 #include <stdarg.h>
    29 #include <stdio.h>
    30 #include <stdlib.h>
    31 #include <string.h>
    32 
    33 #if defined	__WIN32__ || defined _WIN32 || defined __MSDOS__
    34   #include <conio.h>
    35   #include <io.h>
    36 #endif
    37 
    38 #if defined LINUX || defined __FreeBSD__ || defined __OpenBSD__
    39   #include <sclinux.h>
    40   #include <binreloc.h> /* from BinReloc, see www.autopackage.org */
    41 #endif
    42 
    43 #if defined FORTIFY
    44   #include <alloc/fortify.h>
    45 #endif
    46 
    47 #if defined __BORLANDC__ || defined __WATCOMC__
    48   #include <dos.h>
    49   static unsigned total_drives; /* dummy variable */
    50   #define dos_setdrive(i)       _dos_setdrive(i,&total_drives)
    51 #elif defined _MSC_VER && defined _WIN32
    52   #include <direct.h>           /* for _chdrive() */
    53   #define dos_setdrive(i)       _chdrive(i)
    54 #endif
    55 #if defined __BORLANDC__
    56   #include <dir.h>              /* for chdir() */
    57 #elif defined __WATCOMC__
    58   #include <direct.h>           /* for chdir() */
    59 #endif
    60 #if defined __WIN32__ || defined _WIN32 || defined _Windows
    61   #include <windows.h>
    62 #endif
    63 
    64 #include <time.h>
    65 
    66 #include "lstring.h"
    67 #include "sc.h"
    68 #include "svn_version.h"
    69 #include "sctracker.h"
    70 #define VERSION_STR "3.2.3636"
    71 #define VERSION_INT 0x0302
    72 
    73 int pc_functag = 0;
    74 int pc_tag_string = 0;
    75 
    76 static void resetglobals(void);
    77 static void initglobals(void);
    78 static char *get_extension(char *filename);
    79 static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
    80                    char *rname,char *codepage);
    81 static void setconfig(char *root);
    82 static void setcaption(void);
    83 static void about(void);
    84 static void setconstants(void);
    85 static void parse(void);
    86 static void dumplits(void);
    87 static void dumpzero(int count);
    88 static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst);
    89 static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,
    90                     int stock,int fconst);
    91 static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct);
    92 static int declloc(int fstatic);
    93 static void decl_const(int table);
    94 static void declstruct();
    95 static void decl_enum(int table);
    96 static cell needsub(int *tag,constvalue **enumroot);
    97 static void initials(int ident,int tag,cell *size,int dim[],int numdim,
    98                      constvalue *enumroot);
    99 static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
   100                       int startlit,int counteddim[],constvalue *lastdim,
   101                       constvalue *enumroot,int *errorfound);
   102 static cell initvector(int ident,int tag,cell size,int fillzero,
   103                        constvalue *enumroot,int *errorfound);
   104 static cell init(int ident,int *tag,int *errorfound);
   105 static int getstates(const char *funcname);
   106 static void attachstatelist(symbol *sym, int state_id);
   107 static void funcstub(int fnative);
   108 static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock);
   109 static int declargs(symbol *sym,int chkshadow);
   110 static void doarg(char *name,int ident,int offset,int tags[],int numtags,
   111                   int fpublic,int fconst,int chkshadow,arginfo *arg);
   112 static void make_report(symbol *root,FILE *log,char *sourcefile);
   113 static void reduce_referrers(symbol *root);
   114 static long max_stacksize(symbol *root,int *recursion);
   115 static int testsymbols(symbol *root,int level,int testlabs,int testconst);
   116 static void destructsymbols(symbol *root,int level);
   117 static constvalue *find_constval_byval(constvalue *table,cell val);
   118 static symbol *fetchlab(char *name);
   119 static void statement(int *lastindent,int allow_decl);
   120 static void compound(int stmt_sameline,int starttok);
   121 static int test(int label,int parens,int invert);
   122 static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
   123                   int *tag,symbol **symptr,int chkfuncresult);
   124 static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
   125 				  int *tag,symbol **symptr,int chkfuncresult,value *lval);
   126 static void doassert(void);
   127 static void doexit(void);
   128 static int doif(void);
   129 static int dowhile(void);
   130 static int dodo(void);
   131 static int dofor(void);
   132 static void doswitch(void);
   133 static void dogoto(void);
   134 static void dolabel(void);
   135 static void doreturn(void);
   136 static void dofuncenum(int listmode);
   137 static void dobreak(void);
   138 static void docont(void);
   139 static void dosleep(void);
   140 static void dostate(void);
   141 static void addwhile(int *ptr);
   142 static void delwhile(void);
   143 static int *readwhile(void);
   144 static void inst_datetime_defines(void);
   145 
   146 enum {
   147   TEST_PLAIN,           /* no parentheses */
   148   TEST_THEN,            /* '(' <expr> ')' or <expr> 'then' */
   149   TEST_DO,              /* '(' <expr> ')' or <expr> 'do' */
   150   TEST_OPT,             /* '(' <expr> ')' or <expr> */
   151 };
   152 static int norun      = 0;      /* the compiler never ran */
   153 static int autozero   = 1;      /* if 1 will zero out the variable, if 0 omit the zeroing */
   154 static int lastst     = 0;      /* last executed statement type */
   155 static int nestlevel  = 0;      /* number of active (open) compound statements */
   156 static int endlessloop= 0;      /* nesting level of endless loop */
   157 static int rettype    = 0;      /* the type that a "return" expression should have */
   158 static int skipinput  = 0;      /* number of lines to skip from the first input file */
   159 static int optproccall = TRUE;  /* support "procedure call" */
   160 static int verbosity  = 1;      /* verbosity level, 0=quiet, 1=normal, 2=verbose */
   161 static int sc_reparse = 0;      /* needs 3th parse because of changed prototypes? */
   162 static int sc_parsenum = 0;     /* number of the extra parses */
   163 static int wq[wqTABSZ];         /* "while queue", internal stack for nested loops */
   164 static int *wqptr;              /* pointer to next entry */
   165 #if !defined SC_LIGHT
   166   static char sc_rootpath[_MAX_PATH];
   167   static char *sc_documentation=NULL;/* main documentation */
   168 #endif
   169 #if defined	__WIN32__ || defined _WIN32 || defined _Windows
   170   static HWND hwndFinish = 0;
   171 #endif
   172 
   173 SC_VDECL int glbstringread = 0;
   174 char g_tmpfile[_MAX_PATH] = {0};
   175 
   176 /*  "main" of the compiler
   177  */
   178 #if defined __cplusplus
   179   extern "C"
   180 #endif
   181 int pc_compile(int argc, char *argv[])
   182 {
   183   int entry,i,jmpcode;
   184   int retcode;
   185   char incfname[_MAX_PATH];
   186   char reportname[_MAX_PATH];
   187   char codepage[MAXCODEPAGE+1];
   188   FILE *binf;
   189   void *inpfmark;
   190   int lcl_packstr,lcl_needsemicolon,lcl_tabsize;
   191   #if !defined SC_LIGHT
   192     int hdrsize=0;
   193   #endif
   194   char *ptr;
   195 
   196   /* set global variables to their initial value */
   197   binf=NULL;
   198   initglobals();
   199   errorset(sRESET,0);
   200   errorset(sEXPRRELEASE,0);
   201   lexinit();
   202 
   203   /* make sure that we clean up on a fatal error; do this before the first
   204    * call to error(). */
   205   if ((jmpcode=setjmp(errbuf))!=0)
   206     goto cleanup;
   207 
   208   /* allocate memory for fixed tables */
   209   inpfname=(char*)malloc(_MAX_PATH);
   210   if (inpfname==NULL)
   211     error(103);         /* insufficient memory */
   212   litq=(cell*)malloc(litmax*sizeof(cell));
   213   if (litq==NULL)
   214     error(103);         /* insufficient memory */
   215   if (!phopt_init())
   216     error(103);         /* insufficient memory */
   217 
   218   setopt(argc,argv,outfname,errfname,incfname,reportname,codepage);
   219   strcpy(binfname,outfname);
   220   ptr=get_extension(binfname);
   221   if (ptr!=NULL && stricmp(ptr,".asm")==0)
   222     set_extension(binfname,".smx",TRUE);
   223   else
   224     set_extension(binfname,".smx",FALSE);
   225   /* set output names that depend on the input name */
   226   if (sc_listing)
   227     set_extension(outfname,".lst",TRUE);
   228   else
   229     set_extension(outfname,".asm",TRUE);
   230   if (strlen(errfname)!=0)
   231     remove(errfname);   /* delete file on startup */
   232   else if (verbosity>0)
   233     setcaption();
   234   setconfig(argv[0]);   /* the path to the include and codepage files */
   235   sc_ctrlchar_org=sc_ctrlchar;
   236   lcl_packstr=sc_packstr;
   237   lcl_needsemicolon=sc_needsemicolon;
   238   lcl_tabsize=sc_tabsize;
   239   #if !defined NO_CODEPAGE
   240     if (!cp_set(codepage))      /* set codepage */
   241       error(108);               /* codepage mapping file not found */
   242   #endif
   243   /* optionally create a temporary input file that is a collection of all
   244    * input files
   245    */
   246   assert(get_sourcefile(0)!=NULL);  /* there must be at least one source file */
   247   if (get_sourcefile(1)!=NULL) {
   248     /* there are at least two or more source files */
   249     char *tname,*sname;
   250     FILE *ftmp,*fsrc;
   251     int fidx;
   252     #if defined	__WIN32__ || defined _WIN32
   253       tname=_tempnam(NULL,"pawn");
   254     #elif defined __MSDOS__ || defined _Windows
   255       tname=tempnam(NULL,"pawn");
   256     #elif defined(MACOS) && !defined(__MACH__)
   257       /* tempnam is not supported for the Macintosh CFM build. */
   258       error(104,get_sourcefile(1));
   259       tname=NULL;
   260       sname=NULL;
   261     #else
   262       tname=tempnam(NULL,"pawn");
   263     #endif
   264     ftmp=(FILE*)pc_createsrc(tname);
   265     for (fidx=0; (sname=get_sourcefile(fidx))!=NULL; fidx++) {
   266       unsigned char tstring[128];
   267       fsrc=(FILE*)pc_opensrc(sname);
   268       if (fsrc==NULL) {
   269         pc_closesrc(ftmp);
   270         remove(tname);
   271         strcpy(inpfname,sname); /* avoid invalid filename */
   272         error(100,sname);
   273       } /* if */
   274       pc_writesrc(ftmp,(unsigned char*)"#file \"");
   275       pc_writesrc(ftmp,(unsigned char*)sname);
   276       pc_writesrc(ftmp,(unsigned char*)"\"\n");
   277       while (!pc_eofsrc(fsrc) && pc_readsrc(fsrc,tstring,sizeof tstring)) {
   278         pc_writesrc(ftmp,tstring);
   279       } /* while */
   280       pc_closesrc(fsrc);
   281     } /* for */
   282     pc_closesrc(ftmp);
   283     strcpy(inpfname,tname);
   284 	strcpy(g_tmpfile,tname);
   285     free(tname);
   286   } else {
   287     strcpy(inpfname,get_sourcefile(0));
   288   } /* if */
   289   inpf_org=(FILE*)pc_opensrc(inpfname);
   290   if (inpf_org==NULL)
   291     error(100,inpfname);
   292   freading=TRUE;
   293   outf=(FILE*)pc_openasm(outfname); /* first write to assembler file (may be temporary) */
   294   if (outf==NULL)
   295     error(101,outfname);
   296   /* immediately open the binary file, for other programs to check */
   297   if (sc_asmfile || sc_listing) {
   298     binf=NULL;
   299   } else {
   300     binf=(FILE*)pc_openbin(binfname);
   301     if (binf==NULL)
   302       error(101,binfname);
   303   } /* if */
   304   setconstants();               /* set predefined constants and tagnames */
   305   for (i=0; i<skipinput; i++)   /* skip lines in the input file */
   306     if (pc_readsrc(inpf_org,pline,sLINEMAX)!=NULL)
   307       fline++;                  /* keep line number up to date */
   308   skipinput=fline;
   309   sc_status=statFIRST;
   310   /* write starting options (from the command line or the configuration file) */
   311   if (sc_listing) {
   312     char string[150];
   313     sprintf(string,"#pragma ctrlchar 0x%02x\n"
   314                    "#pragma pack %s\n"
   315                    "#pragma semicolon %s\n"
   316                    "#pragma tabsize %d\n",
   317             sc_ctrlchar,
   318             sc_packstr ? "true" : "false",
   319             sc_needsemicolon ? "true" : "false",
   320             sc_tabsize);
   321     pc_writeasm(outf,string);
   322     setfiledirect(inpfname);
   323   } /* if */
   324   /* do the first pass through the file (or possibly two or more "first passes") */
   325   sc_parsenum=0;
   326   inpfmark=pc_getpossrc(inpf_org);
   327   do {
   328     /* reset "defined" flag of all functions and global variables */
   329     reduce_referrers(&glbtab);
   330     delete_symbols(&glbtab,0,TRUE,FALSE);
   331     #if !defined NO_DEFINE
   332       delete_substtable();
   333       inst_datetime_defines();
   334     #endif
   335     resetglobals();
   336     pstructs_free();
   337 	funcenums_free();
   338     sc_ctrlchar=sc_ctrlchar_org;
   339     sc_packstr=lcl_packstr;
   340     sc_needsemicolon=lcl_needsemicolon;
   341     sc_tabsize=lcl_tabsize;
   342     errorset(sRESET,0);
   343     /* reset the source file */
   344     inpf=inpf_org;
   345     freading=TRUE;
   346     pc_resetsrc(inpf,inpfmark); /* reset file position */
   347     fline=skipinput;            /* reset line number */
   348     sc_reparse=FALSE;           /* assume no extra passes */
   349     sc_status=statFIRST;        /* resetglobals() resets it to IDLE */
   350 
   351     if (strlen(incfname)>0) {
   352       if (strcmp(incfname,sDEF_PREFIX)==0) {
   353         plungefile(incfname,FALSE,TRUE);    /* parse "default.inc" */
   354       } else {
   355         if (!plungequalifiedfile(incfname)) /* parse "prefix" include file */
   356           error(100,incfname);          /* cannot read from ... (fatal error) */
   357       } /* if */
   358     } /* if */
   359     preprocess();                       /* fetch first line */
   360     parse();                            /* process all input */
   361     sc_parsenum++;
   362   } while (sc_reparse);
   363 
   364   /* second (or third) pass */
   365   sc_status=statWRITE;                  /* set, to enable warnings */
   366   state_conflict(&glbtab);
   367 
   368   /* write a report, if requested */
   369   #if !defined SC_LIGHT
   370     if (sc_makereport) {
   371       FILE *frep=stdout;
   372       if (strlen(reportname)>0)
   373         frep=fopen(reportname,"wb");    /* avoid translation of \n to \r\n in DOS/Windows */
   374       if (frep!=NULL) {
   375         make_report(&glbtab,frep,get_sourcefile(0));
   376         if (strlen(reportname)>0)
   377           fclose(frep);
   378       } /* if */
   379       if (sc_documentation!=NULL) {
   380         free(sc_documentation);
   381         sc_documentation=NULL;
   382       } /* if */
   383     } /* if */
   384   #endif
   385   if (sc_listing)
   386     goto cleanup;
   387 
   388   /* ??? for re-parsing the listing file instead of the original source
   389    * file (and doing preprocessing twice):
   390    * - close input file, close listing file
   391    * - re-open listing file for reading (inpf)
   392    * - open assembler file (outf)
   393    */
   394 
   395   /* reset "defined" flag of all functions and global variables */
   396   reduce_referrers(&glbtab);
   397   delete_symbols(&glbtab,0,TRUE,FALSE);
   398   funcenums_free();
   399   pstructs_free();
   400   #if !defined NO_DEFINE
   401     delete_substtable();
   402     inst_datetime_defines();
   403   #endif
   404   resetglobals();
   405   sc_ctrlchar=sc_ctrlchar_org;
   406   sc_packstr=lcl_packstr;
   407   sc_needsemicolon=lcl_needsemicolon;
   408   sc_tabsize=lcl_tabsize;
   409   errorset(sRESET,0);
   410   /* reset the source file */
   411   inpf=inpf_org;
   412   freading=TRUE;
   413   pc_resetsrc(inpf,inpfmark);   /* reset file position */
   414   fline=skipinput;              /* reset line number */
   415   lexinit();                    /* clear internal flags of lex() */
   416   sc_status=statWRITE;          /* allow to write --this variable was reset by resetglobals() */
   417   writeleader(&glbtab);
   418   insert_dbgfile(inpfname);
   419   if (strlen(incfname)>0) {
   420     if (strcmp(incfname,sDEF_PREFIX)==0)
   421       plungefile(incfname,FALSE,TRUE);  /* parse "default.inc" (again) */
   422     else
   423       plungequalifiedfile(incfname);    /* parse implicit include file (again) */
   424   } /* if */
   425   preprocess();                         /* fetch first line */
   426   parse();                              /* process all input */
   427   /* inpf is already closed when readline() attempts to pop of a file */
   428   writetrailer();                       /* write remaining stuff */
   429 
   430   entry=testsymbols(&glbtab,0,TRUE,FALSE);  /* test for unused or undefined
   431                                              * functions and variables */
   432   if (!entry)
   433     error(13);                  /* no entry point (no public functions) */
   434 
   435 cleanup:
   436   if (inpf!=NULL)               /* main source file is not closed, do it now */
   437     pc_closesrc(inpf);
   438   /* write the binary file (the file is already open) */
   439   if (!(sc_asmfile || sc_listing) && errnum==0 && jmpcode==0) {
   440     assert(binf!=NULL);
   441     pc_resetasm(outf);          /* flush and loop back, for reading */
   442     #if !defined SC_LIGHT
   443       hdrsize=
   444     #endif
   445     assemble(binf,outf);        /* assembler file is now input */
   446   } /* if */
   447   if (outf!=NULL) {
   448     pc_closeasm(outf,!(sc_asmfile || sc_listing));
   449     outf=NULL;
   450   } /* if */
   451   if (binf!=NULL) {
   452     pc_closebin(binf,errnum!=0);
   453     binf=NULL;
   454   } /* if */
   455 
   456   #if !defined SC_LIGHT
   457     if (errnum==0 && strlen(errfname)==0) {
   458       int recursion;
   459       long stacksize=max_stacksize(&glbtab,&recursion);
   460       int flag_exceed=0;
   461       if (pc_amxlimit>0) {
   462         long totalsize=hdrsize+code_idx;
   463         if (pc_amxram==0)
   464           totalsize+=(glb_declared+pc_stksize)*sizeof(cell);
   465         if (totalsize>=pc_amxlimit)
   466           flag_exceed=1;
   467       } /* if */
   468       if (pc_amxram>0 && (glb_declared+pc_stksize)*sizeof(cell)>=(unsigned long)pc_amxram)
   469         flag_exceed=1;
   470       if (!norun && (sc_debug & sSYMBOLIC)!=0 || verbosity>=2 || stacksize+32>=(long)pc_stksize || flag_exceed) {
   471         pc_printf("Header size:       %8ld bytes\n", (long)hdrsize);
   472         pc_printf("Code size:         %8ld bytes\n", (long)code_idx);
   473         pc_printf("Data size:         %8ld bytes\n", (long)glb_declared*sizeof(cell));
   474         pc_printf("Stack/heap size:   %8ld bytes; ", (long)pc_stksize*sizeof(cell));
   475         pc_printf("estimated max. usage");
   476         if (recursion)
   477           pc_printf(": unknown, due to recursion\n");
   478         else if ((pc_memflags & suSLEEP_INSTR)!=0)
   479           pc_printf(": unknown, due to the \"sleep\" instruction\n");
   480         else
   481           pc_printf("=%ld cells (%ld bytes)\n",stacksize,stacksize*sizeof(cell));
   482         pc_printf("Total requirements:%8ld bytes\n", (long)hdrsize+(long)code_idx+(long)glb_declared*sizeof(cell)+(long)pc_stksize*sizeof(cell));
   483       } /* if */
   484       if (flag_exceed)
   485         error(106,pc_amxlimit+pc_amxram); /* this causes a jump back to label "cleanup" */
   486     } /* if */
   487   #endif
   488 
   489   if (g_tmpfile[0] != '\0') {
   490     remove(g_tmpfile);
   491   }
   492   if (inpfname!=NULL) {
   493     free(inpfname);
   494   } /* if */
   495   if (litq!=NULL)
   496     free(litq);
   497   phopt_cleanup();
   498   stgbuffer_cleanup();
   499   clearstk();
   500   assert(jmpcode!=0 || loctab.next==NULL);/* on normal flow, local symbols
   501                                            * should already have been deleted */
   502   delete_symbols(&loctab,0,TRUE,TRUE);    /* delete local variables if not yet
   503                                            * done (i.e. on a fatal error) */
   504   delete_symbols(&glbtab,0,TRUE,TRUE);
   505   delete_consttable(&tagname_tab);
   506   delete_consttable(&libname_tab);
   507   delete_consttable(&sc_automaton_tab);
   508   delete_consttable(&sc_state_tab);
   509   state_deletetable();
   510   delete_aliastable();
   511   delete_pathtable();
   512   delete_sourcefiletable();
   513   delete_dbgstringtable();
   514   funcenums_free();
   515   pstructs_free();
   516   #if !defined NO_DEFINE
   517     delete_substtable();
   518   #endif
   519   #if !defined SC_LIGHT
   520     delete_docstringtable();
   521     if (sc_documentation!=NULL)
   522       free(sc_documentation);
   523   #endif
   524   delete_autolisttable();
   525   if (errnum!=0) {
   526     if (strlen(errfname)==0)
   527       pc_printf("\n%d Error%s.\n",errnum,(errnum>1) ? "s" : "");
   528     retcode=1;
   529   } else if (warnnum!=0){
   530     if (strlen(errfname)==0)
   531       pc_printf("\n%d Warning%s.\n",warnnum,(warnnum>1) ? "s" : "");
   532     retcode=0;          /* use "0", so that MAKE and similar tools continue */
   533   } else {
   534     retcode=jmpcode;
   535     if (retcode==0 && verbosity>=2)
   536       pc_printf("\nDone.\n");
   537   } /* if */
   538   #if defined	__WIN32__ || defined _WIN32 || defined _Windows
   539     if (IsWindow(hwndFinish))
   540       PostMessageA(hwndFinish,RegisterWindowMessageA("PawnNotify"),retcode,0L);
   541   #endif
   542   #if defined FORTIFY
   543     Fortify_ListAllMemory();
   544   #endif
   545   return retcode;
   546 }
   547 
   548 #if defined __cplusplus
   549   extern "C"
   550 #endif
   551 int pc_addconstant(char *name,cell value,int tag)
   552 {
   553   errorset(sFORCESET,0);        /* make sure error engine is silenced */
   554   sc_status=statIDLE;
   555   add_constant(name,value,sGLOBAL,tag);
   556   return 1;
   557 }
   558 
   559 static void inst_datetime_defines(void)
   560 {
   561   char date[64];
   562   char ltime[64];
   563   time_t td;
   564   struct tm *curtime;
   565 
   566   time(&td);
   567   curtime = localtime(&td);
   568   strftime(date, 31, "\"%m/%d%Y\"", curtime);
   569   strftime(ltime, 31, "\"%H:%M:%S\"", curtime);
   570 
   571   insert_subst("__DATE__", date, 8);
   572   insert_subst("__TIME__", ltime, 8);
   573 }
   574 
   575 #if defined __cplusplus
   576   extern "C"
   577 #endif
   578 int pc_addtag(char *name)
   579 {
   580   cell val;
   581   constvalue *ptr;
   582   int last,tag;
   583 
   584   if (name==NULL) {
   585     /* no tagname was given, check for one */
   586     if (lex(&val,&name)!=tLABEL) {
   587       lexpush();
   588       return 0;         /* untagged */
   589     } /* if */
   590   } /* if */
   591 
   592   assert(strchr(name,':')==NULL); /* colon should already have been stripped */
   593   last=0;
   594   ptr=tagname_tab.next;
   595   while (ptr!=NULL) {
   596     tag=(int)(ptr->value & TAGMASK);
   597     if (strcmp(name,ptr->name)==0)
   598       return tag;       /* tagname is known, return its sequence number */
   599     tag &= (int)~FIXEDTAG;
   600     tag &= (int)~FUNCTAG;
   601     if (tag>last)
   602       last=tag;
   603     ptr=ptr->next;
   604   } /* while */
   605 
   606   /* tagname currently unknown, add it */
   607   tag=last+1;           /* guaranteed not to exist already */
   608   if (isupper(*name))
   609     tag |= (int)FIXEDTAG;
   610   append_constval(&tagname_tab,name,(cell)tag,0);
   611   return tag;
   612 }
   613 
   614 int pc_addfunctag(char *name)
   615 {
   616   cell val;
   617   constvalue *ptr;
   618   int last,tag;
   619 
   620   if (name==NULL) {
   621     /* no tagname was given, check for one */
   622     if (lex(&val,&name)!=tLABEL) {
   623       lexpush();
   624       return 0;         /* untagged */
   625     } /* if */
   626   } /* if */
   627 
   628   assert(strchr(name,':')==NULL); /* colon should already have been stripped */
   629   last=0;
   630   ptr=tagname_tab.next;
   631   while (ptr!=NULL) {
   632     tag=(int)(ptr->value & TAGMASK);
   633     if (strcmp(name,ptr->name)==0)
   634       return tag;       /* tagname is known, return its sequence number */
   635     tag &= (int)~FIXEDTAG;
   636     tag &= (int)~FUNCTAG;
   637     if (tag>last)
   638       last=tag;
   639     ptr=ptr->next;
   640   } /* while */
   641 
   642   /* tagname currently unknown, add it */
   643   tag=last+1;           /* guaranteed not to exist already */
   644   if (isupper(*name))
   645     tag |= (int)FIXEDTAG;
   646   tag |= (int)FUNCTAG;
   647   append_constval(&tagname_tab,name,(cell)tag,0);
   648   return tag;
   649 }
   650 
   651 static void resetglobals(void)
   652 {
   653   /* reset the subset of global variables that is modified by the first pass */
   654   curfunc=NULL;         /* pointer to current function */
   655   lastst=0;             /* last executed statement type */
   656   nestlevel=0;          /* number of active (open) compound statements */
   657   rettype=0;            /* the type that a "return" expression should have */
   658   litidx=0;             /* index to literal table */
   659   stgidx=0;             /* index to the staging buffer */
   660   sc_labnum=0;          /* top value of (internal) labels */
   661   staging=0;            /* true if staging output */
   662   declared=0;           /* number of local cells declared */
   663   glb_declared=0;       /* number of global cells declared */
   664   code_idx=0;           /* number of bytes with generated code */
   665   ntv_funcid=0;         /* incremental number of native function */
   666   curseg=0;             /* 1 if currently parsing CODE, 2 if parsing DATA */
   667   freading=FALSE;       /* no input file ready yet */
   668   fline=0;              /* the line number in the current file */
   669   fnumber=0;            /* the file number in the file table (debugging) */
   670   fcurrent=0;           /* current file being processed (debugging) */
   671   sc_intest=FALSE;      /* true if inside a test */
   672   sideeffect=0;         /* true if an expression causes a side-effect */
   673   stmtindent=0;         /* current indent of the statement */
   674   indent_nowarn=FALSE;  /* do not skip warning "217 loose indentation" */
   675   sc_allowtags=TRUE;    /* allow/detect tagnames */
   676   sc_status=statIDLE;
   677   sc_allowproccall=FALSE;
   678   pc_addlibtable=TRUE;  /* by default, add a "library table" to the output file */
   679   sc_alignnext=FALSE;
   680   pc_docexpr=FALSE;
   681   pc_deprecate=NULL;
   682   sc_curstates=0;
   683   pc_memflags=0;
   684 }
   685 
   686 static void initglobals(void)
   687 {
   688   resetglobals();
   689 
   690   sc_asmfile=FALSE;     /* do not create .ASM file */
   691   sc_listing=FALSE;     /* do not create .LST file */
   692   skipinput=0;          /* number of lines to skip from the first input file */
   693   sc_ctrlchar=CTRL_CHAR;/* the escape character */
   694   litmax=sDEF_LITMAX;   /* current size of the literal table */
   695   errnum=0;             /* number of errors */
   696   warnnum=0;            /* number of warnings */
   697   optproccall=FALSE;    /* sourcemod: do not support "procedure call" */
   698   verbosity=1;          /* verbosity level, no copyright banner */
   699   sc_debug=sCHKBOUNDS|sSYMBOLIC;   /* sourcemod: full debug stuff */
   700   pc_optimize=sOPTIMIZE_DEFAULT;   /* sourcemod: full optimization */
   701   sc_packstr=TRUE;     /* strings are packed by default */
   702   sc_compress=FALSE;	/* always disable compact encoding! */
   703   sc_needsemicolon=FALSE;/* semicolon required to terminate expressions? */
   704   sc_dataalign=sizeof(cell);
   705   pc_stksize=sDEF_AMXSTACK;/* default stack size */
   706   pc_amxlimit=0;        /* no limit on size of the abstract machine */
   707   pc_amxram=0;          /* no limit on data size of the abstract machine */
   708   sc_tabsize=8;         /* assume a TAB is 8 spaces */
   709   sc_rationaltag=0;     /* assume no support for rational numbers */
   710   rational_digits=0;    /* number of fractional digits */
   711 
   712   outfname[0]='\0';     /* output file name */
   713   errfname[0]='\0';     /* error file name */
   714   inpf=NULL;            /* file read from */
   715   inpfname=NULL;        /* pointer to name of the file currently read from */
   716   outf=NULL;            /* file written to */
   717   litq=NULL;            /* the literal queue */
   718   glbtab.next=NULL;     /* clear global variables/constants table */
   719   loctab.next=NULL;     /*   "   local      "    /    "       "   */
   720   tagname_tab.next=NULL;/* tagname table */
   721   libname_tab.next=NULL;/* library table (#pragma library "..." syntax) */
   722 
   723   pline[0]='\0';        /* the line read from the input file */
   724   lptr=NULL;            /* points to the current position in "pline" */
   725   curlibrary=NULL;      /* current library */
   726   inpf_org=NULL;        /* main source file */
   727 
   728   wqptr=wq;             /* initialize while queue pointer */
   729 
   730 #if !defined SC_LIGHT
   731   sc_documentation=NULL;
   732   sc_makereport=FALSE;  /* do not generate a cross-reference report */
   733 #endif
   734 }
   735 
   736 static char *get_extension(char *filename)
   737 {
   738   char *ptr;
   739 
   740   assert(filename!=NULL);
   741   ptr=strrchr(filename,'.');
   742   if (ptr!=NULL) {
   743     /* ignore extension on a directory or at the start of the filename */
   744     if (strchr(ptr,DIRSEP_CHAR)!=NULL || ptr==filename || *(ptr-1)==DIRSEP_CHAR)
   745       ptr=NULL;
   746   } /* if */
   747   return ptr;
   748 }
   749 
   750 /* set_extension
   751  * Set the default extension, or force an extension. To erase the
   752  * extension of a filename, set "extension" to an empty string.
   753  */
   754 SC_FUNC void set_extension(char *filename,char *extension,int force)
   755 {
   756   char *ptr;
   757 
   758   assert(extension!=NULL && (*extension=='\0' || *extension=='.'));
   759   assert(filename!=NULL);
   760   ptr=get_extension(filename);
   761   if (force && ptr!=NULL)
   762     *ptr='\0';          /* set zero terminator at the position of the period */
   763   if (force || ptr==NULL)
   764     strcat(filename,extension);
   765 }
   766 
   767 static const char *option_value(const char *optptr)
   768 {
   769   return (*(optptr+1)=='=' || *(optptr+1)==':') ? optptr+2 : optptr+1;
   770 }
   771 
   772 static int toggle_option(const char *optptr, int option)
   773 {
   774   switch (*option_value(optptr)) {
   775   case '\0':
   776     option=!option;
   777     break;
   778   case '-':
   779     option=FALSE;
   780     break;
   781   case '+':
   782     option=TRUE;
   783     break;
   784   default:
   785     about();
   786   } /* switch */
   787   return option;
   788 }
   789 
   790 /* Parsing command line options is indirectly recursive: parseoptions()
   791  * calls parserespf() to handle options in a a response file and
   792  * parserespf() calls parseoptions() at its turn after having created
   793  * an "option list" from the contents of the file.
   794  */
   795 static void parserespf(char *filename,char *oname,char *ename,char *pname,
   796                        char *rname, char *codepage);
   797 
   798 static void parseoptions(int argc,char **argv,char *oname,char *ename,char *pname,
   799                          char *rname, char *codepage)
   800 {
   801   char str[_MAX_PATH],*name;
   802   const char *ptr;
   803   int arg,i,isoption;
   804 
   805   for (arg=1; arg<argc; arg++) {
   806     #if DIRSEP_CHAR=='/'
   807       isoption= argv[arg][0]=='-';
   808     #else
   809       isoption= argv[arg][0]=='/' || argv[arg][0]=='-';
   810     #endif
   811     if (isoption) {
   812       ptr=&argv[arg][1];
   813       switch (*ptr) {
   814       case 'A':
   815         i=atoi(option_value(ptr));
   816         if ((i % sizeof(cell))==0)
   817           sc_dataalign=i;
   818         else
   819           about();
   820         break;
   821       case 'a':
   822         if (*(ptr+1)!='\0')
   823           about();
   824         sc_asmfile=TRUE;        /* skip last pass of making binary file */
   825         if (verbosity>1)
   826           verbosity=1;
   827         break;
   828 #if 0	/* not allowed in SourceMod */
   829       case 'C':
   830         #if AMX_COMPACTMARGIN > 2
   831           sc_compress=toggle_option(ptr,sc_compress);
   832         #else
   833           about();
   834         #endif
   835         break;
   836 #endif
   837       case 'c':
   838         strlcpy(codepage,option_value(ptr),MAXCODEPAGE);  /* set name of codepage */
   839         break;
   840 #if defined dos_setdrive
   841       case 'D':                 /* set active directory */
   842         ptr=option_value(ptr);
   843         if (ptr[1]==':')
   844           dos_setdrive(toupper(*ptr)-'A'+1);    /* set active drive */
   845         chdir(ptr);
   846         break;
   847 #endif
   848 #if 0 /* not allowed to change for SourceMod */
   849       case 'd':
   850         switch (*option_value(ptr)) {
   851         case '0':
   852           sc_debug=0;
   853           break;
   854         case '1':
   855           sc_debug=sCHKBOUNDS;  /* assertions and bounds checking */
   856           break;
   857         case '2':
   858           sc_debug=sCHKBOUNDS | sSYMBOLIC;  /* also symbolic info */
   859           break;
   860         case '3':
   861           sc_debug=sCHKBOUNDS | sSYMBOLIC;
   862           pc_optimize=sOPTIMIZE_NONE;
   863           /* also avoid peephole optimization */
   864           break;
   865         default:
   866           about();
   867         } /* switch */
   868         break;
   869 #endif
   870       case 'e':
   871         strlcpy(ename,option_value(ptr),_MAX_PATH); /* set name of error file */
   872         break;
   873 #if defined	__WIN32__ || defined _WIN32 || defined _Windows
   874       case 'H':
   875         hwndFinish=(HWND)atoi(option_value(ptr));
   876         if (!IsWindow(hwndFinish))
   877           hwndFinish=(HWND)0;
   878         break;
   879 #endif
   880       case 'i':
   881         strlcpy(str,option_value(ptr),sizeof str);  /* set name of include directory */
   882         i=strlen(str);
   883         if (i>0) {
   884           if (str[i-1]!=DIRSEP_CHAR) {
   885             str[i]=DIRSEP_CHAR;
   886             str[i+1]='\0';
   887           } /* if */
   888           insert_path(str);
   889         } /* if */
   890         break;
   891       case 'l':
   892         if (*(ptr+1)!='\0')
   893           about();
   894         sc_listing=TRUE;        /* skip second pass & code generation */
   895         break;
   896       case 'o':
   897         strlcpy(oname,option_value(ptr),_MAX_PATH); /* set name of (binary) output file */
   898         break;
   899       case 'O':
   900         pc_optimize=*option_value(ptr) - '0';
   901         if (pc_optimize<sOPTIMIZE_NONE || pc_optimize>=sOPTIMIZE_NUMBER || pc_optimize==sOPTIMIZE_NOMACRO)
   902           about();
   903         break;
   904       case 'p':
   905         strlcpy(pname,option_value(ptr),_MAX_PATH); /* set name of implicit include file */
   906         break;
   907 #if !defined SC_LIGHT
   908       case 'r':
   909         strlcpy(rname,option_value(ptr),_MAX_PATH); /* set name of report file */
   910         sc_makereport=TRUE;
   911         if (strlen(rname)>0) {
   912           set_extension(rname,".xml",FALSE);
   913         } else if ((name=get_sourcefile(0))!=NULL) {
   914           assert(strlen(rname)==0);
   915           assert(strlen(name)<_MAX_PATH);
   916           if ((ptr=strrchr(name,DIRSEP_CHAR))!=NULL)
   917             ptr++;          /* strip path */
   918           else
   919             ptr=name;
   920           assert(strlen(ptr)<_MAX_PATH);
   921           strcpy(rname,ptr);
   922           set_extension(rname,".xml",TRUE);
   923         } /* if */
   924         break;
   925 #endif
   926       case 'S':
   927         i=atoi(option_value(ptr));
   928         if (i>32)
   929           pc_stksize=(cell)i;   /* stack size has minimum size */
   930         else
   931           about();
   932         break;
   933       case 's':
   934         skipinput=atoi(option_value(ptr));
   935         break;
   936       case 't':
   937         sc_tabsize=atoi(option_value(ptr));
   938         break;
   939       case 'v':
   940         verbosity= isdigit(*option_value(ptr)) ? atoi(option_value(ptr)) : 2;
   941         if (sc_asmfile && verbosity>1)
   942           verbosity=1;
   943         break;
   944       case 'w':
   945         i=(int)strtol(option_value(ptr),(char **)&ptr,10);
   946         if (*ptr=='-')
   947           pc_enablewarning(i,0);
   948         else if (*ptr=='+')
   949           pc_enablewarning(i,1);
   950         else if (*ptr=='\0')
   951           pc_enablewarning(i,2);
   952         break;
   953       case 'X':
   954         if (*(ptr+1)=='D') {
   955           i=atoi(option_value(ptr+1));
   956           if (i>64)
   957             pc_amxram=(cell)i;  /* abstract machine data/stack has minimum size */
   958           else
   959             about();
   960         } else {
   961           i=atoi(option_value(ptr));
   962           if (i>64)
   963             pc_amxlimit=(cell)i;/* abstract machine has minimum size */
   964           else
   965             about();
   966         } /* if */
   967         break;
   968       case '\\':                /* use \ instead for escape characters */
   969         sc_ctrlchar='\\';
   970         break;
   971       case '^':                 /* use ^ instead for escape characters */
   972         sc_ctrlchar='^';
   973         break;
   974       case ';':
   975         sc_needsemicolon=toggle_option(ptr,sc_needsemicolon);
   976         break;
   977 #if 0 /* not allowed to change in SourceMod */
   978       case '(':
   979         optproccall=!toggle_option(ptr,!optproccall);
   980         break;
   981 #endif
   982       default:                  /* wrong option */
   983         about();
   984       } /* switch */
   985     } else if (argv[arg][0]=='@') {
   986       #if !defined SC_LIGHT
   987         parserespf(&argv[arg][1],oname,ename,pname,rname,codepage);
   988       #endif
   989     } else if ((ptr=strchr(argv[arg],'='))!=NULL) {
   990       i=(int)(ptr-argv[arg]);
   991       if (i>sNAMEMAX) {
   992         i=sNAMEMAX;
   993         error(200,argv[arg],sNAMEMAX);  /* symbol too long, truncated to sNAMEMAX chars */
   994       } /* if */
   995       strlcpy(str,argv[arg],i+1);       /* str holds symbol name */
   996       i=atoi(ptr+1);
   997       add_constant(str,i,sGLOBAL,0);
   998     } else {
   999       strlcpy(str,argv[arg],sizeof(str)-5); /* -5 because default extension is ".sp" */
  1000       set_extension(str,".sp",FALSE);
  1001       insert_sourcefile(str);
  1002       /* The output name is the first input name with a different extension,
  1003        * but it is stored in a different directory
  1004        */
  1005       if (strlen(oname)==0) {
  1006         if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
  1007           ptr++;          /* strip path */
  1008         else
  1009           ptr=str;
  1010         assert(strlen(ptr)<_MAX_PATH);
  1011         strcpy(oname,ptr);
  1012       } /* if */
  1013       set_extension(oname,".asm",TRUE);
  1014 #if !defined SC_LIGHT
  1015       if (sc_makereport && strlen(rname)==0) {
  1016         if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
  1017           ptr++;          /* strip path */
  1018         else
  1019           ptr=str;
  1020         assert(strlen(ptr)<_MAX_PATH);
  1021         strcpy(rname,ptr);
  1022         set_extension(rname,".xml",TRUE);
  1023       } /* if */
  1024 #endif
  1025     } /* if */
  1026   } /* for */
  1027 }
  1028 
  1029 #if !defined SC_LIGHT
  1030 static void parserespf(char *filename,char *oname,char *ename,char *pname,
  1031                        char *rname,char *codepage)
  1032 {
  1033 #define MAX_OPTIONS     100
  1034   FILE *fp;
  1035   char *string, *ptr, **argv;
  1036   int argc;
  1037   long size;
  1038 
  1039   if ((fp=fopen(filename,"r"))==NULL)
  1040     error(100,filename);        /* error reading input file */
  1041   /* load the complete file into memory */
  1042   fseek(fp,0L,SEEK_END);
  1043   size=ftell(fp);
  1044   fseek(fp,0L,SEEK_SET);
  1045   assert(size<INT_MAX);
  1046   if ((string=(char *)malloc((int)size+1))==NULL)
  1047     error(103);                 /* insufficient memory */
  1048   /* fill with zeros; in MS-DOS, fread() may collapse CR/LF pairs to
  1049    * a single '\n', so the string size may be smaller than the file
  1050    * size. */
  1051   memset(string,0,(int)size+1);
  1052   fread(string,1,(int)size,fp);
  1053   fclose(fp);
  1054   /* allocate table for option pointers */
  1055   if ((argv=(char **)malloc(MAX_OPTIONS*sizeof(char*)))==NULL)
  1056     error(103);                 /* insufficient memory */
  1057   /* fill the options table */
  1058   ptr=strtok(string," \t\r\n");
  1059   for (argc=1; argc<MAX_OPTIONS && ptr!=NULL; argc++) {
  1060     /* note: the routine skips argv[0], for compatibility with main() */
  1061     argv[argc]=ptr;
  1062     ptr=strtok(NULL," \t\r\n");
  1063   } /* for */
  1064   if (ptr!=NULL)
  1065     error(102,"option table");   /* table overflow */
  1066   /* parse the option table */
  1067   parseoptions(argc,argv,oname,ename,pname,rname,codepage);
  1068   /* free allocated memory */
  1069   free(argv);
  1070   free(string);
  1071 }
  1072 #endif
  1073 
  1074 static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
  1075                    char *rname,char *codepage)
  1076 {
  1077   delete_sourcefiletable(); /* make sure it is empty */
  1078   *oname='\0';
  1079   *ename='\0';
  1080   *pname='\0';
  1081   *rname='\0';
  1082   *codepage='\0';
  1083   strcpy(pname,sDEF_PREFIX);
  1084 
  1085   #if 0 /* needed to test with BoundsChecker for DOS (it does not pass
  1086          * through arguments) */
  1087     insert_sourcefile("test.p");
  1088     strcpy(oname,"test.asm");
  1089   #endif
  1090 
  1091   #if !defined SC_LIGHT
  1092     /* first parse a "config" file with default options */
  1093     if (argv[0]!=NULL) {
  1094       char cfgfile[_MAX_PATH];
  1095       char *ext;
  1096       strcpy(cfgfile,argv[0]);
  1097       if ((ext=strrchr(cfgfile,DIRSEP_CHAR))!=NULL) {
  1098         *(ext+1)='\0';          /* strip the program filename */
  1099         strcat(cfgfile,"pawn.cfg");
  1100       } else {
  1101         strcpy(cfgfile,"pawn.cfg");
  1102       } /* if */
  1103       if (access(cfgfile,4)==0)
  1104         parserespf(cfgfile,oname,ename,pname,rname,codepage);
  1105     } /* if */
  1106   #endif
  1107   parseoptions(argc,argv,oname,ename,pname,rname,codepage);
  1108   if (get_sourcefile(0)==NULL)
  1109     about();
  1110 }
  1111 
  1112 #if defined __BORLANDC__ || defined __WATCOMC__
  1113   #pragma argsused
  1114 #endif
  1115 static void setconfig(char *root)
  1116 {
  1117   #if defined macintosh
  1118     insert_path(":include:");
  1119   #else
  1120     char path[_MAX_PATH];
  1121     char *ptr,*base;
  1122     int len;
  1123 
  1124     /* add the default "include" directory */
  1125     #if defined __WIN32__ || defined _WIN32
  1126       GetModuleFileNameA(NULL,path,_MAX_PATH);
  1127     #else
  1128       if (root!=NULL)
  1129         strlcpy(path,root,sizeof path); /* path + filename (hopefully) */
  1130     #endif
  1131     #if defined __MSDOS__
  1132       /* strip the options (appended to the path + filename) */
  1133       if ((ptr=strpbrk(path," \t/"))!=NULL)
  1134         *ptr='\0';
  1135     #endif
  1136     /* terminate just behind last \ or : */
  1137     if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL || (ptr=strchr(path,':'))!=NULL) {
  1138       /* If there is no "\" or ":", the string probably does not contain the
  1139        * path; so we just don't add it to the list in that case
  1140        */
  1141       *(ptr+1)='\0';
  1142       base=ptr;
  1143       strcat(path,"include");
  1144       len=strlen(path);
  1145       path[len]=DIRSEP_CHAR;
  1146       path[len+1]='\0';
  1147       /* see if it exists */
  1148       if (access(path,0)!=0 && *base==DIRSEP_CHAR) {
  1149         /* There is no "include" directory below the directory where the compiler
  1150          * is found. This typically means that the compiler is in a "bin" sub-directory
  1151          * and the "include" is below the *parent*. So find the parent...
  1152          */
  1153         *base='\0';
  1154         if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL) {
  1155           *(ptr+1)='\0';
  1156           strcat(path,"include");
  1157           len=strlen(path);
  1158           path[len]=DIRSEP_CHAR;
  1159           path[len+1]='\0';
  1160         } else {
  1161           *base=DIRSEP_CHAR;
  1162         } /* if */
  1163       } /* if */
  1164       insert_path(path);
  1165       /* same for the codepage root */
  1166       #if !defined NO_CODEPAGE
  1167         *ptr='\0';
  1168         if (!cp_path(path,"codepage"))
  1169           error(109,path);        /* codepage path */
  1170       #endif
  1171       /* also copy the root path (for the XML documentation) */
  1172       #if !defined SC_LIGHT
  1173         *ptr='\0';
  1174         strcpy(sc_rootpath,path);
  1175       #endif
  1176     } /* if */
  1177   #endif /* macintosh */
  1178 }
  1179 
  1180 static void setcaption(void)
  1181 {
  1182   pc_printf("SourcePawn Compiler 1.0.0." SVN_REVISION_STRING "\n");
  1183   pc_printf("Copyright (c) 1997-2006, ITB CompuPhase, (C)2004-2006 AlliedModders, LLC\n\n");
  1184 }
  1185 
  1186 static void about(void)
  1187 {
  1188   if (strlen(errfname)==0) {
  1189     setcaption();
  1190     pc_printf("Usage:   pawncc <filename> [filename...] [options]\n\n");
  1191     pc_printf("Options:\n");
  1192     pc_printf("         -A<num>  alignment in bytes of the data segment and the stack\n");
  1193     pc_printf("         -a       output assembler code\n");
  1194 #if 0	/* not toggleable in SourceMod */
  1195     pc_printf("         -C[+/-]  compact encoding for output file (default=%c)\n", sc_compress ? '+' : '-');
  1196 #endif
  1197     pc_printf("         -c<name> codepage name or number; e.g. 1252 for Windows Latin-1\n");
  1198 #if defined dos_setdrive
  1199     pc_printf("         -Dpath   active directory path\n");
  1200 #endif
  1201 #if 0 /* not used for SourceMod */
  1202     pc_printf("         -d<num>  debugging level (default=-d%d)\n",sc_debug);
  1203     pc_printf("             0    no symbolic information, no run-time checks\n");
  1204     pc_printf("             1    run-time checks, no symbolic information\n");
  1205     pc_printf("             2    full debug information and dynamic checking\n");
  1206     pc_printf("             3    same as -d2, but implies -O0\n");
  1207 #endif
  1208     pc_printf("         -e<name> set name of error file (quiet compile)\n");
  1209 #if defined	__WIN32__ || defined _WIN32 || defined _Windows
  1210     pc_printf("         -H<hwnd> window handle to send a notification message on finish\n");
  1211 #endif
  1212     pc_printf("         -i<name> path for include files\n");
  1213     pc_printf("         -l       create list file (preprocess only)\n");
  1214     pc_printf("         -o<name> set base name of (P-code) output file\n");
  1215     pc_printf("         -O<num>  optimization level (default=-O%d)\n",pc_optimize);
  1216     pc_printf("             0    no optimization\n");
  1217 #if 0 /* not used for SourceMod */
  1218     pc_printf("             1    JIT-compatible optimizations only\n");
  1219 #endif
  1220     pc_printf("             2    full optimizations\n");
  1221     pc_printf("         -p<name> set name of \"prefix\" file\n");
  1222 #if !defined SC_LIGHT
  1223     pc_printf("         -r[name] write cross reference report to console or to specified file\n");
  1224 #endif
  1225     pc_printf("         -S<num>  stack/heap size in cells (default=%d)\n",(int)pc_stksize);
  1226     pc_printf("         -s<num>  skip lines from the input file\n");
  1227     pc_printf("         -t<num>  TAB indent size (in character positions, default=%d)\n",sc_tabsize);
  1228     pc_printf("         -v<num>  verbosity level; 0=quiet, 1=normal, 2=verbose (default=%d)\n",verbosity);
  1229     pc_printf("         -w<num>  disable a specific warning by its number\n");
  1230     pc_printf("         -X<num>  abstract machine size limit in bytes\n");
  1231     pc_printf("         -XD<num> abstract machine data/stack size limit in bytes\n");
  1232     pc_printf("         -\\       use '\\' for escape characters\n");
  1233     pc_printf("         -^       use '^' for escape characters\n");
  1234     pc_printf("         -;[+/-]  require a semicolon to end each statement (default=%c)\n", sc_needsemicolon ? '+' : '-');
  1235 #if 0 /* not allowed in SourceMod */
  1236     pc_printf("         -([+/-]  require parantheses for function invocation (default=%c)\n", optproccall ? '-' : '+');
  1237 #endif
  1238     pc_printf("         sym=val  define constant \"sym\" with value \"val\"\n");
  1239     pc_printf("         sym=     define constant \"sym\" with value 0\n");
  1240 #if defined	__WIN32__ || defined _WIN32 || defined _Windows || defined __MSDOS__
  1241     pc_printf("\nOptions may start with a dash or a slash; the options \"-d0\" and \"/d0\" are\n");
  1242     pc_printf("equivalent.\n");
  1243 #endif
  1244     pc_printf("\nOptions with a value may optionally separate the value from the option letter\n");
  1245     pc_printf("with a colon (\":\") or an equal sign (\"=\"). That is, the options \"-d0\", \"-d=0\"\n");
  1246     pc_printf("and \"-d:0\" are all equivalent.\n");
  1247   } /* if */
  1248   norun = 1;
  1249   longjmp(errbuf,3);        /* user abort */
  1250 }
  1251 
  1252 static void setconstants(void)
  1253 {
  1254   int debug;
  1255 
  1256   assert(sc_status==statIDLE);
  1257   append_constval(&tagname_tab,"_",0,0);/* "untagged" */
  1258   append_constval(&tagname_tab,"bool",1,0);
  1259   pc_functag = pc_addfunctag("Function");
  1260   pc_tag_string = pc_addtag("String");
  1261 
  1262   add_constant("true",1,sGLOBAL,1);     /* boolean flags */
  1263   add_constant("false",0,sGLOBAL,1);
  1264   add_constant("EOS",0,sGLOBAL,0);      /* End Of String, or '\0' */
  1265   #if PAWN_CELL_SIZE==16
  1266     add_constant("cellbits",16,sGLOBAL,0);
  1267     #if defined _I16_MAX
  1268       add_constant("cellmax",_I16_MAX,sGLOBAL,0);
  1269       add_constant("cellmin",_I16_MIN,sGLOBAL,0);
  1270     #else
  1271       add_constant("cellmax",SHRT_MAX,sGLOBAL,0);
  1272       add_constant("cellmin",SHRT_MIN,sGLOBAL,0);
  1273     #endif
  1274   #elif PAWN_CELL_SIZE==32
  1275     add_constant("cellbits",32,sGLOBAL,0);
  1276     #if defined _I32_MAX
  1277       add_constant("cellmax",_I32_MAX,sGLOBAL,0);
  1278       add_constant("cellmin",_I32_MIN,sGLOBAL,0);
  1279     #else
  1280       add_constant("cellmax",LONG_MAX,sGLOBAL,0);
  1281       add_constant("cellmin",LONG_MIN,sGLOBAL,0);
  1282     #endif
  1283   #elif PAWN_CELL_SIZE==64
  1284     #if !defined _I64_MIN
  1285       #define _I64_MIN  (-9223372036854775807ULL - 1)
  1286       #define _I64_MAX    9223372036854775807ULL
  1287     #endif
  1288     add_constant("cellbits",64,sGLOBAL,0);
  1289     add_constant("cellmax",_I64_MAX,sGLOBAL,0);
  1290     add_constant("cellmin",_I64_MIN,sGLOBAL,0);
  1291   #else
  1292     #error Unsupported cell size
  1293   #endif
  1294   add_constant("charbits",sCHARBITS,sGLOBAL,0);
  1295   add_constant("charmin",0,sGLOBAL,0);
  1296   add_constant("charmax",~(-1 << sCHARBITS) - 1,sGLOBAL,0);
  1297   add_constant("ucharmax",(1 << (sizeof(cell)-1)*8)-1,sGLOBAL,0);
  1298 
  1299   add_constant("__Pawn",VERSION_INT,sGLOBAL,0);
  1300 
  1301   debug=0;
  1302   if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC))==(sCHKBOUNDS | sSYMBOLIC))
  1303     debug=2;
  1304   else if ((sc_debug & sCHKBOUNDS)==sCHKBOUNDS)
  1305     debug=1;
  1306   add_constant("debug",debug,sGLOBAL,0);
  1307 
  1308   append_constval(&sc_automaton_tab,"",0,0);    /* anonymous automaton */
  1309 }
  1310 
  1311 static int getclassspec(int initialtok,int *fpublic,int *fstatic,int *fstock,int *fconst)
  1312 {
  1313   int tok,err;
  1314   cell val;
  1315   char *str;
  1316 
  1317   assert(fconst!=NULL);
  1318   assert(fstock!=NULL);
  1319   assert(fstatic!=NULL);
  1320   assert(fpublic!=NULL);
  1321   *fconst=FALSE;
  1322   *fstock=FALSE;
  1323   *fstatic=FALSE;
  1324   *fpublic=FALSE;
  1325   switch (initialtok) {
  1326   case tCONST:
  1327     *fconst=TRUE;
  1328     break;
  1329   case tSTOCK:
  1330     *fstock=TRUE;
  1331     break;
  1332   case tSTATIC:
  1333     *fstatic=TRUE;
  1334     break;
  1335   case tPUBLIC:
  1336     *fpublic=TRUE;
  1337     break;
  1338   } /* switch */
  1339 
  1340   err=0;
  1341   do {
  1342     tok=lex(&val,&str);  /* read in (new) token */
  1343     switch (tok) {
  1344     case tCONST:
  1345       if (*fconst)
  1346         err=42;          /* invalid combination of class specifiers */
  1347       *fconst=TRUE;
  1348       break;
  1349     case tSTOCK:
  1350       if (*fstock)
  1351         err=42;          /* invalid combination of class specifiers */
  1352       *fstock=TRUE;
  1353       break;
  1354     case tSTATIC:
  1355       if (*fstatic)
  1356         err=42;          /* invalid combination of class specifiers */
  1357       *fstatic=TRUE;
  1358       break;
  1359     case tPUBLIC:
  1360       if (*fpublic)
  1361         err=42;          /* invalid combination of class specifiers */
  1362       *fpublic=TRUE;
  1363       break;
  1364     default:
  1365       lexpush();
  1366       tok=0;             /* force break out of loop */
  1367     } /* switch */
  1368   } while (tok && err==0);
  1369 
  1370   /* extra checks */
  1371   if (*fstatic && *fpublic) {
  1372     err=42;              /* invalid combination of class specifiers */
  1373     *fstatic=*fpublic=FALSE;
  1374   } /* if */
  1375 
  1376   if (err)
  1377     error(err);
  1378   return err==0;
  1379 }
  1380 
  1381 /*  parse       - process all input text
  1382  *
  1383  *  At this level, only static declarations and function definitions are legal.
  1384  */
  1385 static void parse(void)
  1386 {
  1387   int tok,fconst,fstock,fstatic,fpublic;
  1388   cell val;
  1389   char *str;
  1390 
  1391   while (freading){
  1392     /* first try whether a declaration possibly is native or public */
  1393     tok=lex(&val,&str);  /* read in (new) token */
  1394     switch (tok) {
  1395     case 0:
  1396       /* ignore zero's */
  1397       break;
  1398     case tNEW:
  1399       if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst))
  1400         declglb(NULL,0,fpublic,fstatic,fstock,fconst);
  1401       break;
  1402     case tSTATIC:
  1403       /* This can be a static function or a static global variable; we know
  1404        * which of the two as soon as we have parsed up to the point where an
  1405        * opening paranthesis of a function would be expected. To back out after
  1406        * deciding it was a declaration of a static variable after all, we have
  1407        * to store the symbol name and tag.
  1408        */
  1409       if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
  1410         assert(!fpublic);
  1411         declfuncvar(fpublic,fstatic,fstock,fconst);
  1412       } /* if */
  1413       break;
  1414     case tCONST:
  1415       decl_const(sGLOBAL);
  1416       break;
  1417     case tENUM:
  1418       decl_enum(sGLOBAL);
  1419       break;
  1420     case tFUNCENUM:
  1421       dofuncenum(TRUE);
  1422       break;
  1423     case tFUNCTAG:
  1424       dofuncenum(FALSE);
  1425       break;
  1426     case tSTRUCT:
  1427       declstruct();
  1428       break;
  1429     case tPUBLIC:
  1430       /* This can be a public function or a public variable; see the comment
  1431        * above (for static functions/variables) for details.
  1432        */
  1433       if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
  1434         assert(!fstatic);
  1435         declfuncvar(fpublic,fstatic,fstock,fconst);
  1436       } /* if */
  1437       break;
  1438     case tSTOCK:
  1439       /* This can be a stock function or a stock *global*) variable; see the
  1440        * comment above (for static functions/variables) for details.
  1441        */
  1442       if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
  1443         assert(fstock);
  1444         declfuncvar(fpublic,fstatic,fstock,fconst);
  1445       } /* if */
  1446       break;
  1447     case tLABEL:
  1448     case tSYMBOL:
  1449     case tOPERATOR:
  1450       lexpush();
  1451       if (!newfunc(NULL,-1,FALSE,FALSE,FALSE)) {
  1452         error(10);              /* illegal function or declaration */
  1453         lexclr(TRUE);           /* drop the rest of the line */
  1454         litidx=0;               /* drop the literal queue too */
  1455       } /* if */
  1456       break;
  1457     case tNATIVE:
  1458       funcstub(TRUE);           /* create a dummy function */
  1459       break;
  1460     case tFORWARD:
  1461       funcstub(FALSE);
  1462       break;
  1463     case '}':
  1464       error(54);                /* unmatched closing brace */
  1465       break;
  1466     case '{':
  1467       error(55);                /* start of function body without function header */
  1468       break;
  1469     default:
  1470       if (freading) {
  1471         error(10);              /* illegal function or declaration */
  1472         lexclr(TRUE);           /* drop the rest of the line */
  1473         litidx=0;               /* drop any literal arrays (strings) */
  1474       } /* if */
  1475     } /* switch */
  1476   } /* while */
  1477 }
  1478 
  1479 /*  dumplits
  1480  *
  1481  *  Dump the literal pool (strings etc.)
  1482  *
  1483  *  Global references: litidx (referred to only)
  1484  */
  1485 static void dumplits(void)
  1486 {
  1487   int j,k;
  1488 
  1489   if (sc_status==statSKIP)
  1490     return;
  1491 
  1492   k=0;
  1493   while (k<litidx){
  1494     /* should be in the data segment */
  1495     assert(curseg==2);
  1496     defstorage();
  1497     j=16;       /* 16 values per line */
  1498     while (j && k<litidx){
  1499       outval(litq[k], FALSE);
  1500       stgwrite(" ");
  1501       k++;
  1502       j--;
  1503       if (j==0 || k>=litidx)
  1504         stgwrite("\n");         /* force a newline after 10 dumps */
  1505       /* Note: stgwrite() buffers a line until it is complete. It recognizes
  1506        * the end of line as a sequence of "\n\0", so something like "\n\t"
  1507        * so should not be passed to stgwrite().
  1508        */
  1509     } /* while */
  1510   } /* while */
  1511 }
  1512 
  1513 /*  dumpzero
  1514  *
  1515  *  Dump zero's for default initial values
  1516  */
  1517 static void dumpzero(int count)
  1518 {
  1519   int i;
  1520 
  1521   if (sc_status==statSKIP || count<=0)
  1522     return;
  1523   assert(curseg==2);
  1524   defstorage();
  1525   i=0;
  1526   while (count-- > 0) {
  1527     outval(0, FALSE);
  1528     i=(i+1) % 16;
  1529     stgwrite((i==0 || count==0) ? "\n" : " ");
  1530     if (i==0 && count>0)
  1531       defstorage();
  1532   } /* while */
  1533 }
  1534 
  1535 static void aligndata(int numbytes)
  1536 {
  1537   assert(numbytes % sizeof(cell) == 0);   /* alignment must be a multiple of
  1538                                            * the cell size */
  1539   assert(numbytes!=0);
  1540 
  1541   if ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0) {
  1542     while ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0)
  1543       litadd(0);
  1544   } /* if */
  1545 
  1546 }
  1547 
  1548 #if !defined SC_LIGHT
  1549 /* sc_attachdocumentation()
  1550  * appends documentation comments to the passed-in symbol, or to a global
  1551  * string if "sym" is NULL.
  1552  */
  1553 void sc_attachdocumentation(symbol *sym)
  1554 {
  1555   int line;
  1556   size_t length;
  1557   char *str,*doc;
  1558 
  1559   if (!sc_makereport || sc_status!=statFIRST || sc_parsenum>0) {
  1560     /* just clear the entire table */
  1561     delete_docstringtable();
  1562     return;
  1563   } /* if */
  1564   /* in the case of state functions, multiple documentation sections may
  1565    * appear; we should concatenate these
  1566    * (with forward declarations, this is also already the case, so the assertion
  1567    * below is invalid)
  1568    */
  1569   // assert(sym==NULL || sym->documentation==NULL || sym->states!=NULL);
  1570 
  1571   /* first check the size */
  1572   length=0;
  1573   for (line=0; (str=get_docstring(line))!=NULL && *str!=sDOCSEP; line++) {
  1574     if (length>0)
  1575       length++;   /* count 1 extra for a separating space */
  1576     length+=strlen(str);
  1577   } /* for */
  1578   if (sym==NULL && sc_documentation!=NULL) {
  1579     length += strlen(sc_documentation) + 1 + 4; /* plus 4 for "<p/>" */
  1580     assert(length>strlen(sc_documentation));
  1581   } /* if */
  1582 
  1583   if (length>0) {
  1584     /* allocate memory for the documentation */
  1585     if (sym!=NULL && sym->documentation!=NULL)
  1586       length+=strlen(sym->documentation) + 1 + 4;/* plus 4 for "<p/>" */
  1587     doc=(char*)malloc((length+1)*sizeof(char));
  1588     if (doc!=NULL) {
  1589       /* initialize string or concatenate */
  1590       if (sym==NULL && sc_documentation!=NULL) {
  1591         strcpy(doc,sc_documentation);
  1592         strcat(doc,"<p/>");
  1593       } else if (sym!=NULL && sym->documentation!=NULL) {
  1594         strcpy(doc,sym->documentation);
  1595         strcat(doc,"<p/>");
  1596         free(sym->documentation);
  1597         sym->documentation=NULL;
  1598       } else {
  1599         doc[0]='\0';
  1600       } /* if */
  1601       /* collect all documentation */
  1602       while ((str=get_docstring(0))!=NULL && *str!=sDOCSEP) {
  1603         if (doc[0]!='\0')
  1604           strcat(doc," ");
  1605         strcat(doc,str);
  1606         delete_docstring(0);
  1607       } /* while */
  1608       if (str!=NULL) {
  1609         /* also delete the separator */
  1610         assert(*str==sDOCSEP);
  1611         delete_docstring(0);
  1612       } /* if */
  1613       if (sym!=NULL) {
  1614         assert(sym->documentation==NULL);
  1615         sym->documentation=doc;
  1616       } else {
  1617         if (sc_documentation!=NULL)
  1618           free(sc_documentation);
  1619         sc_documentation=doc;
  1620       } /* if */
  1621     } /* if */
  1622   } else {
  1623     /* delete an empty separator, if present */
  1624     if ((str=get_docstring(0))!=NULL && *str==sDOCSEP)
  1625       delete_docstring(0);
  1626   } /* if */
  1627 }
  1628 
  1629 static void insert_docstring_separator(void)
  1630 {
  1631   char sep[2]={sDOCSEP,'\0'};
  1632   insert_docstring(sep);
  1633 }
  1634 #else
  1635   #define sc_attachdocumentation(s)      (void)(s)
  1636   #define insert_docstring_separator()
  1637 #endif
  1638 
  1639 static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst)
  1640 {
  1641   char name[sNAMEMAX+11];
  1642   int tok,tag=0;
  1643   char *str;
  1644   cell val;
  1645   int invalidfunc;
  1646   pstruct_t *pstruct = NULL;
  1647 
  1648   tok=lex(&val,&str);
  1649   if (tok == tLABEL) {
  1650     pstruct=pstructs_find(str);
  1651     tag=pc_addtag(str);
  1652   } else {
  1653     lexpush();
  1654   }
  1655   tok=lex(&val,&str);
  1656   /* if we arrived here, this may not be a declaration of a native function
  1657    * or variable
  1658    */
  1659   if (tok==tNATIVE) {
  1660     error(42);          /* invalid combination of class specifiers */
  1661     return;
  1662   } /* if */
  1663 
  1664   if (tok!=tSYMBOL && tok!=tOPERATOR) {
  1665     lexpush();
  1666     needtoken(tSYMBOL);
  1667     lexclr(TRUE);       /* drop the rest of the line */
  1668     litidx=0;           /* drop the literal queue too */
  1669     return;
  1670   } /* if */
  1671   if (tok==tOPERATOR) {
  1672     lexpush();          /* push "operator" keyword back (for later analysis) */
  1673     if (!newfunc(NULL,tag,fpublic,fstatic,fstock)) {
  1674       error(10);        /* illegal function or declaration */
  1675       lexclr(TRUE);     /* drop the rest of the line */
  1676       litidx=0;         /* drop the literal queue too */
  1677     } /* if */
  1678   } else {
  1679     /* so tok is tSYMBOL */
  1680     assert(strlen(str)<=sNAMEMAX);
  1681     strcpy(name,str);
  1682     /* only variables can be "const" or both "public" and "stock" */
  1683     invalidfunc= fconst || (fpublic && fstock);
  1684     if (invalidfunc || !newfunc(name,tag,fpublic,fstatic,fstock)) {
  1685       /* if not a function, try a global variable */
  1686       if (pstruct) {
  1687         declstructvar(name,fpublic,pstruct);
  1688       } else {
  1689         declglb(name,tag,fpublic,fstatic,fstock,fconst);
  1690       }
  1691     } /* if */
  1692   } /* if */
  1693 }
  1694 
  1695 /* declstruct	- declare global struct symbols
  1696  * 
  1697  * global references: glb_declared		(altered)
  1698  */
  1699 static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct)
  1700 {
  1701 	char name[sNAMEMAX+1];
  1702 	int tok,i;
  1703 	cell val;
  1704 	char *str;
  1705 	int cur_litidx = 0;
  1706 	cell *values, *found;
  1707 	int usage;
  1708 	symbol *mysym,*sym;
  1709 
  1710 	strcpy(name, firstname);
  1711 
  1712 	values = (cell *)malloc(pstruct->argcount * sizeof(cell));
  1713 	found = (cell *)malloc(pstruct->argcount * sizeof(cell));
  1714 	
  1715 	memset(found, 0, sizeof(cell) * pstruct->argcount);
  1716 
  1717 	//:TODO: Make this work with stock
  1718 
  1719 	/**
  1720 	 * Lastly, very lastly, we will insert a copy of this variable.
  1721 	 * This is soley to expose the pubvar.
  1722 	 */
  1723 	usage = uREAD|uCONST|uSTRUCT;
  1724 	if (fpublic)
  1725 	{
  1726 		usage |= uPUBLIC;
  1727 	}
  1728 	mysym = NULL;
  1729 	for (sym=glbtab.next; sym!=NULL; sym=sym->next)
  1730 	{
  1731 		if (strcmp(name, sym->name) == 0)
  1732 		{
  1733 			if ((sym->usage & uSTRUCT) && sym->vclass == sGLOBAL)
  1734 			{
  1735 				if (sym->usage & uDEFINE)
  1736 				{
  1737 					error(21, name);
  1738 				} else {
  1739 					if (sym->usage & uPUBLIC && !fpublic)
  1740 					{
  1741  						error(42);
  1742 					}
  1743 				}
  1744 			} else {
  1745 				error(21, name);
  1746 			}
  1747 			mysym = sym;
  1748 			break;
  1749 		}
  1750 	}
  1751 	if (!mysym)
  1752 	{
  1753 		mysym=addsym(name, 0, iVARIABLE, sGLOBAL, pc_addtag(pstruct->name), usage);
  1754 	}
  1755 
  1756 	if (!matchtoken('='))
  1757 	{
  1758 		matchtoken(';');
  1759 		/* Mark it as undefined instead */
  1760 		mysym->usage = uSTOCK|uSTRUCT;
  1761 		return;
  1762 	} else {
  1763 		mysym->usage = usage;
  1764 	}
  1765 	needtoken('{');
  1766 	do
  1767 	{
  1768 		structarg_t *arg;
  1769 		/* Detect early exit */
  1770 		if (matchtoken('}'))
  1771 		{
  1772 			lexpush();
  1773 			break;
  1774 		}
  1775 		tok=lex(&val,&str);
  1776 		if (tok != tSYMBOL)
  1777 		{
  1778 			error(1, "-identifier-", str);
  1779 			continue;
  1780 		}
  1781 		arg=pstructs_getarg(pstruct,str);
  1782 		if (arg == NULL)
  1783 		{
  1784 			/* :TODO: change to "Could not find member %s in struct %s" */
  1785 			error(31);
  1786 		}
  1787 		needtoken('=');
  1788 		cur_litidx = litidx;
  1789 		tok=lex(&val,&str);
  1790 		if (!arg)
  1791 		{
  1792 			continue;
  1793 		}
  1794 		if (tok == tSTRING)
  1795 		{
  1796 			assert(litidx != 0);
  1797 			if (arg->dimcount != 1)
  1798 			{
  1799 				error(48);
  1800 			} else if (arg->tag != pc_tag_string) {
  1801 				error(213);
  1802 			}
  1803 			values[arg->index] = glb_declared * sizeof(cell);
  1804 			glb_declared += (litidx-cur_litidx);
  1805 			found[arg->index] = 1;
  1806 		} else if (tok == tNUMBER || tok == tRATIONAL) {
  1807 			/* eat optional 'f' */
  1808 			matchtoken('f');
  1809 			if (arg->ident != iVARIABLE && arg->ident != iREFERENCE)
  1810 			{
  1811 				error(23);
  1812 			} else {
  1813 				if (arg->tag == pc_addtag("Float") && tok == tNUMBER ||
  1814 					arg->tag == 0 && tok == tRATIONAL)
  1815 				{
  1816 					error(213);
  1817 				}
  1818 				if (arg->ident == iVARIABLE)
  1819 				{
  1820 					values[arg->index] = val;
  1821 				} else if (arg->ident == iREFERENCE) {
  1822 					values[arg->index] = glb_declared * sizeof(cell);
  1823 					glb_declared += 1;
  1824 					litadd(val);
  1825 					cur_litidx = litidx;
  1826 				}
  1827 				found[arg->index] = 1;
  1828 			}
  1829 		} else if (tok == tSYMBOL) {
  1830 			for (sym=glbtab.next; sym!=NULL; sym=sym->next)
  1831 			{
  1832 				if (sym->vclass != sGLOBAL)
  1833 				{
  1834 					continue;
  1835 				}
  1836 				if (strcmp(sym->name, str) == 0)
  1837 				{
  1838 					if (arg->ident == iREFERENCE && sym->ident != iVARIABLE)
  1839 					{
  1840 						/* :TODO: Change to "symbol \"%s\" does not have a matching type */
  1841 						error(20, str);
  1842 					} else if (arg->ident == iARRAY) {
  1843 						if (sym->ident != iARRAY)
  1844 						{
  1845 							/* :TODO: Change to "symbol \"%s\" does not have a matching type */
  1846 							error(20, str);
  1847 						} else {
  1848 							/* :TODO: We should check dimension sizes here... */
  1849 						}
  1850 					} else if (arg->ident == iREFARRAY) {
  1851 						if (sym->ident != iARRAY)
  1852 						{
  1853 							/* :TODO: Change to "symbol \"%s\" does not have a matching type */
  1854 							error(20, str);
  1855 						}
  1856 						/* :TODO: Check dimension sizes! */
  1857 					} else {
  1858 						/* :TODO: Change to "symbol \"%s\" does not have a matching type */
  1859 						error(20, str);
  1860 					}
  1861 					if (sym->tag != arg->tag)
  1862 					{
  1863 						error(213);
  1864 					}
  1865 					sym->usage |= uREAD;
  1866 					values[arg->index] = sym->addr;
  1867 					found[arg->index] = 1;
  1868 					refer_symbol(sym, mysym);
  1869 					break;
  1870 				}
  1871 			}
  1872 			if (!sym)
  1873 			{
  1874 				error(17, str);
  1875 			}
  1876 		} else {
  1877 			error(1, "-identifier-", str);
  1878 		}
  1879 	} while (matchtoken(','));
  1880 	needtoken('}');
  1881 	matchtoken(';');	/* eat up optional semicolon */
  1882 
  1883 	for (i=0; i<pstruct->argcount; i++)
  1884 	{
  1885 		if (!found[i])
  1886 		{
  1887 			structarg_t *arg = pstruct->args[i];
  1888 			if (arg->ident == iREFARRAY)
  1889 			{
  1890 				values[arg->index] = glb_declared * sizeof(cell);
  1891 				glb_declared += 1;
  1892 				litadd(0);
  1893 				cur_litidx = litidx;
  1894 			} else if (arg->ident == iVARIABLE) {
  1895 				values[arg->index] = 0;
  1896 			} else {
  1897 				/* :TODO: broken for iARRAY! (unused tho) */
  1898 			}
  1899 		}
  1900 	}
  1901 
  1902 	mysym->addr = glb_declared * sizeof(cell);
  1903 	glb_declared += pstruct->argcount;
  1904 
  1905 	for (i=0; i<pstruct->argcount; i++)
  1906 	{
  1907 		litadd(values[i]);
  1908 	}
  1909 
  1910 	begdseg();
  1911 	dumplits();
  1912 	litidx=0;
  1913 
  1914 	free(found);
  1915 	free(values);
  1916 }
  1917 
  1918 /*  declglb     - declare global symbols
  1919  *
  1920  *  Declare a static (global) variable. Global variables are stored in
  1921  *  the DATA segment.
  1922  *
  1923  *  global references: glb_declared     (altered)
  1924  */
  1925 static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,int fstock,int fconst)
  1926 {
  1927   int ident,tag,ispublic;
  1928   int idxtag[sDIMEN_MAX];
  1929   char name[sNAMEMAX+1];
  1930   cell val,size,cidx;
  1931   ucell address;
  1932   int glb_incr;
  1933   char *str;
  1934   int dim[sDIMEN_MAX];
  1935   int numdim;
  1936   int slength=0;
  1937   short filenum;
  1938   symbol *sym;
  1939   constvalue *enumroot;
  1940   #if !defined NDEBUG
  1941     cell glbdecl=0;
  1942   #endif
  1943 
  1944   assert(!fpublic || !fstatic);         /* may not both be set */
  1945   insert_docstring_separator();         /* see comment in newfunc() */
  1946   filenum=fcurrent;                     /* save file number at the start of the declaration */
  1947   do {
  1948     size=1;                             /* single size (no array) */
  1949     numdim=0;                           /* no dimensions */
  1950     ident=iVARIABLE;
  1951     if (firstname!=NULL) {
  1952       assert(strlen(firstname)<=sNAMEMAX);
  1953       strcpy(name,firstname);           /* save symbol name */
  1954       tag=firsttag;
  1955       firstname=NULL;
  1956     } else {
  1957       tag=pc_addtag(NULL);
  1958       if (lex(&val,&str)!=tSYMBOL)      /* read in (new) token */
  1959         error(20,str);                  /* invalid symbol name */
  1960       assert(strlen(str)<=sNAMEMAX);
  1961       strcpy(name,str);                 /* save symbol name */
  1962     } /* if */
  1963     ispublic=fpublic;
  1964     if (name[0]==PUBLIC_CHAR) {
  1965       ispublic=TRUE;                    /* implicitly public variable */
  1966       assert(!fstatic);
  1967     } /* if */
  1968 	while (matchtoken('[')) {
  1969       ident=iARRAY;
  1970       if (numdim == sDIMEN_MAX) {
  1971         error(53);                      /* exceeding maximum number of dimensions */
  1972         return;
  1973       } /* if */
  1974       size=needsub(&idxtag[numdim],&enumroot);  /* get size; size==0 for "var[]" */
  1975       #if INT_MAX < LONG_MAX
  1976         if (size > INT_MAX)
  1977           error(105);                   /* overflow, exceeding capacity */
  1978       #endif
  1979 #if 0	/* We don't actually care */
  1980       if (ispublic)
  1981         error(56,name);                 /* arrays cannot be public */
  1982 #endif
  1983       dim[numdim++]=(int)size;
  1984     } /* while */
  1985     if (ident == iARRAY && tag == pc_tag_string && dim[numdim-1]) {
  1986       slength=dim[numdim-1];
  1987       dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
  1988     }
  1989     assert(sc_curstates==0);
  1990     sc_curstates=getstates(name);
  1991     if (sc_curstates<0) {
  1992       error(85,name);           /* empty state list on declaration */
  1993       sc_curstates=0;
  1994     } else if (sc_curstates>0 && ispublic) {
  1995       error(88,name);           /* public variables may not have states */
  1996       sc_curstates=0;
  1997     } /* if */
  1998     sym=findconst(name,NULL);
  1999     if (sym==NULL) {
  2000       sym=findglb(name,sSTATEVAR);
  2001       /* if a global variable without states is found and this declaration has
  2002        * states, the declaration is okay
  2003        */
  2004       if (sym!=NULL && sym->states==NULL && sc_curstates>0)
  2005         sym=NULL;               /* set to NULL, we found the global variable */
  2006       if (sc_curstates>0 && findglb(name,sGLOBAL)!=NULL)
  2007         error(233,name);        /* state variable shadows a global variable */
  2008     } /* if */
  2009     /* we have either:
  2010      * a) not found a matching variable (or rejected it, because it was a shadow)
  2011      * b) found a global variable and we were looking for that global variable
  2012      * c) found a state variable in the automaton that we were looking for
  2013      */
  2014     assert(sym==NULL
  2015            || sym->states==NULL && sc_curstates==0
  2016            || sym->states!=NULL && sym->next!=NULL && sym->states->next->index==sc_curstates);
  2017     /* a state variable may only have a single id in its list (so either this
  2018      * variable has no states, or it has a single list)
  2019      */
  2020     assert(sym==NULL || sym->states==NULL || sym->states->next->next==NULL);
  2021     /* it is okay for the (global) variable to exist, as long as it belongs to
  2022      * a different automaton
  2023      */
  2024     if (sym!=NULL && (sym->usage & uDEFINE)!=0)
  2025       error(21,name);                   /* symbol already defined */
  2026     /* if this variable is never used (which can be detected only in the
  2027      * second stage), shut off code generation
  2028      */
  2029     cidx=0;             /* only to avoid a compiler warning */
  2030     if (sc_status==statWRITE && sym!=NULL && (sym->usage & (uREAD | uWRITTEN))==0) {
  2031       sc_status=statSKIP;
  2032       cidx=code_idx;
  2033       #if !defined NDEBUG
  2034         glbdecl=glb_declared;
  2035       #endif
  2036     } /* if */
  2037     begdseg();          /* real (initialized) data in data segment */
  2038     assert(litidx==0);  /* literal queue should be empty */
  2039     if (sc_alignnext) {
  2040       litidx=0;
  2041       aligndata(sc_dataalign);
  2042       dumplits();       /* dump the literal queue */
  2043       sc_alignnext=FALSE;
  2044       litidx=0;         /* global initial data is dumped, so restart at zero */
  2045     } /* if */
  2046     assert(litidx==0);  /* literal queue should be empty (again) */
  2047     initials(ident,tag,&size,dim,numdim,enumroot);/* stores values in the literal queue */
  2048     if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
  2049       slength = glbstringread;
  2050     }
  2051     assert(size>=litidx);
  2052     if (numdim==1)
  2053       dim[0]=(int)size;
  2054     /* before dumping the initial values (or zeros) check whether this variable
  2055      * overlaps another
  2056      */
  2057     if (sc_curstates>0) {
  2058       unsigned char *map;
  2059 
  2060       if (litidx!=0)
  2061         error(89,name); /* state variables may not be initialized */
  2062       /* find an appropriate address for the state variable */
  2063       /* assume that it cannot be found */
  2064       address=sizeof(cell)*glb_declared;
  2065       glb_incr=(int)size;
  2066       /* use a memory map in which every cell occupies one bit */
  2067       if (glb_declared>0 && (map=(unsigned char*)malloc((glb_declared+7)/8))!=NULL) {
  2068         int fsa=state_getfsa(sc_curstates);
  2069         symbol *sweep;
  2070         cell sweepsize,addr;
  2071         memset(map,0,(glb_declared+7)/8);
  2072         assert(fsa>=0);
  2073         /* fill in all variables belonging to this automaton */
  2074         for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
  2075           if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
  2076             continue;   /* hierarchical type, or no states, or same as this variable */
  2077           if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
  2078             continue;   /* a function or a constant */
  2079           if ((sweep->usage & uDEFINE)==0)
  2080             continue;   /* undefined variable, ignore */
  2081           if (fsa!=state_getfsa(sweep->states->next->index))
  2082             continue;   /* wrong automaton */
  2083           /* when arrived here, this is a global variable, with states and
  2084            * belonging to the same automaton as the variable we are declaring
  2085            */
  2086           sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
  2087           assert(sweep->addr % sizeof(cell) == 0);
  2088           addr=sweep->addr/sizeof(cell);
  2089           /* mark this address range */
  2090           while (sweepsize-->0) {
  2091             map[addr/8] |= (unsigned char)(1 << (addr % 8));
  2092             addr++;
  2093           } /* while */
  2094         } /* for */
  2095         /* go over it again, clearing any ranges that have conflicts */
  2096         for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
  2097           if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
  2098             continue;   /* hierarchical type, or no states, or same as this variable */
  2099           if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
  2100             continue;   /* a function or a constant */
  2101           if ((sweep->usage & uDEFINE)==0)
  2102             continue;   /* undefined variable, ignore */
  2103           if (fsa!=state_getfsa(sweep->states->next->index))
  2104             continue;   /* wrong automaton */
  2105           /* when arrived here, this is a global variable, with states and
  2106            * belonging to the same automaton as the variable we are declaring
  2107            */
  2108           /* if the lists of states of the existing variable and the new
  2109            * variable have a non-empty intersection, this is not a suitable
  2110            * overlap point -> wipe the address range
  2111            */
  2112           if (state_conflict_id(sc_curstates,sweep->states->next->index)) {
  2113             sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
  2114             assert(sweep->addr % sizeof(cell) == 0);
  2115             addr=sweep->addr/sizeof(cell);
  2116             /* mark this address range */
  2117             while (sweepsize-->0) {
  2118               map[addr/8] &= (unsigned char)(~(1 << (addr % 8)));
  2119               addr++;
  2120             } /* while */
  2121           } /* if */
  2122         } /* for */
  2123         /* now walk through the map and find a starting point that is big enough */
  2124         sweepsize=0;
  2125         for (addr=0; addr<glb_declared; addr++) {
  2126           if ((map[addr/8] & (1 << (addr % 8)))==0)
  2127             continue;
  2128           for (sweepsize=addr+1; sweepsize<glb_declared; sweepsize++) {
  2129             if ((map[sweepsize/8] & (1 << (sweepsize % 8)))==0)
  2130               break;    /* zero bit found, skip this range */
  2131             if (sweepsize-addr>=size)
  2132               break;    /* fitting range found, no need to search further */
  2133           } /* for */
  2134           if (sweepsize-addr>=size)
  2135             break;      /* fitting range found, no need to search further */
  2136           addr=sweepsize;
  2137         } /* for */
  2138         free(map);
  2139         if (sweepsize-addr>=size) {
  2140           address=sizeof(cell)*addr;    /* fitting range found, set it */
  2141           glb_incr=0;
  2142         } /* if */
  2143       } /* if */
  2144     } else {
  2145       address=sizeof(cell)*glb_declared;
  2146       glb_incr=(int)size;
  2147     } /* if */
  2148     if (address==sizeof(cell)*glb_declared) {
  2149       dumplits();       /* dump the literal queue */
  2150       dumpzero((int)size-litidx);
  2151     } /* if */
  2152     litidx=0;
  2153     if (sym==NULL) {    /* define only if not yet defined */
  2154       sym=addvariable2(name,address,ident,sGLOBAL,tag,dim,numdim,idxtag,slength);
  2155       if (sc_curstates>0)
  2156         attachstatelist(sym,sc_curstates);
  2157     } else {            /* if declared but not yet defined, adjust the variable's address */
  2158       assert(sym->states==NULL && sc_curstates==0
  2159              || sym->states->next!=NULL && sym->states->next->index==sc_curstates && sym->states->next->next==NULL);
  2160       sym->addr=address;
  2161       sym->codeaddr=code_idx;
  2162       sym->usage|=uDEFINE;
  2163     } /* if */
  2164     assert(sym!=NULL);
  2165     sc_curstates=0;
  2166     if (ispublic)
  2167       sym->usage|=uPUBLIC|uREAD;
  2168     if (fconst)
  2169       sym->usage|=uCONST;
  2170     if (fstock)
  2171       sym->usage|=uSTOCK;
  2172     if (fstatic)
  2173       sym->fnumber=filenum;
  2174     sc_attachdocumentation(sym);/* attach any documenation to the variable */
  2175     if (sc_status==statSKIP) {
  2176       sc_status=statWRITE;
  2177       code_idx=cidx;
  2178       assert(glb_declared==glbdecl);
  2179     } else {
  2180       glb_declared+=glb_incr;   /* add total number of cells (if added to the end) */
  2181     } /* if */
  2182   } while (matchtoken(',')); /* enddo */   /* more? */
  2183   needtoken(tTERM);    /* if not comma, must be semicolumn */
  2184 }
  2185 
  2186 /*  declloc     - declare local symbols
  2187  *
  2188  *  Declare local (automatic) variables. Since these variables are relative
  2189  *  to the STACK, there is no switch to the DATA segment. These variables
  2190  *  cannot be initialized either.
  2191  *
  2192  *  global references: declared   (altered)
  2193  *                     funcstatus (referred to only)
  2194  */
  2195 static int declloc(int fstatic)
  2196 {
  2197   int ident,tag;
  2198   int idxtag[sDIMEN_MAX];
  2199   char name[sNAMEMAX+1];
  2200   symbol *sym;
  2201   constvalue *enumroot=NULL;
  2202   cell val,size;
  2203   char *str;
  2204   value lval = {0};
  2205   int cur_lit=0;
  2206   int dim[sDIMEN_MAX];
  2207   int numdim;
  2208   int fconst;
  2209   int staging_start;
  2210   int slength = 0;
  2211 
  2212   fconst=matchtoken(tCONST);
  2213   do {
  2214     ident=iVARIABLE;
  2215     size=1;
  2216     slength=0;
  2217     numdim=0;                           /* no dimensions */
  2218     tag=pc_addtag(NULL);
  2219     if (lex(&val,&str)!=tSYMBOL)        /* read in (new) token */
  2220       error(20,str);                    /* invalid symbol name */
  2221     assert(strlen(str)<=sNAMEMAX);
  2222     strcpy(name,str);                   /* save symbol name */
  2223     if (name[0]==PUBLIC_CHAR)
  2224       error(56,name);                   /* local variables cannot be public */
  2225     /* Note: block locals may be named identical to locals at higher
  2226      * compound blocks (as with standard C); so we must check (and add)
  2227      * the "nesting level" of local variables to verify the
  2228      * multi-definition of symbols.
  2229      */
  2230     if ((sym=findloc(name))!=NULL && sym->compound==nestlevel)
  2231       error(21,name);                   /* symbol already defined */
  2232     /* Although valid, a local variable whose name is equal to that
  2233      * of a global variable or to that of a local variable at a lower
  2234      * level might indicate a bug.
  2235      */
  2236     if ((sym=findloc(name))!=NULL && sym->compound!=nestlevel || findglb(name,sGLOBAL)!=NULL)
  2237       error(219,name);                  /* variable shadows another symbol */
  2238 	if (matchtoken('[')) {
  2239       int _index;
  2240       cell _code;
  2241       int dim_ident;
  2242       symbol *dim_sym;
  2243       value dim_val;
  2244       int all_constant = 1;
  2245       int _staging = staging;
  2246 
  2247       if (!_staging)
  2248         stgset(TRUE);
  2249       stgget(&_index, &_code);
  2250 
  2251       do {
  2252         if (numdim == sDIMEN_MAX) {
  2253           error(53);                      /* exceeding maximum number of dimensions */
  2254           return (all_constant ? iARRAY : iREFARRAY);
  2255         } else if (numdim) { /* if */
  2256           /* If we have a dimension on the stack, push it */
  2257           pushreg(sPRI);
  2258         }
  2259         if (matchtoken(']')) {
  2260           idxtag[numdim] = 0;
  2261           dim[numdim] = 0;
  2262 		  numdim++;
  2263           continue;
  2264         }
  2265         dim_ident = doexpr2(TRUE,FALSE,FALSE,FALSE,&idxtag[numdim],&dim_sym,0,&dim_val);
  2266         if (dim_ident == iVARIABLE || dim_ident == iEXPRESSION || dim_ident == iARRAYCELL) {
  2267           all_constant = 0;
  2268         } else if (dim_ident == iCONSTEXPR) {
  2269           dim[numdim] = dim_val.constval;
  2270 		  /* :TODO: :URGENT: Make sure this still works */
  2271           if (dim_sym && dim_sym->usage & uENUMROOT)
  2272             enumroot = dim_sym->dim.enumlist;
  2273 		  idxtag[numdim] = dim_sym ? dim_sym->tag : 0;
  2274           #if INT_MAX < LONG_MAX
  2275 		    if (dim[numdim] > INT_MAX)
  2276 			  error(105);                   /* overflow, exceeding capacity */
  2277           #endif
  2278         } else {
  2279           error(29); /* invalid expression, assumed 0 */
  2280         }
  2281         numdim++;
  2282 		needtoken(']');
  2283       } while (matchtoken('['));
  2284       if (all_constant) {
  2285         /* Change the last dimension to be based on chars instead if we have a string */
  2286         if (tag == pc_tag_string && numdim && dim[numdim-1]) {
  2287           slength = dim[numdim-1];
  2288           dim[numdim-1] = (dim[numdim-1] + sizeof(cell)-1) / sizeof(cell);
  2289         }
  2290         /* Scrap the code generated */
  2291         ident = iARRAY;
  2292         stgdel(_index, _code);
  2293       } else {
  2294         if (tag == pc_tag_string && numdim && dim[numdim-1]) {
  2295           stradjust(sPRI);
  2296         }
  2297         pushreg(sPRI);
  2298         memset(dim, 0, sizeof(int)*sDIMEN_MAX);
  2299         ident = iREFARRAY;
  2300         genarray(numdim, autozero);
  2301       }
  2302       stgout(_index);
  2303       if (!_staging)
  2304         stgset(FALSE);
  2305     }
  2306     if (getstates(name))
  2307       error(88,name);           /* local variables may not have states */
  2308     if (ident==iARRAY || fstatic) {
  2309       if (sc_alignnext) {
  2310         aligndata(sc_dataalign);
  2311         sc_alignnext=FALSE;
  2312       } /* if */
  2313       cur_lit=litidx;           /* save current index in the literal table */
  2314       if (numdim && !dim[numdim-1])
  2315         size = 0;
  2316       initials(ident,tag,&size,dim,numdim,enumroot);
  2317       if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
  2318         slength = glbstringread;
  2319       }
  2320       if (size==0)
  2321         return ident;           /* error message already given */
  2322       if (numdim==1)
  2323         dim[0]=(int)size;
  2324     }
  2325     /* reserve memory (on the stack) for the variable */
  2326     if (fstatic) {
  2327       /* write zeros for uninitialized fields */
  2328       while (litidx<cur_lit+size)
  2329         litadd(0);
  2330       sym=addvariable2(name,(cur_lit+glb_declared)*sizeof(cell),ident,sSTATIC,
  2331                       tag,dim,numdim,idxtag,slength);
  2332     } else if (ident!=iREFARRAY) {
  2333       declared+=(int)size;      /* variables are put on stack, adjust "declared" */
  2334       sym=addvariable2(name,-declared*sizeof(cell),ident,sLOCAL,tag,
  2335                       dim,numdim,idxtag,slength);
  2336       if (ident==iVARIABLE) {
  2337         assert(!staging);
  2338         stgset(TRUE);           /* start stage-buffering */
  2339         assert(stgidx==0);
  2340         staging_start=stgidx;
  2341       } /* if */
  2342       markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
  2343       modstk(-(int)size*sizeof(cell));
  2344       markstack(MEMUSE_STATIC, size);
  2345       assert(curfunc!=NULL);
  2346       assert((curfunc->usage & uNATIVE)==0);
  2347       if (curfunc->x.stacksize<declared+1)
  2348         curfunc->x.stacksize=declared+1;  /* +1 for PROC opcode */
  2349     } else if (ident==iREFARRAY) {
  2350       declared+=1;	/* one cell for address */
  2351       sym=addvariable(name,-declared*sizeof(cell),ident,sLOCAL,tag,dim,numdim,idxtag);
  2352       //markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
  2353       /* genarray() pushes the address onto the stack, so we don't need to call modstk() here! */
  2354       markheap(MEMUSE_DYNAMIC, 0);
  2355 	  markstack(MEMUSE_STATIC, 1);
  2356       assert(curfunc != NULL && ((curfunc->usage & uNATIVE) == 0));
  2357       if (curfunc->x.stacksize<declared+1)
  2358         curfunc->x.stacksize=declared+1;  /* +1 for PROC opcode */
  2359     } /* if */
  2360     /* now that we have reserved memory for the variable, we can proceed
  2361      * to initialize it */
  2362     assert(sym!=NULL);          /* we declared it, it must be there */
  2363     sym->compound=nestlevel;    /* for multiple declaration/shadowing check */
  2364     if (fconst)
  2365       sym->usage|=uCONST;
  2366     if (!fstatic) {             /* static variables already initialized */
  2367       if (ident==iVARIABLE) {
  2368         /* simple variable, also supports initialization */
  2369         int ctag = tag;         /* set to "tag" by default */
  2370         int explicit_init=FALSE;/* is the variable explicitly initialized? */
  2371         int cident=ident;
  2372         if (matchtoken('=')) {
  2373           if (!autozero)
  2374             error(10);
  2375           cident=doexpr(FALSE,FALSE,FALSE,FALSE,&ctag,NULL,TRUE);
  2376           explicit_init=TRUE;
  2377         } else {
  2378           if (autozero)
  2379             ldconst(0,sPRI);      /* uninitialized variable, set to zero */
  2380         } /* if */
  2381         if (autozero) {
  2382           /* now try to save the value (still in PRI) in the variable */
  2383           lval.sym=sym;
  2384           lval.ident=iVARIABLE;
  2385           lval.constval=0;
  2386           lval.tag=tag;
  2387           check_userop(NULL,ctag,lval.tag,2,NULL,&ctag);
  2388           store(&lval);
  2389           markexpr(sEXPR,NULL,0); /* full expression ends after the store */
  2390         }
  2391         assert(staging);        /* end staging phase (optimize expression) */
  2392         stgout(staging_start);
  2393         stgset(FALSE);
  2394         if (!matchtag_string(cident, ctag) && !matchtag(tag,ctag,TRUE))
  2395           error(213);           /* tag mismatch */
  2396         /* if the variable was not explicitly initialized, reset the
  2397          * "uWRITTEN" flag that store() set */
  2398         if (!explicit_init)
  2399           sym->usage &= ~uWRITTEN;
  2400       } else if (ident!=iREFARRAY) {
  2401         /* an array */
  2402         assert(cur_lit>=0 && cur_lit<=litidx && litidx<=litmax);
  2403         assert(size>0 && size>=sym->dim.array.length);
  2404         assert(numdim>1 || size==sym->dim.array.length);
  2405         if (autozero) {
  2406           /* final literal values that are zero make no sense to put in the literal
  2407            * pool, because values get zero-initialized anyway; we check for this,
  2408            * because users often explicitly initialize strings to ""
  2409            */
  2410           while (litidx>cur_lit && litq[litidx-1]==0)
  2411             litidx--;
  2412           /* if the array is not completely filled, set all values to zero first */
  2413           if (litidx-cur_lit<size && (ucell)size<CELL_MAX)
  2414             fillarray(sym,size*sizeof(cell),0);
  2415         }
  2416         if (cur_lit<litidx) {
  2417           /* check whether the complete array is set to a single value; if
  2418            * it is, more compact code can be generated */
  2419           cell first=litq[cur_lit];
  2420           int i;
  2421           for (i=cur_lit; i<litidx && litq[i]==first; i++)
  2422             /* nothing */;
  2423           if (i==litidx) {
  2424             /* all values are the same */
  2425             fillarray(sym,(litidx-cur_lit)*sizeof(cell),first);
  2426             litidx=cur_lit;     /* reset literal table */
  2427           } else {
  2428             /* copy the literals to the array */
  2429             ldconst((cur_lit+glb_declared)*sizeof(cell),sPRI);
  2430             copyarray(sym,(litidx-cur_lit)*sizeof(cell));
  2431           } /* if */
  2432         } /* if */
  2433       } /* if */
  2434     } /* if */
  2435   } while (matchtoken(',')); /* enddo */   /* more? */
  2436   needtoken(tTERM);    /* if not comma, must be semicolumn */
  2437   return ident;
  2438 }
  2439 
  2440 /* this function returns the maximum value for a cell in case of an error
  2441  * (invalid dimension).
  2442  */
  2443 static cell calc_arraysize(int dim[],int numdim,int cur)
  2444 {
  2445   cell subsize;
  2446   ucell newsize;
  2447 
  2448   /* the return value is in cells, not bytes */
  2449   assert(cur>=0 && cur<=numdim);
  2450   if (cur==numdim)
  2451     return 0;
  2452   subsize=calc_arraysize(dim,numdim,cur+1);
  2453   newsize=dim[cur]+dim[cur]*subsize;
  2454   if ((ucell)subsize>=CELL_MAX || newsize>=CELL_MAX || newsize<(ucell)subsize
  2455       || newsize*sizeof(cell)>=CELL_MAX)
  2456     return CELL_MAX;
  2457   return newsize;
  2458 }
  2459 
  2460 static cell adjust_indirectiontables(int dim[],int numdim,int cur,cell increment,
  2461                                      int startlit,constvalue *lastdim,int *skipdim)
  2462 {
  2463 static int base;
  2464   int d;
  2465   cell accum;
  2466 
  2467   assert(cur>=0 && cur<numdim);
  2468   assert(increment>=0);
  2469   assert(cur>0 && startlit==-1 || startlit>=0 && startlit<=litidx);
  2470   if (cur==0)
  2471     base=startlit;
  2472   if (cur==numdim-1)
  2473     return 0;
  2474   /* 2 or more dimensions left, fill in an indirection vector */
  2475   assert(dim[cur]>0);
  2476   if (dim[cur+1]>0) {
  2477     for (d=0; d<dim[cur]; d++)
  2478       litq[base++]=(dim[cur]+d*(dim[cur+1]-1)+increment) * sizeof(cell);
  2479     accum=dim[cur]*(dim[cur+1]-1);
  2480   } else {
  2481     /* final dimension is variable length */
  2482     constvalue *ld;
  2483     assert(dim[cur+1]==0);
  2484     assert(lastdim!=NULL);
  2485     assert(skipdim!=NULL);
  2486     accum=0;
  2487     /* skip the final dimension sizes for all earlier major dimensions */
  2488     for (d=0,ld=lastdim->next; d<*skipdim; d++,ld=ld->next) {
  2489       assert(ld!=NULL);
  2490     } /* for */
  2491     for (d=0; d<dim[cur]; d++) {
  2492       assert(ld!=NULL);
  2493       assert(strtol(ld->name,NULL,16)==d);
  2494       litq[base++]=(dim[cur]+accum+increment) * sizeof(cell);
  2495       accum+=ld->value-1;
  2496       *skipdim+=1;
  2497       ld=ld->next;
  2498     } /* for */
  2499   } /* if */
  2500   /* create the indirection tables for the lower level */
  2501   if (cur+2<numdim) {   /* are there at least 2 dimensions below this one? */
  2502     increment+=(dim[cur]-1)*dim[cur+1]; /* this many indirection tables follow */
  2503     for (d=0; d<dim[cur]; d++)
  2504       increment+=adjust_indirectiontables(dim,numdim,cur+1,increment,-1,lastdim,skipdim);
  2505   } /* if */
  2506   return accum;
  2507 }
  2508 
  2509 /*  initials
  2510  *
  2511  *  Initialize global objects and local arrays.
  2512  *    size==array cells (count), if 0 on input, the routine counts the number of elements
  2513  *    tag==required tagname id (not the returned tag)
  2514  *
  2515  *  Global references: litidx (altered)
  2516  */
  2517 static void initials(int ident,int tag,cell *size,int dim[],int numdim,
  2518                      constvalue *enumroot)
  2519 {
  2520   int ctag;
  2521   cell tablesize;
  2522   int curlit=litidx;
  2523   int err=0;
  2524 
  2525   if (!matchtoken('=')) {
  2526     assert(ident!=iARRAY || numdim>0);
  2527     if (ident==iARRAY && dim[numdim-1]==0) {
  2528       /* declared as "myvar[];" which is senseless (note: this *does* make
  2529        * sense in the case of a iREFARRAY, which is a function parameter)
  2530        */
  2531       error(9);         /* array has zero length -> invalid size */
  2532     } /* if */
  2533     if (ident==iARRAY) {
  2534       assert(numdim>0 && numdim<=sDIMEN_MAX);
  2535       *size=calc_arraysize(dim,numdim,0);
  2536       if (*size==(cell)CELL_MAX) {
  2537         error(9);       /* array is too big -> invalid size */
  2538         return;
  2539       } /* if */
  2540       /* first reserve space for the indirection vectors of the array, then
  2541        * adjust it to contain the proper values
  2542        * (do not use dumpzero(), as it bypasses the literal queue)
  2543        */
  2544       for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
  2545         litadd(0);
  2546       if (dim[numdim-1]!=0)     /* error 9 has already been given */
  2547         adjust_indirectiontables(dim,numdim,0,0,curlit,NULL,NULL);
  2548     } /* if */
  2549     return;
  2550   } /* if */
  2551 
  2552   if (ident==iVARIABLE) {
  2553     assert(*size==1);
  2554     init(ident,&ctag,NULL);
  2555     if (!matchtag(tag,ctag,TRUE))
  2556       error(213);       /* tag mismatch */
  2557   } else {
  2558     assert(numdim>0);
  2559     if (numdim==1) {
  2560       *size=initvector(ident,tag,dim[0],FALSE,enumroot,NULL);
  2561     } else {
  2562       int errorfound=FALSE;
  2563       int counteddim[sDIMEN_MAX];
  2564       int idx;
  2565       constvalue lastdim={NULL,"",0,0};     /* sizes of the final dimension */
  2566       int skipdim=0;
  2567 
  2568       if (dim[numdim-1]!=0)
  2569         *size=calc_arraysize(dim,numdim,0); /* calc. full size, if known */
  2570       /* already reserve space for the indirection tables (for an array with
  2571        * known dimensions)
  2572        * (do not use dumpzero(), as it bypasses the literal queue)
  2573        */
  2574       for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
  2575         litadd(0);
  2576       /* now initialize the sub-arrays */
  2577       memset(counteddim,0,sizeof counteddim);
  2578       initarray(ident,tag,dim,numdim,0,curlit,counteddim,&lastdim,enumroot,&errorfound);
  2579       /* check the specified array dimensions with the initializer counts */
  2580       for (idx=0; idx<numdim-1; idx++) {
  2581         if (dim[idx]==0) {
  2582           dim[idx]=counteddim[idx];
  2583         } else if (counteddim[idx]<dim[idx]) {
  2584           error(52);            /* array is not fully initialized */
  2585           err++;
  2586         } else if (counteddim[idx]>dim[idx]) {
  2587           error(18);            /* initialization data exceeds declared size */
  2588           err++;
  2589         } /* if */
  2590       } /* for */
  2591       if (numdim>1 && dim[numdim-1]==0) {
  2592         /* also look whether, by any chance, all "counted" final dimensions are
  2593          * the same value; if so, we can store this
  2594          */
  2595         constvalue *ld=lastdim.next;
  2596         int d,match;
  2597         for (d=0; d<dim[numdim-2]; d++) {
  2598           assert(ld!=NULL);
  2599           assert(strtol(ld->name,NULL,16)==d);
  2600           if (d==0)
  2601             match=ld->value;
  2602           else if (match!=ld->value)
  2603             break;
  2604           ld=ld->next;
  2605         } /* for */
  2606         if (d==dim[numdim-2])
  2607           dim[numdim-1]=match;
  2608       } /* if */
  2609       /* after all arrays have been initalized, we know the (major) dimensions
  2610        * of the array and we can properly adjust the indirection vectors
  2611        */
  2612       if (err==0)
  2613         adjust_indirectiontables(dim,numdim,0,0,curlit,&lastdim,&skipdim);
  2614       delete_consttable(&lastdim);  /* clear list of minor dimension sizes */
  2615     } /* if */
  2616   } /* if */
  2617 
  2618   if (*size==0)
  2619     *size=litidx-curlit;        /* number of elements defined */
  2620 }
  2621 
  2622 static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
  2623                       int startlit,int counteddim[],constvalue *lastdim,
  2624                       constvalue *enumroot,int *errorfound)
  2625 {
  2626   cell dsize,totalsize;
  2627   int idx,abortparse;
  2628 
  2629   assert(cur>=0 && cur<numdim);
  2630   assert(startlit>=0);
  2631   assert(cur+2<=numdim);/* there must be 2 dimensions or more to do */
  2632   assert(errorfound!=NULL && *errorfound==FALSE);
  2633   totalsize=0;
  2634   needtoken('{');
  2635   for (idx=0,abortparse=FALSE; !abortparse; idx++) {
  2636     /* In case the major dimension is zero, we need to store the offset
  2637      * to the newly detected sub-array into the indirection table; i.e.
  2638      * this table needs to be expanded and updated.
  2639      * In the current design, the indirection vectors for a multi-dimensional
  2640      * array are adjusted after parsing all initializers. Hence, it is only
  2641      * necessary at this point to reserve space for an extra cell in the
  2642      * indirection vector.
  2643      */
  2644     if (dim[cur]==0) {
  2645       litinsert(0,startlit);
  2646     } else if (idx>=dim[cur]) {
  2647       error(18);            /* initialization data exceeds array size */
  2648       break;
  2649     } /* if */
  2650     if (cur+2<numdim) {
  2651       dsize=initarray(ident,tag,dim,numdim,cur+1,startlit,counteddim,
  2652                       lastdim,enumroot,errorfound);
  2653     } else {
  2654       dsize=initvector(ident,tag,dim[cur+1],TRUE,enumroot,errorfound);
  2655       /* The final dimension may be variable length. We need to keep the
  2656        * lengths of the final dimensions in order to set the indirection
  2657        * vectors for the next-to-last dimension.
  2658        */
  2659       append_constval(lastdim,itoh(idx),dsize,0);
  2660     } /* if */
  2661     totalsize+=dsize;
  2662     if (*errorfound || !matchtoken(','))
  2663       abortparse=TRUE;
  2664   } /* for */
  2665   needtoken('}');
  2666   assert(counteddim!=NULL);
  2667   if (counteddim[cur]>0) {
  2668     if (idx<counteddim[cur])
  2669       error(52);                /* array is not fully initialized */
  2670     else if (idx>counteddim[cur])
  2671       error(18);                /* initialization data exceeds declared size */
  2672   } /* if */
  2673   counteddim[cur]=idx;
  2674 
  2675   return totalsize+dim[cur];    /* size of sub-arrays + indirection vector */
  2676 }
  2677 
  2678 /*  initvector
  2679  *  Initialize a single dimensional array
  2680  */
  2681 static cell initvector(int ident,int tag,cell size,int fillzero,
  2682                        constvalue *enumroot,int *errorfound)
  2683 {
  2684   cell prev1=0,prev2=0;
  2685   int ellips=FALSE;
  2686   int curlit=litidx;
  2687   int rtag,ctag;
  2688 
  2689   assert(ident==iARRAY || ident==iREFARRAY);
  2690   if (matchtoken('{')) {
  2691     constvalue *enumfield=(enumroot!=NULL) ? enumroot->next : NULL;
  2692     do {
  2693       int fieldlit=litidx;
  2694       int matchbrace,i;
  2695       if (matchtoken('}')) {    /* to allow for trailing ',' after the initialization */
  2696         lexpush();
  2697         break;
  2698       } /* if */
  2699       if ((ellips=matchtoken(tELLIPS))!=0)
  2700         break;
  2701       /* for enumeration fields, allow another level of braces ("{...}") */
  2702       matchbrace=0;             /* preset */
  2703       ellips=0;
  2704       if (enumfield!=NULL)
  2705         matchbrace=matchtoken('{');
  2706       for ( ;; ) {
  2707         prev2=prev1;
  2708         prev1=init(ident,&ctag,errorfound);
  2709         if (!matchbrace)
  2710           break;
  2711         if ((ellips=matchtoken(tELLIPS))!=0)
  2712           break;
  2713         if (!matchtoken(',')) {
  2714           needtoken('}');
  2715           break;
  2716         } /* for */
  2717       } /* for */
  2718       /* if this array is based on an enumeration, fill the "field" up with
  2719        * zeros, and toggle the tag
  2720        */
  2721       if (enumroot!=NULL && enumfield==NULL)
  2722         error(227);             /* more initializers than enum fields */
  2723       rtag=tag;                 /* preset, may be overridden by enum field tag */
  2724       if (enumfield!=NULL) {
  2725         cell step;
  2726         int cmptag=enumfield->index;
  2727         symbol *symfield=findconst(enumfield->name,&cmptag);
  2728         if (cmptag>1)
  2729           error(91,enumfield->name); /* ambiguous constant, needs tag override */
  2730         assert(symfield!=NULL);
  2731         assert(fieldlit<litidx);
  2732         if (litidx-fieldlit>symfield->dim.array.length)
  2733           error(228);           /* length of initializer exceeds size of the enum field */
  2734         if (ellips) {
  2735           step=prev1-prev2;
  2736         } else {
  2737           step=0;
  2738           prev1=0;
  2739         } /* if */
  2740         for (i=litidx-fieldlit; i<symfield->dim.array.length; i++) {
  2741           prev1+=step;
  2742           litadd(prev1);
  2743         } /* for */
  2744         rtag=symfield->x.tags.index;  /* set the expected tag to the index tag */
  2745         enumfield=enumfield->next;
  2746       } /* if */
  2747       if (!matchtag(rtag,ctag,TRUE))
  2748         error(213);             /* tag mismatch */
  2749     } while (matchtoken(',')); /* do */
  2750     needtoken('}');
  2751   } else {
  2752     init(ident,&ctag,errorfound);
  2753     if (!matchtag(tag,ctag,TRUE))
  2754       error(213);               /* tagname mismatch */
  2755   } /* if */
  2756   /* fill up the literal queue with a series */
  2757   if (ellips) {
  2758     cell step=((litidx-curlit)==1) ? (cell)0 : prev1-prev2;
  2759     if (size==0 || (litidx-curlit)==0)
  2760       error(41);                /* invalid ellipsis, array size unknown */
  2761     else if ((litidx-curlit)==(int)size)
  2762       error(18);                /* initialisation data exceeds declared size */
  2763     while ((litidx-curlit)<(int)size) {
  2764       prev1+=step;
  2765       litadd(prev1);
  2766     } /* while */
  2767   } /* if */
  2768   if (fillzero && size>0) {
  2769     while ((litidx-curlit)<(int)size)
  2770       litadd(0);
  2771   } /* if */
  2772   if (size==0) {
  2773     size=litidx-curlit;                 /* number of elements defined */
  2774   } else if (litidx-curlit>(int)size) { /* e.g. "myvar[3]={1,2,3,4};" */
  2775     error(18);                  /* initialisation data exceeds declared size */
  2776     litidx=(int)size+curlit;    /* avoid overflow in memory moves */
  2777   } /* if */
  2778   return size;
  2779 }
  2780 
  2781 /*  init
  2782  *
  2783  *  Evaluate one initializer.
  2784  */
  2785 static cell init(int ident,int *tag,int *errorfound)
  2786 {
  2787   cell i = 0;
  2788 
  2789   if (matchtoken(tSTRING)){
  2790     /* lex() automatically stores strings in the literal table (and
  2791      * increases "litidx") */
  2792     if (ident==iVARIABLE) {
  2793       error(6);         /* must be assigned to an array */
  2794       litidx=1;         /* reset literal queue */
  2795     } /* if */
  2796     *tag=pc_tag_string;
  2797   } else if (constexpr(&i,tag,NULL)){
  2798     litadd(i);          /* store expression result in literal table */
  2799   } else {
  2800     if (errorfound!=NULL)
  2801       *errorfound=TRUE;
  2802   } /* if */
  2803   return i;
  2804 }
  2805 
  2806 /*  needsub
  2807  *
  2808  *  Get required array size
  2809  */
  2810 static cell needsub(int *tag,constvalue **enumroot)
  2811 {
  2812   cell val;
  2813   symbol *sym;
  2814 
  2815   assert(tag!=NULL);
  2816   *tag=0;
  2817   if (enumroot!=NULL)
  2818     *enumroot=NULL;         /* preset */
  2819   if (matchtoken(']'))      /* we have already seen "[" */
  2820     return 0;               /* zero size (like "char msg[]") */
  2821 
  2822   constexpr(&val,tag,&sym); /* get value (must be constant expression) */
  2823   if (val<0) {
  2824     error(9);               /* negative array size is invalid; assumed zero */
  2825     val=0;
  2826   } /* if */
  2827   needtoken(']');
  2828 
  2829   if (enumroot!=NULL) {
  2830     /* get the field list for an enumeration */
  2831     assert(*enumroot==NULL);/* should have been preset */
  2832     assert(sym==NULL || sym->ident==iCONSTEXPR);
  2833     if (sym!=NULL && (sym->usage & uENUMROOT)==uENUMROOT) {
  2834       assert(sym->dim.enumlist!=NULL);
  2835       *enumroot=sym->dim.enumlist;
  2836     } /* if */
  2837   } /* if */
  2838 
  2839   return val;               /* return array size */
  2840 }
  2841 
  2842 /*  decl_const  - declare a single constant
  2843  *
  2844  */
  2845 static void decl_const(int vclass)
  2846 {
  2847   char constname[sNAMEMAX+1];
  2848   cell val;
  2849   char *str;
  2850   int tag,exprtag;
  2851   int symbolline;
  2852   symbol *sym;
  2853 
  2854   insert_docstring_separator();         /* see comment in newfunc() */
  2855   do {
  2856     tag=pc_addtag(NULL);
  2857     if (lex(&val,&str)!=tSYMBOL)        /* read in (new) token */
  2858       error(20,str);                    /* invalid symbol name */
  2859     symbolline=fline;                   /* save line where symbol was found */
  2860     strcpy(constname,str);              /* save symbol name */
  2861     needtoken('=');
  2862     constexpr(&val,&exprtag,NULL);      /* get value */
  2863     /* add_constant() checks for duplicate definitions */
  2864     if (!matchtag(tag,exprtag,FALSE)) {
  2865       /* temporarily reset the line number to where the symbol was defined */
  2866       int orgfline=fline;
  2867       fline=symbolline;
  2868       error(213);                       /* tagname mismatch */
  2869       fline=orgfline;
  2870     } /* if */
  2871     sym=add_constant(constname,val,vclass,tag);
  2872     if (sym!=NULL)
  2873       sc_attachdocumentation(sym);/* attach any documenation to the constant */
  2874   } while (matchtoken(',')); /* enddo */   /* more? */
  2875   needtoken(tTERM);
  2876 }
  2877 
  2878 /*
  2879  * declstruct - declare a struct type
  2880  */
  2881 static void declstruct(void)
  2882 {
  2883 	cell val;
  2884 	char *str;
  2885 	int tok;
  2886 	pstruct_t *pstruct;
  2887 	int size;
  2888 
  2889 	/* get the explicit tag (required!) */
  2890 	tok = lex(&val,&str);
  2891 	if (tok != tSYMBOL)
  2892 	{
  2893 		error(93);
  2894 	}
  2895 
  2896 	if (pstructs_find(str) != NULL)
  2897 	{
  2898 		/* :TODO: change to "struct requires unique struct name" */
  2899 		error(58);
  2900 	}
  2901 
  2902 	pstruct = pstructs_add(str);
  2903 
  2904 	needtoken('{');
  2905 	do
  2906 	{
  2907 		structarg_t arg;
  2908 		if (matchtoken('}'))
  2909 		{
  2910 			/* Quick exit */
  2911 			lexpush();
  2912 			break;
  2913 		}
  2914 		memset(&arg, 0, sizeof(structarg_t));
  2915 		tok = lex(&val,&str);
  2916 		if (tok == tCONST)
  2917 		{
  2918 			arg.fconst = 1;
  2919 			tok = lex(&val,&str);
  2920 		}
  2921 		arg.ident = 0;
  2922 		if (tok == '&')
  2923 		{
  2924 			arg.ident = iREFERENCE;
  2925 			tok = lex(&val,&str);
  2926 		}
  2927 		if (tok == tLABEL)
  2928 		{
  2929 			arg.tag = pc_addtag(str);
  2930 			tok = lex(&val,&str);
  2931 		}
  2932 		if (tok != tSYMBOL)
  2933 		{
  2934 			error(1, "-identifier-", str);
  2935 			continue;
  2936 		}
  2937 		strcpy(arg.name, str);
  2938 		if (matchtoken('['))
  2939 		{
  2940 			if (arg.ident == iREFERENCE)
  2941 			{
  2942 				error(67, arg.name);
  2943 			}
  2944 			arg.ident = iARRAY;
  2945 			do 
  2946 			{
  2947 				constvalue *enumroot;
  2948 				int ignore_tag;
  2949 				if (arg.dimcount == sDIMEN_MAX)
  2950 				{
  2951 					error(53);
  2952 					break;
  2953 				}
  2954 				size = needsub(&ignore_tag, &enumroot);
  2955 				arg.dims[arg.dimcount++] = size;
  2956 			} while (matchtoken('['));
  2957 			/* Handle strings */
  2958 			if (arg.tag == pc_tag_string && arg.dims[arg.dimcount-1])
  2959 			{
  2960 				arg.dims[arg.dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
  2961 			}
  2962 			if (arg.dimcount == 1 && !arg.dims[arg.dimcount-1])
  2963 			{
  2964 				arg.ident = iREFARRAY;
  2965 			}
  2966 		} else if (!arg.ident) {
  2967 			arg.ident = iVARIABLE;
  2968 		}
  2969 		if (pstructs_addarg(pstruct, &arg) == NULL)
  2970 		{
  2971 			/* :TODO: change to "struct member name appears more than once" */
  2972 			error(58);
  2973 		}
  2974 	} while (matchtoken(','));
  2975 	needtoken('}');
  2976 	matchtoken(';');	/* eat up optional semicolon */
  2977 }
  2978 
  2979 
  2980 /**
  2981  * dofuncenum - declare function enumerations
  2982  */
  2983 static void dofuncenum(int listmode)
  2984 {
  2985 	cell val;
  2986 	char *str;
  2987 	// char *ptr;
  2988 	char tagname[sNAMEMAX+1];
  2989 	constvalue *cur;
  2990 	funcenum_t *fenum = NULL;
  2991 	int i;
  2992 
  2993 	/* get the explicit tag (required!) */
  2994 	int l = lex(&val,&str);
  2995 	if (l != tSYMBOL)
  2996 	{
  2997 		error(93);
  2998 	}
  2999 
  3000 	/* This tag can't already exist! */
  3001 	cur=tagname_tab.next;
  3002 	while (cur)
  3003 	{
  3004 		if (strcmp(cur->name, str) == 0)
  3005 		{
  3006 			/* Another bad one... */
  3007 			if (!(cur->value & FUNCTAG))
  3008 			{
  3009 				error(94);
  3010 			}
  3011 			break;
  3012 		}
  3013 		cur = cur->next;
  3014 	}
  3015 	strcpy(tagname, str);
  3016 
  3017 	fenum = funcenums_add(tagname);
  3018 
  3019 	if (listmode)
  3020 	{
  3021 		needtoken('{');
  3022 	}
  3023 	do
  3024 	{
  3025 		functag_t func;
  3026 		if (listmode && matchtoken('}'))
  3027 		{
  3028 			/* Quick exit */
  3029 			lexpush();
  3030 			break;
  3031 		}
  3032 		memset(&func, 0, sizeof(func));
  3033 		func.ret_tag = pc_addtag(NULL);	/* Get the return tag */
  3034 		l = lex(&val, &str);
  3035 		/* :TODO:
  3036 		 * Right now, there is a problem.  We can't pass non-public function pointer addresses around,
  3037 		 * because the address isn't known until the final reparse.  Unfortunately, you can write code
  3038 		 * before the address is known, because Pawn's compiler isn't truly multipass.
  3039 		 *
  3040 		 * When you call a function, there's no problem, because it does not write the address.
  3041 		 * The assembly looks like this:
  3042 		 *   call MyFunction
  3043 		 * Then, only at assembly time (once all passes are done), does it know the address.
  3044 		 * I do not see any solution to this because there is no way I know to inject the function name
  3045 		 * rather than the constant value.  And even if we could, we'd have to change the assembler recognize that.
  3046 		 */
  3047 		/*if (l == tSTOCK)
  3048 		{
  3049 			func.type = uSTOCK;
  3050 		} else */if (l == tPUBLIC) {
  3051 			func.type = uPUBLIC;
  3052 		} else {
  3053 			error(1, "-public-", str);
  3054 		}
  3055 		needtoken('(');
  3056 		do 
  3057 		{
  3058 			funcarg_t *arg = &(func.args[func.argcount]);
  3059 
  3060 			/* Quick exit */
  3061 			if (matchtoken(')'))
  3062 			{
  3063 				lexpush();
  3064 				break;
  3065 			}
  3066 			l = lex(&val, &str);
  3067 			if (l == '&')
  3068 			{
  3069 				if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
  3070 				{
  3071 					error(1, "-identifier-", "&");
  3072 				}
  3073 				arg->ident = iREFERENCE;
  3074 			} else if (l == tCONST) {
  3075 				if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
  3076 				{
  3077 					error(1, "-identifier-", "const");
  3078 				}
  3079 				arg->fconst=TRUE;
  3080 			} else if (l == tLABEL) {
  3081 				if (arg->tagcount > 0)
  3082 				{
  3083 					error(1, "-identifier-", "-tagname-");
  3084 				}
  3085 				arg->tags[arg->tagcount++] = pc_addtag(str);
  3086 #if 0
  3087 				while (arg->tagcount < sTAGS_MAX)
  3088 				{
  3089 					if (!matchtoken('_') && !needtoken(tSYMBOL))
  3090 					{
  3091 						break;
  3092 					}
  3093 					tokeninfo(&val, &ptr);
  3094 					arg->tags[arg->tagcount++] = pc_addtag(ptr);
  3095 					if (matchtoken('}'))
  3096 					{
  3097 						break;
  3098 					}
  3099 					needtoken(',');
  3100 				}
  3101 				needtoken(':');
  3102 #endif
  3103 				l=tLABEL;
  3104 			} else if (l == tSYMBOL) {
  3105 				if (func.argcount >= sARGS_MAX)
  3106 				{
  3107 					error(45);
  3108 				}
  3109 				if (str[0] == PUBLIC_CHAR)
  3110 				{
  3111 					error(56, str);
  3112 				}
  3113 				if (matchtoken('['))
  3114 				{
  3115 					cell size;
  3116 					if (arg->ident == iREFERENCE)
  3117 					{
  3118 						error(67, str);
  3119 					}
  3120 					do 
  3121 					{
  3122 						constvalue *enumroot;
  3123 						int ignore_tag;
  3124 						if (arg->dimcount == sDIMEN_MAX)
  3125 						{
  3126 							error(53);
  3127 							break;
  3128 						}
  3129 						size = needsub(&ignore_tag, &enumroot);
  3130 						arg->dims[arg->dimcount] = size;
  3131 						arg->dimcount += 1;
  3132 					} while (matchtoken('['));
  3133 					/* Handle strings */
  3134 					if ((arg->tagcount == 1 && arg->tags[0] == pc_tag_string)
  3135 						&& arg->dims[arg->dimcount-1])
  3136 					{
  3137 						arg->dims[arg->dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
  3138 					}
  3139 					arg->ident=iREFARRAY;
  3140 				} else if (arg->ident == 0) {
  3141 					arg->ident = iVARIABLE;
  3142 				}
  3143 			
  3144 				if (matchtoken('='))
  3145 				{
  3146 					needtoken('0');
  3147 					arg->ommittable = TRUE;
  3148 					func.ommittable = TRUE;
  3149 				} else if (func.ommittable) {
  3150 					error(95);
  3151 				}
  3152 				func.argcount++;
  3153 			} else if (l == tELLIPS) {
  3154 				if (arg->ident == iVARIABLE)
  3155 				{
  3156 					error(10);
  3157 				}
  3158 				arg->ident = iVARARGS;
  3159 				func.argcount++;
  3160 			} else {
  3161 				error(10);
  3162 			}
  3163 		} while (l == '&' || l == tLABEL || l == tCONST || l != tELLIPS && matchtoken(','));
  3164 		needtoken(')');
  3165 		for (i=0; i<func.argcount; i++)
  3166 		{
  3167 			if (func.args[i].tagcount == 0)
  3168 			{
  3169 				func.args[i].tags[0] = 0;
  3170 				func.args[i].tagcount = 1;
  3171 			}
  3172 		}
  3173 		functags_add(fenum, &func);
  3174 		if (!listmode)
  3175 		{
  3176 			break;
  3177 		}
  3178 	} while (matchtoken(','));
  3179 	if (listmode)
  3180 	{
  3181 		needtoken('}');
  3182 	}
  3183 	matchtoken(';'); /* eat an optional semicolon.  nom nom nom */
  3184 	errorset(sRESET, 0);
  3185 }
  3186 
  3187 /*  decl_enum   - declare enumerated constants
  3188  *
  3189  */
  3190 static void decl_enum(int vclass)
  3191 {
  3192   char enumname[sNAMEMAX+1],constname[sNAMEMAX+1];
  3193   cell val,value,size;
  3194   char *str;
  3195   int tag,explicittag;
  3196   cell increment,multiplier;
  3197   constvalue *enumroot;
  3198   symbol *enumsym;
  3199 
  3200   /* get an explicit tag, if any (we need to remember whether an explicit
  3201    * tag was passed, even if that explicit tag was "_:", so we cannot call
  3202    * pc_addtag() here
  3203    */
  3204   if (lex(&val,&str)==tLABEL) {
  3205     tag=pc_addtag(str);
  3206     explicittag=TRUE;
  3207   } else {
  3208     lexpush();
  3209     tag=0;
  3210     explicittag=FALSE;
  3211   } /* if */
  3212 
  3213   /* get optional enum name (also serves as a tag if no explicit tag was set) */
  3214   if (lex(&val,&str)==tSYMBOL) {        /* read in (new) token */
  3215     strcpy(enumname,str);               /* save enum name (last constant) */
  3216     if (!explicittag)
  3217       tag=pc_addtag(enumname);
  3218   } else {
  3219     lexpush();                          /* analyze again */
  3220     enumname[0]='\0';
  3221   } /* if */
  3222 
  3223   /* get increment and multiplier */
  3224   increment=1;
  3225   multiplier=1;
  3226   if (matchtoken('(')) {
  3227     if (matchtoken(taADD)) {
  3228       constexpr(&increment,NULL,NULL);
  3229     } else if (matchtoken(taMULT)) {
  3230       constexpr(&multiplier,NULL,NULL);
  3231     } else if (matchtoken(taSHL)) {
  3232       constexpr(&val,NULL,NULL);
  3233       while (val-->0)
  3234         multiplier*=2;
  3235     } /* if */
  3236     needtoken(')');
  3237   } /* if */
  3238 
  3239   if (strlen(enumname)>0) {
  3240     /* already create the root symbol, so the fields can have it as their "parent" */
  3241     enumsym=add_constant(enumname,0,vclass,tag);
  3242     if (enumsym!=NULL)
  3243       enumsym->usage |= uENUMROOT;
  3244     /* start a new list for the element names */
  3245     if ((enumroot=(constvalue*)malloc(sizeof(constvalue)))==NULL)
  3246       error(103);                       /* insufficient memory (fatal error) */
  3247     memset(enumroot,0,sizeof(constvalue));
  3248   } else {
  3249     enumsym=NULL;
  3250     enumroot=NULL;
  3251   } /* if */
  3252 
  3253   needtoken('{');
  3254   /* go through all constants */
  3255   value=0;                              /* default starting value */
  3256   do {
  3257     int idxtag,fieldtag;
  3258     symbol *sym;
  3259     if (matchtoken('}')) {              /* quick exit if '}' follows ',' */
  3260       lexpush();
  3261       break;
  3262     } /* if */
  3263     idxtag=pc_addtag(NULL);             /* optional explicit item tag */
  3264     if (needtoken(tSYMBOL)) {           /* read in (new) token */
  3265       tokeninfo(&val,&str);             /* get the information */
  3266       strcpy(constname,str);            /* save symbol name */
  3267     } else {
  3268       constname[0]='\0';
  3269     } /* if */
  3270     size=increment;                     /* default increment of 'val' */
  3271     fieldtag=0;                         /* default field tag */
  3272     if (matchtoken('[')) {
  3273       constexpr(&size,&fieldtag,NULL);  /* get size */
  3274       needtoken(']');
  3275     } /* if */
  3276     /* :TODO: do we need a size modifier here for pc_tag_string? */
  3277     if (matchtoken('='))
  3278       constexpr(&value,NULL,NULL);      /* get value */
  3279     /* add_constant() checks whether a variable (global or local) or
  3280      * a constant with the same name already exists
  3281      */
  3282     sym=add_constant(constname,value,vclass,tag);
  3283     if (sym==NULL)
  3284       continue;                         /* error message already given */
  3285     /* set the item tag and the item size, for use in indexing arrays */
  3286     sym->x.tags.index=idxtag;
  3287     sym->x.tags.field=fieldtag;
  3288     sym->dim.array.length=size;
  3289     sym->dim.array.level=0;
  3290     sym->dim.array.slength=0;
  3291     sym->parent=enumsym;
  3292     /* add the constant to a separate list as well */
  3293     if (enumroot!=NULL) {
  3294       sym->usage |= uENUMFIELD;
  3295       append_constval(enumroot,constname,value,tag);
  3296     } /* if */
  3297     if (multiplier==1)
  3298       value+=size;
  3299     else
  3300       value*=size*multiplier;
  3301   } while (matchtoken(','));
  3302   needtoken('}');       /* terminates the constant list */
  3303   matchtoken(';');      /* eat an optional ; */
  3304 
  3305   /* set the enum name to the "next" value (typically the last value plus one) */
  3306   if (enumsym!=NULL) {
  3307     assert((enumsym->usage & uENUMROOT)!=0);
  3308     enumsym->addr=value;
  3309     /* assign the constant list */
  3310     assert(enumroot!=NULL);
  3311     enumsym->dim.enumlist=enumroot;
  3312     sc_attachdocumentation(enumsym);  /* attach any documenation to the enumeration */
  3313   } /* if */
  3314 }
  3315 
  3316 static int getstates(const char *funcname)
  3317 {
  3318   char fsaname[sNAMEMAX+1],statename[sNAMEMAX+1];
  3319   cell val;
  3320   char *str;
  3321   constvalue *automaton;
  3322   constvalue *state;
  3323   int fsa,islabel;
  3324   int *list;
  3325   int count,listsize,state_id;
  3326 
  3327   if (!matchtoken('<'))
  3328     return 0;
  3329   if (matchtoken('>'))
  3330     return -1;          /* special construct: all other states (fall-back) */
  3331 
  3332   count=0;
  3333   listsize=0;
  3334   list=NULL;
  3335   fsa=-1;
  3336 
  3337   do {
  3338     if (!(islabel=matchtoken(tLABEL)) && !needtoken(tSYMBOL))
  3339       break;
  3340     tokeninfo(&val,&str);
  3341     assert(strlen(str)<sizeof fsaname);
  3342     strcpy(fsaname,str);  /* assume this is the name of the automaton */
  3343     if (islabel || matchtoken(':')) {
  3344       /* token is an automaton name, add the name and get a new token */
  3345       if (!needtoken(tSYMBOL))
  3346         break;
  3347       tokeninfo(&val,&str);
  3348       assert(strlen(str)<sizeof statename);
  3349       strcpy(statename,str);
  3350     } else {
  3351       /* the token was the state name (part of an anynymous automaton) */
  3352       assert(strlen(fsaname)<sizeof statename);
  3353       strcpy(statename,fsaname);
  3354       fsaname[0]='\0';
  3355     } /* if */
  3356     if (fsa<0 || fsaname[0]!='\0') {
  3357       automaton=automaton_add(fsaname);
  3358       assert(automaton!=NULL);
  3359       if (fsa>=0 && automaton->index!=fsa)
  3360         error(83,funcname); /* multiple automatons for a single function/variable */
  3361       fsa=automaton->index;
  3362     } /* if */
  3363     state=state_add(statename,fsa);
  3364     /* add this state to the state combination list (it will be attached to the
  3365      * automaton later) */
  3366     state_buildlist(&list,&listsize,&count,(int)state->value);
  3367   } while (matchtoken(','));
  3368   needtoken('>');
  3369 
  3370   if (count>0) {
  3371     assert(automaton!=NULL);
  3372     assert(fsa>=0);
  3373     state_id=state_addlist(list,count,fsa);
  3374     assert(state_id>0);
  3375   } else {
  3376     /* error is already given */
  3377     state_id=0;
  3378   } /* if */
  3379   if (list!=NULL)
  3380     free(list);
  3381 
  3382   return state_id;
  3383 }
  3384 
  3385 static void attachstatelist(symbol *sym, int state_id)
  3386 {
  3387   assert(sym!=NULL);
  3388   if ((sym->usage & uDEFINE)!=0 && (sym->states==NULL || state_id==0))
  3389     error(21,sym->name); /* function already defined, either without states or the current definition has no states */
  3390 
  3391   if (state_id!=0) {
  3392     /* add the state list id */
  3393     constvalue *stateptr;
  3394     if (sym->states==NULL) {
  3395       if ((sym->states=(constvalue*)malloc(sizeof(constvalue)))==NULL)
  3396         error(103);             /* insufficient memory (fatal error) */
  3397       memset(sym->states,0,sizeof(constvalue));
  3398     } /* if */
  3399     /* see whether the id already exists (add new state only if it does not
  3400      * yet exist
  3401      */
  3402     assert(sym->states!=NULL);
  3403     for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index!=state_id; stateptr=stateptr->next)
  3404       /* nothing */;
  3405     assert(state_id<=SHRT_MAX);
  3406     if (stateptr==NULL)
  3407       append_constval(sym->states,"",code_idx,(short)state_id);
  3408     else if (stateptr->value==0)
  3409       stateptr->value=code_idx;
  3410     else
  3411       error(84,sym->name);
  3412     /* also check for another conflicting situation: a fallback function
  3413      * without any states
  3414      */
  3415     if (state_id==-1 && sc_status!=statFIRST) {
  3416       /* in the second round, all states should have been accumulated */
  3417       assert(sym->states!=NULL);
  3418       for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index==-1; stateptr=stateptr->next)
  3419         /* nothing */;
  3420       if (stateptr==NULL)
  3421         error(85,sym->name);      /* no states are defined for this function */
  3422     } /* if */
  3423   } /* if */
  3424 }
  3425 
  3426 /*
  3427  *  Finds a function in the global symbol table or creates a new entry.
  3428  *  It does some basic processing and error checking.
  3429  */
  3430 SC_FUNC symbol *fetchfunc(char *name,int tag)
  3431 {
  3432   symbol *sym;
  3433 
  3434   if ((sym=findglb(name,sGLOBAL))!=0) {   /* already in symbol table? */
  3435     if (sym->ident!=iFUNCTN) {
  3436       error(21,name);                     /* yes, but not as a function */
  3437       return NULL;                        /* make sure the old symbol is not damaged */
  3438     } else if ((sym->usage & uNATIVE)!=0) {
  3439       error(21,name);                     /* yes, and it is a native */
  3440     } /* if */
  3441     assert(sym->vclass==sGLOBAL);
  3442     if ((sym->usage & uPROTOTYPED)!=0 && sym->tag!=tag)
  3443       error(25);                          /* mismatch from earlier prototype */
  3444     if ((sym->usage & uDEFINE)==0) {
  3445       /* as long as the function stays undefined, update the address and the tag */
  3446       if (sym->states==NULL)
  3447         sym->addr=code_idx;
  3448       sym->tag=tag;
  3449     } /* if */
  3450   } else {
  3451     /* don't set the "uDEFINE" flag; it may be a prototype */
  3452     sym=addsym(name,code_idx,iFUNCTN,sGLOBAL,tag,0);
  3453     assert(sym!=NULL);          /* fatal error 103 must be given on error */
  3454     /* assume no arguments */
  3455     sym->dim.arglist=(arginfo*)malloc(1*sizeof(arginfo));
  3456     sym->dim.arglist[0].ident=0;
  3457     /* set library ID to NULL (only for native functions) */
  3458     sym->x.lib=NULL;
  3459     /* set the required stack size to zero (only for non-native functions) */
  3460     sym->x.stacksize=1;         /* 1 for PROC opcode */
  3461   } /* if */
  3462   if (pc_deprecate!=NULL) {
  3463     assert(sym!=NULL);
  3464     sym->flags|=flgDEPRECATED;
  3465     if (sc_status==statWRITE) {
  3466       if (sym->documentation!=NULL) {
  3467         free(sym->documentation);
  3468         sym->documentation=NULL;
  3469       } /* if */
  3470       sym->documentation=pc_deprecate;
  3471     } else {
  3472       free(pc_deprecate);
  3473     } /* if */
  3474     pc_deprecate=NULL;
  3475   } /* if */
  3476 
  3477   return sym;
  3478 }
  3479 
  3480 /* This routine adds symbolic information for each argument.
  3481  */
  3482 static void define_args(void)
  3483 {
  3484   symbol *sym;
  3485 
  3486   /* At this point, no local variables have been declared. All
  3487    * local symbols are function arguments.
  3488    */
  3489   sym=loctab.next;
  3490   while (sym!=NULL) {
  3491     assert(sym->ident!=iLABEL);
  3492     assert(sym->vclass==sLOCAL);
  3493     markexpr(sLDECL,sym->name,sym->addr); /* mark for better optimization */
  3494     sym=sym->next;
  3495   } /* while */
  3496 }
  3497 
  3498 static int operatorname(char *name)
  3499 {
  3500   int opertok;
  3501   char *str;
  3502   cell val;
  3503 
  3504   assert(name!=NULL);
  3505 
  3506   /* check the operator */
  3507   opertok=lex(&val,&str);
  3508   switch (opertok) {
  3509   case '+':
  3510   case '-':
  3511   case '*':
  3512   case '/':
  3513   case '%':
  3514   case '>':
  3515   case '<':
  3516   case '!':
  3517   case '~':
  3518   case '=':
  3519     name[0]=(char)opertok;
  3520     name[1]='\0';
  3521     break;
  3522   case tINC:
  3523     strcpy(name,"++");
  3524     break;
  3525   case tDEC:
  3526     strcpy(name,"--");
  3527     break;
  3528   case tlEQ:
  3529     strcpy(name,"==");
  3530     break;
  3531   case tlNE:
  3532     strcpy(name,"!=");
  3533     break;
  3534   case tlLE:
  3535     strcpy(name,"<=");
  3536     break;
  3537   case tlGE:
  3538     strcpy(name,">=");
  3539     break;
  3540   default:
  3541     name[0]='\0';
  3542     error(7);           /* operator cannot be redefined (or bad operator name) */
  3543     return 0;
  3544   } /* switch */
  3545 
  3546   return opertok;
  3547 }
  3548 
  3549 static int operatoradjust(int opertok,symbol *sym,char *opername,int resulttag)
  3550 {
  3551   int tags[2]={0,0};
  3552   int count=0;
  3553   arginfo *arg;
  3554   char tmpname[sNAMEMAX+1];
  3555   symbol *oldsym;
  3556 
  3557   if (opertok==0)
  3558     return TRUE;
  3559 
  3560   assert(sym!=NULL && sym->ident==iFUNCTN && sym->dim.arglist!=NULL);
  3561   /* count arguments and save (first two) tags */
  3562   while (arg=&sym->dim.arglist[count], arg->ident!=0) {
  3563     if (count<2) {
  3564       if (arg->numtags>1)
  3565         error(65,count+1);  /* function argument may only have a single tag */
  3566       else if (arg->numtags==1)
  3567         tags[count]=arg->tags[0];
  3568     } /* if */
  3569     if (opertok=='~' && count==0) {
  3570       if (arg->ident!=iREFARRAY)
  3571         error(73,arg->name);/* must be an array argument */
  3572     } else {
  3573       if (arg->ident!=iVARIABLE)
  3574         error(66,arg->name);/* must be non-reference argument */
  3575     } /* if */
  3576     if (arg->hasdefault)
  3577       error(59,arg->name);  /* arguments of an operator may not have a default value */
  3578     count++;
  3579   } /* while */
  3580 
  3581   /* for '!', '++' and '--', count must be 1
  3582    * for '-', count may be 1 or 2
  3583    * for '=', count must be 1, and the resulttag is also important
  3584    * for all other (binary) operators and the special '~' operator, count must be 2
  3585    */
  3586   switch (opertok) {
  3587   case '!':
  3588   case '=':
  3589   case tINC:
  3590   case tDEC:
  3591     if (count!=1)
  3592       error(62);      /* number or placement of the operands does not fit the operator */
  3593     break;
  3594   case '-':
  3595     if (count!=1 && count!=2)
  3596       error(62);      /* number or placement of the operands does not fit the operator */
  3597     break;
  3598   default:
  3599     if (count!=2)
  3600       error(62);      /* number or placement of the operands does not fit the operator */
  3601   } /* switch */
  3602 
  3603   if (tags[0]==0 && (opertok!='=' && tags[1]==0 || opertok=='=' && resulttag==0))
  3604     error(64);        /* cannot change predefined operators */
  3605 
  3606   /* change the operator name */
  3607   assert(strlen(opername)>0);
  3608   operator_symname(tmpname,opername,tags[0],tags[1],count,resulttag);
  3609   if ((oldsym=findglb(tmpname,sGLOBAL))!=NULL) {
  3610     int i;
  3611     if ((oldsym->usage & uDEFINE)!=0) {
  3612       char errname[2*sNAMEMAX+16];
  3613       funcdisplayname(errname,tmpname);
  3614       error(21,errname);        /* symbol already defined */
  3615     } /* if */
  3616     sym->usage|=oldsym->usage;  /* copy flags from the previous definition */
  3617     for (i=0; i<oldsym->numrefers; i++)
  3618       if (oldsym->refer[i]!=NULL)
  3619         refer_symbol(sym,oldsym->refer[i]);
  3620     delete_symbol(&glbtab,oldsym);
  3621   } /* if */
  3622   strcpy(sym->name,tmpname);
  3623   sym->hash=namehash(sym->name);/* calculate new hash */
  3624 
  3625   /* operators should return a value, except the '~' operator */
  3626   if (opertok!='~')
  3627     sym->usage |= uRETVALUE;
  3628 
  3629   return TRUE;
  3630 }
  3631 
  3632 static int check_operatortag(int opertok,int resulttag,char *opername)
  3633 {
  3634   assert(opername!=NULL && strlen(opername)>0);
  3635   switch (opertok) {
  3636   case '!':
  3637   case '<':
  3638   case '>':
  3639   case tlEQ:
  3640   case tlNE:
  3641   case tlLE:
  3642   case tlGE:
  3643     if (resulttag!=pc_addtag("bool")) {
  3644       error(63,opername,"bool:"); /* operator X requires a "bool:" result tag */
  3645       return FALSE;
  3646     } /* if */
  3647     break;
  3648   case '~':
  3649     if (resulttag!=0) {
  3650       error(63,opername,"_:");    /* operator "~" requires a "_:" result tag */
  3651       return FALSE;
  3652     } /* if */
  3653     break;
  3654   } /* switch */
  3655   return TRUE;
  3656 }
  3657 
  3658 static char *tag2str(char *dest,int tag)
  3659 {
  3660   tag &= TAGMASK;
  3661   assert(tag>=0);
  3662   sprintf(dest,"0%x",tag);
  3663   return isdigit(dest[1]) ? &dest[1] : dest;
  3664 }
  3665 
  3666 SC_FUNC char *operator_symname(char *symname,char *opername,int tag1,int tag2,int numtags,int resulttag)
  3667 {
  3668   char tagstr1[10], tagstr2[10];
  3669   int opertok;
  3670 
  3671   assert(numtags>=1 && numtags<=2);
  3672   opertok= (opername[1]=='\0') ? opername[0] : 0;
  3673   if (opertok=='=')
  3674     sprintf(symname,"%s%s%s",tag2str(tagstr1,resulttag),opername,tag2str(tagstr2,tag1));
  3675   else if (numtags==1 || opertok=='~')
  3676     sprintf(symname,"%s%s",opername,tag2str(tagstr1,tag1));
  3677   else
  3678     sprintf(symname,"%s%s%s",tag2str(tagstr1,tag1),opername,tag2str(tagstr2,tag2));
  3679   return symname;
  3680 }
  3681 
  3682 static int parse_funcname(char *fname,int *tag1,int *tag2,char *opname)
  3683 {
  3684   char *ptr,*name;
  3685   int unary;
  3686 
  3687   /* tags are only positive, so if the function name starts with a '-',
  3688    * the operator is an unary '-' or '--' operator.
  3689    */
  3690   if (*fname=='-') {
  3691     *tag1=0;
  3692     unary=TRUE;
  3693     ptr=fname;
  3694   } else {
  3695     *tag1=(int)strtol(fname,&ptr,16);
  3696     unary= ptr==fname;  /* unary operator if it doesn't start with a tag name */
  3697   } /* if */
  3698   assert(!unary || *tag1==0);
  3699   assert(*ptr!='\0');
  3700   for (name=opname; !isdigit(*ptr); )
  3701     *name++ = *ptr++;
  3702   *name='\0';
  3703   *tag2=(int)strtol(ptr,NULL,16);
  3704   return unary;
  3705 }
  3706 
  3707 constvalue *find_tag_byval(int tag)
  3708 {
  3709   constvalue *tagsym;
  3710   tagsym=find_constval_byval(&tagname_tab,tag & ~PUBLICTAG);
  3711   if (tagsym==NULL)
  3712     tagsym=find_constval_byval(&tagname_tab,tag | PUBLICTAG);
  3713   return tagsym;
  3714 }
  3715 
  3716 SC_FUNC char *funcdisplayname(char *dest,char *funcname)
  3717 {
  3718   int tags[2];
  3719   char opname[10];
  3720   constvalue *tagsym[2];
  3721   int unary;
  3722 
  3723   if (isalpha(*funcname) || *funcname=='_' || *funcname==PUBLIC_CHAR || *funcname=='\0') {
  3724     if (dest!=funcname)
  3725       strcpy(dest,funcname);
  3726     return dest;
  3727   } /* if */
  3728 
  3729   unary=parse_funcname(funcname,&tags[0],&tags[1],opname);
  3730   tagsym[1]=find_tag_byval(tags[1]);
  3731   assert(tagsym[1]!=NULL);
  3732   if (unary) {
  3733     sprintf(dest,"operator%s(%s:)",opname,tagsym[1]->name);
  3734   } else {
  3735     tagsym[0]=find_tag_byval(tags[0]);
  3736     assert(tagsym[0]!=NULL);
  3737     /* special case: the assignment operator has the return value as the 2nd tag */
  3738     if (opname[0]=='=' && opname[1]=='\0')
  3739       sprintf(dest,"%s:operator%s(%s:)",tagsym[0]->name,opname,tagsym[1]->name);
  3740     else
  3741       sprintf(dest,"operator%s(%s:,%s:)",opname,tagsym[0]->name,tagsym[1]->name);
  3742   } /* if */
  3743   return dest;
  3744 }
  3745 
  3746 static void funcstub(int fnative)
  3747 {
  3748   int tok,tag,fpublic;
  3749   char *str;
  3750   cell val,size;
  3751   char symbolname[sNAMEMAX+1];
  3752   int idxtag[sDIMEN_MAX];
  3753   int dim[sDIMEN_MAX];
  3754   int numdim;
  3755   symbol *sym,*sub;
  3756   int opertok;
  3757 
  3758   opertok=0;
  3759   lastst=0;
  3760   litidx=0;                     /* clear the literal pool */
  3761   assert(loctab.next==NULL);    /* local symbol table should be empty */
  3762 
  3763   tag=pc_addtag(NULL);			/* get the tag of the return value */
  3764   numdim=0;
  3765   while (matchtoken('[')) {
  3766     /* the function returns an array, get this tag for the index and the array
  3767      * dimensions
  3768      */
  3769     if (numdim == sDIMEN_MAX) {
  3770       error(53);                /* exceeding maximum number of dimensions */
  3771       return;
  3772     } /* if */
  3773     size=needsub(&idxtag[numdim],NULL); /* get size; size==0 for "var[]" */
  3774     if (size==0)
  3775       error(9);                 /* invalid array size */
  3776     #if INT_MAX < LONG_MAX
  3777       if (size > INT_MAX)
  3778         error(105);             /* overflow, exceeding capacity */
  3779     #endif
  3780     dim[numdim++]=(int)size;
  3781   } /* while */
  3782 
  3783   if (tag == pc_tag_string && numdim && dim[numdim-1])
  3784     dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
  3785 
  3786   tok=lex(&val,&str);
  3787   fpublic=(tok==tPUBLIC) || (tok==tSYMBOL && str[0]==PUBLIC_CHAR);
  3788   if (fnative) {
  3789     if (fpublic || tok==tSTOCK || tok==tSTATIC || tok==tSYMBOL && *str==PUBLIC_CHAR)
  3790       error(42);                /* invalid combination of class specifiers */
  3791   } else {
  3792     if (tok==tPUBLIC || tok==tSTOCK || tok==tSTATIC)
  3793       tok=lex(&val,&str);
  3794   } /* if */
  3795 
  3796   if (tok==tOPERATOR) {
  3797     opertok=operatorname(symbolname);
  3798     if (opertok==0)
  3799       return;                   /* error message already given */
  3800     check_operatortag(opertok,tag,symbolname);
  3801   } else {
  3802     if (tok!=tSYMBOL && freading) {
  3803       error(10);                /* illegal function or declaration */
  3804       return;
  3805     } /* if */
  3806     strcpy(symbolname,str);
  3807   } /* if */
  3808   needtoken('(');               /* only functions may be native/forward */
  3809 
  3810   sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
  3811   if (sym==NULL)
  3812     return;
  3813   if (fnative) {
  3814     sym->usage=(char)(uNATIVE | uRETVALUE | uDEFINE | (sym->usage & uPROTOTYPED));
  3815     sym->x.lib=curlibrary;
  3816   } else if (fpublic) {
  3817     sym->usage|=uPUBLIC;
  3818   } /* if */
  3819   sym->usage|=uFORWARD;
  3820 
  3821   declargs(sym,FALSE);
  3822   /* "declargs()" found the ")" */
  3823   sc_attachdocumentation(sym);  /* attach any documenation to the function */
  3824   if (!operatoradjust(opertok,sym,symbolname,tag))
  3825     sym->usage &= ~uDEFINE;
  3826 
  3827   if (getstates(symbolname)!=0) {
  3828     if (fnative || opertok!=0)
  3829       error(82);                /* native functions and operators may not have states */
  3830     else
  3831       error(231);               /* ignoring state specifications on forward declarations */
  3832   } /* if */
  3833 
  3834   /* for a native operator, also need to specify an "exported" function name;
  3835    * for a native function, this is optional
  3836    */
  3837   if (fnative) {
  3838     if (opertok!=0) {
  3839       needtoken('=');
  3840       lexpush();        /* push back, for matchtoken() to retrieve again */
  3841     } /* if */
  3842     if (matchtoken('=')) {
  3843       /* allow number or symbol */
  3844       if (matchtoken(tSYMBOL)) {
  3845         tokeninfo(&val,&str);
  3846         insert_alias(sym->name,str);
  3847       } else {
  3848         constexpr(&val,NULL,NULL);
  3849         sym->addr=val;
  3850         /* At the moment, I have assumed that this syntax is only valid if
  3851          * val < 0. To properly mix "normal" native functions and indexed
  3852          * native functions, one should use negative indices anyway.
  3853          * Special code for a negative index in sym->addr exists in SC4.C
  3854          * (ffcall()) and in SC6.C (the loops for counting the number of native
  3855          * variables and for writing them).
  3856          */
  3857       } /* if */
  3858     } /* if */
  3859   } /* if */
  3860   needtoken(tTERM);
  3861 
  3862   /* attach the array to the function symbol */
  3863   if (numdim>0) {
  3864     assert(sym!=NULL);
  3865     sub=addvariable(symbolname,0,iARRAY,sGLOBAL,tag,dim,numdim,idxtag);
  3866     sub->parent=sym;
  3867   } /* if */
  3868 
  3869   litidx=0;                     /* clear the literal pool */
  3870   delete_symbols(&loctab,0,TRUE,TRUE);/* clear local variables queue */
  3871 }
  3872 
  3873 /*  newfunc    - begin a function
  3874  *
  3875  *  This routine is called from "parse" and tries to make a function
  3876  *  out of the following text
  3877  *
  3878  *  Global references: funcstatus,lastst,litidx
  3879  *                     rettype  (altered)
  3880  *                     curfunc  (altered)
  3881  *                     declared (altered)
  3882  *                     glb_declared (altered)
  3883  *                     sc_alignnext (altered)
  3884  */
  3885 static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock)
  3886 {
  3887   symbol *sym;
  3888   int argcnt,tok,tag,funcline;
  3889   int opertok,opererror;
  3890   char symbolname[sNAMEMAX+1];
  3891   char *str;
  3892   cell val,cidx,glbdecl;
  3893   short filenum;
  3894   int state_id;
  3895 
  3896   assert(litidx==0);    /* literal queue should be empty */
  3897   litidx=0;             /* clear the literal pool (should already be empty) */
  3898   opertok=0;
  3899   lastst=0;             /* no statement yet */
  3900   cidx=0;               /* just to avoid compiler warnings */
  3901   glbdecl=0;
  3902   assert(loctab.next==NULL);    /* local symbol table should be empty */
  3903   filenum=fcurrent;     /* save file number at the start of the declaration */
  3904 
  3905   if (firstname!=NULL) {
  3906     assert(strlen(firstname)<=sNAMEMAX);
  3907     strcpy(symbolname,firstname);       /* save symbol name */
  3908     tag=firsttag;
  3909   } else {
  3910     tag= (firsttag>=0) ? firsttag : pc_addtag(NULL);
  3911     tok=lex(&val,&str);
  3912     assert(!fpublic);
  3913     if (tok==tNATIVE || tok==tPUBLIC && stock)
  3914       error(42);                /* invalid combination of class specifiers */
  3915     if (tok==tOPERATOR) {
  3916       opertok=operatorname(symbolname);
  3917       if (opertok==0)
  3918         return TRUE;            /* error message already given */
  3919       check_operatortag(opertok,tag,symbolname);
  3920     } else {
  3921       if (tok!=tSYMBOL && freading) {
  3922         error(20,str);          /* invalid symbol name */
  3923         return FALSE;
  3924       } /* if */
  3925       assert(strlen(str)<=sNAMEMAX);
  3926       strcpy(symbolname,str);
  3927     } /* if */
  3928   } /* if */
  3929   /* check whether this is a function or a variable declaration */
  3930   if (!matchtoken('('))
  3931     return FALSE;
  3932   /* so it is a function, proceed */
  3933   funcline=fline;               /* save line at which the function is defined */
  3934   if (symbolname[0]==PUBLIC_CHAR) {
  3935     fpublic=TRUE;               /* implicitly public function */
  3936     if (stock)
  3937       error(42);                /* invalid combination of class specifiers */
  3938   } /* if */
  3939   sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
  3940   if (sym==NULL || (sym->usage & uNATIVE)!=0)
  3941     return TRUE;                /* it was recognized as a function declaration, but not as a valid one */
  3942   if (fpublic)
  3943     sym->usage|=uPUBLIC;
  3944   if (fstatic)
  3945     sym->fnumber=filenum;
  3946   /* if the function was used before being declared, and it has a tag for the
  3947    * result, add a third pass (as second "skimming" parse) because the function
  3948    * result may have been used with user-defined operators, which have now
  3949    * been incorrectly flagged (as the return tag was unknown at the time of
  3950    * the call)
  3951    */
  3952   if ((sym->usage & (uPROTOTYPED | uREAD))==uREAD && sym->tag!=0) {
  3953     int curstatus=sc_status;
  3954     sc_status=statWRITE;  /* temporarily set status to WRITE, so the warning isn't blocked */
  3955 #if 0 /* SourceMod - silly, should be removed in first pass, so removed */
  3956     error(208);
  3957 #endif
  3958     sc_status=curstatus;
  3959     sc_reparse=TRUE;      /* must add another pass to "initial scan" phase */
  3960   } /* if */
  3961 #if 0	/* Not used for SourceMod */
  3962   /* we want public functions to be explicitly prototyped, as they are called
  3963    * from the outside
  3964    */
  3965   if (fpublic && (sym->usage & uFORWARD)==0)
  3966     error(235,symbolname);
  3967 #endif
  3968   /* declare all arguments */
  3969   argcnt=declargs(sym,TRUE);
  3970   opererror=!operatoradjust(opertok,sym,symbolname,tag);
  3971   if (strcmp(symbolname,uMAINFUNC)==0 || strcmp(symbolname,uENTRYFUNC)==0) {
  3972     if (argcnt>0)
  3973       error(5);         /* "main()" and "entry()" functions may not have any arguments */
  3974     sym->usage|=uREAD;  /* "main()" is the program's entry point: always used */
  3975   } /* if */
  3976   state_id=getstates(symbolname);
  3977   if (state_id>0 && (opertok!=0 || strcmp(symbolname,uMAINFUNC)==0))
  3978     error(82);          /* operators may not have states, main() may neither */
  3979   attachstatelist(sym,state_id);
  3980   /* "declargs()" found the ")"; if a ";" appears after this, it was a
  3981    * prototype */
  3982   if (matchtoken(';')) {
  3983     sym->usage|=uFORWARD;
  3984     if (!sc_needsemicolon)
  3985       error(218);       /* old style prototypes used with optional semicolumns */
  3986     delete_symbols(&loctab,0,TRUE,TRUE);  /* prototype is done; forget everything */
  3987     return TRUE;
  3988   } /* if */
  3989   /* so it is not a prototype, proceed */
  3990   /* if this is a function that is not referred to (this can only be detected
  3991    * in the second stage), shut code generation off */
  3992   if (sc_status==statWRITE && (sym->usage & uREAD)==0 && !fpublic) {
  3993     sc_status=statSKIP;
  3994     cidx=code_idx;
  3995     glbdecl=glb_declared;
  3996   } /* if */
  3997   if ((sym->flags & flgDEPRECATED)!=0) {
  3998     char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";
  3999     error(234,symbolname,ptr);  /* deprecated (probably a public function) */
  4000   } /* if */
  4001   begcseg();
  4002   sym->usage|=uDEFINE;  /* set the definition flag */
  4003   if (stock)
  4004     sym->usage|=uSTOCK;
  4005   if (opertok!=0 && opererror)
  4006     sym->usage &= ~uDEFINE;
  4007   /* if the function has states, dump the label to the start of the function */
  4008   if (state_id!=0) {
  4009     constvalue *ptr=sym->states->next;
  4010     while (ptr!=NULL) {
  4011       assert(sc_status!=statWRITE || strlen(ptr->name)>0);
  4012       if (ptr->index==state_id) {
  4013         setlabel((int)strtol(ptr->name,NULL,16));
  4014         break;
  4015       } /* if */
  4016       ptr=ptr->next;
  4017     } /* while */
  4018   } /* if */
  4019   startfunc(sym->name); /* creates stack frame */
  4020   insert_dbgline(funcline);
  4021   setline(FALSE);
  4022   if (sc_alignnext) {
  4023     alignframe(sc_dataalign);
  4024     sc_alignnext=FALSE;
  4025   } /* if */
  4026   declared=0;           /* number of local cells */
  4027   resetstacklist();
  4028   resetheaplist();
  4029   rettype=(sym->usage & uRETVALUE);      /* set "return type" variable */
  4030   curfunc=sym;
  4031   define_args();        /* add the symbolic info for the function arguments */
  4032   #if !defined SC_LIGHT
  4033     if (matchtoken('{')) {
  4034       lexpush();
  4035     } else {
  4036       /* Insert a separator so that comments following the statement will not
  4037        * be attached to this function; they should be attached to the next
  4038        * function. This is not a problem for functions having a compound block,
  4039        * because the closing brace is an explicit "end token" for the function.
  4040        * With single statement functions, the preprocessor may overread the
  4041        * source code before the parser determines an "end of statement".
  4042        */
  4043       insert_docstring_separator();
  4044     } /* if */
  4045   #endif
  4046   sc_curstates=state_id;/* set state id, for accessing global state variables */
  4047   statement(NULL,FALSE);
  4048   sc_curstates=0;
  4049   if ((rettype & uRETVALUE)!=0)
  4050     sym->usage|=uRETVALUE;
  4051   if (declared!=0) {
  4052     /* This happens only in a very special (and useless) case, where a function
  4053      * has only a single statement in its body (no compound block) and that
  4054      * statement declares a new variable
  4055      */
  4056     popstacklist(1);
  4057     declared=0;
  4058   } /* if */
  4059   if ((lastst!=tRETURN) && (lastst!=tGOTO)){
  4060     ldconst(0,sPRI);
  4061     ffret(strcmp(sym->name,uENTRYFUNC)!=0);
  4062     if ((sym->usage & uRETVALUE)!=0) {
  4063       char symname[2*sNAMEMAX+16];  /* allow space for user defined operators */
  4064       funcdisplayname(symname,sym->name);
  4065       error(209,symname);       /* function should return a value */
  4066     } /* if */
  4067   } /* if */
  4068   endfunc();
  4069   sym->codeaddr=code_idx;
  4070   sc_attachdocumentation(sym);  /* attach collected documenation to the function */
  4071   if (litidx) {                 /* if there are literals defined */
  4072     glb_declared+=litidx;
  4073     begdseg();                  /* flip to DATA segment */
  4074     dumplits();                 /* dump literal strings */
  4075     litidx=0;
  4076   } /* if */
  4077   testsymbols(&loctab,0,TRUE,TRUE);     /* test for unused arguments and labels */
  4078   delete_symbols(&loctab,0,TRUE,TRUE);  /* clear local variables queue */
  4079   assert(loctab.next==NULL);
  4080   curfunc=NULL;
  4081   if (sc_status==statSKIP) {
  4082     sc_status=statWRITE;
  4083     code_idx=cidx;
  4084     glb_declared=glbdecl;
  4085   } /* if */
  4086   return TRUE;
  4087 }
  4088 
  4089 static int argcompare(arginfo *a1,arginfo *a2)
  4090 {
  4091   int result,level,i;
  4092 
  4093 #if 0	/* SourceMod uses case insensitive args for forwards */
  4094   result= strcmp(a1->name,a2->name)==0;     /* name */
  4095 #else
  4096   result=1;
  4097 #endif
  4098   if (result)
  4099     result= a1->ident==a2->ident;           /* type/class */
  4100   if (result)
  4101     result= a1->usage==a2->usage;           /* "const" flag */
  4102   if (result)
  4103     result= a1->numtags==a2->numtags;       /* tags (number and names) */
  4104   for (i=0; result && i<a1->numtags; i++)
  4105     result= a1->tags[i]==a2->tags[i];
  4106   if (result)
  4107     result= a1->numdim==a2->numdim;         /* array dimensions & index tags */
  4108   for (level=0; result && level<a1->numdim; level++)
  4109     result= a1->dim[level]==a2->dim[level];
  4110   for (level=0; result && level<a1->numdim; level++)
  4111     result= a1->idxtag[level]==a2->idxtag[level];
  4112   if (result)
  4113     result= a1->hasdefault==a2->hasdefault; /* availability of default value */
  4114   if (a1->hasdefault) {
  4115     if (a1->ident==iREFARRAY) {
  4116       if (result)
  4117         result= a1->defvalue.array.size==a2->defvalue.array.size;
  4118       if (result)
  4119         result= a1->defvalue.array.arraysize==a2->defvalue.array.arraysize;
  4120       /* ??? should also check contents of the default array (these troubles
  4121        * go away in a 2-pass compiler that forbids double declarations, but
  4122        * Pawn currently does not forbid them) */
  4123     } else {
  4124       if (result) {
  4125         if ((a1->hasdefault & uSIZEOF)!=0 || (a1->hasdefault & uTAGOF)!=0 || (a1->hasdefault & uCOUNTOF)!=0)
  4126           result= a1->hasdefault==a2->hasdefault
  4127                   && strcmp(a1->defvalue.size.symname,a2->defvalue.size.symname)==0
  4128                   && a1->defvalue.size.level==a2->defvalue.size.level;
  4129         else
  4130           result= a1->defvalue.val==a2->defvalue.val;
  4131       } /* if */
  4132     } /* if */
  4133     if (result)
  4134       result= a1->defvalue_tag==a2->defvalue_tag;
  4135   } /* if */
  4136   return result;
  4137 }
  4138 
  4139 /*  declargs()
  4140  *
  4141  *  This routine adds an entry in the local symbol table for each argument
  4142  *  found in the argument list. It returns the number of arguments.
  4143  */
  4144 static int declargs(symbol *sym,int chkshadow)
  4145 {
  4146   #define MAXTAGS 16
  4147   char *ptr;
  4148   int argcnt,oldargcnt,tok,tags[MAXTAGS],numtags;
  4149   cell val;
  4150   arginfo arg, *arglist;
  4151   char name[sNAMEMAX+1];
  4152   int ident,fpublic,fconst;
  4153   int idx;
  4154 
  4155   /* if the function is already defined earlier, get the number of arguments
  4156    * of the existing definition
  4157    */
  4158   oldargcnt=0;
  4159   if ((sym->usage & uPROTOTYPED)!=0)
  4160     while (sym->dim.arglist[oldargcnt].ident!=0)
  4161       oldargcnt++;
  4162   argcnt=0;                             /* zero aruments up to now */
  4163   ident=iVARIABLE;
  4164   numtags=0;
  4165   fconst=FALSE;
  4166   fpublic= (sym->usage & (uPUBLIC|uSTOCK))!=0;
  4167   /* the '(' parantheses has already been parsed */
  4168   if (!matchtoken(')')){
  4169     do {                                /* there are arguments; process them */
  4170       /* any legal name increases argument count (and stack offset) */
  4171       tok=lex(&val,&ptr);
  4172       switch (tok) {
  4173       case 0:
  4174         /* nothing */
  4175         break;
  4176       case '&':
  4177         if (ident!=iVARIABLE || numtags>0)
  4178           error(1,"-identifier-","&");
  4179         ident=iREFERENCE;
  4180         break;
  4181       case tCONST:
  4182         if (ident!=iVARIABLE || numtags>0)
  4183           error(1,"-identifier-","const");
  4184         fconst=TRUE;
  4185         break;
  4186       case tLABEL:
  4187         if (numtags>0)
  4188           error(1,"-identifier-","-tagname-");
  4189         tags[0]=pc_addtag(ptr);
  4190         numtags=1;
  4191         break;
  4192       case '{':
  4193         if (numtags>0)
  4194           error(1,"-identifier-","-tagname-");
  4195         numtags=0;
  4196         while (numtags<MAXTAGS) {
  4197           if (!matchtoken('_') && !needtoken(tSYMBOL))
  4198             break;
  4199           tokeninfo(&val,&ptr);
  4200           tags[numtags++]=pc_addtag(ptr);
  4201           if (matchtoken('}'))
  4202             break;
  4203           needtoken(',');
  4204         } /* for */
  4205         needtoken(':');
  4206         tok=tLABEL;     /* for outer loop: flag that we have seen a tagname */
  4207         break;
  4208       case tSYMBOL:
  4209         if (argcnt>=sMAXARGS)
  4210           error(45);                    /* too many function arguments */
  4211         strcpy(name,ptr);               /* save symbol name */
  4212         if (name[0]==PUBLIC_CHAR)
  4213           error(56,name);               /* function arguments cannot be public */
  4214         if (numtags==0)
  4215           tags[numtags++]=0;            /* default tag */
  4216         /* Stack layout:
  4217          *   base + 0*sizeof(cell)  == previous "base"
  4218          *   base + 1*sizeof(cell)  == function return address
  4219          *   base + 2*sizeof(cell)  == number of arguments
  4220          *   base + 3*sizeof(cell)  == first argument of the function
  4221          * So the offset of each argument is "(argcnt+3) * sizeof(cell)".
  4222          */
  4223         doarg(name,ident,(argcnt+3)*sizeof(cell),tags,numtags,fpublic,fconst,chkshadow,&arg);
  4224         /* :TODO: fix this so stocks that are func pointers can't have default arguments? */
  4225         if ((sym->usage & uPUBLIC) && arg.hasdefault)
  4226           error(59,name);       /* arguments of a public function may not have a default value */
  4227         if ((sym->usage & uPROTOTYPED)==0) {
  4228           /* redimension the argument list, add the entry */
  4229           sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
  4230           if (sym->dim.arglist==0)
  4231             error(103);                 /* insufficient memory */
  4232           memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo));  /* keep the list terminated */
  4233           sym->dim.arglist[argcnt]=arg;
  4234         } else {
  4235           /* check the argument with the earlier definition */
  4236           if (argcnt>oldargcnt || !argcompare(&sym->dim.arglist[argcnt],&arg))
  4237             error(25);          /* function definition does not match prototype */
  4238           /* may need to free default array argument and the tag list */
  4239           if (arg.ident==iREFARRAY && arg.hasdefault)
  4240             free(arg.defvalue.array.data);
  4241           else if (arg.ident==iVARIABLE
  4242                    && ((arg.hasdefault & uSIZEOF)!=0 || (arg.hasdefault & uTAGOF)!=0) || (arg.hasdefault & uCOUNTOF)!=0)
  4243             free(arg.defvalue.size.symname);
  4244           free(arg.tags);
  4245         } /* if */
  4246         argcnt++;
  4247         ident=iVARIABLE;
  4248         numtags=0;
  4249         fconst=FALSE;
  4250         break;
  4251       case tELLIPS:
  4252         if (ident!=iVARIABLE)
  4253           error(10);                    /* illegal function or declaration */
  4254         if (numtags==0)
  4255           tags[numtags++]=0;            /* default tag */
  4256         if ((sym->usage & uPROTOTYPED)==0) {
  4257           /* redimension the argument list, add the entry iVARARGS */
  4258           sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
  4259           if (sym->dim.arglist==0)
  4260             error(103);                 /* insufficient memory */
  4261           memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo));  /* keep the list terminated */
  4262           sym->dim.arglist[argcnt].ident=iVARARGS;
  4263           sym->dim.arglist[argcnt].hasdefault=FALSE;
  4264           sym->dim.arglist[argcnt].defvalue.val=0;
  4265           sym->dim.arglist[argcnt].defvalue_tag=0;
  4266           sym->dim.arglist[argcnt].numtags=numtags;
  4267           sym->dim.arglist[argcnt].tags=(int*)malloc(numtags*sizeof tags[0]);
  4268           if (sym->dim.arglist[argcnt].tags==NULL)
  4269             error(103);                 /* insufficient memory */
  4270           memcpy(sym->dim.arglist[argcnt].tags,tags,numtags*sizeof tags[0]);
  4271         } else {
  4272           if (argcnt>oldargcnt || sym->dim.arglist[argcnt].ident!=iVARARGS)
  4273             error(25);          /* function definition does not match prototype */
  4274         } /* if */
  4275         argcnt++;
  4276         break;
  4277       default:
  4278         error(10);                      /* illegal function or declaration */
  4279       } /* switch */
  4280     } while (tok=='&' || tok==tLABEL || tok==tCONST
  4281              || tok!=tELLIPS && matchtoken(',')); /* more? */
  4282     /* if the next token is not ",", it should be ")" */
  4283     needtoken(')');
  4284   } /* if */
  4285   /* resolve any "sizeof" arguments (now that all arguments are known) */
  4286   assert(sym->dim.arglist!=NULL);
  4287   arglist=sym->dim.arglist;
  4288   for (idx=0; idx<argcnt && arglist[idx].ident!=0; idx++) {
  4289     if ((arglist[idx].hasdefault & uSIZEOF)!=0 
  4290          || (arglist[idx].hasdefault & uTAGOF)!=0 
  4291          || (arglist[idx].hasdefault & uCOUNTOF)!=0) {
  4292       int altidx;
  4293       /* Find the argument with the name mentioned after the "sizeof". Note
  4294        * that we cannot use findloc here because we need the arginfo struct,
  4295        * not the symbol.
  4296        */
  4297       ptr=arglist[idx].defvalue.size.symname;
  4298       assert(ptr!=NULL);
  4299       for (altidx=0; altidx<argcnt && strcmp(ptr,arglist[altidx].name)!=0; altidx++)
  4300         /* nothing */;
  4301       if (altidx>=argcnt) {
  4302         error(17,ptr);                  /* undefined symbol */
  4303       } else {
  4304         assert(arglist[idx].defvalue.size.symname!=NULL);
  4305         /* check the level against the number of dimensions */
  4306         if (arglist[idx].defvalue.size.level>0
  4307             && arglist[idx].defvalue.size.level>=arglist[altidx].numdim)
  4308           error(28,arglist[idx].name);  /* invalid subscript */
  4309         /* check the type of the argument whose size to take; for a iVARIABLE
  4310          * or a iREFERENCE, this is always 1 (so the code is redundant)
  4311          */
  4312         assert(arglist[altidx].ident!=iVARARGS);
  4313         if (arglist[altidx].ident!=iREFARRAY 
  4314             && (((arglist[idx].hasdefault & uSIZEOF)!=0)
  4315                   || (arglist[idx].hasdefault & uCOUNTOF)!=0)) {
  4316           if ((arglist[idx].hasdefault & uTAGOF)!=0) {
  4317             error(81,arglist[idx].name);  /* cannot take "tagof" an indexed array */
  4318           } else {
  4319             assert(arglist[altidx].ident==iVARIABLE || arglist[altidx].ident==iREFERENCE);
  4320             error(223,ptr);             /* redundant sizeof */
  4321           } /* if */
  4322         } /* if */
  4323       } /* if */
  4324     } /* if */
  4325   } /* for */
  4326 
  4327   sym->usage|=uPROTOTYPED;
  4328   errorset(sRESET,0);           /* reset error flag (clear the "panic mode")*/
  4329   return argcnt;
  4330 }
  4331 
  4332 /*  doarg       - declare one argument type
  4333  *
  4334  *  this routine is called from "declargs()" and adds an entry in the local
  4335  *  symbol table for one argument.
  4336  *
  4337  *  "fpublic" indicates whether the function for this argument list is public.
  4338  *  The arguments themselves are never public.
  4339  */
  4340 static void doarg(char *name,int ident,int offset,int tags[],int numtags,
  4341                   int fpublic,int fconst,int chkshadow,arginfo *arg)
  4342 {
  4343   symbol *argsym;
  4344   constvalue *enumroot;
  4345   cell size;
  4346   int slength=0;
  4347 
  4348   strcpy(arg->name,name);
  4349   arg->hasdefault=FALSE;        /* preset (most common case) */
  4350   arg->defvalue.val=0;          /* clear */
  4351   arg->defvalue_tag=0;
  4352   arg->numdim=0;
  4353   if (matchtoken('[')) {
  4354     if (ident==iREFERENCE)
  4355       error(67,name);           /* illegal declaration ("&name[]" is unsupported) */
  4356     do {
  4357       if (arg->numdim == sDIMEN_MAX) {
  4358         error(53);              /* exceeding maximum number of dimensions */
  4359         return;
  4360       } /* if */
  4361       size=needsub(&arg->idxtag[arg->numdim],&enumroot);/* may be zero here, it is a pointer anyway */
  4362       #if INT_MAX < LONG_MAX
  4363         if (size > INT_MAX)
  4364           error(105);           /* overflow, exceeding capacity */
  4365       #endif
  4366       arg->dim[arg->numdim]=(int)size;
  4367       arg->numdim+=1;
  4368     } while (matchtoken('['));
  4369     ident=iREFARRAY;            /* "reference to array" (is a pointer) */
  4370     if (checktag(tags, numtags, pc_tag_string)) {
  4371       slength = arg->dim[arg->numdim - 1];
  4372       arg->dim[arg->numdim - 1] = (size + sizeof(cell) - 1) / sizeof(cell);
  4373     }
  4374     if (matchtoken('=')) {
  4375       lexpush();                /* initials() needs the "=" token again */
  4376       assert(litidx==0);        /* at the start of a function, this is reset */
  4377       assert(numtags>0);
  4378       initials(ident,tags[0],&size,arg->dim,arg->numdim,enumroot);
  4379       assert(size>=litidx);
  4380       /* allocate memory to hold the initial values */
  4381       arg->defvalue.array.data=(cell *)malloc(litidx*sizeof(cell));
  4382       if (arg->defvalue.array.data!=NULL) {
  4383         int i;
  4384         memcpy(arg->defvalue.array.data,litq,litidx*sizeof(cell));
  4385         arg->hasdefault=TRUE;   /* argument has default value */
  4386         arg->defvalue.array.size=litidx;
  4387         arg->defvalue.array.addr=-1;
  4388         /* calulate size to reserve on the heap */
  4389         arg->defvalue.array.arraysize=1;
  4390         for (i=0; i<arg->numdim; i++)
  4391           arg->defvalue.array.arraysize*=arg->dim[i];
  4392         if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
  4393           arg->defvalue.array.arraysize = arg->defvalue.array.size;
  4394       } /* if */
  4395       litidx=0;                 /* reset */
  4396     } /* if */
  4397   } else {
  4398     if (matchtoken('=')) {
  4399       unsigned char size_tag_token;
  4400       assert(ident==iVARIABLE || ident==iREFERENCE);
  4401       arg->hasdefault=TRUE;     /* argument has a default value */
  4402       size_tag_token=(unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
  4403       if (size_tag_token==0)
  4404         size_tag_token=(unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
  4405       if (size_tag_token==0)
  4406         size_tag_token=(unsigned char)(matchtoken(tCELLSOF) ? uCOUNTOF : 0);
  4407       if (size_tag_token!=0) {
  4408         int paranthese;
  4409         if (ident==iREFERENCE)
  4410           error(66,name);       /* argument may not be a reference */
  4411         paranthese=0;
  4412         while (matchtoken('('))
  4413           paranthese++;
  4414         if (needtoken(tSYMBOL)) {
  4415           /* save the name of the argument whose size id to take */
  4416           char *name;
  4417           cell val;
  4418           tokeninfo(&val,&name);
  4419           if ((arg->defvalue.size.symname=duplicatestring(name)) == NULL)
  4420             error(103);         /* insufficient memory */
  4421           arg->defvalue.size.level=0;
  4422           if (size_tag_token==uSIZEOF || size_tag_token==uCOUNTOF) {
  4423             while (matchtoken('[')) {
  4424               arg->defvalue.size.level+=(short)1;
  4425               needtoken(']');
  4426             } /* while */
  4427           } /* if */
  4428           if (ident==iVARIABLE) /* make sure we set this only if not a reference */
  4429             arg->hasdefault |= size_tag_token;  /* uSIZEOF or uTAGOF */
  4430         } /* if */
  4431         while (paranthese--)
  4432           needtoken(')');
  4433       } else {
  4434         constexpr(&arg->defvalue.val,&arg->defvalue_tag,NULL);
  4435         assert(numtags>0);
  4436         if (!matchtag(tags[0],arg->defvalue_tag,TRUE))
  4437           error(213);           /* tagname mismatch */
  4438       } /* if */
  4439     } /* if */
  4440   } /* if */
  4441   arg->ident=(char)ident;
  4442   arg->usage=(char)(fconst ? uCONST : 0);
  4443   arg->numtags=numtags;
  4444   arg->tags=(int*)malloc(numtags*sizeof tags[0]);
  4445   if (arg->tags==NULL)
  4446     error(103);                 /* insufficient memory */
  4447   memcpy(arg->tags,tags,numtags*sizeof tags[0]);
  4448   argsym=findloc(name);
  4449   if (argsym!=NULL) {
  4450     error(21,name);             /* symbol already defined */
  4451   } else {
  4452     if (chkshadow && (argsym=findglb(name,sSTATEVAR))!=NULL && argsym->ident!=iFUNCTN)
  4453       error(219,name);          /* variable shadows another symbol */
  4454     /* add details of type and address */
  4455     assert(numtags>0);
  4456     argsym=addvariable2(name,offset,ident,sLOCAL,tags[0],
  4457                        arg->dim,arg->numdim,arg->idxtag,slength);
  4458     argsym->compound=0;
  4459     if (ident==iREFERENCE)
  4460       argsym->usage|=uREAD;     /* because references are passed back */
  4461     if (fpublic)
  4462       argsym->usage|=uREAD;     /* arguments of public functions are always "used" */
  4463     if (fconst)
  4464       argsym->usage|=uCONST;
  4465   } /* if */
  4466 }
  4467 
  4468 static int count_referrers(symbol *entry)
  4469 {
  4470   int i,count;
  4471 
  4472   count=0;
  4473   for (i=0; i<entry->numrefers; i++)
  4474     if (entry->refer[i]!=NULL)
  4475       count++;
  4476   return count;
  4477 }
  4478 
  4479 #if !defined SC_LIGHT
  4480 static int find_xmltag(char *source,char *xmltag,char *xmlparam,char *xmlvalue,
  4481                        char **outer_start,int *outer_length,
  4482                        char **inner_start,int *inner_length)
  4483 {
  4484   char *ptr,*inner_end;
  4485   int xmltag_len,xmlparam_len,xmlvalue_len;
  4486   int match;
  4487 
  4488   assert(source!=NULL);
  4489   assert(xmltag!=NULL);
  4490   assert(outer_start!=NULL);
  4491   assert(outer_length!=NULL);
  4492   assert(inner_start!=NULL);
  4493   assert(inner_length!=NULL);
  4494 
  4495   /* both NULL or both non-NULL */
  4496   assert(xmlvalue!=NULL && xmlparam!=NULL || xmlvalue==NULL && xmlparam==NULL);
  4497 
  4498   xmltag_len=strlen(xmltag);
  4499   xmlparam_len= (xmlparam!=NULL) ? strlen(xmlparam) : 0;
  4500   xmlvalue_len= (xmlvalue!=NULL) ? strlen(xmlvalue) : 0;
  4501   ptr=source;
  4502   /* find an opening '<' */
  4503   while ((ptr=strchr(ptr,'<'))!=NULL) {
  4504     *outer_start=ptr;           /* be optimistic... */
  4505     match=FALSE;                /* ...and pessimistic at the same time */
  4506     ptr++;                      /* skip '<' */
  4507     while (*ptr!='\0' && *ptr<=' ')
  4508       ptr++;                    /* skip white space */
  4509     if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
  4510       /* xml tag found, optionally check the parameter */
  4511       ptr+=xmltag_len;
  4512       while (*ptr!='\0' && *ptr<=' ')
  4513         ptr++;                  /* skip white space */
  4514       if (xmlparam!=NULL) {
  4515         if (strncmp(ptr,xmlparam,xmlparam_len)==0 && (*(ptr+xmlparam_len)<=' ' || *(ptr+xmlparam_len)=='=')) {
  4516           ptr+=xmlparam_len;
  4517           while (*ptr!='\0' && *ptr<=' ')
  4518             ptr++;              /* skip white space */
  4519           if (*ptr=='=') {
  4520             ptr++;              /* skip '=' */
  4521             while (*ptr!='\0' && *ptr<=' ')
  4522               ptr++;            /* skip white space */
  4523             if (*ptr=='"' || *ptr=='\'')
  4524               ptr++;            /* skip " or ' */
  4525             assert(xmlvalue!=NULL);
  4526             if (strncmp(ptr,xmlvalue,xmlvalue_len)==0
  4527                 && (*(ptr+xmlvalue_len)<=' '
  4528                     || *(ptr+xmlvalue_len)=='>'
  4529                     || *(ptr+xmlvalue_len)=='"'
  4530                     || *(ptr+xmlvalue_len)=='\''))
  4531               match=TRUE;       /* found it */
  4532           } /* if */
  4533         } /* if */
  4534       } else {
  4535         match=TRUE;             /* don't check the parameter */
  4536       } /* if */
  4537     } /* if */
  4538     if (match) {
  4539       /* now find the end of the opening tag */
  4540       while (*ptr!='\0' && *ptr!='>')
  4541         ptr++;
  4542       if (*ptr=='>')
  4543         ptr++;
  4544       while (*ptr!='\0' && *ptr<=' ')
  4545         ptr++;                  /* skip white space */
  4546       *inner_start=ptr;
  4547       /* find the start of the closing tag (assume no nesting) */
  4548       while ((ptr=strchr(ptr,'<'))!=NULL) {
  4549         inner_end=ptr;
  4550         ptr++;                  /* skip '<' */
  4551         while (*ptr!='\0' && *ptr<=' ')
  4552           ptr++;                /* skip white space */
  4553         if (*ptr=='/') {
  4554           ptr++;                /* skip / */
  4555           while (*ptr!='\0' && *ptr<=' ')
  4556             ptr++;              /* skip white space */
  4557           if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
  4558             /* find the end of the closing tag */
  4559             while (*ptr!='\0' && *ptr!='>')
  4560               ptr++;
  4561             if (*ptr=='>')
  4562               ptr++;
  4563             /* set the lengths of the inner and outer segment */
  4564             assert(*inner_start!=NULL);
  4565             *inner_length=(int)(inner_end-*inner_start);
  4566             assert(*outer_start!=NULL);
  4567             *outer_length=(int)(ptr-*outer_start);
  4568             break;              /* break out of the loop */
  4569           } /* if */
  4570         } /* if */
  4571       } /* while */
  4572       return TRUE;
  4573     } /* if */
  4574   } /* while */
  4575   return FALSE; /* not found */
  4576 }
  4577 
  4578 static char *xmlencode(char *dest,char *source)
  4579 {
  4580   char temp[2*sNAMEMAX+20],*ptr;
  4581 
  4582   /* replace < by &lt; and such; normally, such a symbol occurs at most once in
  4583    * a symbol name (e.g. "operator<")
  4584    */
  4585   ptr=temp;
  4586   while (*source!='\0') {
  4587     switch (*source) {
  4588     case '<':
  4589       strcpy(ptr,"&lt;");
  4590       ptr+=4;
  4591       break;
  4592     case '>':
  4593       strcpy(ptr,"&gt;");
  4594       ptr+=4;
  4595       break;
  4596     case '&':
  4597       strcpy(ptr,"&amp;");
  4598       ptr+=5;
  4599       break;
  4600     default:
  4601       *ptr++=*source;
  4602     } /* switch */
  4603     source++;
  4604   } /* while */
  4605   *ptr='\0';
  4606   strcpy(dest,temp);
  4607   return dest;
  4608 }
  4609 
  4610 static void make_report(symbol *root,FILE *log,char *sourcefile)
  4611 {
  4612   char symname[_MAX_PATH];
  4613   int i,arg;
  4614   symbol *sym,*ref;
  4615   constvalue *tagsym;
  4616   constvalue *enumroot;
  4617   char *ptr;
  4618 
  4619   /* adapt the installation directory */
  4620   strcpy(symname,sc_rootpath);
  4621   #if DIRSEP_CHAR=='\\'
  4622     while ((ptr=strchr(symname,':'))!=NULL)
  4623       *ptr='|';
  4624     while ((ptr=strchr(symname,DIRSEP_CHAR))!=NULL)
  4625       *ptr='/';
  4626   #endif
  4627 
  4628   /* the XML header */
  4629   fprintf(log,"<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n");
  4630   fprintf(log,"<?xml-stylesheet href=\"file:///%s/xml/pawndoc.xsl\" type=\"text/xsl\"?>\n",symname);
  4631   fprintf(log,"<doc source=\"%s\">\n",sourcefile);
  4632   ptr=strrchr(sourcefile,DIRSEP_CHAR);
  4633   if (ptr!=NULL)
  4634     ptr++;
  4635   else
  4636     ptr=sourcefile;
  4637   fprintf(log,"\t<assembly>\n\t\t<name>%s</name>\n\t</assembly>\n",ptr);
  4638 
  4639   /* attach the global documentation, if any */
  4640   if (sc_documentation!=NULL) {
  4641     fprintf(log,"\n\t<!-- general -->\n");
  4642     fprintf(log,"\t<general>\n\t\t");
  4643     fputs(sc_documentation,log);
  4644     fprintf(log,"\n\t</general>\n\n");
  4645   } /* if */
  4646 
  4647   /* use multiple passes to print constants variables and functions in
  4648    * separate sections
  4649    */
  4650   fprintf(log,"\t<members>\n");
  4651 
  4652   fprintf(log,"\n\t\t<!-- enumerations -->\n");
  4653   for (sym=root->next; sym!=NULL; sym=sym->next) {
  4654     if (sym->parent!=NULL)
  4655       continue;                 /* hierarchical data type */
  4656     assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
  4657            || sym->ident==iARRAY || sym->ident==iFUNCTN);
  4658     if (sym->ident!=iCONSTEXPR || (sym->usage & uENUMROOT)==0)
  4659       continue;
  4660     if ((sym->usage & uREAD)==0)
  4661       continue;
  4662     fprintf(log,"\t\t<member name=\"T:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
  4663     if (sym->tag!=0) {
  4664       tagsym=find_tag_byval(sym->tag);
  4665       assert(tagsym!=NULL);
  4666       fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
  4667     } /* if */
  4668     /* browse through all fields */
  4669     if ((enumroot=sym->dim.enumlist)!=NULL) {
  4670       enumroot=enumroot->next;  /* skip root */
  4671       while (enumroot!=NULL) {
  4672         fprintf(log,"\t\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,enumroot->name),enumroot->value);
  4673         /* find the constant with this name and get the tag */
  4674         ref=findglb(enumroot->name,sGLOBAL);
  4675         if (ref!=NULL) {
  4676           if (ref->x.tags.index!=0) {
  4677             tagsym=find_tag_byval(ref->x.tags.index);
  4678             assert(tagsym!=NULL);
  4679             fprintf(log,"\t\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
  4680           } /* if */
  4681           if (ref->dim.array.length!=1)
  4682             fprintf(log,"\t\t\t\t<size value=\"%ld\"/>\n",(long)ref->dim.array.length);
  4683         } /* if */
  4684         fprintf(log,"\t\t\t</member>\n");
  4685         enumroot=enumroot->next;
  4686       } /* while */
  4687     } /* if */
  4688     assert(sym->refer!=NULL);
  4689     for (i=0; i<sym->numrefers; i++) {
  4690       if ((ref=sym->refer[i])!=NULL)
  4691         fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
  4692     } /* for */
  4693     if (sym->documentation!=NULL)
  4694       fprintf(log,"\t\t\t%s\n",sym->documentation);
  4695     fprintf(log,"\t\t</member>\n");
  4696   } /* for */
  4697 
  4698   fprintf(log,"\n\t\t<!-- constants -->\n");
  4699   for (sym=root->next; sym!=NULL; sym=sym->next) {
  4700     if (sym->parent!=NULL)
  4701       continue;                 /* hierarchical data type */
  4702     assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
  4703            || sym->ident==iARRAY || sym->ident==iFUNCTN);
  4704     if (sym->ident!=iCONSTEXPR)
  4705       continue;
  4706     if ((sym->usage & uREAD)==0 || (sym->usage & (uENUMFIELD | uENUMROOT))!=0)
  4707       continue;
  4708     fprintf(log,"\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
  4709     if (sym->tag!=0) {
  4710       tagsym=find_tag_byval(sym->tag);
  4711       assert(tagsym!=NULL);
  4712       fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
  4713     } /* if */
  4714     assert(sym->refer!=NULL);
  4715     for (i=0; i<sym->numrefers; i++) {
  4716       if ((ref=sym->refer[i])!=NULL)
  4717         fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
  4718     } /* for */
  4719     if (sym->documentation!=NULL)
  4720       fprintf(log,"\t\t\t%s\n",sym->documentation);
  4721     fprintf(log,"\t\t</member>\n");
  4722   } /* for */
  4723 
  4724   fprintf(log,"\n\t\t<!-- variables -->\n");
  4725   for (sym=root->next; sym!=NULL; sym=sym->next) {
  4726     if (sym->parent!=NULL)
  4727       continue;                 /* hierarchical data type */
  4728     if (sym->ident!=iVARIABLE && sym->ident!=iARRAY)
  4729       continue;
  4730     fprintf(log,"\t\t<member name=\"F:%s\">\n",funcdisplayname(symname,sym->name));
  4731     if (sym->tag!=0) {
  4732       tagsym=find_tag_byval(sym->tag);
  4733       assert(tagsym!=NULL);
  4734       fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
  4735     } /* if */
  4736     assert(sym->refer!=NULL);
  4737     if ((sym->usage & uPUBLIC)!=0)
  4738       fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
  4739     for (i=0; i<sym->numrefers; i++) {
  4740       if ((ref=sym->refer[i])!=NULL)
  4741         fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
  4742     } /* for */
  4743     if (sym->documentation!=NULL)
  4744       fprintf(log,"\t\t\t%s\n",sym->documentation);
  4745     fprintf(log,"\t\t</member>\n");
  4746   } /* for */
  4747 
  4748   fprintf(log,"\n\t\t<!-- functions -->\n");
  4749   for (sym=root->next; sym!=NULL; sym=sym->next) {
  4750     if (sym->parent!=NULL)
  4751       continue;                 /* hierarchical data type */
  4752     if (sym->ident!=iFUNCTN)
  4753       continue;
  4754     if ((sym->usage & (uREAD | uNATIVE))==uNATIVE)
  4755       continue;                 /* unused native function */
  4756     funcdisplayname(symname,sym->name);
  4757     xmlencode(symname,symname);
  4758     fprintf(log,"\t\t<member name=\"M:%s\" syntax=\"%s(",symname,symname);
  4759     /* print only the names of the parameters between the parentheses */
  4760     assert(sym->dim.arglist!=NULL);
  4761     for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
  4762       int dim;
  4763       if (arg>0)
  4764         fprintf(log,", ");
  4765       switch (sym->dim.arglist[arg].ident) {
  4766       case iVARIABLE:
  4767         fprintf(log,"%s",sym->dim.arglist[arg].name);
  4768         break;
  4769       case iREFERENCE:
  4770         fprintf(log,"&amp;%s",sym->dim.arglist[arg].name);
  4771         break;
  4772       case iREFARRAY:
  4773         fprintf(log,"%s",sym->dim.arglist[arg].name);
  4774         for (dim=0; dim<sym->dim.arglist[arg].numdim;dim++)
  4775           fprintf(log,"[]");
  4776         break;
  4777       case iVARARGS:
  4778         fprintf(log,"...");
  4779         break;
  4780       } /* switch */
  4781     } /* for */
  4782     /* ??? should also print an "array return" size */
  4783     fprintf(log,")\">\n");
  4784     if (sym->tag!=0) {
  4785       tagsym=find_tag_byval(sym->tag);
  4786       assert(tagsym!=NULL);
  4787       fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
  4788     } /* if */
  4789     /* check whether this function is called from the outside */
  4790     if ((sym->usage & uNATIVE)!=0)
  4791       fprintf(log,"\t\t\t<attribute name=\"native\"/>\n");
  4792     if ((sym->usage & uPUBLIC)!=0)
  4793       fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
  4794     if (strcmp(sym->name,uMAINFUNC)==0 || strcmp(sym->name,uENTRYFUNC)==0)
  4795       fprintf(log,"\t\t\t<attribute name=\"entry\"/>\n");
  4796     if ((sym->usage & uNATIVE)==0)
  4797       fprintf(log,"\t\t\t<stacksize value=\"%ld\"/>\n",(long)sym->x.stacksize);
  4798     if (sym->states!=NULL) {
  4799       constvalue *stlist=sym->states->next;
  4800       assert(stlist!=NULL);     /* there should be at least one state item */
  4801       while (stlist!=NULL && stlist->index==-1)
  4802         stlist=stlist->next;
  4803       assert(stlist!=NULL);     /* state id should be found */
  4804       i=state_getfsa(stlist->index);
  4805       assert(i>=0);             /* automaton 0 exists */
  4806       stlist=automaton_findid(i);
  4807       assert(stlist!=NULL);     /* automaton should be found */
  4808       fprintf(log,"\t\t\t<automaton name=\"%s\"/>\n", strlen(stlist->name)>0 ? stlist->name : "(anonymous)");
  4809       //??? dump state decision table
  4810     } /* if */
  4811     assert(sym->refer!=NULL);
  4812     for (i=0; i<sym->numrefers; i++)
  4813       if ((ref=sym->refer[i])!=NULL)
  4814         fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
  4815     /* print all symbols that are required for this function to compile */
  4816     for (ref=root->next; ref!=NULL; ref=ref->next) {
  4817       if (ref==sym)
  4818         continue;
  4819       for (i=0; i<ref->numrefers; i++)
  4820         if (ref->refer[i]==sym)
  4821           fprintf(log,"\t\t\t<dependency name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
  4822     } /* for */
  4823     /* print parameter list, with tag & const information, plus descriptions */
  4824     assert(sym->dim.arglist!=NULL);
  4825     for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
  4826       int dim,paraminfo;
  4827       char *outer_start,*inner_start;
  4828       int outer_length,inner_length;
  4829       if (sym->dim.arglist[arg].ident==iVARARGS)
  4830         fprintf(log,"\t\t\t<param name=\"...\">\n");
  4831       else
  4832         fprintf(log,"\t\t\t<param name=\"%s\">\n",sym->dim.arglist[arg].name);
  4833       /* print the tag name(s) for each parameter */
  4834       assert(sym->dim.arglist[arg].numtags>0);
  4835       assert(sym->dim.arglist[arg].tags!=NULL);
  4836       paraminfo=(sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0)
  4837                 || sym->dim.arglist[arg].ident==iREFERENCE
  4838                 || sym->dim.arglist[arg].ident==iREFARRAY;
  4839       if (paraminfo)
  4840         fprintf(log,"\t\t\t\t<paraminfo>");
  4841       if (sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0) {
  4842         assert(paraminfo);
  4843         if (sym->dim.arglist[arg].numtags>1)
  4844           fprintf(log," {");
  4845         for (i=0; i<sym->dim.arglist[arg].numtags; i++) {
  4846           if (i>0)
  4847             fprintf(log,",");
  4848           tagsym=find_tag_byval(sym->dim.arglist[arg].tags[i]);
  4849           assert(tagsym!=NULL);
  4850           fprintf(log,"%s",tagsym->name);
  4851         } /* for */
  4852         if (sym->dim.arglist[arg].numtags>1)
  4853           fprintf(log,"}");
  4854       } /* if */
  4855       switch (sym->dim.arglist[arg].ident) {
  4856       case iREFERENCE:
  4857         fprintf(log," &amp;");
  4858         break;
  4859       case iREFARRAY:
  4860         fprintf(log," ");
  4861         for (dim=0; dim<sym->dim.arglist[arg].numdim; dim++) {
  4862           if (sym->dim.arglist[arg].dim[dim]==0) {
  4863             fprintf(log,"[]");
  4864           } else {
  4865             //??? find index tag
  4866             fprintf(log,"[%d]",sym->dim.arglist[arg].dim[dim]);
  4867           } /* if */
  4868         } /* for */
  4869         break;
  4870       } /* switch */
  4871       if (paraminfo)
  4872         fprintf(log," </paraminfo>\n");
  4873       /* print the user description of the parameter (parse through
  4874        * sym->documentation)
  4875        */
  4876       if (sym->documentation!=NULL
  4877           && find_xmltag(sym->documentation, "param", "name", sym->dim.arglist[arg].name,
  4878                          &outer_start, &outer_length, &inner_start, &inner_length))
  4879       {
  4880         char *tail;
  4881         fprintf(log,"\t\t\t\t%.*s\n",inner_length,inner_start);
  4882         /* delete from documentation string */
  4883         tail=outer_start+outer_length;
  4884         memmove(outer_start,tail,strlen(tail)+1);
  4885       } /* if */
  4886       fprintf(log,"\t\t\t</param>\n");
  4887     } /* for */
  4888     if (sym->documentation!=NULL)
  4889       fprintf(log,"\t\t\t%s\n",sym->documentation);
  4890     fprintf(log,"\t\t</member>\n");
  4891   } /* for */
  4892 
  4893   fprintf(log,"\n\t</members>\n");
  4894   fprintf(log,"</doc>\n");
  4895 }
  4896 #endif
  4897 
  4898 /* Every symbol has a referrer list, that contains the functions that use
  4899  * the symbol. Now, if function "apple" is accessed by functions "banana" and
  4900  * "citron", but neither function "banana" nor "citron" are used by anyone
  4901  * else, then, by inference, function "apple" is not used either.
  4902  */
  4903 static void reduce_referrers(symbol *root)
  4904 {
  4905   int i,restart;
  4906   symbol *sym,*ref;
  4907 
  4908   do {
  4909     restart=0;
  4910     for (sym=root->next; sym!=NULL; sym=sym->next) {
  4911       if (sym->parent!=NULL)
  4912         continue;                 /* hierarchical data type */
  4913       if (sym->ident==iFUNCTN
  4914           && (sym->usage & uNATIVE)==0
  4915           && (sym->usage & uPUBLIC)==0 && strcmp(sym->name,uMAINFUNC)!=0 && strcmp(sym->name,uENTRYFUNC)!=0
  4916           && count_referrers(sym)==0)
  4917       {
  4918         sym->usage&=~(uREAD | uWRITTEN);  /* erase usage bits if there is no referrer */
  4919         /* find all symbols that are referred by this symbol */
  4920         for (ref=root->next; ref!=NULL; ref=ref->next) {
  4921           if (ref->parent!=NULL)
  4922             continue;             /* hierarchical data type */
  4923           assert(ref->refer!=NULL);
  4924           for (i=0; i<ref->numrefers && ref->refer[i]!=sym; i++)
  4925             /* nothing */;
  4926           if (i<ref->numrefers) {
  4927             assert(ref->refer[i]==sym);
  4928             ref->refer[i]=NULL;
  4929             restart++;
  4930           } /* if */
  4931         } /* for */
  4932       } else if ((sym->ident==iVARIABLE || sym->ident==iARRAY)
  4933                  && (sym->usage & uPUBLIC)==0
  4934                  && sym->parent==NULL
  4935                  && count_referrers(sym)==0)
  4936       {
  4937         sym->usage&=~(uREAD | uWRITTEN);  /* erase usage bits if there is no referrer */
  4938       } /* if */
  4939     } /* for */
  4940     /* after removing a symbol, check whether more can be removed */
  4941   } while (restart>0);
  4942 }
  4943 
  4944 #if !defined SC_LIGHT
  4945 static long max_stacksize_recurse(symbol *sourcesym,symbol *sym,long basesize,int *pubfuncparams,int *recursion)
  4946 {
  4947   long size,maxsize;
  4948   int i;
  4949 
  4950   assert(sym!=NULL);
  4951   assert(sym->ident==iFUNCTN);
  4952   assert((sym->usage & uNATIVE)==0);
  4953   assert(recursion!=NULL);
  4954 
  4955   maxsize=sym->x.stacksize;
  4956   for (i=0; i<sym->numrefers; i++) {
  4957     if (sym->refer[i]!=NULL) {
  4958       assert(sym->refer[i]->ident==iFUNCTN);
  4959       assert((sym->refer[i]->usage & uNATIVE)==0); /* a native function cannot refer to a user-function */
  4960       if (sym->refer[i]==sourcesym) {   /* recursion detection */
  4961         *recursion=1;
  4962         break;                          /* recursion was detected, quit loop */
  4963       } /* if */
  4964       size=max_stacksize_recurse(sourcesym,sym->refer[i],sym->x.stacksize,pubfuncparams,recursion);
  4965       if (maxsize<size)
  4966         maxsize=size;
  4967     } /* if */
  4968   } /* for */
  4969 
  4970   if ((sym->usage & uPUBLIC)!=0) {
  4971     /* Find out how many parameters a public function has, then see if this
  4972      * is bigger than some maximum
  4973      */
  4974     arginfo *arg=sym->dim.arglist;
  4975     int count=0;
  4976     assert(arg!=0);
  4977     while (arg->ident!=0) {
  4978       count++;
  4979       arg++;
  4980     } /* while */
  4981     assert(pubfuncparams!=0);
  4982     if (count>*pubfuncparams)
  4983       *pubfuncparams=count;
  4984   } /* if */
  4985 
  4986   return maxsize+basesize;
  4987 }
  4988 
  4989 static long max_stacksize(symbol *root,int *recursion)
  4990 {
  4991   /* Loop over all non-native functions. For each function, loop
  4992    * over all of its referrers, accumulating the stack requirements.
  4993    * Detect (indirect) recursion with a "mark-and-sweep" algorithm.
  4994    * I (mis-)use the "compound" field of the symbol structure for
  4995    * the marker, as this field is unused for functions.
  4996    *
  4997    * Note that the stack is shared with the heap. A host application
  4998    * may "eat" cells from the heap as well, through amx_Allot(). The
  4999    * stack requirements are thus only an estimate.
  5000    */
  5001   long size,maxsize;
  5002   int maxparams;
  5003   symbol *sym;
  5004 
  5005   assert(root!=NULL);
  5006   assert(recursion!=NULL);
  5007   #if !defined NDEBUG
  5008     for (sym=root->next; sym!=NULL; sym=sym->next)
  5009       if (sym->ident==iFUNCTN)
  5010         assert(sym->compound==0);
  5011   #endif
  5012 
  5013   maxsize=0;
  5014   maxparams=0;
  5015   *recursion=0;         /* assume no recursion */
  5016   for (sym=root->next; sym!=NULL; sym=sym->next) {
  5017     /* drop out if this is not a user-implemented function */
  5018     if (sym->ident!=iFUNCTN || (sym->usage & uNATIVE)!=0)
  5019       continue;
  5020     /* accumulate stack size for this symbol */
  5021     size=max_stacksize_recurse(sym,sym,0L,&maxparams,recursion);
  5022     assert(size>=0);
  5023     if (maxsize<size)
  5024       maxsize=size;
  5025   } /* for */
  5026 
  5027   maxsize++;                  /* +1 because a zero cell is always pushed on top
  5028                                * of the stack to catch stack overwrites */
  5029   return maxsize+(maxparams+1);/* +1 because # of parameters is always pushed on entry */
  5030 }
  5031 #endif
  5032 
  5033 /*  testsymbols - test for unused local or global variables
  5034  *
  5035  *  "Public" functions are excluded from the check, since these
  5036  *  may be exported to other object modules.
  5037  *  Labels are excluded from the check if the argument 'testlabs'
  5038  *  is 0. Thus, labels are not tested until the end of the function.
  5039  *  Constants may also be excluded (convenient for global constants).
  5040  *
  5041  *  When the nesting level drops below "level", the check stops.
  5042  *
  5043  *  The function returns whether there is an "entry" point for the file.
  5044  *  This flag will only be 1 when browsing the global symbol table.
  5045  */
  5046 static int testsymbols(symbol *root,int level,int testlabs,int testconst)
  5047 {
  5048   char symname[2*sNAMEMAX+16];
  5049   int entry=FALSE;
  5050 
  5051   symbol *sym=root->next;
  5052   while (sym!=NULL && sym->compound>=level) {
  5053     switch (sym->ident) {
  5054     case iLABEL:
  5055       if (testlabs) {
  5056         if ((sym->usage & uDEFINE)==0) {
  5057           error(19,sym->name);      /* not a label: ... */
  5058         } else if ((sym->usage & uREAD)==0) {
  5059           errorset(sSETPOS,sym->lnumber);
  5060           error(203,sym->name);     /* symbol isn't used: ... */
  5061         } /* if */
  5062       } /* if */
  5063       break;
  5064     case iFUNCTN:
  5065       if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK | uPUBLIC))==uDEFINE) {
  5066         funcdisplayname(symname,sym->name);
  5067         if (strlen(symname)>0)
  5068           error(203,symname);       /* symbol isn't used ... (and not public/native/stock) */
  5069       } /* if */
  5070       if ((sym->usage & uPUBLIC)!=0 || strcmp(sym->name,uMAINFUNC)==0)
  5071         entry=TRUE;                 /* there is an entry point */
  5072       /* also mark the function to the debug information */
  5073       if (((sym->usage & uREAD)!=0 || (sym->usage & uPUBLIC)!=0) && (sym->usage & uNATIVE)==0)
  5074         insert_dbgsymbol(sym);
  5075       break;
  5076     case iCONSTEXPR:
  5077       if (testconst && (sym->usage & uREAD)==0) {
  5078         errorset(sSETPOS,sym->lnumber);
  5079         error(203,sym->name);       /* symbol isn't used: ... */
  5080       } /* if */
  5081       break;
  5082     default:
  5083       /* a variable */
  5084       if (sym->parent!=NULL)
  5085         break;                      /* hierarchical data type */
  5086       if ((sym->usage & (uWRITTEN | uREAD | uSTOCK))==0) {
  5087         if (testconst)
  5088           errorset(sSETPOS,sym->lnumber);
  5089         error(203,sym->name,sym->lnumber);  /* symbol isn't used (and not stock) */
  5090       } else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC))==0) {
  5091         errorset(sSETPOS,sym->lnumber);
  5092         error(204,sym->name);       /* value assigned to symbol is never used */
  5093 #if 0 // ??? not sure whether it is a good idea to force people use "const"
  5094       } else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST))==0 && sym->ident==iREFARRAY) {
  5095         errorset(sSETPOS,sym->lnumber);
  5096         error(214,sym->name);       /* make array argument "const" */
  5097 #endif
  5098       } /* if */
  5099       /* also mark the variable (local or global) to the debug information */
  5100       if ((sym->usage & (uWRITTEN | uREAD))!=0 && (sym->usage & uNATIVE)==0)
  5101         insert_dbgsymbol(sym);
  5102     } /* if */
  5103     sym=sym->next;
  5104   } /* while */
  5105 
  5106   return entry;
  5107 }
  5108 
  5109 static cell calc_array_datasize(symbol *sym, cell *offset)
  5110 {
  5111   cell length;
  5112 
  5113   assert(sym!=NULL);
  5114   assert(sym->ident==iARRAY || sym->ident==iREFARRAY);
  5115   length=sym->dim.array.length;
  5116   if (sym->dim.array.level > 0) {
  5117     cell sublength=calc_array_datasize(finddepend(sym),offset);
  5118     if (offset!=NULL)
  5119       *offset=length*(*offset+sizeof(cell));
  5120     if (sublength>0)
  5121       length*=length*sublength;
  5122     else
  5123       length=0;
  5124   } else {
  5125     if (offset!=NULL)
  5126       *offset=0;
  5127   } /* if */
  5128   return length;
  5129 }
  5130 
  5131 static void destructsymbols(symbol *root,int level)
  5132 {
  5133   cell offset=0;
  5134   int savepri=FALSE;
  5135   symbol *sym=root->next;
  5136   while (sym!=NULL && sym->compound>=level) {
  5137     if (sym->ident==iVARIABLE || sym->ident==iARRAY) {
  5138       char symbolname[16];
  5139       symbol *opsym;
  5140       cell elements;
  5141       /* check that the '~' operator is defined for this tag */
  5142       operator_symname(symbolname,"~",sym->tag,0,1,0);
  5143       if ((opsym=findglb(symbolname,sGLOBAL))!=NULL) {
  5144         /* save PRI, in case of a return statment */
  5145         if (!savepri) {
  5146           pushreg(sPRI);        /* right-hand operand is in PRI */
  5147           savepri=TRUE;
  5148         } /* if */
  5149         /* if the variable is an array, get the number of elements */
  5150         if (sym->ident==iARRAY) {
  5151           elements=calc_array_datasize(sym,&offset);
  5152           /* "elements" can be zero when the variable is declared like
  5153            *    new mytag: myvar[2][] = { {1, 2}, {3, 4} }
  5154            * one should declare all dimensions!
  5155            */
  5156           if (elements==0)
  5157             error(46,sym->name);        /* array size is unknown */
  5158         } else {
  5159           elements=1;
  5160           offset=0;
  5161         } /* if */
  5162         pushval(elements);
  5163         /* call the '~' operator */
  5164         address(sym,sPRI);
  5165         addconst(offset);       /* add offset to array data to the address */
  5166         pushreg(sPRI);
  5167         pushval(2 /* *sizeof(cell)*/ );/* 2 parameters */
  5168         assert(opsym->ident==iFUNCTN);
  5169         ffcall(opsym,NULL,1);
  5170         if (sc_status!=statSKIP)
  5171           markusage(opsym,uREAD);   /* do not mark as "used" when this call itself is skipped */
  5172         if ((opsym->usage & uNATIVE)!=0 && opsym->x.lib!=NULL)
  5173           opsym->x.lib->value += 1; /* increment "usage count" of the library */
  5174       } /* if */
  5175     } /* if */
  5176     sym=sym->next;
  5177   } /* while */
  5178   /* restore PRI, if it was saved */
  5179   if (savepri)
  5180     popreg(sPRI);
  5181 }
  5182 
  5183 static constvalue *insert_constval(constvalue *prev,constvalue *next,const char *name,cell val,
  5184                                    int index)
  5185 {
  5186   constvalue *cur;
  5187 
  5188   if ((cur=(constvalue*)malloc(sizeof(constvalue)))==NULL)
  5189     error(103);       /* insufficient memory (fatal error) */
  5190   memset(cur,0,sizeof(constvalue));
  5191   if (name!=NULL) {
  5192     assert(strlen(name)<sNAMEMAX);
  5193     strcpy(cur->name,name);
  5194   } /* if */
  5195   cur->value=val;
  5196   cur->index=index;
  5197   cur->next=next;
  5198   prev->next=cur;
  5199   return cur;
  5200 }
  5201 
  5202 SC_FUNC constvalue *append_constval(constvalue *table,const char *name,cell val,int index)
  5203 {
  5204   constvalue *cur,*prev;
  5205 
  5206   /* find the end of the constant table */
  5207   for (prev=table, cur=table->next; cur!=NULL; prev=cur, cur=cur->next)
  5208     /* nothing */;
  5209   return insert_constval(prev,NULL,name,val,index);
  5210 }
  5211 
  5212 SC_FUNC constvalue *find_constval(constvalue *table,char *name,int index)
  5213 {
  5214   constvalue *ptr = table->next;
  5215 
  5216   while (ptr!=NULL) {
  5217     if (strcmp(name,ptr->name)==0 && ptr->index==index)
  5218       return ptr;
  5219     ptr=ptr->next;
  5220   } /* while */
  5221   return NULL;
  5222 }
  5223 
  5224 static constvalue *find_constval_byval(constvalue *table,cell val)
  5225 {
  5226   constvalue *ptr = table->next;
  5227 
  5228   while (ptr!=NULL) {
  5229     if (ptr->value==val)
  5230       return ptr;
  5231     ptr=ptr->next;
  5232   } /* while */
  5233   return NULL;
  5234 }
  5235 
  5236 #if 0   /* never used */
  5237 static int delete_constval(constvalue *table,char *name)
  5238 {
  5239   constvalue *prev = table;
  5240   constvalue *cur = prev->next;
  5241 
  5242   while (cur!=NULL) {
  5243     if (strcmp(name,cur->name)==0) {
  5244       prev->next=cur->next;
  5245       free(cur);
  5246       return TRUE;
  5247     } /* if */
  5248     prev=cur;
  5249     cur=cur->next;
  5250   } /* while */
  5251   return FALSE;
  5252 }
  5253 #endif
  5254 
  5255 SC_FUNC void delete_consttable(constvalue *table)
  5256 {
  5257   constvalue *cur=table->next, *next;
  5258 
  5259   while (cur!=NULL) {
  5260     next=cur->next;
  5261     free(cur);
  5262     cur=next;
  5263   } /* while */
  5264   memset(table,0,sizeof(constvalue));
  5265 }
  5266 
  5267 /*  add_constant
  5268  *
  5269  *  Adds a symbol to the symbol table. Returns NULL on failure.
  5270  */
  5271 SC_FUNC symbol *add_constant(char *name,cell val,int vclass,int tag)
  5272 {
  5273   symbol *sym;
  5274 
  5275   /* Test whether a global or local symbol with the same name exists. Since
  5276    * constants are stored in the symbols table, this also finds previously
  5277    * defind constants. */
  5278   sym=findglb(name,sSTATEVAR);
  5279   if (!sym)
  5280     sym=findloc(name);
  5281   if (sym) {
  5282     int redef=0;
  5283     if (sym->ident!=iCONSTEXPR)
  5284       redef=1;                  /* redefinition a function/variable to a constant is not allowed */
  5285     if ((sym->usage & uENUMFIELD)!=0) {
  5286       /* enum field, special case if it has a different tag and the new symbol is also an enum field */
  5287       constvalue *tagid;
  5288       symbol *tagsym;
  5289       if (sym->tag==tag)
  5290         redef=1;                /* enumeration field is redefined (same tag) */
  5291       tagid=find_tag_byval(tag);
  5292       if (tagid==NULL) {
  5293         redef=1;                /* new constant does not have a tag */
  5294       } else {
  5295         tagsym=findconst(tagid->name,NULL);
  5296         if (tagsym==NULL || (tagsym->usage & uENUMROOT)==0)
  5297           redef=1;              /* new constant is not an enumeration field */
  5298       } /* if */
  5299       /* in this particular case (enumeration field that is part of a different
  5300        * enum, and non-conflicting with plain constants) we want to be able to
  5301        * redefine it
  5302        */
  5303       if (!redef)
  5304         goto redef_enumfield;
  5305     } else if (sym->tag!=tag) {
  5306       redef=1;                  /* redefinition of a constant (non-enum) to a different tag is not allowed */
  5307     } /* if */
  5308     if (redef) {
  5309       error(21,name);           /* symbol already defined */
  5310       return NULL;
  5311     } else if (sym->addr!=val) {
  5312       error(201,name);          /* redefinition of constant (different value) */
  5313       sym->addr=val;            /* set new value */
  5314     } /* if */
  5315     /* silently ignore redefinitions of constants with the same value & tag */
  5316     return sym;
  5317   } /* if */
  5318 
  5319   /* constant doesn't exist yet (or is allowed to be redefined) */
  5320 redef_enumfield:
  5321   sym=addsym(name,val,iCONSTEXPR,vclass,tag,uDEFINE);
  5322   assert(sym!=NULL);            /* fatal error 103 must be given on error */
  5323   if (sc_status == statIDLE)
  5324     sym->usage |= uPREDEF;
  5325   return sym;
  5326 }
  5327 
  5328 /*  statement           - The Statement Parser
  5329  *
  5330  *  This routine is called whenever the parser needs to know what statement
  5331  *  it encounters (i.e. whenever program syntax requires a statement).
  5332  */
  5333 static void statement(int *lastindent,int allow_decl)
  5334 {
  5335   int tok,save;
  5336   cell val;
  5337   char *st;
  5338 
  5339   if (!freading) {
  5340     error(36);                  /* empty statement */
  5341     return;
  5342   } /* if */
  5343   errorset(sRESET,0);
  5344 
  5345   tok=lex(&val,&st);
  5346   if (tok!='{') {
  5347     insert_dbgline(fline);
  5348     setline(TRUE);
  5349   } /* if */
  5350   /* lex() has set stmtindent */
  5351   if (lastindent!=NULL && tok!=tLABEL) {
  5352     if (*lastindent>=0 && *lastindent!=stmtindent && !indent_nowarn && sc_tabsize>0)
  5353       error(217);               /* loose indentation */
  5354     *lastindent=stmtindent;
  5355     indent_nowarn=FALSE;        /* if warning was blocked, re-enable it */
  5356   } /* if */
  5357   switch (tok) {
  5358   case 0:
  5359     /* nothing */
  5360     break;
  5361   case tNEW:
  5362     if (allow_decl) {
  5363       autozero=1;
  5364       declloc(FALSE);
  5365       lastst=tNEW;
  5366     } else {
  5367       error(3);                 /* declaration only valid in a block */
  5368     } /* if */
  5369     break;
  5370   case tDECL:
  5371     if (allow_decl) {
  5372       autozero=0;
  5373       declloc(FALSE);
  5374       lastst=tDECL;
  5375     } else {
  5376       error(3);                 /* declaration only valid in a block */
  5377     } /* if */
  5378     break;
  5379   case tSTATIC:
  5380     if (allow_decl) {
  5381       declloc(TRUE);
  5382       lastst=tNEW;
  5383     } else {
  5384       error(3);                 /* declaration only valid in a block */
  5385     } /* if */
  5386     break;
  5387   case '{':
  5388   case tBEGIN:
  5389     save=fline;
  5390     if (!matchtoken('}'))       /* {} is the empty statement */
  5391       compound(save==fline,tok);
  5392     /* lastst (for "last statement") does not change */
  5393     break;
  5394   case ';':
  5395     error(36);                  /* empty statement */
  5396     break;
  5397   case tIF:
  5398     lastst=doif();
  5399     break;
  5400   case tWHILE:
  5401     lastst=dowhile();
  5402     break;
  5403   case tDO:
  5404     lastst=dodo();
  5405     break;
  5406   case tFOR:
  5407     lastst=dofor();
  5408     break;
  5409   case tSWITCH:
  5410     doswitch();
  5411     lastst=tSWITCH;
  5412     break;
  5413   case tCASE:
  5414   case tDEFAULT:
  5415     error(14);     /* not in switch */
  5416     break;
  5417   case tGOTO:
  5418     dogoto();
  5419     lastst=tGOTO;
  5420     break;
  5421   case tLABEL:
  5422     dolabel();
  5423     lastst=tLABEL;
  5424     break;
  5425   case tRETURN:
  5426     doreturn();
  5427     lastst=tRETURN;
  5428     break;
  5429   case tBREAK:
  5430     dobreak();
  5431     lastst=tBREAK;
  5432     break;
  5433   case tCONTINUE:
  5434     docont();
  5435     lastst=tCONTINUE;
  5436     break;
  5437   case tEXIT:
  5438     doexit();
  5439     lastst=tEXIT;
  5440     break;
  5441   case tASSERT:
  5442     doassert();
  5443     lastst=tASSERT;
  5444     break;
  5445   case tSLEEP:
  5446     dosleep();
  5447     lastst=tSLEEP;
  5448     break;
  5449   case tSTATE:
  5450     dostate();
  5451     lastst=tSTATE;
  5452     break;
  5453   case tCONST:
  5454     decl_const(sLOCAL);
  5455     break;
  5456   case tENUM:
  5457     decl_enum(sLOCAL);
  5458     break;
  5459   default:          /* non-empty expression */
  5460     sc_allowproccall=optproccall;
  5461     lexpush();      /* analyze token later */
  5462     doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE);
  5463     needtoken(tTERM);
  5464     lastst=tEXPR;
  5465     sc_allowproccall=FALSE;
  5466   } /* switch */
  5467 }
  5468 
  5469 static void compound(int stmt_sameline,int starttok)
  5470 {
  5471   int indent=-1;
  5472   cell save_decl=declared;
  5473   int count_stmt=0;
  5474   int block_start=fline;  /* save line where the compound block started */
  5475   int endtok;
  5476 
  5477   pushstacklist();
  5478   pushheaplist();
  5479   /* if there is more text on this line, we should adjust the statement indent */
  5480   if (stmt_sameline) {
  5481     int i;
  5482     const unsigned char *p=lptr;
  5483     /* go back to the opening brace */
  5484     while (*p!=starttok) {
  5485       assert(p>pline);
  5486       p--;
  5487     } /* while */
  5488     assert(*p==starttok);  /* it should be found */
  5489     /* go forward, skipping white-space */
  5490     p++;
  5491     while (*p<=' ' && *p!='\0')
  5492       p++;
  5493     assert(*p!='\0'); /* a token should be found */
  5494     stmtindent=0;
  5495     for (i=0; i<(int)(p-pline); i++)
  5496       if (pline[i]=='\t' && sc_tabsize>0)
  5497         stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize);
  5498       else
  5499         stmtindent++;
  5500   } /* if */
  5501 
  5502   endtok=(starttok=='{') ? '}' : tEND;
  5503   nestlevel+=1;                 /* increase compound statement level */
  5504   while (matchtoken(endtok)==0){/* repeat until compound statement is closed */
  5505     if (!freading){
  5506       error(30,block_start);    /* compound block not closed at end of file */
  5507       break;
  5508     } else {
  5509       if (count_stmt>0 && (lastst==tRETURN || lastst==tBREAK || lastst==tCONTINUE || lastst==tENDLESS))
  5510         error(225);             /* unreachable code */
  5511       statement(&indent,TRUE);  /* do a statement */
  5512       count_stmt++;
  5513     } /* if */
  5514   } /* while */
  5515   if (lastst!=tRETURN)
  5516     destructsymbols(&loctab,nestlevel);
  5517   if (lastst!=tRETURN && lastst!=tGOTO) {
  5518     popheaplist(1);
  5519     popstacklist(1);
  5520   } else {
  5521     popheaplist(0);
  5522     popstacklist(0);
  5523   }
  5524   testsymbols(&loctab,nestlevel,FALSE,TRUE);        /* look for unused block locals */
  5525   declared=save_decl;
  5526   delete_symbols(&loctab,nestlevel,FALSE,TRUE);     /* erase local symbols, but
  5527                                                      * retain block local labels
  5528                                                      * (within the function) */
  5529   nestlevel-=1;                 /* decrease compound statement level */
  5530 }
  5531 
  5532 /*  doexpr
  5533  *
  5534  *  Global references: stgidx   (referred to only)
  5535  */
  5536 static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
  5537                   int *tag,symbol **symptr,int chkfuncresult)
  5538 {
  5539   return doexpr2(comma,chkeffect,allowarray,mark_endexpr,tag,symptr,chkfuncresult,NULL);
  5540 }
  5541 
  5542 /*  doexpr2
  5543  *
  5544  *  Global references: stgidx   (referred to only)
  5545  */
  5546 static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
  5547                   int *tag,symbol **symptr,int chkfuncresult,value *lval)
  5548 {
  5549   int index,ident;
  5550   int localstaging=FALSE;
  5551   cell val;
  5552 
  5553   if (!staging) {
  5554     stgset(TRUE);               /* start stage-buffering */
  5555     localstaging=TRUE;
  5556     assert(stgidx==0);
  5557   } /* if */
  5558   index=stgidx;
  5559   errorset(sEXPRMARK,0);
  5560   do {
  5561     /* on second round through, mark the end of the previous expression */
  5562     if (index!=stgidx)
  5563       markexpr(sEXPR,NULL,0);
  5564     sideeffect=FALSE;
  5565     ident=expression(&val,tag,symptr,chkfuncresult,lval);
  5566     if (!allowarray && (ident==iARRAY || ident==iREFARRAY))
  5567       error(33,"-unknown-");    /* array must be indexed */
  5568     if (chkeffect && !sideeffect)
  5569       error(215);               /* expression has no effect */
  5570     sc_allowproccall=FALSE;     /* cannot use "procedure call" syntax anymore */
  5571   } while (comma && matchtoken(',')); /* more? */
  5572   if (mark_endexpr)
  5573     markexpr(sEXPR,NULL,0);     /* optionally, mark the end of the expression */
  5574   errorset(sEXPRRELEASE,0);
  5575   if (localstaging) {
  5576     stgout(index);
  5577     stgset(FALSE);              /* stop staging */
  5578   } /* if */
  5579   return ident;
  5580 }
  5581 
  5582 /*  constexpr
  5583  */
  5584 SC_FUNC int constexpr(cell *val,int *tag,symbol **symptr)
  5585 {
  5586   int ident,index;
  5587   cell cidx;
  5588 
  5589   stgset(TRUE);         /* start stage-buffering */
  5590   stgget(&index,&cidx); /* mark position in code generator */
  5591   errorset(sEXPRMARK,0);
  5592   ident=expression(val,tag,symptr,FALSE,NULL);
  5593   stgdel(index,cidx);   /* scratch generated code */
  5594   stgset(FALSE);        /* stop stage-buffering */
  5595   if (ident!=iCONSTEXPR) {
  5596     error(8);           /* must be constant expression */
  5597     if (val!=NULL)
  5598       *val=0;
  5599     if (tag!=NULL)
  5600       *tag=0;
  5601     if (symptr!=NULL)
  5602       *symptr=NULL;
  5603   } /* if */
  5604   errorset(sEXPRRELEASE,0);
  5605   return (ident==iCONSTEXPR);
  5606 }
  5607 
  5608 /*  test
  5609  *
  5610  *  In the case a "simple assignment" operator ("=") is used within a test,
  5611  *  the warning "possibly unintended assignment" is displayed. This routine
  5612  *  sets the global variable "sc_intest" to true, it is restored upon termination.
  5613  *  In the case the assignment was intended, use parantheses around the
  5614  *  expression to avoid the warning; primary() sets "sc_intest" to 0.
  5615  *
  5616  *  Global references: sc_intest (altered, but restored upon termination)
  5617  */
  5618 static int test(int label,int parens,int invert)
  5619 {
  5620   int index,tok;
  5621   cell cidx;
  5622   int ident,tag;
  5623   int endtok;
  5624   cell constval;
  5625   symbol *sym;
  5626   int localstaging=FALSE;
  5627 
  5628   if (!staging) {
  5629     stgset(TRUE);               /* start staging */
  5630     localstaging=TRUE;
  5631     #if !defined NDEBUG
  5632       stgget(&index,&cidx);     /* should start at zero if started locally */
  5633       assert(index==0);
  5634     #endif
  5635   } /* if */
  5636 
  5637   PUSHSTK_I(sc_intest);
  5638   sc_intest=TRUE;
  5639   endtok=0;
  5640   if (parens!=TEST_PLAIN) {
  5641     if (matchtoken('('))
  5642       endtok=')';
  5643     else if (parens==TEST_THEN)
  5644       endtok=tTHEN;
  5645     else if (parens==TEST_DO)
  5646       endtok=tDO;
  5647   } /* if */
  5648   do {
  5649     stgget(&index,&cidx);       /* mark position (of last expression) in
  5650                                  * code generator */
  5651     ident=expression(&constval,&tag,&sym,TRUE,NULL);
  5652     tok=matchtoken(',');
  5653     if (tok)
  5654       markexpr(sEXPR,NULL,0);
  5655   } while (tok); /* do */
  5656   if (endtok!=0)
  5657     needtoken(endtok);
  5658   if (ident==iARRAY || ident==iREFARRAY) {
  5659     char *ptr=(sym->name!=NULL) ? sym->name : "-unknown-";
  5660     error(33,ptr);              /* array must be indexed */
  5661   } /* if */
  5662   if (ident==iCONSTEXPR) {      /* constant expression */
  5663     int testtype=0;
  5664     sc_intest=(short)POPSTK_I();/* restore stack */
  5665     stgdel(index,cidx);
  5666     if (constval) {             /* code always executed */
  5667       error(206);               /* redundant test: always non-zero */
  5668       testtype=tENDLESS;
  5669     } else {
  5670       error(205);               /* redundant code: never executed */
  5671       jumplabel(label);
  5672     } /* if */
  5673     if (localstaging) {
  5674       stgout(0);                /* write "jumplabel" code */
  5675       stgset(FALSE);            /* stop staging */
  5676     } /* if */
  5677     return testtype;
  5678   } /* if */
  5679   if (tag!=0 && tag!=pc_addtag("bool"))
  5680     if (check_userop(lneg,tag,0,1,NULL,&tag))
  5681       invert= !invert;          /* user-defined ! operator inverted result */
  5682   if (invert)
  5683     jmp_ne0(label);             /* jump to label if true (different from 0) */
  5684   else
  5685     jmp_eq0(label);             /* jump to label if false (equal to 0) */
  5686   markexpr(sEXPR,NULL,0);       /* end expression (give optimizer a chance) */
  5687   sc_intest=(short)POPSTK_I();  /* double typecast to avoid warning with Microsoft C */
  5688   if (localstaging) {
  5689     stgout(0);                  /* output queue from the very beginning (see
  5690                                  * assert() when localstaging is set to TRUE) */
  5691     stgset(FALSE);              /* stop staging */
  5692   } /* if */
  5693   return 0;
  5694 }
  5695 
  5696 static int doif(void)
  5697 {
  5698   int flab1,flab2;
  5699   int ifindent;
  5700   int lastst_true;
  5701 
  5702   ifindent=stmtindent;          /* save the indent of the "if" instruction */
  5703   flab1=getlabel();             /* get label number for false branch */
  5704   test(flab1,TEST_THEN,FALSE);  /* get expression, branch to flab1 if false */
  5705   statement(NULL,FALSE);        /* if true, do a statement */
  5706   if (!matchtoken(tELSE)) {     /* if...else ? */
  5707     setlabel(flab1);            /* no, simple if..., print false label */
  5708   } else {
  5709     lastst_true=lastst;         /* save last statement of the "true" branch */
  5710     /* to avoid the "dangling else" error, we want a warning if the "else"
  5711      * has a lower indent than the matching "if" */
  5712     if (stmtindent<ifindent && sc_tabsize>0)
  5713       error(217);               /* loose indentation */
  5714     flab2=getlabel();
  5715     if ((lastst!=tRETURN) && (lastst!=tGOTO))
  5716       jumplabel(flab2);         /* "true" branch jumps around "else" clause, unless the "true" branch statement already jumped */
  5717     setlabel(flab1);            /* print false label */
  5718     statement(NULL,FALSE);      /* do "else" clause */
  5719     setlabel(flab2);            /* print true label */
  5720     /* if both the "true" branch and the "false" branch ended with the same
  5721      * kind of statement, set the last statement id to that kind, rather than
  5722      * to the generic tIF; this allows for better "unreachable code" checking
  5723      */
  5724     if (lastst==lastst_true)
  5725       return lastst;
  5726   } /* if */
  5727   return tIF;
  5728 }
  5729 
  5730 static int dowhile(void)
  5731 {
  5732   int wq[wqSIZE];               /* allocate local queue */
  5733   int save_endlessloop,retcode;
  5734 
  5735   save_endlessloop=endlessloop;
  5736   addwhile(wq);                 /* add entry to queue for "break" */
  5737   setlabel(wq[wqLOOP]);         /* loop label */
  5738   /* The debugger uses the "break" opcode to be able to "break" out of
  5739    * a loop. To make sure that each loop has a break opcode, even for the
  5740    * tiniest loop, set it below the top of the loop
  5741    */
  5742   setline(TRUE);
  5743   endlessloop=test(wq[wqEXIT],TEST_DO,FALSE);/* branch to wq[wqEXIT] if false */
  5744   statement(NULL,FALSE);        /* if so, do a statement */
  5745   jumplabel(wq[wqLOOP]);        /* and loop to "while" start */
  5746   setlabel(wq[wqEXIT]);         /* exit label */
  5747   delwhile();                   /* delete queue entry */
  5748 
  5749   retcode=endlessloop ? tENDLESS : tWHILE;
  5750   endlessloop=save_endlessloop;
  5751   return retcode;
  5752 }
  5753 
  5754 /*
  5755  *  Note that "continue" will in this case not jump to the top of the loop, but
  5756  *  to the end: just before the TRUE-or-FALSE testing code.
  5757  */
  5758 static int dodo(void)
  5759 {
  5760   int wq[wqSIZE],top;
  5761   int save_endlessloop,retcode;
  5762 
  5763   save_endlessloop=endlessloop;
  5764   addwhile(wq);           /* see "dowhile" for more info */
  5765   top=getlabel();         /* make a label first */
  5766   setlabel(top);          /* loop label */
  5767   statement(NULL,FALSE);
  5768   needtoken(tWHILE);
  5769   setlabel(wq[wqLOOP]);   /* "continue" always jumps to WQLOOP. */
  5770   setline(TRUE);
  5771   endlessloop=test(wq[wqEXIT],TEST_OPT,FALSE);
  5772   jumplabel(top);
  5773   setlabel(wq[wqEXIT]);
  5774   delwhile();
  5775   needtoken(tTERM);
  5776 
  5777   retcode=endlessloop ? tENDLESS : tDO;
  5778   endlessloop=save_endlessloop;
  5779   return retcode;
  5780 }
  5781 
  5782 static int dofor(void)
  5783 {
  5784   int wq[wqSIZE],skiplab;
  5785   cell save_decl;
  5786   int save_nestlevel,save_endlessloop;
  5787   int index,endtok;
  5788   int *ptr;
  5789 
  5790   save_decl=declared;
  5791   save_nestlevel=nestlevel;
  5792   save_endlessloop=endlessloop;
  5793   pushstacklist();
  5794   
  5795   addwhile(wq);
  5796   skiplab=getlabel();
  5797   endtok= matchtoken('(') ? ')' : tDO;
  5798   if (matchtoken(';')==0) {
  5799     /* new variable declarations are allowed here */
  5800     if (matchtoken(tNEW)) {
  5801       /* The variable in expr1 of the for loop is at a
  5802        * 'compound statement' level of it own.
  5803        */
  5804       nestlevel++;
  5805       autozero=1;
  5806       declloc(FALSE); /* declare local variable */
  5807     } else {
  5808       doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE);  /* expression 1 */
  5809       needtoken(';');
  5810     } /* if */
  5811   } /* if */
  5812   /* Adjust the "declared" field in the "while queue", in case that
  5813    * local variables were declared in the first expression of the
  5814    * "for" loop. These are deleted in separately, so a "break" or a "continue"
  5815    * must ignore these fields.
  5816    */
  5817   ptr=readwhile();
  5818   assert(ptr!=NULL);
  5819   /*ptr[wqBRK]=(int)declared;
  5820    *ptr[wqCONT]=(int)declared;
  5821    */
  5822   ptr[wqBRK] = stackusage->list_id;
  5823   ptr[wqCONT] = stackusage->list_id;
  5824   jumplabel(skiplab);               /* skip expression 3 1st time */
  5825   setlabel(wq[wqLOOP]);             /* "continue" goes to this label: expr3 */
  5826   setline(TRUE);
  5827   /* Expressions 2 and 3 are reversed in the generated code: expression 3
  5828    * precedes expression 2. When parsing, the code is buffered and marks for
  5829    * the start of each expression are insterted in the buffer.
  5830    */
  5831   assert(!staging);
  5832   stgset(TRUE);                     /* start staging */
  5833   assert(stgidx==0);
  5834   index=stgidx;
  5835   stgmark(sSTARTREORDER);
  5836   stgmark((char)(sEXPRSTART+0));    /* mark start of 2nd expression in stage */
  5837   setlabel(skiplab);                /* jump to this point after 1st expression */
  5838   if (matchtoken(';')) {
  5839     endlessloop=1;
  5840   } else {
  5841     endlessloop=test(wq[wqEXIT],TEST_PLAIN,FALSE);/* expression 2 (jump to wq[wqEXIT] if false) */
  5842     needtoken(';');
  5843   } /* if */
  5844   stgmark((char)(sEXPRSTART+1));    /* mark start of 3th expression in stage */
  5845   if (!matchtoken(endtok)) {
  5846     doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE);    /* expression 3 */
  5847     needtoken(endtok);
  5848   } /* if */
  5849   stgmark(sENDREORDER);             /* mark end of reversed evaluation */
  5850   stgout(index);
  5851   stgset(FALSE);                    /* stop staging */
  5852   statement(NULL,FALSE);
  5853   jumplabel(wq[wqLOOP]);
  5854   setlabel(wq[wqEXIT]);
  5855   delwhile();
  5856 
  5857   assert(nestlevel>=save_nestlevel);
  5858   if (nestlevel>save_nestlevel) {
  5859     /* Clean up the space and the symbol table for the local
  5860      * variable in "expr1".
  5861      */
  5862     destructsymbols(&loctab,nestlevel);
  5863     popstacklist(1);
  5864     testsymbols(&loctab,nestlevel,FALSE,TRUE);  /* look for unused block locals */
  5865     declared=save_decl;
  5866     delete_symbols(&loctab,nestlevel,FALSE,TRUE);
  5867     nestlevel=save_nestlevel;     /* reset 'compound statement' nesting level */
  5868   } /* if */
  5869 
  5870   index=endlessloop ? tENDLESS : tFOR;
  5871   endlessloop=save_endlessloop;
  5872   return index;
  5873 }
  5874 
  5875 /* The switch statement is incompatible with its C sibling:
  5876  * 1. the cases are not drop through
  5877  * 2. only one instruction may appear below each case, use a compound
  5878  *    instruction to execute multiple instructions
  5879  * 3. the "case" keyword accepts a comma separated list of values to
  5880  *    match
  5881  *
  5882  * SWITCH param
  5883  *   PRI = expression result
  5884  *   param = table offset (code segment)
  5885  *
  5886  */
  5887 static void doswitch(void)
  5888 {
  5889   int lbl_table,lbl_exit,lbl_case;
  5890   int swdefault,casecount;
  5891   int tok,endtok;
  5892   cell val;
  5893   char *str;
  5894   constvalue caselist = { NULL, "", 0, 0};   /* case list starts empty */
  5895   constvalue *cse,*csp;
  5896   char labelname[sNAMEMAX+1];
  5897 
  5898   endtok= matchtoken('(') ? ')' : tDO;
  5899   doexpr(TRUE,FALSE,FALSE,FALSE,NULL,NULL,TRUE);/* evaluate switch expression */
  5900   needtoken(endtok);
  5901   /* generate the code for the switch statement, the label is the address
  5902    * of the case table (to be generated later).
  5903    */
  5904   lbl_table=getlabel();
  5905   lbl_case=0;                   /* just to avoid a compiler warning */
  5906   ffswitch(lbl_table);
  5907 
  5908   if (matchtoken(tBEGIN)) {
  5909     endtok=tEND;
  5910   } else {
  5911     endtok='}';
  5912     needtoken('{');
  5913   } /* if */
  5914   lbl_exit=getlabel();          /* get label number for jumping out of switch */
  5915   swdefault=FALSE;
  5916   casecount=0;
  5917   do {
  5918     tok=lex(&val,&str);         /* read in (new) token */
  5919     switch (tok) {
  5920     case tCASE:
  5921       if (swdefault!=FALSE)
  5922         error(15);        /* "default" case must be last in switch statement */
  5923       lbl_case=getlabel();
  5924       PUSHSTK_I(sc_allowtags);
  5925       sc_allowtags=FALSE; /* do not allow tagnames here */
  5926       do {
  5927         casecount++;
  5928 
  5929         /* ??? enforce/document that, in a switch, a statement cannot start
  5930          *     with a label. Then, you can search for:
  5931          *     * the first semicolon (marks the end of a statement)
  5932          *     * an opening brace (marks the start of a compound statement)
  5933          *     and search for the right-most colon before that statement
  5934          *     Now, by replacing the ':' by a special COLON token, you can
  5935          *     parse all expressions until that special token.
  5936          */
  5937 
  5938         constexpr(&val,NULL,NULL);
  5939         /* Search the insertion point (the table is kept in sorted order, so
  5940          * that advanced abstract machines can sift the case table with a
  5941          * binary search). Check for duplicate case values at the same time.
  5942          */
  5943         for (csp=&caselist, cse=caselist.next;
  5944              cse!=NULL && cse->value<val;
  5945              csp=cse, cse=cse->next)
  5946           /* nothing */;
  5947         if (cse!=NULL && cse->value==val)
  5948           error(40,val);                /* duplicate "case" label */
  5949         /* Since the label is stored as a string in the "constvalue", the
  5950          * size of an identifier must be at least 8, as there are 8
  5951          * hexadecimal digits in a 32-bit number.
  5952          */
  5953         #if sNAMEMAX < 8
  5954           #error Length of identifier (sNAMEMAX) too small.
  5955         #endif
  5956         assert(csp!=NULL);
  5957         assert(csp->next==cse);
  5958         insert_constval(csp,cse,itoh(lbl_case),val,0);
  5959         if (matchtoken(tDBLDOT)) {
  5960           error(1, ":", "..");
  5961         } /* if */
  5962       } while (matchtoken(','));
  5963       needtoken(':');                   /* ':' ends the case */
  5964       sc_allowtags=(short)POPSTK_I();   /* reset */
  5965       setlabel(lbl_case);
  5966       statement(NULL,FALSE);
  5967       jumplabel(lbl_exit);
  5968       break;
  5969     case tDEFAULT:
  5970       if (swdefault!=FALSE)
  5971         error(16);         /* multiple defaults in switch */
  5972       lbl_case=getlabel();
  5973       setlabel(lbl_case);
  5974       needtoken(':');
  5975       swdefault=TRUE;
  5976       statement(NULL,FALSE);
  5977       /* Jump to lbl_exit, even thouh this is the last clause in the
  5978        * switch, because the jump table is generated between the last
  5979        * clause of the switch and the exit label.
  5980        */
  5981       jumplabel(lbl_exit);
  5982       break;
  5983     default:
  5984       if (tok!=endtok) {
  5985         error(2);
  5986         indent_nowarn=TRUE; /* disable this check */
  5987         tok=endtok;     /* break out of the loop after an error */
  5988       } /* if */
  5989     } /* switch */
  5990   } while (tok!=endtok);
  5991 
  5992   #if !defined NDEBUG
  5993     /* verify that the case table is sorted (unfortunatly, duplicates can
  5994      * occur; there really shouldn't be duplicate cases, but the compiler
  5995      * may not crash or drop into an assertion for a user error). */
  5996     for (cse=caselist.next; cse!=NULL && cse->next!=NULL; cse=cse->next)
  5997       assert(cse->value <= cse->next->value);
  5998   #endif
  5999   /* generate the table here, before lbl_exit (general jump target) */
  6000   setlabel(lbl_table);
  6001   assert(swdefault==FALSE || swdefault==TRUE);
  6002   if (swdefault==FALSE) {
  6003     /* store lbl_exit as the "none-matched" label in the switch table */
  6004     strcpy(labelname,itoh(lbl_exit));
  6005   } else {
  6006     /* lbl_case holds the label of the "default" clause */
  6007     strcpy(labelname,itoh(lbl_case));
  6008   } /* if */
  6009   ffcase(casecount,labelname,TRUE);
  6010   /* generate the rest of the table */
  6011   for (cse=caselist.next; cse!=NULL; cse=cse->next)
  6012     ffcase(cse->value,cse->name,FALSE);
  6013 
  6014   setlabel(lbl_exit);
  6015   delete_consttable(&caselist); /* clear list of case labels */
  6016 }
  6017 
  6018 static void doassert(void)
  6019 {
  6020   int flab1,index;
  6021   cell cidx;
  6022 
  6023   if ((sc_debug & sCHKBOUNDS)!=0) {
  6024     flab1=getlabel();           /* get label number for "OK" branch */
  6025     test(flab1,TEST_PLAIN,TRUE);/* get expression and branch to flab1 if true */
  6026     insert_dbgline(fline);      /* make sure we can find the correct line number */
  6027     ffabort(xASSERTION);
  6028     setlabel(flab1);
  6029   } else {
  6030     stgset(TRUE);               /* start staging */
  6031     stgget(&index,&cidx);       /* mark position in code generator */
  6032     do {
  6033       expression(NULL,NULL,NULL,FALSE,NULL);
  6034       stgdel(index,cidx);       /* just scrap the code */
  6035     } while (matchtoken(','));
  6036     stgset(FALSE);              /* stop staging */
  6037   } /* if */
  6038   needtoken(tTERM);
  6039 }
  6040 
  6041 static void dogoto(void)
  6042 {
  6043   char *st;
  6044   cell val;
  6045   symbol *sym;
  6046 
  6047   /* if we were inside an endless loop, assume that we jump out of it */
  6048   endlessloop=0;
  6049 
  6050   if (lex(&val,&st)==tSYMBOL) {
  6051     sym=fetchlab(st);
  6052     jumplabel((int)sym->addr);
  6053     sym->usage|=uREAD;  /* set "uREAD" bit */
  6054     // ??? if the label is defined (check sym->usage & uDEFINE), check
  6055     //     sym->compound (nesting level of the label) against nestlevel;
  6056     //     if sym->compound < nestlevel, call the destructor operator
  6057   } else {
  6058     error(20,st);       /* illegal symbol name */
  6059   } /* if */
  6060   needtoken(tTERM);
  6061 }
  6062 
  6063 static void dolabel(void)
  6064 {
  6065   char *st;
  6066   cell val;
  6067   symbol *sym;
  6068 
  6069   tokeninfo(&val,&st);  /* retrieve label name again */
  6070   if (find_constval(&tagname_tab,st,0)!=NULL)
  6071     error(221,st);      /* label name shadows tagname */
  6072   sym=fetchlab(st);
  6073   setlabel((int)sym->addr);
  6074   /* since one can jump around variable declarations or out of compound
  6075    * blocks, the stack must be manually adjusted
  6076    */
  6077   //:TODO: This is actually generated, egads!
  6078   //We have to support this and LCTRL/SCTRL
  6079   setstk(-declared*sizeof(cell));
  6080   sym->usage|=uDEFINE;  /* label is now defined */
  6081 }
  6082 
  6083 /*  fetchlab
  6084  *
  6085  *  Finds a label from the (local) symbol table or adds one to it.
  6086  *  Labels are local in scope.
  6087  *
  6088  *  Note: The "_usage" bit is set to zero. The routines that call "fetchlab()"
  6089  *        must set this bit accordingly.
  6090  */
  6091 static symbol *fetchlab(char *name)
  6092 {
  6093   symbol *sym;
  6094 
  6095   sym=findloc(name);            /* labels are local in scope */
  6096   if (sym){
  6097     if (sym->ident!=iLABEL)
  6098       error(19,sym->name);      /* not a label: ... */
  6099   } else {
  6100     sym=addsym(name,getlabel(),iLABEL,sLOCAL,0,0);
  6101     assert(sym!=NULL);          /* fatal error 103 must be given on error */
  6102     sym->x.declared=(int)declared;
  6103     sym->compound=nestlevel;
  6104   } /* if */
  6105   return sym;
  6106 }
  6107 
  6108 /*  doreturn
  6109  *
  6110  *  Global references: rettype  (altered)
  6111  */
  6112 static void doreturn(void)
  6113 {
  6114   int tag,ident;
  6115   int level;
  6116   symbol *sym,*sub;
  6117 
  6118   if (!matchtoken(tTERM)) {
  6119     /* "return <value>" */
  6120     if ((rettype & uRETNONE)!=0)
  6121       error(78);                        /* mix "return;" and "return value;" */
  6122     ident=doexpr(TRUE,FALSE,TRUE,FALSE,&tag,&sym,TRUE);
  6123     needtoken(tTERM);
  6124     /* see if this function already has a sub type (an array attached) */
  6125     sub=finddepend(curfunc);
  6126     assert(sub==NULL || sub->ident==iREFARRAY);
  6127     if ((rettype & uRETVALUE)!=0) {
  6128       int retarray=(ident==iARRAY || ident==iREFARRAY);
  6129       /* there was an earlier "return" statement in this function */
  6130       if (sub==NULL && retarray || sub!=NULL && !retarray)
  6131         error(79);                      /* mixing "return array;" and "return value;" */
  6132       if (retarray && (curfunc->usage & uPUBLIC)!=0)
  6133         error(90,curfunc->name);        /* public function may not return array */
  6134     } /* if */
  6135     rettype|=uRETVALUE;                 /* function returns a value */
  6136     /* check tagname with function tagname */
  6137     assert(curfunc!=NULL);
  6138     if (!matchtag_string(ident, tag) && !matchtag(curfunc->tag,tag,TRUE))
  6139       error(213);                       /* tagname mismatch */
  6140     if (ident==iARRAY || ident==iREFARRAY) {
  6141       int dim[sDIMEN_MAX],numdim;
  6142       cell arraysize;
  6143       assert(sym!=NULL);
  6144       if (sub!=NULL) {
  6145         assert(sub->ident==iREFARRAY);
  6146         /* this function has an array attached already; check that the current
  6147          * "return" statement returns exactly the same array
  6148          */
  6149         level=sym->dim.array.level;
  6150         if (sub->dim.array.level!=level) {
  6151           error(48);                    /* array dimensions must match */
  6152         } else {
  6153           for (numdim=0; numdim<=level; numdim++) {
  6154             dim[numdim]=(int)sub->dim.array.length;
  6155             if (sym->dim.array.length!=dim[numdim])
  6156               error(47);    /* array sizes must match */
  6157             if (numdim<level) {
  6158               sym=finddepend(sym);
  6159               sub=finddepend(sub);
  6160               assert(sym!=NULL && sub!=NULL);
  6161               /* ^^^ both arrays have the same dimensions (this was checked
  6162                *     earlier) so the dependend should always be found
  6163                */
  6164             } /* if */
  6165           } /* for */
  6166         } /* if */
  6167       } else {
  6168         int idxtag[sDIMEN_MAX];
  6169         int argcount;
  6170         /* this function does not yet have an array attached; clone the
  6171          * returned symbol beneath the current function
  6172          */
  6173         sub=sym;
  6174         assert(sub!=NULL);
  6175         level=sub->dim.array.level;
  6176         for (numdim=0; numdim<=level; numdim++) {
  6177           dim[numdim]=(int)sub->dim.array.length;
  6178           idxtag[numdim]=sub->x.tags.index;
  6179           if (numdim<level) {
  6180             sub=finddepend(sub);
  6181             assert(sub!=NULL);
  6182           } /* if */
  6183           /* check that all dimensions are known */
  6184           if (dim[numdim]<=0)
  6185             error(46,sym->name);
  6186         } /* for */
  6187         /* the address of the array is stored in a hidden parameter; the address
  6188          * of this parameter is 1 + the number of parameters (times the size of
  6189          * a cell) + the size of the stack frame and the return address
  6190          *   base + 0*sizeof(cell)         == previous "base"
  6191          *   base + 1*sizeof(cell)         == function return address
  6192          *   base + 2*sizeof(cell)         == number of arguments
  6193          *   base + 3*sizeof(cell)         == first argument of the function
  6194          *   ...
  6195          *   base + ((n-1)+3)*sizeof(cell) == last argument of the function
  6196          *   base + (n+3)*sizeof(cell)     == hidden parameter with array address
  6197          */
  6198         assert(curfunc!=NULL);
  6199         assert(curfunc->dim.arglist!=NULL);
  6200         for (argcount=0; curfunc->dim.arglist[argcount].ident!=0; argcount++)
  6201           /* nothing */;
  6202         sub=addvariable(curfunc->name,(argcount+3)*sizeof(cell),iREFARRAY,sGLOBAL,curfunc->tag,dim,numdim,idxtag);
  6203         sub->parent=curfunc;
  6204       } /* if */
  6205       /* get the hidden parameter, copy the array (the array is on the heap;
  6206        * it stays on the heap for the moment, and it is removed -usually- at
  6207        * the end of the expression/statement, see expression() in SC3.C)
  6208        */
  6209       address(sub,sALT);                /* ALT = destination */
  6210       arraysize=calc_arraysize(dim,numdim,0);
  6211       memcopy(arraysize*sizeof(cell));  /* source already in PRI */
  6212       /* moveto1(); is not necessary, callfunction() does a popreg() */
  6213     } /* if */
  6214   } else {
  6215     /* this return statement contains no expression */
  6216     ldconst(0,sPRI);
  6217     if ((rettype & uRETVALUE)!=0) {
  6218       char symname[2*sNAMEMAX+16];      /* allow space for user defined operators */
  6219       assert(curfunc!=NULL);
  6220       funcdisplayname(symname,curfunc->name);
  6221       error(209,symname);               /* function should return a value */
  6222     } /* if */
  6223     rettype|=uRETNONE;                  /* function does not return anything */
  6224   } /* if */
  6225   destructsymbols(&loctab,0);           /* call destructor for *all* locals */
  6226   genheapfree(-1);
  6227   genstackfree(-1);						/* free everything on the stack */
  6228   ffret(strcmp(curfunc->name,uENTRYFUNC)!=0);
  6229 }
  6230 
  6231 static void dobreak(void)
  6232 {
  6233   int *ptr;
  6234 
  6235   endlessloop=0;      /* if we were inside an endless loop, we just jumped out */
  6236   ptr=readwhile();      /* readwhile() gives an error if not in loop */
  6237   needtoken(tTERM);
  6238   if (ptr==NULL)
  6239     return;
  6240   destructsymbols(&loctab,nestlevel);
  6241   genstackfree(ptr[wqBRK]);
  6242   jumplabel(ptr[wqEXIT]);
  6243 }
  6244 
  6245 static void docont(void)
  6246 {
  6247   int *ptr;
  6248 
  6249   ptr=readwhile();      /* readwhile() gives an error if not in loop */
  6250   needtoken(tTERM);
  6251   if (ptr==NULL)
  6252     return;
  6253   destructsymbols(&loctab,nestlevel);
  6254   genstackfree(ptr[wqCONT]);
  6255   genheapfree(ptr[wqCONT]);
  6256   jumplabel(ptr[wqLOOP]);
  6257 }
  6258 
  6259 SC_FUNC void exporttag(int tag)
  6260 {
  6261   /* find the tag by value in the table, then set the top bit to mark it
  6262    * "public"
  6263    */
  6264   if (tag!=0 && (tag & PUBLICTAG)==0) {
  6265     constvalue *ptr;
  6266     for (ptr=tagname_tab.next; ptr!=NULL && tag!=(int)(ptr->value & TAGMASK); ptr=ptr->next)
  6267       /* nothing */;
  6268     if (ptr!=NULL)
  6269       ptr->value |= PUBLICTAG;
  6270   } /* if */
  6271 }
  6272 
  6273 static void doexit(void)
  6274 {
  6275   int tag=0;
  6276 
  6277   if (matchtoken(tTERM)==0){
  6278     doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
  6279     needtoken(tTERM);
  6280   } else {
  6281     ldconst(0,sPRI);
  6282   } /* if */
  6283   ldconst(tag,sALT);
  6284   exporttag(tag);
  6285   destructsymbols(&loctab,0);           /* call destructor for *all* locals */
  6286   ffabort(xEXIT);
  6287 }
  6288 
  6289 static void dosleep(void)
  6290 {
  6291   int tag=0;
  6292 
  6293   if (matchtoken(tTERM)==0){
  6294     doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
  6295     needtoken(tTERM);
  6296   } else {
  6297     ldconst(0,sPRI);
  6298   } /* if */
  6299   ldconst(tag,sALT);
  6300   exporttag(tag);
  6301   ffabort(xSLEEP);
  6302 
  6303   /* for stack usage checking, mark the use of the sleep instruction */
  6304   pc_memflags |= suSLEEP_INSTR;
  6305 }
  6306 
  6307 static void dostate(void)
  6308 {
  6309   char name[sNAMEMAX+1];
  6310   constvalue *automaton;
  6311   constvalue *state;
  6312   constvalue *stlist;
  6313   int flabel;
  6314   symbol *sym;
  6315   #if !defined SC_LIGHT
  6316     int length,index,listid,listindex,stateindex;
  6317     char *doc;
  6318   #endif
  6319 
  6320   /* check for an optional condition */
  6321   if (matchtoken('(')) {
  6322     flabel=getlabel();          /* get label number for "false" branch */
  6323     pc_docexpr=TRUE;            /* attach expression as a documentation string */
  6324     test(flabel,TEST_PLAIN,FALSE);/* get expression, branch to flabel if false */
  6325     pc_docexpr=FALSE;
  6326     needtoken(')');
  6327   } else {
  6328     flabel=-1;
  6329   } /* if */
  6330 
  6331   if (!sc_getstateid(&automaton,&state)) {
  6332     delete_autolisttable();
  6333     return;
  6334   } /* if */
  6335   needtoken(tTERM);
  6336 
  6337   /* store the new state id */
  6338   assert(state!=NULL);
  6339   ldconst(state->value,sPRI);
  6340   assert(automaton!=NULL);
  6341   assert(automaton->index==0 && automaton->name[0]=='\0' || automaton->index>0);
  6342   storereg(automaton->value,sPRI);
  6343 
  6344   /* find the optional entry() function for the state */
  6345   sym=findglb(uENTRYFUNC,sGLOBAL);
  6346   if (sc_status==statWRITE && sym!=NULL && sym->ident==iFUNCTN && sym->states!=NULL) {
  6347     for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
  6348       assert(strlen(stlist->name)!=0);
  6349       if (state_getfsa(stlist->index)==automaton->index && state_inlist(stlist->index,(int)state->value))
  6350         break;      /* found! */
  6351     } /* for */
  6352     assert(stlist==NULL || state_inlist(stlist->index,state->value));
  6353     if (stlist!=NULL) {
  6354       /* the label to jump to is in stlist->name */
  6355       ffcall(sym,stlist->name,0);
  6356     } /* if */
  6357   } /* if */
  6358 
  6359   if (flabel>=0)
  6360     setlabel(flabel);           /* condition was false, jump around the state switch */
  6361 
  6362   #if !defined SC_LIGHT
  6363     /* mark for documentation */
  6364     if (sc_status==statFIRST) {
  6365       char *str;
  6366       /* get the last list id attached to the function, this contains the source states */
  6367       assert(curfunc!=NULL);
  6368       if (curfunc->states!=NULL) {
  6369         stlist=curfunc->states->next;
  6370         assert(stlist!=NULL);
  6371         while (stlist->next!=NULL)
  6372           stlist=stlist->next;
  6373         listid=stlist->index;
  6374       } else {
  6375         listid=-1;
  6376       } /* if */
  6377       listindex=0;
  6378       length=strlen(name)+70; /* +70 for the fixed part "<transition ... />\n" */
  6379       /* see if there are any condition strings to attach */
  6380       for (index=0; (str=get_autolist(index))!=NULL; index++)
  6381         length+=strlen(str);
  6382       if ((doc=(char*)malloc(length*sizeof(char)))!=NULL) {
  6383         do {
  6384           sprintf(doc,"<transition target=\"%s\"",name);
  6385           if (listid>=0) {
  6386             /* get the source state */
  6387             stateindex=state_listitem(listid,listindex);
  6388             state=state_findid(stateindex);
  6389             assert(state!=NULL);
  6390             sprintf(doc+strlen(doc)," source=\"%s\"",state->name);
  6391           } /* if */
  6392           if (get_autolist(0)!=NULL) {
  6393             /* add the condition */
  6394             strcat(doc," condition=\"");
  6395             for (index=0; (str=get_autolist(index))!=NULL; index++) {
  6396               /* remove the ')' token that may be appended before detecting that the expression has ended */
  6397               if (*str!=')' || *(str+1)!='\0' || get_autolist(index+1)!=NULL)
  6398                 strcat(doc,str);
  6399             } /* for */
  6400             strcat(doc,"\"");
  6401           } /* if */
  6402           strcat(doc,"/>\n");
  6403           insert_docstring(doc);
  6404         } while (listid>=0 && ++listindex<state_count(listid));
  6405         free(doc);
  6406       } /* if */
  6407     } /* if */
  6408   #endif
  6409   delete_autolisttable();
  6410 }
  6411 
  6412 
  6413 static void addwhile(int *ptr)
  6414 {
  6415   int k;
  6416 
  6417   ptr[wqBRK]=(int)declared;     /* stack pointer (for "break") */
  6418   ptr[wqCONT]=(int)declared;    /* for "continue", possibly adjusted later */
  6419   ptr[wqLOOP]=getlabel();
  6420   ptr[wqEXIT]=getlabel();
  6421   if (wqptr>=(wq+wqTABSZ-wqSIZE))
  6422     error(102,"loop table");    /* loop table overflow (too many active loops)*/
  6423   k=0;
  6424   while (k<wqSIZE){     /* copy "ptr" to while queue table */
  6425     *wqptr=*ptr;
  6426     wqptr+=1;
  6427     ptr+=1;
  6428     k+=1;
  6429   } /* while */
  6430 }
  6431 
  6432 static void delwhile(void)
  6433 {
  6434   if (wqptr>wq)
  6435     wqptr-=wqSIZE;
  6436 }
  6437 
  6438 static int *readwhile(void)
  6439 {
  6440   if (wqptr<=wq){
  6441     error(24);          /* out of context */
  6442     return NULL;
  6443   } else {
  6444     return (wqptr-wqSIZE);
  6445   } /* if */
  6446 }
  6447