1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/sourcepawn/compiler/sc1.c Sun Jul 06 04:49:55 2008 +0000
1.3 @@ -0,0 +1,6665 @@
1.4 +/* Pawn compiler
1.5 + *
1.6 + * Function and variable definition and declaration, statement parser.
1.7 + *
1.8 + * Copyright (c) ITB CompuPhase, 1997-2006
1.9 + *
1.10 + * This software is provided "as-is", without any express or implied warranty.
1.11 + * In no event will the authors be held liable for any damages arising from
1.12 + * the use of this software.
1.13 + *
1.14 + * Permission is granted to anyone to use this software for any purpose,
1.15 + * including commercial applications, and to alter it and redistribute it
1.16 + * freely, subject to the following restrictions:
1.17 + *
1.18 + * 1. The origin of this software must not be misrepresented; you must not
1.19 + * claim that you wrote the original software. If you use this software in
1.20 + * a product, an acknowledgment in the product documentation would be
1.21 + * appreciated but is not required.
1.22 + * 2. Altered source versions must be plainly marked as such, and must not be
1.23 + * misrepresented as being the original software.
1.24 + * 3. This notice may not be removed or altered from any source distribution.
1.25 + *
1.26 + * Version: $Id$
1.27 + */
1.28 +#include <assert.h>
1.29 +#include <ctype.h>
1.30 +#include <limits.h>
1.31 +#include <stdarg.h>
1.32 +#include <stdio.h>
1.33 +#include <stdlib.h>
1.34 +#include <string.h>
1.35 +
1.36 +#if defined __WIN32__ || defined _WIN32 || defined __MSDOS__
1.37 + #include <conio.h>
1.38 + #include <io.h>
1.39 +#endif
1.40 +
1.41 +#if defined LINUX || defined __FreeBSD__ || defined __OpenBSD__
1.42 + #include <sclinux.h>
1.43 + #include <binreloc.h> /* from BinReloc, see www.autopackage.org */
1.44 +#endif
1.45 +
1.46 +#if defined FORTIFY
1.47 + #include <alloc/fortify.h>
1.48 +#endif
1.49 +
1.50 +#if defined __BORLANDC__ || defined __WATCOMC__
1.51 + #include <dos.h>
1.52 + static unsigned total_drives; /* dummy variable */
1.53 + #define dos_setdrive(i) _dos_setdrive(i,&total_drives)
1.54 +#elif defined _MSC_VER && defined _WIN32
1.55 + #include <direct.h> /* for _chdrive() */
1.56 + #define dos_setdrive(i) _chdrive(i)
1.57 +#endif
1.58 +#if defined __BORLANDC__
1.59 + #include <dir.h> /* for chdir() */
1.60 +#elif defined __WATCOMC__
1.61 + #include <direct.h> /* for chdir() */
1.62 +#endif
1.63 +#if defined __WIN32__ || defined _WIN32 || defined _Windows
1.64 + #include <windows.h>
1.65 +#endif
1.66 +
1.67 +#include <time.h>
1.68 +
1.69 +#include "lstring.h"
1.70 +#include "sc.h"
1.71 +#include "svn_version.h"
1.72 +#include "sctracker.h"
1.73 +#define VERSION_STR "3.2.3636"
1.74 +#define VERSION_INT 0x0302
1.75 +
1.76 +int pc_anytag = 0;
1.77 +int pc_functag = 0;
1.78 +int pc_tag_string = 0;
1.79 +
1.80 +static void resetglobals(void);
1.81 +static void initglobals(void);
1.82 +static char *get_extension(char *filename);
1.83 +static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
1.84 + char *rname,char *codepage);
1.85 +static void setconfig(char *root);
1.86 +static void setcaption(void);
1.87 +static void about(void);
1.88 +static void setconstants(void);
1.89 +static void parse(void);
1.90 +static void dumplits(void);
1.91 +static void dumpzero(int count);
1.92 +static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst);
1.93 +static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,
1.94 + int stock,int fconst);
1.95 +static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct);
1.96 +static int declloc(int fstatic);
1.97 +static void decl_const(int table);
1.98 +static void declstruct();
1.99 +static void decl_enum(int table);
1.100 +static cell needsub(int *tag,constvalue **enumroot);
1.101 +static void initials(int ident,int tag,cell *size,int dim[],int numdim,
1.102 + constvalue *enumroot);
1.103 +static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
1.104 + int startlit,int counteddim[],constvalue *lastdim,
1.105 + constvalue *enumroot,int *errorfound);
1.106 +static cell initvector(int ident,int tag,cell size,int fillzero,
1.107 + constvalue *enumroot,int *errorfound);
1.108 +static cell init(int ident,int *tag,int *errorfound);
1.109 +static int getstates(const char *funcname);
1.110 +static void attachstatelist(symbol *sym, int state_id);
1.111 +static void funcstub(int fnative);
1.112 +static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock);
1.113 +static int declargs(symbol *sym,int chkshadow);
1.114 +static void doarg(char *name,int ident,int offset,int tags[],int numtags,
1.115 + int fpublic,int fconst,int chkshadow,arginfo *arg);
1.116 +static void make_report(symbol *root,FILE *log,char *sourcefile);
1.117 +static void reduce_referrers(symbol *root);
1.118 +static long max_stacksize(symbol *root,int *recursion);
1.119 +static int testsymbols(symbol *root,int level,int testlabs,int testconst);
1.120 +static void destructsymbols(symbol *root,int level);
1.121 +static constvalue *find_constval_byval(constvalue *table,cell val);
1.122 +static symbol *fetchlab(char *name);
1.123 +static void statement(int *lastindent,int allow_decl);
1.124 +static void compound(int stmt_sameline,int starttok);
1.125 +static int test(int label,int parens,int invert);
1.126 +static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
1.127 + int *tag,symbol **symptr,int chkfuncresult);
1.128 +static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
1.129 + int *tag,symbol **symptr,int chkfuncresult,value *lval);
1.130 +static void doassert(void);
1.131 +static void doexit(void);
1.132 +static int doif(void);
1.133 +static int dowhile(void);
1.134 +static int dodo(void);
1.135 +static int dofor(void);
1.136 +static void doswitch(void);
1.137 +static void dogoto(void);
1.138 +static void dolabel(void);
1.139 +static void doreturn(void);
1.140 +static void dofuncenum(int listmode);
1.141 +static void dobreak(void);
1.142 +static void docont(void);
1.143 +static void dosleep(void);
1.144 +static void dostate(void);
1.145 +static void addwhile(int *ptr);
1.146 +static void delwhile(void);
1.147 +static int *readwhile(void);
1.148 +static void inst_datetime_defines(void);
1.149 +static void inst_binary_name(char *binfname);
1.150 +
1.151 +enum {
1.152 + TEST_PLAIN, /* no parentheses */
1.153 + TEST_THEN, /* '(' <expr> ')' or <expr> 'then' */
1.154 + TEST_DO, /* '(' <expr> ')' or <expr> 'do' */
1.155 + TEST_OPT, /* '(' <expr> ')' or <expr> */
1.156 +};
1.157 +static int norun = 0; /* the compiler never ran */
1.158 +static int autozero = 1; /* if 1 will zero out the variable, if 0 omit the zeroing */
1.159 +static int lastst = 0; /* last executed statement type */
1.160 +static int nestlevel = 0; /* number of active (open) compound statements */
1.161 +static int endlessloop= 0; /* nesting level of endless loop */
1.162 +static int rettype = 0; /* the type that a "return" expression should have */
1.163 +static int skipinput = 0; /* number of lines to skip from the first input file */
1.164 +static int optproccall = TRUE; /* support "procedure call" */
1.165 +static int verbosity = 1; /* verbosity level, 0=quiet, 1=normal, 2=verbose */
1.166 +static int sc_reparse = 0; /* needs 3th parse because of changed prototypes? */
1.167 +static int sc_parsenum = 0; /* number of the extra parses */
1.168 +static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
1.169 +static int *wqptr; /* pointer to next entry */
1.170 +#if !defined SC_LIGHT
1.171 + static char sc_rootpath[_MAX_PATH];
1.172 + static char *sc_documentation=NULL;/* main documentation */
1.173 +#endif
1.174 +#if defined __WIN32__ || defined _WIN32 || defined _Windows
1.175 + static HWND hwndFinish = 0;
1.176 +#endif
1.177 +
1.178 +SC_VDECL int glbstringread = 0;
1.179 +char g_tmpfile[_MAX_PATH] = {0};
1.180 +
1.181 +/* "main" of the compiler
1.182 + */
1.183 +#if defined __cplusplus
1.184 + extern "C"
1.185 +#endif
1.186 +int pc_compile(int argc, char *argv[])
1.187 +{
1.188 + int entry,i,jmpcode;
1.189 + int retcode;
1.190 + char incfname[_MAX_PATH];
1.191 + char reportname[_MAX_PATH];
1.192 + char codepage[MAXCODEPAGE+1];
1.193 + FILE *binf;
1.194 + void *inpfmark;
1.195 + int lcl_packstr,lcl_needsemicolon,lcl_tabsize;
1.196 + #if !defined SC_LIGHT
1.197 + int hdrsize=0;
1.198 + #endif
1.199 + char *ptr;
1.200 +
1.201 + /* set global variables to their initial value */
1.202 + binf=NULL;
1.203 + initglobals();
1.204 + errorset(sRESET,0);
1.205 + errorset(sEXPRRELEASE,0);
1.206 + lexinit();
1.207 +
1.208 + /* make sure that we clean up on a fatal error; do this before the first
1.209 + * call to error(). */
1.210 + if ((jmpcode=setjmp(errbuf))!=0)
1.211 + goto cleanup;
1.212 +
1.213 + /* allocate memory for fixed tables */
1.214 + inpfname=(char*)malloc(_MAX_PATH);
1.215 + if (inpfname==NULL)
1.216 + error(123); /* insufficient memory */
1.217 + litq=(cell*)malloc(litmax*sizeof(cell));
1.218 + if (litq==NULL)
1.219 + error(123); /* insufficient memory */
1.220 + if (!phopt_init())
1.221 + error(123); /* insufficient memory */
1.222 +
1.223 + setopt(argc,argv,outfname,errfname,incfname,reportname,codepage);
1.224 + strcpy(binfname,outfname);
1.225 + ptr=get_extension(binfname);
1.226 + if (ptr!=NULL && stricmp(ptr,".asm")==0)
1.227 + set_extension(binfname,".smx",TRUE);
1.228 + else
1.229 + set_extension(binfname,".smx",FALSE);
1.230 + /* set output names that depend on the input name */
1.231 + if (sc_listing)
1.232 + set_extension(outfname,".lst",TRUE);
1.233 + else
1.234 + set_extension(outfname,".asm",TRUE);
1.235 + if (strlen(errfname)!=0)
1.236 + remove(errfname); /* delete file on startup */
1.237 + else if (verbosity>0)
1.238 + setcaption();
1.239 + setconfig(argv[0]); /* the path to the include and codepage files */
1.240 + sc_ctrlchar_org=sc_ctrlchar;
1.241 + lcl_packstr=sc_packstr;
1.242 + lcl_needsemicolon=sc_needsemicolon;
1.243 + lcl_tabsize=sc_tabsize;
1.244 + #if !defined NO_CODEPAGE
1.245 + if (!cp_set(codepage)) /* set codepage */
1.246 + error(128); /* codepage mapping file not found */
1.247 + #endif
1.248 + /* optionally create a temporary input file that is a collection of all
1.249 + * input files
1.250 + */
1.251 + assert(get_sourcefile(0)!=NULL); /* there must be at least one source file */
1.252 + if (get_sourcefile(1)!=NULL) {
1.253 + /* there are at least two or more source files */
1.254 + char *tname,*sname;
1.255 + FILE *ftmp,*fsrc;
1.256 + int fidx;
1.257 + #if defined __WIN32__ || defined _WIN32
1.258 + tname=_tempnam(NULL,"pawn");
1.259 + #elif defined __MSDOS__ || defined _Windows
1.260 + tname=tempnam(NULL,"pawn");
1.261 + #elif defined(MACOS) && !defined(__MACH__)
1.262 + /* tempnam is not supported for the Macintosh CFM build. */
1.263 + error(124,get_sourcefile(1));
1.264 + tname=NULL;
1.265 + sname=NULL;
1.266 + #else
1.267 + tname=tempnam(NULL,"pawn");
1.268 + #endif
1.269 + ftmp=(FILE*)pc_createsrc(tname);
1.270 + for (fidx=0; (sname=get_sourcefile(fidx))!=NULL; fidx++) {
1.271 + unsigned char tstring[128];
1.272 + fsrc=(FILE*)pc_opensrc(sname);
1.273 + if (fsrc==NULL) {
1.274 + pc_closesrc(ftmp);
1.275 + remove(tname);
1.276 + strcpy(inpfname,sname); /* avoid invalid filename */
1.277 + error(120,sname);
1.278 + } /* if */
1.279 + pc_writesrc(ftmp,(unsigned char*)"#file \"");
1.280 + pc_writesrc(ftmp,(unsigned char*)sname);
1.281 + pc_writesrc(ftmp,(unsigned char*)"\"\n");
1.282 + while (!pc_eofsrc(fsrc) && pc_readsrc(fsrc,tstring,sizeof tstring)) {
1.283 + pc_writesrc(ftmp,tstring);
1.284 + } /* while */
1.285 + pc_closesrc(fsrc);
1.286 + } /* for */
1.287 + pc_closesrc(ftmp);
1.288 + strcpy(inpfname,tname);
1.289 + strcpy(g_tmpfile,tname);
1.290 + free(tname);
1.291 + } else {
1.292 + strcpy(inpfname,get_sourcefile(0));
1.293 + } /* if */
1.294 + inpf_org=(FILE*)pc_opensrc(inpfname);
1.295 + if (inpf_org==NULL)
1.296 + error(120,inpfname);
1.297 + freading=TRUE;
1.298 + outf=(FILE*)pc_openasm(outfname); /* first write to assembler file (may be temporary) */
1.299 + if (outf==NULL)
1.300 + error(121,outfname);
1.301 + /* immediately open the binary file, for other programs to check */
1.302 + if (sc_asmfile || sc_listing) {
1.303 + binf=NULL;
1.304 + } else {
1.305 + binf=(FILE*)pc_openbin(binfname);
1.306 + if (binf==NULL)
1.307 + error(121,binfname);
1.308 + } /* if */
1.309 + setconstants(); /* set predefined constants and tagnames */
1.310 + for (i=0; i<skipinput; i++) /* skip lines in the input file */
1.311 + if (pc_readsrc(inpf_org,pline,sLINEMAX)!=NULL)
1.312 + fline++; /* keep line number up to date */
1.313 + skipinput=fline;
1.314 + sc_status=statFIRST;
1.315 + /* write starting options (from the command line or the configuration file) */
1.316 + if (sc_listing) {
1.317 + char string[150];
1.318 + sprintf(string,"#pragma ctrlchar 0x%02x\n"
1.319 + "#pragma pack %s\n"
1.320 + "#pragma semicolon %s\n"
1.321 + "#pragma tabsize %d\n",
1.322 + sc_ctrlchar,
1.323 + sc_packstr ? "true" : "false",
1.324 + sc_needsemicolon ? "true" : "false",
1.325 + sc_tabsize);
1.326 + pc_writeasm(outf,string);
1.327 + setfiledirect(inpfname);
1.328 + } /* if */
1.329 + /* do the first pass through the file (or possibly two or more "first passes") */
1.330 + sc_parsenum=0;
1.331 + inpfmark=pc_getpossrc(inpf_org);
1.332 + do {
1.333 + /* reset "defined" flag of all functions and global variables */
1.334 + reduce_referrers(&glbtab);
1.335 + delete_symbols(&glbtab,0,TRUE,FALSE);
1.336 + #if !defined NO_DEFINE
1.337 + delete_substtable();
1.338 + inst_datetime_defines();
1.339 + inst_binary_name(binfname);
1.340 + #endif
1.341 + resetglobals();
1.342 + pstructs_free();
1.343 + funcenums_free();
1.344 + sc_ctrlchar=sc_ctrlchar_org;
1.345 + sc_packstr=lcl_packstr;
1.346 + sc_needsemicolon=lcl_needsemicolon;
1.347 + sc_tabsize=lcl_tabsize;
1.348 + errorset(sRESET,0);
1.349 + /* reset the source file */
1.350 + inpf=inpf_org;
1.351 + freading=TRUE;
1.352 + pc_resetsrc(inpf,inpfmark); /* reset file position */
1.353 + fline=skipinput; /* reset line number */
1.354 + sc_reparse=FALSE; /* assume no extra passes */
1.355 + sc_status=statFIRST; /* resetglobals() resets it to IDLE */
1.356 +
1.357 + if (strlen(incfname)>0) {
1.358 + if (strcmp(incfname,sDEF_PREFIX)==0) {
1.359 + plungefile(incfname,FALSE,TRUE); /* parse "default.inc" */
1.360 + } else {
1.361 + if (!plungequalifiedfile(incfname)) /* parse "prefix" include file */
1.362 + error(120,incfname); /* cannot read from ... (fatal error) */
1.363 + } /* if */
1.364 + } /* if */
1.365 + preprocess(); /* fetch first line */
1.366 + parse(); /* process all input */
1.367 + sc_parsenum++;
1.368 + } while (sc_reparse);
1.369 +
1.370 + /* second (or third) pass */
1.371 + sc_status=statWRITE; /* set, to enable warnings */
1.372 + state_conflict(&glbtab);
1.373 +
1.374 + /* write a report, if requested */
1.375 + #if !defined SC_LIGHT
1.376 + if (sc_makereport) {
1.377 + FILE *frep=stdout;
1.378 + if (strlen(reportname)>0)
1.379 + frep=fopen(reportname,"wb"); /* avoid translation of \n to \r\n in DOS/Windows */
1.380 + if (frep!=NULL) {
1.381 + make_report(&glbtab,frep,get_sourcefile(0));
1.382 + if (strlen(reportname)>0)
1.383 + fclose(frep);
1.384 + } /* if */
1.385 + if (sc_documentation!=NULL) {
1.386 + free(sc_documentation);
1.387 + sc_documentation=NULL;
1.388 + } /* if */
1.389 + } /* if */
1.390 + #endif
1.391 + if (sc_listing)
1.392 + goto cleanup;
1.393 +
1.394 + /* ??? for re-parsing the listing file instead of the original source
1.395 + * file (and doing preprocessing twice):
1.396 + * - close input file, close listing file
1.397 + * - re-open listing file for reading (inpf)
1.398 + * - open assembler file (outf)
1.399 + */
1.400 +
1.401 + /* reset "defined" flag of all functions and global variables */
1.402 + reduce_referrers(&glbtab);
1.403 + delete_symbols(&glbtab,0,TRUE,FALSE);
1.404 + funcenums_free();
1.405 + pstructs_free();
1.406 + #if !defined NO_DEFINE
1.407 + delete_substtable();
1.408 + inst_datetime_defines();
1.409 + inst_binary_name(binfname);
1.410 + #endif
1.411 + resetglobals();
1.412 + sc_ctrlchar=sc_ctrlchar_org;
1.413 + sc_packstr=lcl_packstr;
1.414 + sc_needsemicolon=lcl_needsemicolon;
1.415 + sc_tabsize=lcl_tabsize;
1.416 + errorset(sRESET,0);
1.417 + /* reset the source file */
1.418 + inpf=inpf_org;
1.419 + freading=TRUE;
1.420 + pc_resetsrc(inpf,inpfmark); /* reset file position */
1.421 + fline=skipinput; /* reset line number */
1.422 + lexinit(); /* clear internal flags of lex() */
1.423 + sc_status=statWRITE; /* allow to write --this variable was reset by resetglobals() */
1.424 + writeleader(&glbtab);
1.425 + insert_dbgfile(inpfname);
1.426 + if (strlen(incfname)>0) {
1.427 + if (strcmp(incfname,sDEF_PREFIX)==0)
1.428 + plungefile(incfname,FALSE,TRUE); /* parse "default.inc" (again) */
1.429 + else
1.430 + plungequalifiedfile(incfname); /* parse implicit include file (again) */
1.431 + } /* if */
1.432 + preprocess(); /* fetch first line */
1.433 + parse(); /* process all input */
1.434 + /* inpf is already closed when readline() attempts to pop of a file */
1.435 + writetrailer(); /* write remaining stuff */
1.436 +
1.437 + entry=testsymbols(&glbtab,0,TRUE,FALSE); /* test for unused or undefined
1.438 + * functions and variables */
1.439 + if (!entry)
1.440 + error(13); /* no entry point (no public functions) */
1.441 +
1.442 +cleanup:
1.443 + if (inpf!=NULL) /* main source file is not closed, do it now */
1.444 + pc_closesrc(inpf);
1.445 + /* write the binary file (the file is already open) */
1.446 + if (!(sc_asmfile || sc_listing) && errnum==0 && jmpcode==0) {
1.447 + assert(binf!=NULL);
1.448 + pc_resetasm(outf); /* flush and loop back, for reading */
1.449 + #if !defined SC_LIGHT
1.450 + hdrsize=
1.451 + #endif
1.452 + assemble(binf,outf); /* assembler file is now input */
1.453 + } /* if */
1.454 + if (outf!=NULL) {
1.455 + pc_closeasm(outf,!(sc_asmfile || sc_listing));
1.456 + outf=NULL;
1.457 + } /* if */
1.458 + if (binf!=NULL) {
1.459 + pc_closebin(binf,errnum!=0);
1.460 + binf=NULL;
1.461 + } /* if */
1.462 +
1.463 + #if !defined SC_LIGHT
1.464 + if (errnum==0 && strlen(errfname)==0) {
1.465 +#if 0 //bug in compiler -- someone's script caused this function to infrecurs
1.466 + int recursion;
1.467 + long stacksize=max_stacksize(&glbtab,&recursion);
1.468 +#endif
1.469 + int flag_exceed=0;
1.470 + if (pc_amxlimit>0) {
1.471 + long totalsize=hdrsize+code_idx;
1.472 + if (pc_amxram==0)
1.473 + totalsize+=(glb_declared+pc_stksize)*sizeof(cell);
1.474 + if (totalsize>=pc_amxlimit)
1.475 + flag_exceed=1;
1.476 + } /* if */
1.477 + if (pc_amxram>0 && (glb_declared+pc_stksize)*sizeof(cell)>=(unsigned long)pc_amxram)
1.478 + flag_exceed=1;
1.479 + if (!norun && (sc_debug & sSYMBOLIC)!=0 || verbosity>=2 || flag_exceed) {
1.480 + pc_printf("Header size: %8ld bytes\n", (long)hdrsize);
1.481 + pc_printf("Code size: %8ld bytes\n", (long)code_idx);
1.482 + pc_printf("Data size: %8ld bytes\n", (long)glb_declared*sizeof(cell));
1.483 + pc_printf("Stack/heap size: %8ld bytes; ", (long)pc_stksize*sizeof(cell));
1.484 +#if 0
1.485 + pc_printf("estimated max. usage");
1.486 + if (recursion)
1.487 + pc_printf(": unknown, due to recursion\n");
1.488 + else if ((pc_memflags & suSLEEP_INSTR)!=0)
1.489 + pc_printf(": unknown, due to the \"sleep\" instruction\n");
1.490 + else
1.491 + pc_printf("=%ld cells (%ld bytes)\n",stacksize,stacksize*sizeof(cell));
1.492 +#endif
1.493 + pc_printf("Total requirements:%8ld bytes\n", (long)hdrsize+(long)code_idx+(long)glb_declared*sizeof(cell)+(long)pc_stksize*sizeof(cell));
1.494 + } /* if */
1.495 + if (flag_exceed)
1.496 + error(126,pc_amxlimit+pc_amxram); /* this causes a jump back to label "cleanup" */
1.497 + } /* if */
1.498 + #endif
1.499 +
1.500 + if (g_tmpfile[0] != '\0') {
1.501 + remove(g_tmpfile);
1.502 + }
1.503 + if (inpfname!=NULL) {
1.504 + free(inpfname);
1.505 + } /* if */
1.506 + if (litq!=NULL)
1.507 + free(litq);
1.508 + phopt_cleanup();
1.509 + stgbuffer_cleanup();
1.510 + clearstk();
1.511 + assert(jmpcode!=0 || loctab.next==NULL);/* on normal flow, local symbols
1.512 + * should already have been deleted */
1.513 + delete_symbols(&loctab,0,TRUE,TRUE); /* delete local variables if not yet
1.514 + * done (i.e. on a fatal error) */
1.515 + delete_symbols(&glbtab,0,TRUE,TRUE);
1.516 + delete_consttable(&tagname_tab);
1.517 + delete_consttable(&libname_tab);
1.518 + delete_consttable(&sc_automaton_tab);
1.519 + delete_consttable(&sc_state_tab);
1.520 + state_deletetable();
1.521 + delete_aliastable();
1.522 + delete_pathtable();
1.523 + delete_sourcefiletable();
1.524 + delete_dbgstringtable();
1.525 + funcenums_free();
1.526 + pstructs_free();
1.527 + #if !defined NO_DEFINE
1.528 + delete_substtable();
1.529 + #endif
1.530 + #if !defined SC_LIGHT
1.531 + delete_docstringtable();
1.532 + if (sc_documentation!=NULL)
1.533 + free(sc_documentation);
1.534 + #endif
1.535 + delete_autolisttable();
1.536 + if (errnum!=0) {
1.537 + if (strlen(errfname)==0)
1.538 + pc_printf("\n%d Error%s.\n",errnum,(errnum>1) ? "s" : "");
1.539 + retcode=1;
1.540 + } else if (warnnum!=0){
1.541 + if (strlen(errfname)==0)
1.542 + pc_printf("\n%d Warning%s.\n",warnnum,(warnnum>1) ? "s" : "");
1.543 + retcode=0; /* use "0", so that MAKE and similar tools continue */
1.544 + } else {
1.545 + retcode=jmpcode;
1.546 + if (retcode==0 && verbosity>=2)
1.547 + pc_printf("\nDone.\n");
1.548 + } /* if */
1.549 + #if defined __WIN32__ || defined _WIN32 || defined _Windows
1.550 + if (IsWindow(hwndFinish))
1.551 + PostMessageA(hwndFinish,RegisterWindowMessageA("PawnNotify"),retcode,0L);
1.552 + #endif
1.553 + #if defined FORTIFY
1.554 + Fortify_ListAllMemory();
1.555 + #endif
1.556 + return retcode;
1.557 +}
1.558 +
1.559 +#if defined __cplusplus
1.560 + extern "C"
1.561 +#endif
1.562 +int pc_addconstant(char *name,cell value,int tag)
1.563 +{
1.564 + errorset(sFORCESET,0); /* make sure error engine is silenced */
1.565 + sc_status=statIDLE;
1.566 + add_constant(name,value,sGLOBAL,tag);
1.567 + return 1;
1.568 +}
1.569 +
1.570 +static void inst_binary_name(char *binfname)
1.571 +{
1.572 + size_t i, len;
1.573 + char *binptr;
1.574 + char newpath[512], newname[512];
1.575 +
1.576 + binptr = NULL;
1.577 + len = strlen(binfname);
1.578 + for (i = len - 1; i >= 0 && i < len; i--)
1.579 + {
1.580 + if (binfname[i] == '/'
1.581 +#if defined WIN32 || defined _WIN32
1.582 + || binfname[i] == '\\'
1.583 +#endif
1.584 + )
1.585 + {
1.586 + binptr = &binfname[i + 1];
1.587 + break;
1.588 + }
1.589 + }
1.590 +
1.591 + if (binptr == NULL)
1.592 + {
1.593 + binptr = binfname;
1.594 + }
1.595 +
1.596 + snprintf(newpath, sizeof(newpath), "\"%s\"", binfname);
1.597 + snprintf(newname, sizeof(newname), "\"%s\"", binptr);
1.598 +
1.599 + insert_subst("__BINARY_PATH__", newpath, 15);
1.600 + insert_subst("__BINARY_NAME__", newname, 15);
1.601 +}
1.602 +
1.603 +static void inst_datetime_defines(void)
1.604 +{
1.605 + char date[64];
1.606 + char ltime[64];
1.607 + time_t td;
1.608 + struct tm *curtime;
1.609 +
1.610 + time(&td);
1.611 + curtime = localtime(&td);
1.612 + strftime(date, 31, "\"%m/%d/%Y\"", curtime);
1.613 + strftime(ltime, 31, "\"%H:%M:%S\"", curtime);
1.614 +
1.615 + insert_subst("__DATE__", date, 8);
1.616 + insert_subst("__TIME__", ltime, 8);
1.617 +}
1.618 +
1.619 +#if defined __cplusplus
1.620 + extern "C"
1.621 +#endif
1.622 +int pc_addtag(char *name)
1.623 +{
1.624 + cell val;
1.625 + constvalue *ptr;
1.626 + int last,tag;
1.627 +
1.628 + if (name==NULL) {
1.629 + /* no tagname was given, check for one */
1.630 + if (lex(&val,&name)!=tLABEL) {
1.631 + lexpush();
1.632 + return 0; /* untagged */
1.633 + } /* if */
1.634 + } /* if */
1.635 +
1.636 + assert(strchr(name,':')==NULL); /* colon should already have been stripped */
1.637 + last=0;
1.638 + ptr=tagname_tab.next;
1.639 + while (ptr!=NULL) {
1.640 + tag=(int)(ptr->value & TAGMASK);
1.641 + if (strcmp(name,ptr->name)==0)
1.642 + return tag; /* tagname is known, return its sequence number */
1.643 + tag &= (int)~FIXEDTAG;
1.644 + tag &= (int)~FUNCTAG;
1.645 + if (tag>last)
1.646 + last=tag;
1.647 + ptr=ptr->next;
1.648 + } /* while */
1.649 +
1.650 + /* tagname currently unknown, add it */
1.651 + tag=last+1; /* guaranteed not to exist already */
1.652 + if (isupper(*name))
1.653 + tag |= (int)FIXEDTAG;
1.654 + append_constval(&tagname_tab,name,(cell)tag,0);
1.655 + return tag;
1.656 +}
1.657 +
1.658 +int pc_addfunctag(char *name)
1.659 +{
1.660 + cell val;
1.661 + constvalue *ptr;
1.662 + int last,tag;
1.663 +
1.664 + if (name==NULL) {
1.665 + /* no tagname was given, check for one */
1.666 + if (lex(&val,&name)!=tLABEL) {
1.667 + lexpush();
1.668 + return 0; /* untagged */
1.669 + } /* if */
1.670 + } /* if */
1.671 +
1.672 + assert(strchr(name,':')==NULL); /* colon should already have been stripped */
1.673 + last=0;
1.674 + ptr=tagname_tab.next;
1.675 + while (ptr!=NULL) {
1.676 + tag=(int)(ptr->value & TAGMASK);
1.677 + if (strcmp(name,ptr->name)==0)
1.678 + return tag; /* tagname is known, return its sequence number */
1.679 + tag &= (int)~FIXEDTAG;
1.680 + tag &= (int)~FUNCTAG;
1.681 + if (tag>last)
1.682 + last=tag;
1.683 + ptr=ptr->next;
1.684 + } /* while */
1.685 +
1.686 + /* tagname currently unknown, add it */
1.687 + tag=last+1; /* guaranteed not to exist already */
1.688 + if (isupper(*name))
1.689 + tag |= (int)FIXEDTAG;
1.690 + tag |= (int)FUNCTAG;
1.691 + append_constval(&tagname_tab,name,(cell)tag,0);
1.692 + return tag;
1.693 +}
1.694 +
1.695 +static void resetglobals(void)
1.696 +{
1.697 + /* reset the subset of global variables that is modified by the first pass */
1.698 + curfunc=NULL; /* pointer to current function */
1.699 + lastst=0; /* last executed statement type */
1.700 + nestlevel=0; /* number of active (open) compound statements */
1.701 + rettype=0; /* the type that a "return" expression should have */
1.702 + litidx=0; /* index to literal table */
1.703 + stgidx=0; /* index to the staging buffer */
1.704 + sc_labnum=0; /* top value of (internal) labels */
1.705 + staging=0; /* true if staging output */
1.706 + declared=0; /* number of local cells declared */
1.707 + glb_declared=0; /* number of global cells declared */
1.708 + code_idx=0; /* number of bytes with generated code */
1.709 + ntv_funcid=0; /* incremental number of native function */
1.710 + curseg=0; /* 1 if currently parsing CODE, 2 if parsing DATA */
1.711 + freading=FALSE; /* no input file ready yet */
1.712 + fline=0; /* the line number in the current file */
1.713 + fnumber=0; /* the file number in the file table (debugging) */
1.714 + fcurrent=0; /* current file being processed (debugging) */
1.715 + sc_intest=FALSE; /* true if inside a test */
1.716 + sideeffect=0; /* true if an expression causes a side-effect */
1.717 + stmtindent=0; /* current indent of the statement */
1.718 + indent_nowarn=FALSE; /* do not skip warning "217 loose indentation" */
1.719 + sc_allowtags=TRUE; /* allow/detect tagnames */
1.720 + sc_status=statIDLE;
1.721 + sc_allowproccall=FALSE;
1.722 + pc_addlibtable=TRUE; /* by default, add a "library table" to the output file */
1.723 + sc_alignnext=FALSE;
1.724 + pc_docexpr=FALSE;
1.725 + pc_deprecate=NULL;
1.726 + sc_curstates=0;
1.727 + pc_memflags=0;
1.728 +}
1.729 +
1.730 +static void initglobals(void)
1.731 +{
1.732 + resetglobals();
1.733 +
1.734 + sc_asmfile=FALSE; /* do not create .ASM file */
1.735 + sc_listing=FALSE; /* do not create .LST file */
1.736 + skipinput=0; /* number of lines to skip from the first input file */
1.737 + sc_ctrlchar=CTRL_CHAR;/* the escape character */
1.738 + litmax=sDEF_LITMAX; /* current size of the literal table */
1.739 + errnum=0; /* number of errors */
1.740 + warnnum=0; /* number of warnings */
1.741 + optproccall=FALSE; /* sourcemod: do not support "procedure call" */
1.742 + verbosity=1; /* verbosity level, no copyright banner */
1.743 + sc_debug=sCHKBOUNDS|sSYMBOLIC; /* sourcemod: full debug stuff */
1.744 + pc_optimize=sOPTIMIZE_DEFAULT; /* sourcemod: full optimization */
1.745 + sc_packstr=TRUE; /* strings are packed by default */
1.746 + sc_compress=FALSE; /* always disable compact encoding! */
1.747 + sc_needsemicolon=FALSE;/* semicolon required to terminate expressions? */
1.748 + sc_dataalign=sizeof(cell);
1.749 + pc_stksize=sDEF_AMXSTACK;/* default stack size */
1.750 + pc_amxlimit=0; /* no limit on size of the abstract machine */
1.751 + pc_amxram=0; /* no limit on data size of the abstract machine */
1.752 + sc_tabsize=8; /* assume a TAB is 8 spaces */
1.753 + sc_rationaltag=0; /* assume no support for rational numbers */
1.754 + rational_digits=0; /* number of fractional digits */
1.755 +
1.756 + outfname[0]='\0'; /* output file name */
1.757 + errfname[0]='\0'; /* error file name */
1.758 + inpf=NULL; /* file read from */
1.759 + inpfname=NULL; /* pointer to name of the file currently read from */
1.760 + outf=NULL; /* file written to */
1.761 + litq=NULL; /* the literal queue */
1.762 + glbtab.next=NULL; /* clear global variables/constants table */
1.763 + loctab.next=NULL; /* " local " / " " */
1.764 + tagname_tab.next=NULL;/* tagname table */
1.765 + libname_tab.next=NULL;/* library table (#pragma library "..." syntax) */
1.766 +
1.767 + pline[0]='\0'; /* the line read from the input file */
1.768 + lptr=NULL; /* points to the current position in "pline" */
1.769 + curlibrary=NULL; /* current library */
1.770 + inpf_org=NULL; /* main source file */
1.771 +
1.772 + wqptr=wq; /* initialize while queue pointer */
1.773 +
1.774 +#if !defined SC_LIGHT
1.775 + sc_documentation=NULL;
1.776 + sc_makereport=FALSE; /* do not generate a cross-reference report */
1.777 +#endif
1.778 +}
1.779 +
1.780 +static char *get_extension(char *filename)
1.781 +{
1.782 + char *ptr;
1.783 +
1.784 + assert(filename!=NULL);
1.785 + ptr=strrchr(filename,'.');
1.786 + if (ptr!=NULL) {
1.787 + /* ignore extension on a directory or at the start of the filename */
1.788 + if (strchr(ptr,DIRSEP_CHAR)!=NULL || ptr==filename || *(ptr-1)==DIRSEP_CHAR)
1.789 + ptr=NULL;
1.790 + } /* if */
1.791 + return ptr;
1.792 +}
1.793 +
1.794 +/* set_extension
1.795 + * Set the default extension, or force an extension. To erase the
1.796 + * extension of a filename, set "extension" to an empty string.
1.797 + */
1.798 +SC_FUNC void set_extension(char *filename,char *extension,int force)
1.799 +{
1.800 + char *ptr;
1.801 +
1.802 + assert(extension!=NULL && (*extension=='\0' || *extension=='.'));
1.803 + assert(filename!=NULL);
1.804 + ptr=get_extension(filename);
1.805 + if (force && ptr!=NULL)
1.806 + *ptr='\0'; /* set zero terminator at the position of the period */
1.807 + if (force || ptr==NULL)
1.808 + strcat(filename,extension);
1.809 +}
1.810 +
1.811 +static const char *option_value(const char *optptr)
1.812 +{
1.813 + return (*(optptr+1)=='=' || *(optptr+1)==':') ? optptr+2 : optptr+1;
1.814 +}
1.815 +
1.816 +static int toggle_option(const char *optptr, int option)
1.817 +{
1.818 + switch (*option_value(optptr)) {
1.819 + case '\0':
1.820 + option=!option;
1.821 + break;
1.822 + case '-':
1.823 + option=FALSE;
1.824 + break;
1.825 + case '+':
1.826 + option=TRUE;
1.827 + break;
1.828 + default:
1.829 + about();
1.830 + } /* switch */
1.831 + return option;
1.832 +}
1.833 +
1.834 +/* Parsing command line options is indirectly recursive: parseoptions()
1.835 + * calls parserespf() to handle options in a a response file and
1.836 + * parserespf() calls parseoptions() at its turn after having created
1.837 + * an "option list" from the contents of the file.
1.838 + */
1.839 +static void parserespf(char *filename,char *oname,char *ename,char *pname,
1.840 + char *rname, char *codepage);
1.841 +
1.842 +static void parseoptions(int argc,char **argv,char *oname,char *ename,char *pname,
1.843 + char *rname, char *codepage)
1.844 +{
1.845 + char str[_MAX_PATH],*name;
1.846 + const char *ptr;
1.847 + int arg,i,isoption;
1.848 +
1.849 + for (arg=1; arg<argc; arg++) {
1.850 + #if DIRSEP_CHAR=='/'
1.851 + isoption= argv[arg][0]=='-';
1.852 + #else
1.853 + isoption= argv[arg][0]=='/' || argv[arg][0]=='-';
1.854 + #endif
1.855 + if (isoption) {
1.856 + ptr=&argv[arg][1];
1.857 + switch (*ptr) {
1.858 + case 'A':
1.859 + i=atoi(option_value(ptr));
1.860 + if ((i % sizeof(cell))==0)
1.861 + sc_dataalign=i;
1.862 + else
1.863 + about();
1.864 + break;
1.865 + case 'a':
1.866 + if (*(ptr+1)!='\0')
1.867 + about();
1.868 + sc_asmfile=TRUE; /* skip last pass of making binary file */
1.869 + if (verbosity>1)
1.870 + verbosity=1;
1.871 + break;
1.872 +#if 0 /* not allowed in SourceMod */
1.873 + case 'C':
1.874 + #if AMX_COMPACTMARGIN > 2
1.875 + sc_compress=toggle_option(ptr,sc_compress);
1.876 + #else
1.877 + about();
1.878 + #endif
1.879 + break;
1.880 +#endif
1.881 + case 'c':
1.882 + strlcpy(codepage,option_value(ptr),MAXCODEPAGE); /* set name of codepage */
1.883 + break;
1.884 +#if defined dos_setdrive
1.885 + case 'D': /* set active directory */
1.886 + ptr=option_value(ptr);
1.887 + if (ptr[1]==':')
1.888 + dos_setdrive(toupper(*ptr)-'A'+1); /* set active drive */
1.889 + chdir(ptr);
1.890 + break;
1.891 +#endif
1.892 +#if 0 /* not allowed to change for SourceMod */
1.893 + case 'd':
1.894 + switch (*option_value(ptr)) {
1.895 + case '0':
1.896 + sc_debug=0;
1.897 + break;
1.898 + case '1':
1.899 + sc_debug=sCHKBOUNDS; /* assertions and bounds checking */
1.900 + break;
1.901 + case '2':
1.902 + sc_debug=sCHKBOUNDS | sSYMBOLIC; /* also symbolic info */
1.903 + break;
1.904 + case '3':
1.905 + sc_debug=sCHKBOUNDS | sSYMBOLIC;
1.906 + pc_optimize=sOPTIMIZE_NONE;
1.907 + /* also avoid peephole optimization */
1.908 + break;
1.909 + default:
1.910 + about();
1.911 + } /* switch */
1.912 + break;
1.913 +#endif
1.914 + case 'e':
1.915 + strlcpy(ename,option_value(ptr),_MAX_PATH); /* set name of error file */
1.916 + break;
1.917 +#if defined __WIN32__ || defined _WIN32 || defined _Windows
1.918 + case 'H':
1.919 + hwndFinish=(HWND)atoi(option_value(ptr));
1.920 + if (!IsWindow(hwndFinish))
1.921 + hwndFinish=(HWND)0;
1.922 + break;
1.923 +#endif
1.924 + case 'i':
1.925 + strlcpy(str,option_value(ptr),sizeof str); /* set name of include directory */
1.926 + i=strlen(str);
1.927 + if (i>0) {
1.928 + if (str[i-1]!=DIRSEP_CHAR) {
1.929 + str[i]=DIRSEP_CHAR;
1.930 + str[i+1]='\0';
1.931 + } /* if */
1.932 + insert_path(str);
1.933 + } /* if */
1.934 + break;
1.935 + case 'l':
1.936 + if (*(ptr+1)!='\0')
1.937 + about();
1.938 + sc_listing=TRUE; /* skip second pass & code generation */
1.939 + break;
1.940 + case 'o':
1.941 + strlcpy(oname,option_value(ptr),_MAX_PATH); /* set name of (binary) output file */
1.942 + break;
1.943 + case 'O':
1.944 + pc_optimize=*option_value(ptr) - '0';
1.945 + if (pc_optimize<sOPTIMIZE_NONE || pc_optimize>=sOPTIMIZE_NUMBER || pc_optimize==sOPTIMIZE_NOMACRO)
1.946 + about();
1.947 + break;
1.948 + case 'p':
1.949 + strlcpy(pname,option_value(ptr),_MAX_PATH); /* set name of implicit include file */
1.950 + break;
1.951 +#if !defined SC_LIGHT
1.952 + case 'r':
1.953 + strlcpy(rname,option_value(ptr),_MAX_PATH); /* set name of report file */
1.954 + sc_makereport=TRUE;
1.955 + if (strlen(rname)>0) {
1.956 + set_extension(rname,".xml",FALSE);
1.957 + } else if ((name=get_sourcefile(0))!=NULL) {
1.958 + assert(strlen(rname)==0);
1.959 + assert(strlen(name)<_MAX_PATH);
1.960 + if ((ptr=strrchr(name,DIRSEP_CHAR))!=NULL)
1.961 + ptr++; /* strip path */
1.962 + else
1.963 + ptr=name;
1.964 + assert(strlen(ptr)<_MAX_PATH);
1.965 + strcpy(rname,ptr);
1.966 + set_extension(rname,".xml",TRUE);
1.967 + } /* if */
1.968 + break;
1.969 +#endif
1.970 + case 'S':
1.971 + i=atoi(option_value(ptr));
1.972 + if (i>32)
1.973 + pc_stksize=(cell)i; /* stack size has minimum size */
1.974 + else
1.975 + about();
1.976 + break;
1.977 + case 's':
1.978 + skipinput=atoi(option_value(ptr));
1.979 + break;
1.980 + case 't':
1.981 + sc_tabsize=atoi(option_value(ptr));
1.982 + break;
1.983 + case 'v':
1.984 + verbosity= isdigit(*option_value(ptr)) ? atoi(option_value(ptr)) : 2;
1.985 + if (sc_asmfile && verbosity>1)
1.986 + verbosity=1;
1.987 + break;
1.988 + case 'w':
1.989 + i=(int)strtol(option_value(ptr),(char **)&ptr,10);
1.990 + if (*ptr=='-')
1.991 + pc_enablewarning(i,0);
1.992 + else if (*ptr=='+')
1.993 + pc_enablewarning(i,1);
1.994 + else if (*ptr=='\0')
1.995 + pc_enablewarning(i,2);
1.996 + break;
1.997 + case 'X':
1.998 + if (*(ptr+1)=='D') {
1.999 + i=atoi(option_value(ptr+1));
1.1000 + if (i>64)
1.1001 + pc_amxram=(cell)i; /* abstract machine data/stack has minimum size */
1.1002 + else
1.1003 + about();
1.1004 + } else {
1.1005 + i=atoi(option_value(ptr));
1.1006 + if (i>64)
1.1007 + pc_amxlimit=(cell)i;/* abstract machine has minimum size */
1.1008 + else
1.1009 + about();
1.1010 + } /* if */
1.1011 + break;
1.1012 + case '\\': /* use \ instead for escape characters */
1.1013 + sc_ctrlchar='\\';
1.1014 + break;
1.1015 + case '^': /* use ^ instead for escape characters */
1.1016 + sc_ctrlchar='^';
1.1017 + break;
1.1018 + case ';':
1.1019 + sc_needsemicolon=toggle_option(ptr,sc_needsemicolon);
1.1020 + break;
1.1021 +#if 0 /* not allowed to change in SourceMod */
1.1022 + case '(':
1.1023 + optproccall=!toggle_option(ptr,!optproccall);
1.1024 + break;
1.1025 +#endif
1.1026 + default: /* wrong option */
1.1027 + about();
1.1028 + } /* switch */
1.1029 + } else if (argv[arg][0]=='@') {
1.1030 + #if !defined SC_LIGHT
1.1031 + parserespf(&argv[arg][1],oname,ename,pname,rname,codepage);
1.1032 + #endif
1.1033 + } else if ((ptr=strchr(argv[arg],'='))!=NULL) {
1.1034 + i=(int)(ptr-argv[arg]);
1.1035 + if (i>sNAMEMAX) {
1.1036 + i=sNAMEMAX;
1.1037 + error(200,argv[arg],sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
1.1038 + } /* if */
1.1039 + strlcpy(str,argv[arg],i+1); /* str holds symbol name */
1.1040 + i=atoi(ptr+1);
1.1041 + add_constant(str,i,sGLOBAL,0);
1.1042 + } else {
1.1043 + strlcpy(str,argv[arg],sizeof(str)-5); /* -5 because default extension is ".sp" */
1.1044 + set_extension(str,".sp",FALSE);
1.1045 + insert_sourcefile(str);
1.1046 + /* The output name is the first input name with a different extension,
1.1047 + * but it is stored in a different directory
1.1048 + */
1.1049 + if (strlen(oname)==0) {
1.1050 + if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
1.1051 + ptr++; /* strip path */
1.1052 + else
1.1053 + ptr=str;
1.1054 + assert(strlen(ptr)<_MAX_PATH);
1.1055 + strcpy(oname,ptr);
1.1056 + } /* if */
1.1057 + set_extension(oname,".asm",TRUE);
1.1058 +#if !defined SC_LIGHT
1.1059 + if (sc_makereport && strlen(rname)==0) {
1.1060 + if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
1.1061 + ptr++; /* strip path */
1.1062 + else
1.1063 + ptr=str;
1.1064 + assert(strlen(ptr)<_MAX_PATH);
1.1065 + strcpy(rname,ptr);
1.1066 + set_extension(rname,".xml",TRUE);
1.1067 + } /* if */
1.1068 +#endif
1.1069 + } /* if */
1.1070 + } /* for */
1.1071 +}
1.1072 +
1.1073 +#if !defined SC_LIGHT
1.1074 +static void parserespf(char *filename,char *oname,char *ename,char *pname,
1.1075 + char *rname,char *codepage)
1.1076 +{
1.1077 +#define MAX_OPTIONS 100
1.1078 + FILE *fp;
1.1079 + char *string, *ptr, **argv;
1.1080 + int argc;
1.1081 + long size;
1.1082 +
1.1083 + if ((fp=fopen(filename,"r"))==NULL)
1.1084 + error(120,filename); /* error reading input file */
1.1085 + /* load the complete file into memory */
1.1086 + fseek(fp,0L,SEEK_END);
1.1087 + size=ftell(fp);
1.1088 + fseek(fp,0L,SEEK_SET);
1.1089 + assert(size<INT_MAX);
1.1090 + if ((string=(char *)malloc((int)size+1))==NULL)
1.1091 + error(123); /* insufficient memory */
1.1092 + /* fill with zeros; in MS-DOS, fread() may collapse CR/LF pairs to
1.1093 + * a single '\n', so the string size may be smaller than the file
1.1094 + * size. */
1.1095 + memset(string,0,(int)size+1);
1.1096 + fread(string,1,(int)size,fp);
1.1097 + fclose(fp);
1.1098 + /* allocate table for option pointers */
1.1099 + if ((argv=(char **)malloc(MAX_OPTIONS*sizeof(char*)))==NULL)
1.1100 + error(123); /* insufficient memory */
1.1101 + /* fill the options table */
1.1102 + ptr=strtok(string," \t\r\n");
1.1103 + for (argc=1; argc<MAX_OPTIONS && ptr!=NULL; argc++) {
1.1104 + /* note: the routine skips argv[0], for compatibility with main() */
1.1105 + argv[argc]=ptr;
1.1106 + ptr=strtok(NULL," \t\r\n");
1.1107 + } /* for */
1.1108 + if (ptr!=NULL)
1.1109 + error(122,"option table"); /* table overflow */
1.1110 + /* parse the option table */
1.1111 + parseoptions(argc,argv,oname,ename,pname,rname,codepage);
1.1112 + /* free allocated memory */
1.1113 + free(argv);
1.1114 + free(string);
1.1115 +}
1.1116 +#endif
1.1117 +
1.1118 +static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
1.1119 + char *rname,char *codepage)
1.1120 +{
1.1121 + delete_sourcefiletable(); /* make sure it is empty */
1.1122 + *oname='\0';
1.1123 + *ename='\0';
1.1124 + *pname='\0';
1.1125 + *rname='\0';
1.1126 + *codepage='\0';
1.1127 + strcpy(pname,sDEF_PREFIX);
1.1128 +
1.1129 + #if 0 /* needed to test with BoundsChecker for DOS (it does not pass
1.1130 + * through arguments) */
1.1131 + insert_sourcefile("test.p");
1.1132 + strcpy(oname,"test.asm");
1.1133 + #endif
1.1134 +
1.1135 + #if !defined SC_LIGHT
1.1136 + /* first parse a "config" file with default options */
1.1137 + if (argv[0]!=NULL) {
1.1138 + char cfgfile[_MAX_PATH];
1.1139 + char *ext;
1.1140 + strcpy(cfgfile,argv[0]);
1.1141 + if ((ext=strrchr(cfgfile,DIRSEP_CHAR))!=NULL) {
1.1142 + *(ext+1)='\0'; /* strip the program filename */
1.1143 + strcat(cfgfile,"pawn.cfg");
1.1144 + } else {
1.1145 + strcpy(cfgfile,"pawn.cfg");
1.1146 + } /* if */
1.1147 + if (access(cfgfile,4)==0)
1.1148 + parserespf(cfgfile,oname,ename,pname,rname,codepage);
1.1149 + } /* if */
1.1150 + #endif
1.1151 + parseoptions(argc,argv,oname,ename,pname,rname,codepage);
1.1152 + if (get_sourcefile(0)==NULL)
1.1153 + about();
1.1154 +}
1.1155 +
1.1156 +#if defined __BORLANDC__ || defined __WATCOMC__
1.1157 + #pragma argsused
1.1158 +#endif
1.1159 +static void setconfig(char *root)
1.1160 +{
1.1161 + #if defined macintosh
1.1162 + insert_path(":include:");
1.1163 + #else
1.1164 + char path[_MAX_PATH];
1.1165 + char *ptr,*base;
1.1166 + int len;
1.1167 +
1.1168 + /* add the default "include" directory */
1.1169 + #if defined __WIN32__ || defined _WIN32
1.1170 + GetModuleFileNameA(NULL,path,_MAX_PATH);
1.1171 + #elif defined LINUX || defined __FreeBSD__ || defined __OpenBSD__
1.1172 + /* see www.autopackage.org for the BinReloc module */
1.1173 + br_init_lib(NULL);
1.1174 + ptr=br_find_exe("spcomp");
1.1175 + strlcpy(path,ptr,sizeof path);
1.1176 + free(ptr);
1.1177 + #else
1.1178 + if (root!=NULL)
1.1179 + strlcpy(path,root,sizeof path); /* path + filename (hopefully) */
1.1180 + #endif
1.1181 + #if defined __MSDOS__
1.1182 + /* strip the options (appended to the path + filename) */
1.1183 + if ((ptr=strpbrk(path," \t/"))!=NULL)
1.1184 + *ptr='\0';
1.1185 + #endif
1.1186 + /* terminate just behind last \ or : */
1.1187 + if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL || (ptr=strchr(path,':'))!=NULL) {
1.1188 + /* If there is no "\" or ":", the string probably does not contain the
1.1189 + * path; so we just don't add it to the list in that case
1.1190 + */
1.1191 + *(ptr+1)='\0';
1.1192 + base=ptr;
1.1193 + strcat(path,"include");
1.1194 + len=strlen(path);
1.1195 + path[len]=DIRSEP_CHAR;
1.1196 + path[len+1]='\0';
1.1197 + /* see if it exists */
1.1198 + if (access(path,0)!=0 && *base==DIRSEP_CHAR) {
1.1199 + /* There is no "include" directory below the directory where the compiler
1.1200 + * is found. This typically means that the compiler is in a "bin" sub-directory
1.1201 + * and the "include" is below the *parent*. So find the parent...
1.1202 + */
1.1203 + *base='\0';
1.1204 + if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL) {
1.1205 + *(ptr+1)='\0';
1.1206 + strcat(path,"include");
1.1207 + len=strlen(path);
1.1208 + path[len]=DIRSEP_CHAR;
1.1209 + path[len+1]='\0';
1.1210 + } else {
1.1211 + *base=DIRSEP_CHAR;
1.1212 + } /* if */
1.1213 + } /* if */
1.1214 + insert_path(path);
1.1215 + /* same for the codepage root */
1.1216 + #if !defined NO_CODEPAGE
1.1217 + *ptr='\0';
1.1218 + if (!cp_path(path,"codepage"))
1.1219 + error(129,path); /* codepage path */
1.1220 + #endif
1.1221 + /* also copy the root path (for the XML documentation) */
1.1222 + #if !defined SC_LIGHT
1.1223 + *ptr='\0';
1.1224 + strcpy(sc_rootpath,path);
1.1225 + #endif
1.1226 + } /* if */
1.1227 + #endif /* macintosh */
1.1228 +}
1.1229 +
1.1230 +static void setcaption(void)
1.1231 +{
1.1232 + pc_printf("SourcePawn Compiler " SVN_FULL_VERSION "\n");
1.1233 + pc_printf("Copyright (c) 1997-2006, ITB CompuPhase, (C)2004-2008 AlliedModders, LLC\n\n");
1.1234 +}
1.1235 +
1.1236 +static void about(void)
1.1237 +{
1.1238 + if (strlen(errfname)==0) {
1.1239 + setcaption();
1.1240 + pc_printf("Usage: spcomp <filename> [filename...] [options]\n\n");
1.1241 + pc_printf("Options:\n");
1.1242 + pc_printf(" -A<num> alignment in bytes of the data segment and the stack\n");
1.1243 + pc_printf(" -a output assembler code\n");
1.1244 +#if 0 /* not toggleable in SourceMod */
1.1245 + pc_printf(" -C[+/-] compact encoding for output file (default=%c)\n", sc_compress ? '+' : '-');
1.1246 +#endif
1.1247 + pc_printf(" -c<name> codepage name or number; e.g. 1252 for Windows Latin-1\n");
1.1248 +#if defined dos_setdrive
1.1249 + pc_printf(" -Dpath active directory path\n");
1.1250 +#endif
1.1251 +#if 0 /* not used for SourceMod */
1.1252 + pc_printf(" -d<num> debugging level (default=-d%d)\n",sc_debug);
1.1253 + pc_printf(" 0 no symbolic information, no run-time checks\n");
1.1254 + pc_printf(" 1 run-time checks, no symbolic information\n");
1.1255 + pc_printf(" 2 full debug information and dynamic checking\n");
1.1256 + pc_printf(" 3 same as -d2, but implies -O0\n");
1.1257 +#endif
1.1258 + pc_printf(" -e<name> set name of error file (quiet compile)\n");
1.1259 +#if defined __WIN32__ || defined _WIN32 || defined _Windows
1.1260 + pc_printf(" -H<hwnd> window handle to send a notification message on finish\n");
1.1261 +#endif
1.1262 + pc_printf(" -i<name> path for include files\n");
1.1263 + pc_printf(" -l create list file (preprocess only)\n");
1.1264 + pc_printf(" -o<name> set base name of (P-code) output file\n");
1.1265 + pc_printf(" -O<num> optimization level (default=-O%d)\n",pc_optimize);
1.1266 + pc_printf(" 0 no optimization\n");
1.1267 +#if 0 /* not used for SourceMod */
1.1268 + pc_printf(" 1 JIT-compatible optimizations only\n");
1.1269 +#endif
1.1270 + pc_printf(" 2 full optimizations\n");
1.1271 + pc_printf(" -p<name> set name of \"prefix\" file\n");
1.1272 +#if !defined SC_LIGHT
1.1273 + pc_printf(" -r[name] write cross reference report to console or to specified file\n");
1.1274 +#endif
1.1275 + pc_printf(" -S<num> stack/heap size in cells (default=%d)\n",(int)pc_stksize);
1.1276 + pc_printf(" -s<num> skip lines from the input file\n");
1.1277 + pc_printf(" -t<num> TAB indent size (in character positions, default=%d)\n",sc_tabsize);
1.1278 + pc_printf(" -v<num> verbosity level; 0=quiet, 1=normal, 2=verbose (default=%d)\n",verbosity);
1.1279 + pc_printf(" -w<num> disable a specific warning by its number\n");
1.1280 + pc_printf(" -X<num> abstract machine size limit in bytes\n");
1.1281 + pc_printf(" -XD<num> abstract machine data/stack size limit in bytes\n");
1.1282 + pc_printf(" -\\ use '\\' for escape characters\n");
1.1283 + pc_printf(" -^ use '^' for escape characters\n");
1.1284 + pc_printf(" -;[+/-] require a semicolon to end each statement (default=%c)\n", sc_needsemicolon ? '+' : '-');
1.1285 +#if 0 /* not allowed in SourceMod */
1.1286 + pc_printf(" -([+/-] require parantheses for function invocation (default=%c)\n", optproccall ? '-' : '+');
1.1287 +#endif
1.1288 + pc_printf(" sym=val define constant \"sym\" with value \"val\"\n");
1.1289 + pc_printf(" sym= define constant \"sym\" with value 0\n");
1.1290 +#if defined __WIN32__ || defined _WIN32 || defined _Windows || defined __MSDOS__
1.1291 + pc_printf("\nOptions may start with a dash or a slash; the options \"-d0\" and \"/d0\" are\n");
1.1292 + pc_printf("equivalent.\n");
1.1293 +#endif
1.1294 + pc_printf("\nOptions with a value may optionally separate the value from the option letter\n");
1.1295 + pc_printf("with a colon (\":\") or an equal sign (\"=\"). That is, the options \"-d0\", \"-d=0\"\n");
1.1296 + pc_printf("and \"-d:0\" are all equivalent.\n");
1.1297 + } /* if */
1.1298 + norun = 1;
1.1299 + longjmp(errbuf,3); /* user abort */
1.1300 +}
1.1301 +
1.1302 +static void setconstants(void)
1.1303 +{
1.1304 + int debug;
1.1305 +
1.1306 + assert(sc_status==statIDLE);
1.1307 + append_constval(&tagname_tab,"_",0,0);/* "untagged" */
1.1308 + append_constval(&tagname_tab,"bool",1,0);
1.1309 +
1.1310 + pc_anytag = pc_addtag("any");
1.1311 + pc_functag = pc_addfunctag("Function");
1.1312 + pc_tag_string = pc_addtag("String");
1.1313 +
1.1314 + add_constant("true",1,sGLOBAL,1); /* boolean flags */
1.1315 + add_constant("false",0,sGLOBAL,1);
1.1316 + add_constant("EOS",0,sGLOBAL,0); /* End Of String, or '\0' */
1.1317 + #if PAWN_CELL_SIZE==16
1.1318 + add_constant("cellbits",16,sGLOBAL,0);
1.1319 + #if defined _I16_MAX
1.1320 + add_constant("cellmax",_I16_MAX,sGLOBAL,0);
1.1321 + add_constant("cellmin",_I16_MIN,sGLOBAL,0);
1.1322 + #else
1.1323 + add_constant("cellmax",SHRT_MAX,sGLOBAL,0);
1.1324 + add_constant("cellmin",SHRT_MIN,sGLOBAL,0);
1.1325 + #endif
1.1326 + #elif PAWN_CELL_SIZE==32
1.1327 + add_constant("cellbits",32,sGLOBAL,0);
1.1328 + #if defined _I32_MAX
1.1329 + add_constant("cellmax",_I32_MAX,sGLOBAL,0);
1.1330 + add_constant("cellmin",_I32_MIN,sGLOBAL,0);
1.1331 + #else
1.1332 + add_constant("cellmax",LONG_MAX,sGLOBAL,0);
1.1333 + add_constant("cellmin",LONG_MIN,sGLOBAL,0);
1.1334 + #endif
1.1335 + #elif PAWN_CELL_SIZE==64
1.1336 + #if !defined _I64_MIN
1.1337 + #define _I64_MIN (-9223372036854775807ULL - 1)
1.1338 + #define _I64_MAX 9223372036854775807ULL
1.1339 + #endif
1.1340 + add_constant("cellbits",64,sGLOBAL,0);
1.1341 + add_constant("cellmax",_I64_MAX,sGLOBAL,0);
1.1342 + add_constant("cellmin",_I64_MIN,sGLOBAL,0);
1.1343 + #else
1.1344 + #error Unsupported cell size
1.1345 + #endif
1.1346 + add_constant("charbits",sCHARBITS,sGLOBAL,0);
1.1347 + add_constant("charmin",0,sGLOBAL,0);
1.1348 + add_constant("charmax",~(-1 << sCHARBITS) - 1,sGLOBAL,0);
1.1349 + add_constant("ucharmax",(1 << (sizeof(cell)-1)*8)-1,sGLOBAL,0);
1.1350 +
1.1351 + add_constant("__Pawn",VERSION_INT,sGLOBAL,0);
1.1352 +
1.1353 + debug=0;
1.1354 + if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC))==(sCHKBOUNDS | sSYMBOLIC))
1.1355 + debug=2;
1.1356 + else if ((sc_debug & sCHKBOUNDS)==sCHKBOUNDS)
1.1357 + debug=1;
1.1358 + add_constant("debug",debug,sGLOBAL,0);
1.1359 +
1.1360 + append_constval(&sc_automaton_tab,"",0,0); /* anonymous automaton */
1.1361 +}
1.1362 +
1.1363 +static int getclassspec(int initialtok,int *fpublic,int *fstatic,int *fstock,int *fconst)
1.1364 +{
1.1365 + int tok,err;
1.1366 + cell val;
1.1367 + char *str;
1.1368 +
1.1369 + assert(fconst!=NULL);
1.1370 + assert(fstock!=NULL);
1.1371 + assert(fstatic!=NULL);
1.1372 + assert(fpublic!=NULL);
1.1373 + *fconst=FALSE;
1.1374 + *fstock=FALSE;
1.1375 + *fstatic=FALSE;
1.1376 + *fpublic=FALSE;
1.1377 + switch (initialtok) {
1.1378 + case tCONST:
1.1379 + *fconst=TRUE;
1.1380 + break;
1.1381 + case tSTOCK:
1.1382 + *fstock=TRUE;
1.1383 + break;
1.1384 + case tSTATIC:
1.1385 + *fstatic=TRUE;
1.1386 + break;
1.1387 + case tPUBLIC:
1.1388 + *fpublic=TRUE;
1.1389 + break;
1.1390 + } /* switch */
1.1391 +
1.1392 + err=0;
1.1393 + do {
1.1394 + tok=lex(&val,&str); /* read in (new) token */
1.1395 + switch (tok) {
1.1396 + case tCONST:
1.1397 + if (*fconst)
1.1398 + err=42; /* invalid combination of class specifiers */
1.1399 + *fconst=TRUE;
1.1400 + break;
1.1401 + case tSTOCK:
1.1402 + if (*fstock)
1.1403 + err=42; /* invalid combination of class specifiers */
1.1404 + *fstock=TRUE;
1.1405 + break;
1.1406 + case tSTATIC:
1.1407 + if (*fstatic)
1.1408 + err=42; /* invalid combination of class specifiers */
1.1409 + *fstatic=TRUE;
1.1410 + break;
1.1411 + case tPUBLIC:
1.1412 + if (*fpublic)
1.1413 + err=42; /* invalid combination of class specifiers */
1.1414 + *fpublic=TRUE;
1.1415 + break;
1.1416 + default:
1.1417 + lexpush();
1.1418 + tok=0; /* force break out of loop */
1.1419 + } /* switch */
1.1420 + } while (tok && err==0);
1.1421 +
1.1422 + /* extra checks */
1.1423 + if (*fstatic && *fpublic) {
1.1424 + err=42; /* invalid combination of class specifiers */
1.1425 + *fstatic=*fpublic=FALSE;
1.1426 + } /* if */
1.1427 +
1.1428 + if (err)
1.1429 + error(err);
1.1430 + return err==0;
1.1431 +}
1.1432 +
1.1433 +/* parse - process all input text
1.1434 + *
1.1435 + * At this level, only static declarations and function definitions are legal.
1.1436 + */
1.1437 +static void parse(void)
1.1438 +{
1.1439 + int tok,fconst,fstock,fstatic,fpublic;
1.1440 + cell val;
1.1441 + char *str;
1.1442 +
1.1443 + while (freading){
1.1444 + /* first try whether a declaration possibly is native or public */
1.1445 + tok=lex(&val,&str); /* read in (new) token */
1.1446 + switch (tok) {
1.1447 + case 0:
1.1448 + /* ignore zero's */
1.1449 + break;
1.1450 + case tNEW:
1.1451 + if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst))
1.1452 + declglb(NULL,0,fpublic,fstatic,fstock,fconst);
1.1453 + break;
1.1454 + case tSTATIC:
1.1455 + /* This can be a static function or a static global variable; we know
1.1456 + * which of the two as soon as we have parsed up to the point where an
1.1457 + * opening paranthesis of a function would be expected. To back out after
1.1458 + * deciding it was a declaration of a static variable after all, we have
1.1459 + * to store the symbol name and tag.
1.1460 + */
1.1461 + if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
1.1462 + assert(!fpublic);
1.1463 + declfuncvar(fpublic,fstatic,fstock,fconst);
1.1464 + } /* if */
1.1465 + break;
1.1466 + case tCONST:
1.1467 + decl_const(sGLOBAL);
1.1468 + break;
1.1469 + case tENUM:
1.1470 + decl_enum(sGLOBAL);
1.1471 + break;
1.1472 + case tFUNCENUM:
1.1473 + dofuncenum(TRUE);
1.1474 + break;
1.1475 + case tFUNCTAG:
1.1476 + dofuncenum(FALSE);
1.1477 + break;
1.1478 + case tSTRUCT:
1.1479 + declstruct();
1.1480 + break;
1.1481 + case tPUBLIC:
1.1482 + /* This can be a public function or a public variable; see the comment
1.1483 + * above (for static functions/variables) for details.
1.1484 + */
1.1485 + if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
1.1486 + assert(!fstatic);
1.1487 + declfuncvar(fpublic,fstatic,fstock,fconst);
1.1488 + } /* if */
1.1489 + break;
1.1490 + case tSTOCK:
1.1491 + /* This can be a stock function or a stock *global*) variable; see the
1.1492 + * comment above (for static functions/variables) for details.
1.1493 + */
1.1494 + if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
1.1495 + assert(fstock);
1.1496 + declfuncvar(fpublic,fstatic,fstock,fconst);
1.1497 + } /* if */
1.1498 + break;
1.1499 + case tLABEL:
1.1500 + case tSYMBOL:
1.1501 + case tOPERATOR:
1.1502 + lexpush();
1.1503 + if (!newfunc(NULL,-1,FALSE,FALSE,FALSE)) {
1.1504 + error(10); /* illegal function or declaration */
1.1505 + lexclr(TRUE); /* drop the rest of the line */
1.1506 + litidx=0; /* drop the literal queue too */
1.1507 + } /* if */
1.1508 + break;
1.1509 + case tNATIVE:
1.1510 + funcstub(TRUE); /* create a dummy function */
1.1511 + break;
1.1512 + case tFORWARD:
1.1513 + funcstub(FALSE);
1.1514 + break;
1.1515 + case '}':
1.1516 + error(54); /* unmatched closing brace */
1.1517 + break;
1.1518 + case '{':
1.1519 + error(55); /* start of function body without function header */
1.1520 + break;
1.1521 + default:
1.1522 + if (freading) {
1.1523 + error(10); /* illegal function or declaration */
1.1524 + lexclr(TRUE); /* drop the rest of the line */
1.1525 + litidx=0; /* drop any literal arrays (strings) */
1.1526 + } /* if */
1.1527 + } /* switch */
1.1528 + } /* while */
1.1529 +}
1.1530 +
1.1531 +/* dumplits
1.1532 + *
1.1533 + * Dump the literal pool (strings etc.)
1.1534 + *
1.1535 + * Global references: litidx (referred to only)
1.1536 + */
1.1537 +static void dumplits(void)
1.1538 +{
1.1539 + int j,k;
1.1540 +
1.1541 + if (sc_status==statSKIP)
1.1542 + return;
1.1543 +
1.1544 + k=0;
1.1545 + while (k<litidx){
1.1546 + /* should be in the data segment */
1.1547 + assert(curseg==2);
1.1548 + defstorage();
1.1549 + j=16; /* 16 values per line */
1.1550 + while (j && k<litidx){
1.1551 + outval(litq[k], FALSE);
1.1552 + stgwrite(" ");
1.1553 + k++;
1.1554 + j--;
1.1555 + if (j==0 || k>=litidx)
1.1556 + stgwrite("\n"); /* force a newline after 10 dumps */
1.1557 + /* Note: stgwrite() buffers a line until it is complete. It recognizes
1.1558 + * the end of line as a sequence of "\n\0", so something like "\n\t"
1.1559 + * so should not be passed to stgwrite().
1.1560 + */
1.1561 + } /* while */
1.1562 + } /* while */
1.1563 +}
1.1564 +
1.1565 +/* dumpzero
1.1566 + *
1.1567 + * Dump zero's for default initial values
1.1568 + */
1.1569 +static void dumpzero(int count)
1.1570 +{
1.1571 + int i;
1.1572 +
1.1573 + if (sc_status==statSKIP || count<=0)
1.1574 + return;
1.1575 + assert(curseg==2);
1.1576 + defstorage();
1.1577 + i=0;
1.1578 + while (count-- > 0) {
1.1579 + outval(0, FALSE);
1.1580 + i=(i+1) % 16;
1.1581 + stgwrite((i==0 || count==0) ? "\n" : " ");
1.1582 + if (i==0 && count>0)
1.1583 + defstorage();
1.1584 + } /* while */
1.1585 +}
1.1586 +
1.1587 +static void aligndata(int numbytes)
1.1588 +{
1.1589 + assert(numbytes % sizeof(cell) == 0); /* alignment must be a multiple of
1.1590 + * the cell size */
1.1591 + assert(numbytes!=0);
1.1592 +
1.1593 + if ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0) {
1.1594 + while ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0)
1.1595 + litadd(0);
1.1596 + } /* if */
1.1597 +
1.1598 +}
1.1599 +
1.1600 +#if !defined SC_LIGHT
1.1601 +/* sc_attachdocumentation()
1.1602 + * appends documentation comments to the passed-in symbol, or to a global
1.1603 + * string if "sym" is NULL.
1.1604 + */
1.1605 +void sc_attachdocumentation(symbol *sym)
1.1606 +{
1.1607 + int line;
1.1608 + size_t length;
1.1609 + char *str,*doc;
1.1610 +
1.1611 + if (!sc_makereport || sc_status!=statFIRST || sc_parsenum>0) {
1.1612 + /* just clear the entire table */
1.1613 + delete_docstringtable();
1.1614 + return;
1.1615 + } /* if */
1.1616 + /* in the case of state functions, multiple documentation sections may
1.1617 + * appear; we should concatenate these
1.1618 + * (with forward declarations, this is also already the case, so the assertion
1.1619 + * below is invalid)
1.1620 + */
1.1621 + // assert(sym==NULL || sym->documentation==NULL || sym->states!=NULL);
1.1622 +
1.1623 + /* first check the size */
1.1624 + length=0;
1.1625 + for (line=0; (str=get_docstring(line))!=NULL && *str!=sDOCSEP; line++) {
1.1626 + if (length>0)
1.1627 + length++; /* count 1 extra for a separating space */
1.1628 + length+=strlen(str);
1.1629 + } /* for */
1.1630 + if (sym==NULL && sc_documentation!=NULL) {
1.1631 + length += strlen(sc_documentation) + 1 + 4; /* plus 4 for "<p/>" */
1.1632 + assert(length>strlen(sc_documentation));
1.1633 + } /* if */
1.1634 +
1.1635 + if (length>0) {
1.1636 + /* allocate memory for the documentation */
1.1637 + if (sym!=NULL && sym->documentation!=NULL)
1.1638 + length+=strlen(sym->documentation) + 1 + 4;/* plus 4 for "<p/>" */
1.1639 + doc=(char*)malloc((length+1)*sizeof(char));
1.1640 + if (doc!=NULL) {
1.1641 + /* initialize string or concatenate */
1.1642 + if (sym==NULL && sc_documentation!=NULL) {
1.1643 + strcpy(doc,sc_documentation);
1.1644 + strcat(doc,"<p/>");
1.1645 + } else if (sym!=NULL && sym->documentation!=NULL) {
1.1646 + strcpy(doc,sym->documentation);
1.1647 + strcat(doc,"<p/>");
1.1648 + free(sym->documentation);
1.1649 + sym->documentation=NULL;
1.1650 + } else {
1.1651 + doc[0]='\0';
1.1652 + } /* if */
1.1653 + /* collect all documentation */
1.1654 + while ((str=get_docstring(0))!=NULL && *str!=sDOCSEP) {
1.1655 + if (doc[0]!='\0')
1.1656 + strcat(doc," ");
1.1657 + strcat(doc,str);
1.1658 + delete_docstring(0);
1.1659 + } /* while */
1.1660 + if (str!=NULL) {
1.1661 + /* also delete the separator */
1.1662 + assert(*str==sDOCSEP);
1.1663 + delete_docstring(0);
1.1664 + } /* if */
1.1665 + if (sym!=NULL) {
1.1666 + assert(sym->documentation==NULL);
1.1667 + sym->documentation=doc;
1.1668 + } else {
1.1669 + if (sc_documentation!=NULL)
1.1670 + free(sc_documentation);
1.1671 + sc_documentation=doc;
1.1672 + } /* if */
1.1673 + } /* if */
1.1674 + } else {
1.1675 + /* delete an empty separator, if present */
1.1676 + if ((str=get_docstring(0))!=NULL && *str==sDOCSEP)
1.1677 + delete_docstring(0);
1.1678 + } /* if */
1.1679 +}
1.1680 +
1.1681 +static void insert_docstring_separator(void)
1.1682 +{
1.1683 + char sep[2]={sDOCSEP,'\0'};
1.1684 + insert_docstring(sep);
1.1685 +}
1.1686 +#else
1.1687 + #define sc_attachdocumentation(s) (void)(s)
1.1688 + #define insert_docstring_separator()
1.1689 +#endif
1.1690 +
1.1691 +static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst)
1.1692 +{
1.1693 + char name[sNAMEMAX+11];
1.1694 + int tok,tag=0;
1.1695 + char *str;
1.1696 + cell val;
1.1697 + int invalidfunc;
1.1698 + pstruct_t *pstruct = NULL;
1.1699 +
1.1700 + tok=lex(&val,&str);
1.1701 + if (tok == tLABEL) {
1.1702 + pstruct=pstructs_find(str);
1.1703 + tag=pc_addtag(str);
1.1704 + } else {
1.1705 + lexpush();
1.1706 + }
1.1707 + tok=lex(&val,&str);
1.1708 + /* if we arrived here, this may not be a declaration of a native function
1.1709 + * or variable
1.1710 + */
1.1711 + if (tok==tNATIVE) {
1.1712 + error(42); /* invalid combination of class specifiers */
1.1713 + return;
1.1714 + } /* if */
1.1715 +
1.1716 + if (tok!=tSYMBOL && tok!=tOPERATOR) {
1.1717 + lexpush();
1.1718 + needtoken(tSYMBOL);
1.1719 + lexclr(TRUE); /* drop the rest of the line */
1.1720 + litidx=0; /* drop the literal queue too */
1.1721 + return;
1.1722 + } /* if */
1.1723 + if (tok==tOPERATOR) {
1.1724 + lexpush(); /* push "operator" keyword back (for later analysis) */
1.1725 + if (!newfunc(NULL,tag,fpublic,fstatic,fstock)) {
1.1726 + error(10); /* illegal function or declaration */
1.1727 + lexclr(TRUE); /* drop the rest of the line */
1.1728 + litidx=0; /* drop the literal queue too */
1.1729 + } /* if */
1.1730 + } else {
1.1731 + /* so tok is tSYMBOL */
1.1732 + assert(strlen(str)<=sNAMEMAX);
1.1733 + strcpy(name,str);
1.1734 + /* only variables can be "const" or both "public" and "stock" */
1.1735 + invalidfunc= fconst || (fpublic && fstock);
1.1736 + if (invalidfunc || !newfunc(name,tag,fpublic,fstatic,fstock)) {
1.1737 + /* if not a function, try a global variable */
1.1738 + if (pstruct) {
1.1739 + declstructvar(name,fpublic,pstruct);
1.1740 + } else {
1.1741 + declglb(name,tag,fpublic,fstatic,fstock,fconst);
1.1742 + }
1.1743 + } /* if */
1.1744 + } /* if */
1.1745 +}
1.1746 +
1.1747 +/* declstruct - declare global struct symbols
1.1748 + *
1.1749 + * global references: glb_declared (altered)
1.1750 + */
1.1751 +static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct)
1.1752 +{
1.1753 + char name[sNAMEMAX+1];
1.1754 + int tok,i;
1.1755 + cell val;
1.1756 + char *str;
1.1757 + int cur_litidx = 0;
1.1758 + cell *values, *found;
1.1759 + int usage;
1.1760 + symbol *mysym,*sym;
1.1761 +
1.1762 + strcpy(name, firstname);
1.1763 +
1.1764 + values = (cell *)malloc(pstruct->argcount * sizeof(cell));
1.1765 + found = (cell *)malloc(pstruct->argcount * sizeof(cell));
1.1766 +
1.1767 + memset(found, 0, sizeof(cell) * pstruct->argcount);
1.1768 +
1.1769 + //:TODO: Make this work with stock
1.1770 +
1.1771 + /**
1.1772 + * Lastly, very lastly, we will insert a copy of this variable.
1.1773 + * This is soley to expose the pubvar.
1.1774 + */
1.1775 + usage = uREAD|uCONST|uSTRUCT;
1.1776 + if (fpublic)
1.1777 + {
1.1778 + usage |= uPUBLIC;
1.1779 + }
1.1780 + mysym = NULL;
1.1781 + for (sym=glbtab.next; sym!=NULL; sym=sym->next)
1.1782 + {
1.1783 + if (strcmp(name, sym->name) == 0)
1.1784 + {
1.1785 + if ((sym->usage & uSTRUCT) && sym->vclass == sGLOBAL)
1.1786 + {
1.1787 + if (sym->usage & uDEFINE)
1.1788 + {
1.1789 + error(21, name);
1.1790 + } else {
1.1791 + if (sym->usage & uPUBLIC && !fpublic)
1.1792 + {
1.1793 + error(42);
1.1794 + }
1.1795 + }
1.1796 + } else {
1.1797 + error(21, name);
1.1798 + }
1.1799 + mysym = sym;
1.1800 + break;
1.1801 + }
1.1802 + }
1.1803 + if (!mysym)
1.1804 + {
1.1805 + mysym=addsym(name, 0, iVARIABLE, sGLOBAL, pc_addtag(pstruct->name), usage);
1.1806 + }
1.1807 +
1.1808 + if (!matchtoken('='))
1.1809 + {
1.1810 + matchtoken(';');
1.1811 + /* Mark it as undefined instead */
1.1812 + mysym->usage = uSTOCK|uSTRUCT;
1.1813 + return;
1.1814 + } else {
1.1815 + mysym->usage = usage;
1.1816 + }
1.1817 + needtoken('{');
1.1818 + do
1.1819 + {
1.1820 + structarg_t *arg;
1.1821 + /* Detect early exit */
1.1822 + if (matchtoken('}'))
1.1823 + {
1.1824 + lexpush();
1.1825 + break;
1.1826 + }
1.1827 + tok=lex(&val,&str);
1.1828 + if (tok != tSYMBOL)
1.1829 + {
1.1830 + error(1, "-identifier-", str);
1.1831 + continue;
1.1832 + }
1.1833 + arg=pstructs_getarg(pstruct,str);
1.1834 + if (arg == NULL)
1.1835 + {
1.1836 + error(96, str, sym->name);
1.1837 + }
1.1838 + needtoken('=');
1.1839 + cur_litidx = litidx;
1.1840 + tok=lex(&val,&str);
1.1841 + if (!arg)
1.1842 + {
1.1843 + continue;
1.1844 + }
1.1845 + if (tok == tSTRING)
1.1846 + {
1.1847 + assert(litidx != 0);
1.1848 + if (arg->dimcount != 1)
1.1849 + {
1.1850 + error(48);
1.1851 + } else if (arg->tag != pc_tag_string) {
1.1852 + error(213);
1.1853 + }
1.1854 + values[arg->index] = glb_declared * sizeof(cell);
1.1855 + glb_declared += (litidx-cur_litidx);
1.1856 + found[arg->index] = 1;
1.1857 + } else if (tok == tNUMBER || tok == tRATIONAL) {
1.1858 + /* eat optional 'f' */
1.1859 + matchtoken('f');
1.1860 + if (arg->ident != iVARIABLE && arg->ident != iREFERENCE)
1.1861 + {
1.1862 + error(23);
1.1863 + } else {
1.1864 + if (arg->tag == pc_addtag("Float") && tok == tNUMBER ||
1.1865 + arg->tag == 0 && tok == tRATIONAL)
1.1866 + {
1.1867 + error(213);
1.1868 + }
1.1869 + if (arg->ident == iVARIABLE)
1.1870 + {
1.1871 + values[arg->index] = val;
1.1872 + } else if (arg->ident == iREFERENCE) {
1.1873 + values[arg->index] = glb_declared * sizeof(cell);
1.1874 + glb_declared += 1;
1.1875 + litadd(val);
1.1876 + cur_litidx = litidx;
1.1877 + }
1.1878 + found[arg->index] = 1;
1.1879 + }
1.1880 + } else if (tok == tSYMBOL) {
1.1881 + for (sym=glbtab.next; sym!=NULL; sym=sym->next)
1.1882 + {
1.1883 + if (sym->vclass != sGLOBAL)
1.1884 + {
1.1885 + continue;
1.1886 + }
1.1887 + if (strcmp(sym->name, str) == 0)
1.1888 + {
1.1889 + if (arg->ident == iREFERENCE && sym->ident != iVARIABLE)
1.1890 + {
1.1891 + error(97, str);
1.1892 + } else if (arg->ident == iARRAY) {
1.1893 + if (sym->ident != iARRAY)
1.1894 + {
1.1895 + error(97, str);
1.1896 + } else {
1.1897 + /* :TODO: We should check dimension sizes here... */
1.1898 + }
1.1899 + } else if (arg->ident == iREFARRAY) {
1.1900 + if (sym->ident != iARRAY)
1.1901 + {
1.1902 + error(97, str);
1.1903 + }
1.1904 + /* :TODO: Check dimension sizes! */
1.1905 + } else {
1.1906 + error(97, str);
1.1907 + }
1.1908 + if (sym->tag != arg->tag)
1.1909 + {
1.1910 + error(213);
1.1911 + }
1.1912 + sym->usage |= uREAD;
1.1913 + values[arg->index] = sym->addr;
1.1914 + found[arg->index] = 1;
1.1915 + refer_symbol(sym, mysym);
1.1916 + break;
1.1917 + }
1.1918 + }
1.1919 + if (!sym)
1.1920 + {
1.1921 + error(17, str);
1.1922 + }
1.1923 + } else {
1.1924 + error(1, "-identifier-", str);
1.1925 + }
1.1926 + } while (matchtoken(','));
1.1927 + needtoken('}');
1.1928 + matchtoken(';'); /* eat up optional semicolon */
1.1929 +
1.1930 + for (i=0; i<pstruct->argcount; i++)
1.1931 + {
1.1932 + if (!found[i])
1.1933 + {
1.1934 + structarg_t *arg = pstruct->args[i];
1.1935 + if (arg->ident == iREFARRAY)
1.1936 + {
1.1937 + values[arg->index] = glb_declared * sizeof(cell);
1.1938 + glb_declared += 1;
1.1939 + litadd(0);
1.1940 + cur_litidx = litidx;
1.1941 + } else if (arg->ident == iVARIABLE) {
1.1942 + values[arg->index] = 0;
1.1943 + } else {
1.1944 + /* :TODO: broken for iARRAY! (unused tho) */
1.1945 + }
1.1946 + }
1.1947 + }
1.1948 +
1.1949 + mysym->addr = glb_declared * sizeof(cell);
1.1950 + glb_declared += pstruct->argcount;
1.1951 +
1.1952 + for (i=0; i<pstruct->argcount; i++)
1.1953 + {
1.1954 + litadd(values[i]);
1.1955 + }
1.1956 +
1.1957 + begdseg();
1.1958 + dumplits();
1.1959 + litidx=0;
1.1960 +
1.1961 + free(found);
1.1962 + free(values);
1.1963 +}
1.1964 +
1.1965 +/* declglb - declare global symbols
1.1966 + *
1.1967 + * Declare a static (global) variable. Global variables are stored in
1.1968 + * the DATA segment.
1.1969 + *
1.1970 + * global references: glb_declared (altered)
1.1971 + */
1.1972 +static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,int fstock,int fconst)
1.1973 +{
1.1974 + int ident,tag,ispublic;
1.1975 + int idxtag[sDIMEN_MAX];
1.1976 + char name[sNAMEMAX+1];
1.1977 + cell val,size,cidx;
1.1978 + ucell address;
1.1979 + int glb_incr;
1.1980 + char *str;
1.1981 + int dim[sDIMEN_MAX];
1.1982 + int numdim;
1.1983 + int slength=0;
1.1984 + short filenum;
1.1985 + symbol *sym;
1.1986 + constvalue *enumroot;
1.1987 + #if !defined NDEBUG
1.1988 + cell glbdecl=0;
1.1989 + #endif
1.1990 +
1.1991 + assert(!fpublic || !fstatic); /* may not both be set */
1.1992 + insert_docstring_separator(); /* see comment in newfunc() */
1.1993 + filenum=fcurrent; /* save file number at the start of the declaration */
1.1994 + do {
1.1995 + size=1; /* single size (no array) */
1.1996 + numdim=0; /* no dimensions */
1.1997 + ident=iVARIABLE;
1.1998 + if (firstname!=NULL) {
1.1999 + assert(strlen(firstname)<=sNAMEMAX);
1.2000 + strcpy(name,firstname); /* save symbol name */
1.2001 + tag=firsttag;
1.2002 + firstname=NULL;
1.2003 + } else {
1.2004 + tag=pc_addtag(NULL);
1.2005 + if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
1.2006 + error(20,str); /* invalid symbol name */
1.2007 + assert(strlen(str)<=sNAMEMAX);
1.2008 + strcpy(name,str); /* save symbol name */
1.2009 + } /* if */
1.2010 + ispublic=fpublic;
1.2011 + if (name[0]==PUBLIC_CHAR) {
1.2012 + ispublic=TRUE; /* implicitly public variable */
1.2013 + assert(!fstatic);
1.2014 + } /* if */
1.2015 + while (matchtoken('[')) {
1.2016 + ident=iARRAY;
1.2017 + if (numdim == sDIMEN_MAX) {
1.2018 + error(53); /* exceeding maximum number of dimensions */
1.2019 + return;
1.2020 + } /* if */
1.2021 + size=needsub(&idxtag[numdim],&enumroot); /* get size; size==0 for "var[]" */
1.2022 + #if INT_MAX < LONG_MAX
1.2023 + if (size > INT_MAX)
1.2024 + error(125); /* overflow, exceeding capacity */
1.2025 + #endif
1.2026 +#if 0 /* We don't actually care */
1.2027 + if (ispublic)
1.2028 + error(56,name); /* arrays cannot be public */
1.2029 +#endif
1.2030 + dim[numdim++]=(int)size;
1.2031 + } /* while */
1.2032 + if (ident == iARRAY && tag == pc_tag_string && dim[numdim-1]) {
1.2033 + slength=dim[numdim-1];
1.2034 + dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
1.2035 + }
1.2036 + assert(sc_curstates==0);
1.2037 + sc_curstates=getstates(name);
1.2038 + if (sc_curstates<0) {
1.2039 + error(85,name); /* empty state list on declaration */
1.2040 + sc_curstates=0;
1.2041 + } else if (sc_curstates>0 && ispublic) {
1.2042 + error(88,name); /* public variables may not have states */
1.2043 + sc_curstates=0;
1.2044 + } /* if */
1.2045 + sym=findconst(name,NULL);
1.2046 + if (sym==NULL) {
1.2047 + sym=findglb(name,sSTATEVAR);
1.2048 + /* if a global variable without states is found and this declaration has
1.2049 + * states, the declaration is okay
1.2050 + */
1.2051 + if (sym!=NULL && sym->states==NULL && sc_curstates>0)
1.2052 + sym=NULL; /* set to NULL, we found the global variable */
1.2053 + if (sc_curstates>0 && findglb(name,sGLOBAL)!=NULL)
1.2054 + error(233,name); /* state variable shadows a global variable */
1.2055 + } /* if */
1.2056 + /* we have either:
1.2057 + * a) not found a matching variable (or rejected it, because it was a shadow)
1.2058 + * b) found a global variable and we were looking for that global variable
1.2059 + * c) found a state variable in the automaton that we were looking for
1.2060 + */
1.2061 + assert(sym==NULL
1.2062 + || sym->states==NULL && sc_curstates==0
1.2063 + || sym->states!=NULL && sym->next!=NULL && sym->states->next->index==sc_curstates);
1.2064 + /* a state variable may only have a single id in its list (so either this
1.2065 + * variable has no states, or it has a single list)
1.2066 + */
1.2067 + assert(sym==NULL || sym->states==NULL || sym->states->next->next==NULL);
1.2068 + /* it is okay for the (global) variable to exist, as long as it belongs to
1.2069 + * a different automaton
1.2070 + */
1.2071 + if (sym!=NULL && (sym->usage & uDEFINE)!=0)
1.2072 + error(21,name); /* symbol already defined */
1.2073 + /* if this variable is never used (which can be detected only in the
1.2074 + * second stage), shut off code generation
1.2075 + */
1.2076 + cidx=0; /* only to avoid a compiler warning */
1.2077 + if (sc_status==statWRITE && sym!=NULL && (sym->usage & (uREAD | uWRITTEN))==0) {
1.2078 + sc_status=statSKIP;
1.2079 + cidx=code_idx;
1.2080 + #if !defined NDEBUG
1.2081 + glbdecl=glb_declared;
1.2082 + #endif
1.2083 + } /* if */
1.2084 + begdseg(); /* real (initialized) data in data segment */
1.2085 + assert(litidx==0); /* literal queue should be empty */
1.2086 + if (sc_alignnext) {
1.2087 + litidx=0;
1.2088 + aligndata(sc_dataalign);
1.2089 + dumplits(); /* dump the literal queue */
1.2090 + sc_alignnext=FALSE;
1.2091 + litidx=0; /* global initial data is dumped, so restart at zero */
1.2092 + } /* if */
1.2093 + assert(litidx==0); /* literal queue should be empty (again) */
1.2094 + initials(ident,tag,&size,dim,numdim,enumroot);/* stores values in the literal queue */
1.2095 + if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
1.2096 + slength = glbstringread;
1.2097 + }
1.2098 + assert(size>=litidx);
1.2099 + if (numdim==1)
1.2100 + dim[0]=(int)size;
1.2101 + /* before dumping the initial values (or zeros) check whether this variable
1.2102 + * overlaps another
1.2103 + */
1.2104 + if (sc_curstates>0) {
1.2105 + unsigned char *map;
1.2106 +
1.2107 + if (litidx!=0)
1.2108 + error(89,name); /* state variables may not be initialized */
1.2109 + /* find an appropriate address for the state variable */
1.2110 + /* assume that it cannot be found */
1.2111 + address=sizeof(cell)*glb_declared;
1.2112 + glb_incr=(int)size;
1.2113 + /* use a memory map in which every cell occupies one bit */
1.2114 + if (glb_declared>0 && (map=(unsigned char*)malloc((glb_declared+7)/8))!=NULL) {
1.2115 + int fsa=state_getfsa(sc_curstates);
1.2116 + symbol *sweep;
1.2117 + cell sweepsize,addr;
1.2118 + memset(map,0,(glb_declared+7)/8);
1.2119 + assert(fsa>=0);
1.2120 + /* fill in all variables belonging to this automaton */
1.2121 + for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
1.2122 + if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
1.2123 + continue; /* hierarchical type, or no states, or same as this variable */
1.2124 + if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
1.2125 + continue; /* a function or a constant */
1.2126 + if ((sweep->usage & uDEFINE)==0)
1.2127 + continue; /* undefined variable, ignore */
1.2128 + if (fsa!=state_getfsa(sweep->states->next->index))
1.2129 + continue; /* wrong automaton */
1.2130 + /* when arrived here, this is a global variable, with states and
1.2131 + * belonging to the same automaton as the variable we are declaring
1.2132 + */
1.2133 + sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
1.2134 + assert(sweep->addr % sizeof(cell) == 0);
1.2135 + addr=sweep->addr/sizeof(cell);
1.2136 + /* mark this address range */
1.2137 + while (sweepsize-->0) {
1.2138 + map[addr/8] |= (unsigned char)(1 << (addr % 8));
1.2139 + addr++;
1.2140 + } /* while */
1.2141 + } /* for */
1.2142 + /* go over it again, clearing any ranges that have conflicts */
1.2143 + for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
1.2144 + if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
1.2145 + continue; /* hierarchical type, or no states, or same as this variable */
1.2146 + if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
1.2147 + continue; /* a function or a constant */
1.2148 + if ((sweep->usage & uDEFINE)==0)
1.2149 + continue; /* undefined variable, ignore */
1.2150 + if (fsa!=state_getfsa(sweep->states->next->index))
1.2151 + continue; /* wrong automaton */
1.2152 + /* when arrived here, this is a global variable, with states and
1.2153 + * belonging to the same automaton as the variable we are declaring
1.2154 + */
1.2155 + /* if the lists of states of the existing variable and the new
1.2156 + * variable have a non-empty intersection, this is not a suitable
1.2157 + * overlap point -> wipe the address range
1.2158 + */
1.2159 + if (state_conflict_id(sc_curstates,sweep->states->next->index)) {
1.2160 + sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
1.2161 + assert(sweep->addr % sizeof(cell) == 0);
1.2162 + addr=sweep->addr/sizeof(cell);
1.2163 + /* mark this address range */
1.2164 + while (sweepsize-->0) {
1.2165 + map[addr/8] &= (unsigned char)(~(1 << (addr % 8)));
1.2166 + addr++;
1.2167 + } /* while */
1.2168 + } /* if */
1.2169 + } /* for */
1.2170 + /* now walk through the map and find a starting point that is big enough */
1.2171 + sweepsize=0;
1.2172 + for (addr=0; addr<glb_declared; addr++) {
1.2173 + if ((map[addr/8] & (1 << (addr % 8)))==0)
1.2174 + continue;
1.2175 + for (sweepsize=addr+1; sweepsize<glb_declared; sweepsize++) {
1.2176 + if ((map[sweepsize/8] & (1 << (sweepsize % 8)))==0)
1.2177 + break; /* zero bit found, skip this range */
1.2178 + if (sweepsize-addr>=size)
1.2179 + break; /* fitting range found, no need to search further */
1.2180 + } /* for */
1.2181 + if (sweepsize-addr>=size)
1.2182 + break; /* fitting range found, no need to search further */
1.2183 + addr=sweepsize;
1.2184 + } /* for */
1.2185 + free(map);
1.2186 + if (sweepsize-addr>=size) {
1.2187 + address=sizeof(cell)*addr; /* fitting range found, set it */
1.2188 + glb_incr=0;
1.2189 + } /* if */
1.2190 + } /* if */
1.2191 + } else {
1.2192 + address=sizeof(cell)*glb_declared;
1.2193 + glb_incr=(int)size;
1.2194 + } /* if */
1.2195 + if (size != CELL_MAX && address==sizeof(cell)*glb_declared) {
1.2196 + dumplits(); /* dump the literal queue */
1.2197 + dumpzero((int)size-litidx);
1.2198 + } /* if */
1.2199 + litidx=0;
1.2200 + if (sym==NULL) { /* define only if not yet defined */
1.2201 + sym=addvariable2(name,address,ident,sGLOBAL,tag,dim,numdim,idxtag,slength);
1.2202 + if (sc_curstates>0)
1.2203 + attachstatelist(sym,sc_curstates);
1.2204 + } else { /* if declared but not yet defined, adjust the variable's address */
1.2205 + assert(sym->states==NULL && sc_curstates==0
1.2206 + || sym->states->next!=NULL && sym->states->next->index==sc_curstates && sym->states->next->next==NULL);
1.2207 + sym->addr=address;
1.2208 + sym->codeaddr=code_idx;
1.2209 + sym->usage|=uDEFINE;
1.2210 + } /* if */
1.2211 + assert(sym!=NULL);
1.2212 + sc_curstates=0;
1.2213 + if (ispublic)
1.2214 + sym->usage|=uPUBLIC|uREAD;
1.2215 + if (fconst)
1.2216 + sym->usage|=uCONST;
1.2217 + if (fstock)
1.2218 + sym->usage|=uSTOCK;
1.2219 + if (fstatic)
1.2220 + sym->fnumber=filenum;
1.2221 + sc_attachdocumentation(sym);/* attach any documenation to the variable */
1.2222 + if (sc_status==statSKIP) {
1.2223 + sc_status=statWRITE;
1.2224 + code_idx=cidx;
1.2225 + assert(glb_declared==glbdecl);
1.2226 + } else {
1.2227 + glb_declared+=glb_incr; /* add total number of cells (if added to the end) */
1.2228 + } /* if */
1.2229 + } while (matchtoken(',')); /* enddo */ /* more? */
1.2230 + needtoken(tTERM); /* if not comma, must be semicolumn */
1.2231 +}
1.2232 +
1.2233 +/* declloc - declare local symbols
1.2234 + *
1.2235 + * Declare local (automatic) variables. Since these variables are relative
1.2236 + * to the STACK, there is no switch to the DATA segment. These variables
1.2237 + * cannot be initialized either.
1.2238 + *
1.2239 + * global references: declared (altered)
1.2240 + * funcstatus (referred to only)
1.2241 + */
1.2242 +static int declloc(int fstatic)
1.2243 +{
1.2244 + int ident,tag;
1.2245 + int idxtag[sDIMEN_MAX];
1.2246 + char name[sNAMEMAX+1];
1.2247 + symbol *sym;
1.2248 + constvalue *enumroot=NULL;
1.2249 + cell val,size;
1.2250 + char *str;
1.2251 + value lval = {0};
1.2252 + int cur_lit=0;
1.2253 + int dim[sDIMEN_MAX];
1.2254 + int numdim;
1.2255 + int fconst;
1.2256 + int staging_start;
1.2257 + int slength = 0;
1.2258 +
1.2259 + fconst=matchtoken(tCONST);
1.2260 + do {
1.2261 + ident=iVARIABLE;
1.2262 + size=1;
1.2263 + slength=0;
1.2264 + numdim=0; /* no dimensions */
1.2265 + tag=pc_addtag(NULL);
1.2266 + if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
1.2267 + error(20,str); /* invalid symbol name */
1.2268 + assert(strlen(str)<=sNAMEMAX);
1.2269 + strcpy(name,str); /* save symbol name */
1.2270 + if (name[0]==PUBLIC_CHAR)
1.2271 + error(56,name); /* local variables cannot be public */
1.2272 + /* Note: block locals may be named identical to locals at higher
1.2273 + * compound blocks (as with standard C); so we must check (and add)
1.2274 + * the "nesting level" of local variables to verify the
1.2275 + * multi-definition of symbols.
1.2276 + */
1.2277 + if ((sym=findloc(name))!=NULL && sym->compound==nestlevel)
1.2278 + error(21,name); /* symbol already defined */
1.2279 + /* Although valid, a local variable whose name is equal to that
1.2280 + * of a global variable or to that of a local variable at a lower
1.2281 + * level might indicate a bug.
1.2282 + */
1.2283 + if ((sym=findloc(name))!=NULL && sym->compound!=nestlevel || findglb(name,sGLOBAL)!=NULL)
1.2284 + error(219,name); /* variable shadows another symbol */
1.2285 + if (matchtoken('[')) {
1.2286 + int _index;
1.2287 + cell _code;
1.2288 + int dim_ident;
1.2289 + symbol *dim_sym;
1.2290 + value dim_val;
1.2291 + int all_constant = 1;
1.2292 + int _staging = staging;
1.2293 +
1.2294 + if (!_staging)
1.2295 + stgset(TRUE);
1.2296 + stgget(&_index, &_code);
1.2297 +
1.2298 + do {
1.2299 + if (numdim == sDIMEN_MAX) {
1.2300 + error(53); /* exceeding maximum number of dimensions */
1.2301 + return (all_constant ? iARRAY : iREFARRAY);
1.2302 + } else if (numdim) { /* if */
1.2303 + /* If we have a dimension on the stack, push it */
1.2304 + pushreg(sPRI);
1.2305 + }
1.2306 + if (matchtoken(']')) {
1.2307 + idxtag[numdim] = 0;
1.2308 + dim[numdim] = 0;
1.2309 + numdim++;
1.2310 + continue;
1.2311 + }
1.2312 + dim_ident = doexpr2(TRUE,FALSE,FALSE,FALSE,&idxtag[numdim],&dim_sym,0,&dim_val);
1.2313 + if (dim_ident == iVARIABLE || dim_ident == iEXPRESSION || dim_ident == iARRAYCELL) {
1.2314 + all_constant = 0;
1.2315 + } else if (dim_ident == iCONSTEXPR) {
1.2316 + dim[numdim] = dim_val.constval;
1.2317 + /* :TODO: :URGENT: Make sure this still works */
1.2318 + if (dim_sym && dim_sym->usage & uENUMROOT)
1.2319 + enumroot = dim_sym->dim.enumlist;
1.2320 + idxtag[numdim] = dim_sym ? dim_sym->tag : 0;
1.2321 + #if INT_MAX < LONG_MAX
1.2322 + if (dim[numdim] > INT_MAX)
1.2323 + error(125); /* overflow, exceeding capacity */
1.2324 + #endif
1.2325 + } else {
1.2326 + error(29); /* invalid expression, assumed 0 */
1.2327 + }
1.2328 + numdim++;
1.2329 + needtoken(']');
1.2330 + } while (matchtoken('['));
1.2331 + if (all_constant) {
1.2332 + /* Change the last dimension to be based on chars instead if we have a string */
1.2333 + if (tag == pc_tag_string && numdim && dim[numdim-1]) {
1.2334 + slength = dim[numdim-1];
1.2335 + dim[numdim-1] = (dim[numdim-1] + sizeof(cell)-1) / sizeof(cell);
1.2336 + }
1.2337 + /* Scrap the code generated */
1.2338 + ident = iARRAY;
1.2339 + stgdel(_index, _code);
1.2340 + } else {
1.2341 + if (tag == pc_tag_string && numdim && dim[numdim-1]) {
1.2342 + stradjust(sPRI);
1.2343 + }
1.2344 + pushreg(sPRI);
1.2345 + memset(dim, 0, sizeof(int)*sDIMEN_MAX);
1.2346 + ident = iREFARRAY;
1.2347 + genarray(numdim, autozero);
1.2348 + }
1.2349 + stgout(_index);
1.2350 + if (!_staging)
1.2351 + stgset(FALSE);
1.2352 + }
1.2353 + if (getstates(name))
1.2354 + error(88,name); /* local variables may not have states */
1.2355 + if (ident==iARRAY || fstatic) {
1.2356 + if (sc_alignnext) {
1.2357 + aligndata(sc_dataalign);
1.2358 + sc_alignnext=FALSE;
1.2359 + } /* if */
1.2360 + cur_lit=litidx; /* save current index in the literal table */
1.2361 + if (numdim && !dim[numdim-1])
1.2362 + size = 0;
1.2363 + initials(ident,tag,&size,dim,numdim,enumroot);
1.2364 + if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
1.2365 + slength = glbstringread;
1.2366 + }
1.2367 + if (size==0)
1.2368 + return ident; /* error message already given */
1.2369 + if (numdim==1)
1.2370 + dim[0]=(int)size;
1.2371 + }
1.2372 + /* reserve memory (on the stack) for the variable */
1.2373 + if (fstatic) {
1.2374 + /* write zeros for uninitialized fields */
1.2375 + while (litidx<cur_lit+size)
1.2376 + litadd(0);
1.2377 + sym=addvariable2(name,(cur_lit+glb_declared)*sizeof(cell),ident,sSTATIC,
1.2378 + tag,dim,numdim,idxtag,slength);
1.2379 + } else if (ident!=iREFARRAY) {
1.2380 + declared+=(int)size; /* variables are put on stack, adjust "declared" */
1.2381 + sym=addvariable2(name,-declared*sizeof(cell),ident,sLOCAL,tag,
1.2382 + dim,numdim,idxtag,slength);
1.2383 + if (ident==iVARIABLE) {
1.2384 + assert(!staging);
1.2385 + stgset(TRUE); /* start stage-buffering */
1.2386 + assert(stgidx==0);
1.2387 + staging_start=stgidx;
1.2388 + } /* if */
1.2389 + markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
1.2390 + modstk(-(int)size*sizeof(cell));
1.2391 + markstack(MEMUSE_STATIC, size);
1.2392 + assert(curfunc!=NULL);
1.2393 + assert((curfunc->usage & uNATIVE)==0);
1.2394 + if (curfunc->x.stacksize<declared+1)
1.2395 + curfunc->x.stacksize=declared+1; /* +1 for PROC opcode */
1.2396 + } else if (ident==iREFARRAY) {
1.2397 + declared+=1; /* one cell for address */
1.2398 + sym=addvariable(name,-declared*sizeof(cell),ident,sLOCAL,tag,dim,numdim,idxtag);
1.2399 + //markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
1.2400 + /* genarray() pushes the address onto the stack, so we don't need to call modstk() here! */
1.2401 + markheap(MEMUSE_DYNAMIC, 0);
1.2402 + markstack(MEMUSE_STATIC, 1);
1.2403 + assert(curfunc != NULL && ((curfunc->usage & uNATIVE) == 0));
1.2404 + if (curfunc->x.stacksize<declared+1)
1.2405 + curfunc->x.stacksize=declared+1; /* +1 for PROC opcode */
1.2406 + } /* if */
1.2407 + /* now that we have reserved memory for the variable, we can proceed
1.2408 + * to initialize it */
1.2409 + assert(sym!=NULL); /* we declared it, it must be there */
1.2410 + sym->compound=nestlevel; /* for multiple declaration/shadowing check */
1.2411 + if (fconst)
1.2412 + sym->usage|=uCONST;
1.2413 + if (!fstatic) { /* static variables already initialized */
1.2414 + if (ident==iVARIABLE) {
1.2415 + /* simple variable, also supports initialization */
1.2416 + int ctag = tag; /* set to "tag" by default */
1.2417 + int explicit_init=FALSE;/* is the variable explicitly initialized? */
1.2418 + int cident=ident;
1.2419 + if (matchtoken('=')) {
1.2420 + if (!autozero)
1.2421 + error(10);
1.2422 + cident=doexpr(FALSE,FALSE,FALSE,FALSE,&ctag,NULL,TRUE);
1.2423 + explicit_init=TRUE;
1.2424 + } else {
1.2425 + if (autozero)
1.2426 + ldconst(0,sPRI); /* uninitialized variable, set to zero */
1.2427 + } /* if */
1.2428 + if (autozero) {
1.2429 + /* now try to save the value (still in PRI) in the variable */
1.2430 + lval.sym=sym;
1.2431 + lval.ident=iVARIABLE;
1.2432 + lval.constval=0;
1.2433 + lval.tag=tag;
1.2434 + check_userop(NULL,ctag,lval.tag,2,NULL,&ctag);
1.2435 + store(&lval);
1.2436 + markexpr(sEXPR,NULL,0); /* full expression ends after the store */
1.2437 + }
1.2438 + assert(staging); /* end staging phase (optimize expression) */
1.2439 + stgout(staging_start);
1.2440 + stgset(FALSE);
1.2441 + if (!matchtag_string(cident, ctag) && !matchtag(tag,ctag,TRUE))
1.2442 + {
1.2443 + if (tag & FUNCTAG)
1.2444 + error(100); /* error - function prototypes do not match */
1.2445 + else
1.2446 + error(213); /* warning - tag mismatch */
1.2447 + }
1.2448 + /* if the variable was not explicitly initialized, reset the
1.2449 + * "uWRITTEN" flag that store() set */
1.2450 + if (!explicit_init)
1.2451 + sym->usage &= ~uWRITTEN;
1.2452 + } else if (ident!=iREFARRAY) {
1.2453 + /* an array */
1.2454 + assert(cur_lit>=0 && cur_lit<=litidx && litidx<=litmax);
1.2455 + assert(size>0 && size>=sym->dim.array.length);
1.2456 + assert(numdim>1 || size==sym->dim.array.length);
1.2457 + if (autozero) {
1.2458 + /* final literal values that are zero make no sense to put in the literal
1.2459 + * pool, because values get zero-initialized anyway; we check for this,
1.2460 + * because users often explicitly initialize strings to ""
1.2461 + */
1.2462 + while (litidx>cur_lit && litq[litidx-1]==0)
1.2463 + litidx--;
1.2464 + /* if the array is not completely filled, set all values to zero first */
1.2465 + if (litidx-cur_lit<size && (ucell)size<CELL_MAX)
1.2466 + fillarray(sym,size*sizeof(cell),0);
1.2467 + }
1.2468 + if (cur_lit<litidx) {
1.2469 + /* check whether the complete array is set to a single value; if
1.2470 + * it is, more compact code can be generated */
1.2471 + cell first=litq[cur_lit];
1.2472 + int i;
1.2473 + for (i=cur_lit; i<litidx && litq[i]==first; i++)
1.2474 + /* nothing */;
1.2475 + if (i==litidx) {
1.2476 + /* all values are the same */
1.2477 + fillarray(sym,(litidx-cur_lit)*sizeof(cell),first);
1.2478 + litidx=cur_lit; /* reset literal table */
1.2479 + } else {
1.2480 + /* copy the literals to the array */
1.2481 + ldconst((cur_lit+glb_declared)*sizeof(cell),sPRI);
1.2482 + copyarray(sym,(litidx-cur_lit)*sizeof(cell));
1.2483 + } /* if */
1.2484 + } /* if */
1.2485 + } /* if */
1.2486 + } /* if */
1.2487 + } while (matchtoken(',')); /* enddo */ /* more? */
1.2488 + needtoken(tTERM); /* if not comma, must be semicolumn */
1.2489 + return ident;
1.2490 +}
1.2491 +
1.2492 +/* this function returns the maximum value for a cell in case of an error
1.2493 + * (invalid dimension).
1.2494 + */
1.2495 +static cell calc_arraysize(int dim[],int numdim,int cur)
1.2496 +{
1.2497 + cell subsize;
1.2498 + ucell newsize;
1.2499 +
1.2500 + /* the return value is in cells, not bytes */
1.2501 + assert(cur>=0 && cur<=numdim);
1.2502 + if (cur==numdim)
1.2503 + return 0;
1.2504 + subsize=calc_arraysize(dim,numdim,cur+1);
1.2505 + newsize=dim[cur]+dim[cur]*subsize;
1.2506 + if ((ucell)subsize>=CELL_MAX || newsize>=CELL_MAX || newsize*sizeof(cell)>=CELL_MAX)
1.2507 + return CELL_MAX;
1.2508 + return newsize;
1.2509 +}
1.2510 +
1.2511 +static cell gen_indirection_vecs(array_info_t *ar, int dim, cell cur_offs)
1.2512 +{
1.2513 + int i;
1.2514 + cell write_offs = cur_offs;
1.2515 + cell *data_offs = ar->data_offs;
1.2516 +
1.2517 + cur_offs += ar->dim_list[dim];
1.2518 +
1.2519 + /**
1.2520 + * Dimension n-x where x > 2 will have sub-vectors.
1.2521 + * Otherwise, we just need to reference the data section.
1.2522 + */
1.2523 + if (ar->dim_count > 2 && dim < ar->dim_count - 2)
1.2524 + {
1.2525 + /**
1.2526 + * For each index at this dimension, write offstes to our sub-vectors.
1.2527 + * After we write one sub-vector, we generate its sub-vectors recursively.
1.2528 + * At the end, we're given the next offset we can use.
1.2529 + */
1.2530 + for (i = 0; i < ar->dim_list[dim]; i++)
1.2531 + {
1.2532 + ar->base[write_offs] = (cur_offs - write_offs) * sizeof(cell);
1.2533 + write_offs++;
1.2534 + ar->cur_dims[dim] = i;
1.2535 + cur_offs = gen_indirection_vecs(ar, dim + 1, cur_offs);
1.2536 + }
1.2537 + } else if (ar->dim_count > 1) {
1.2538 + /**
1.2539 + * In this section, there are no sub-vectors, we need to write offsets
1.2540 + * to the data. This is separate so the data stays in one big chunk.
1.2541 + * The data offset will increment by the size of the last dimension,
1.2542 + * because that is where the data is finally computed as. But the last
1.2543 + * dimension can be of variable size, so we have to detect that.
1.2544 + */
1.2545 + if (ar->dim_list[dim + 1] == 0)
1.2546 + {
1.2547 + int vec_start = 0;
1.2548 +
1.2549 + /**
1.2550 + * Using the precalculated offsets, compute an index into the last
1.2551 + * dimension array.
1.2552 + */
1.2553 + for (i = 0; i < dim; i++)
1.2554 + {
1.2555 + vec_start += ar->cur_dims[i] * ar->dim_offs_precalc[i];
1.2556 + }
1.2557 +
1.2558 + /**
1.2559 + * Now, vec_start points to a vector of last dimension offsets for
1.2560 + * the preceding dimension combination(s).
1.2561 + * I.e. (1,2,i,j) in [3][4][5][] will be:
1.2562 + * j = 1*(4*5) + 2*(5) + i, and the parenthetical expressions are
1.2563 + * precalculated for us so we can easily generalize here.
1.2564 + */
1.2565 + for (i = 0; i < ar->dim_list[dim]; i++)
1.2566 + {
1.2567 + ar->base[write_offs] = (*data_offs - write_offs) * sizeof(cell);
1.2568 + write_offs++;
1.2569 + *data_offs = *data_offs + ar->lastdim_list[vec_start + i];
1.2570 + }
1.2571 + } else {
1.2572 + /**
1.2573 + * The last dimension size is constant. There's no extra work to
1.2574 + * compute the last dimension size.
1.2575 + */
1.2576 + for (i = 0; i < ar->dim_list[dim]; i++)
1.2577 + {
1.2578 + ar->base[write_offs] = (*data_offs - write_offs) * sizeof(cell);
1.2579 + write_offs++;
1.2580 + *data_offs = *data_offs + ar->dim_list[dim + 1];
1.2581 + }
1.2582 + }
1.2583 + }
1.2584 +
1.2585 + return cur_offs;
1.2586 +}
1.2587 +
1.2588 +static cell calc_indirection(const int dim_list[], int dim_count, int dim)
1.2589 +{
1.2590 + cell size = dim_list[dim];
1.2591 +
1.2592 + if (dim < dim_count - 2)
1.2593 + {
1.2594 + size += dim_list[dim] * calc_indirection(dim_list, dim_count, dim + 1);
1.2595 + }
1.2596 +
1.2597 + return size;
1.2598 +}
1.2599 +
1.2600 +static void adjust_indirectiontables(int dim[],int numdim,int cur,cell increment,
1.2601 + int startlit,constvalue *lastdim,int *skipdim)
1.2602 +{
1.2603 + /* Find how many cells the indirection table will be */
1.2604 + cell tbl_size;
1.2605 + int *dyn_list = NULL;
1.2606 + int cur_dims[sDIMEN_MAX];
1.2607 + cell dim_offset_precalc[sDIMEN_MAX];
1.2608 + array_info_t ar;
1.2609 +
1.2610 + if (numdim == 1)
1.2611 + {
1.2612 + return;
1.2613 + }
1.2614 +
1.2615 + tbl_size = calc_indirection(dim, numdim, 0);
1.2616 + memset(cur_dims, 0, sizeof(cur_dims));
1.2617 +
1.2618 + /**
1.2619 + * Flatten the last dimension array list -- this makes
1.2620 + * things MUCH easier in the indirection calculator.
1.2621 + */
1.2622 + if (lastdim)
1.2623 + {
1.2624 + int i;
1.2625 + constvalue *ld = lastdim->next;
1.2626 +
1.2627 + /* Get the total number of last dimensions. */
1.2628 + for (i = 0; ld != NULL; i++, ld = ld->next)
1.2629 + {
1.2630 + /* Nothing */
1.2631 + }
1.2632 + /* Store them in an array instead of a linked list. */
1.2633 + dyn_list = (int *)malloc(sizeof(int) * i);
1.2634 + for (i = 0, ld = lastdim->next;
1.2635 + ld != NULL;
1.2636 + i++, ld = ld->next)
1.2637 + {
1.2638 + dyn_list[i] = ld->value;
1.2639 + }
1.2640 +
1.2641 + /**
1.2642 + * Pre-calculate all of the offsets. This speeds up and simplifies
1.2643 + * the indirection process. For example, if we have an array like:
1.2644 + * [a][b][c][d][], and given (A,B,C), we want to find the size of
1.2645 + * the last dimension [A][B][C][i], we must do:
1.2646 + *
1.2647 + * list[A*(b*c*d) + B*(c*d) + C*(d) + i]
1.2648 + *
1.2649 + * Generalizing this algorithm in the indirection process is expensive,
1.2650 + * so we lessen the need for nested loops by pre-computing the parts:
1.2651 + * (b*c*d), (c*d), and (d).
1.2652 + *
1.2653 + * In other words, finding the offset to dimension N at index I is
1.2654 + * I * (S[N+1] * S[N+2] ... S[N+n-1]) where S[] is the size of dimension
1.2655 + * function, and n is the index of the last dimension.
1.2656 + */
1.2657 + for (i = 0; i < numdim - 1; i++)
1.2658 + {
1.2659 + int j;
1.2660 +
1.2661 + dim_offset_precalc[i] = 1;
1.2662 + for (j = i + 1; j < numdim - 1; j++)
1.2663 + {
1.2664 + dim_offset_precalc[i] *= dim[j];
1.2665 + }
1.2666 + }
1.2667 +
1.2668 + ar.dim_offs_precalc = dim_offset_precalc;
1.2669 + ar.lastdim_list = dyn_list;
1.2670 + } else {
1.2671 + ar.dim_offs_precalc = NULL;
1.2672 + ar.lastdim_list = NULL;
1.2673 + }
1.2674 +
1.2675 + ar.base = &litq[startlit];
1.2676 + ar.data_offs = &tbl_size;
1.2677 + ar.dim_list = dim;
1.2678 + ar.dim_count = numdim;
1.2679 + ar.cur_dims = cur_dims;
1.2680 +
1.2681 + gen_indirection_vecs(&ar, 0, 0);
1.2682 +
1.2683 + free(dyn_list);
1.2684 +}
1.2685 +
1.2686 +/* initials
1.2687 + *
1.2688 + * Initialize global objects and local arrays.
1.2689 + * size==array cells (count), if 0 on input, the routine counts the number of elements
1.2690 + * tag==required tagname id (not the returned tag)
1.2691 + *
1.2692 + * Global references: litidx (altered)
1.2693 + */
1.2694 +static void initials2(int ident,int tag,cell *size,int dim[],int numdim,
1.2695 + constvalue *enumroot, int eq_match_override, int curlit_override)
1.2696 +{
1.2697 + int ctag;
1.2698 + cell tablesize;
1.2699 + int curlit=(curlit_override == -1) ? litidx : curlit_override;
1.2700 + int err=0;
1.2701 +
1.2702 + if (eq_match_override == -1) {
1.2703 + eq_match_override = matchtoken('=');
1.2704 + }
1.2705 +
1.2706 + if (!eq_match_override) {
1.2707 + assert(ident!=iARRAY || numdim>0);
1.2708 + if (ident==iARRAY && dim[numdim-1]==0) {
1.2709 + /* declared as "myvar[];" which is senseless (note: this *does* make
1.2710 + * sense in the case of a iREFARRAY, which is a function parameter)
1.2711 + */
1.2712 + error(9); /* array has zero length -> invalid size */
1.2713 + } /* if */
1.2714 + if (ident==iARRAY) {
1.2715 + assert(numdim>0 && numdim<=sDIMEN_MAX);
1.2716 + *size=calc_arraysize(dim,numdim,0);
1.2717 + if (*size==(cell)CELL_MAX) {
1.2718 + error(9); /* array is too big -> invalid size */
1.2719 + return;
1.2720 + } /* if */
1.2721 + /* first reserve space for the indirection vectors of the array, then
1.2722 + * adjust it to contain the proper values
1.2723 + * (do not use dumpzero(), as it bypasses the literal queue)
1.2724 + */
1.2725 + for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
1.2726 + litadd(0);
1.2727 + if (dim[numdim-1]!=0) /* error 9 has already been given */
1.2728 + adjust_indirectiontables(dim,numdim,0,0,curlit,NULL,NULL);
1.2729 + } /* if */
1.2730 + return;
1.2731 + } /* if */
1.2732 +
1.2733 + if (ident==iVARIABLE) {
1.2734 + assert(*size==1);
1.2735 + init(ident,&ctag,NULL);
1.2736 + if (!matchtag(tag,ctag,TRUE))
1.2737 + {
1.2738 + if (tag & FUNCTAG)
1.2739 + error(100); /* error - function prototypes do not match */
1.2740 + else
1.2741 + error(213); /* warning - tag mismatch */
1.2742 + }
1.2743 + } else {
1.2744 + assert(numdim>0);
1.2745 + if (numdim==1) {
1.2746 + *size=initvector(ident,tag,dim[0],FALSE,enumroot,NULL);
1.2747 + } else {
1.2748 + int errorfound=FALSE;
1.2749 + int counteddim[sDIMEN_MAX];
1.2750 + int idx;
1.2751 + constvalue lastdim={NULL,"",0,0}; /* sizes of the final dimension */
1.2752 + int skipdim=0;
1.2753 +
1.2754 + if (dim[numdim-1]!=0)
1.2755 + *size=calc_arraysize(dim,numdim,0); /* calc. full size, if known */
1.2756 + /* already reserve space for the indirection tables (for an array with
1.2757 + * known dimensions)
1.2758 + * (do not use dumpzero(), as it bypasses the literal queue)
1.2759 + */
1.2760 + for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
1.2761 + litadd(0);
1.2762 + /* now initialize the sub-arrays */
1.2763 + memset(counteddim,0,sizeof counteddim);
1.2764 + initarray(ident,tag,dim,numdim,0,curlit,counteddim,&lastdim,enumroot,&errorfound);
1.2765 + /* check the specified array dimensions with the initializer counts */
1.2766 + for (idx=0; idx<numdim-1; idx++) {
1.2767 + if (dim[idx]==0) {
1.2768 + dim[idx]=counteddim[idx];
1.2769 + } else if (counteddim[idx]<dim[idx]) {
1.2770 + error(52); /* array is not fully initialized */
1.2771 + err++;
1.2772 + } else if (counteddim[idx]>dim[idx]) {
1.2773 + error(18); /* initialization data exceeds declared size */
1.2774 + err++;
1.2775 + } /* if */
1.2776 + } /* for */
1.2777 + if (numdim>1 && dim[numdim-1]==0) {
1.2778 + /* also look whether, by any chance, all "counted" final dimensions are
1.2779 + * the same value; if so, we can store this
1.2780 + */
1.2781 + constvalue *ld=lastdim.next;
1.2782 + int d,match;
1.2783 + for (d=0; d<dim[numdim-2]; d++) {
1.2784 + assert(ld!=NULL);
1.2785 + assert(strtol(ld->name,NULL,16)==d);
1.2786 + if (d==0)
1.2787 + match=ld->value;
1.2788 + else if (match!=ld->value)
1.2789 + break;
1.2790 + ld=ld->next;
1.2791 + } /* for */
1.2792 + if (d==dim[numdim-2])
1.2793 + dim[numdim-1]=match;
1.2794 + } /* if */
1.2795 + /* after all arrays have been initalized, we know the (major) dimensions
1.2796 + * of the array and we can properly adjust the indirection vectors
1.2797 + */
1.2798 + if (err==0)
1.2799 + adjust_indirectiontables(dim,numdim,0,0,curlit,&lastdim,&skipdim);
1.2800 + delete_consttable(&lastdim); /* clear list of minor dimension sizes */
1.2801 + } /* if */
1.2802 + } /* if */
1.2803 +
1.2804 + if (*size==0)
1.2805 + *size=litidx-curlit; /* number of elements defined */
1.2806 +}
1.2807 +
1.2808 +static void initials(int ident,int tag,cell *size,int dim[],int numdim,
1.2809 + constvalue *enumroot)
1.2810 +{
1.2811 + initials2(ident, tag, size, dim, numdim, enumroot, -1, -1);
1.2812 +}
1.2813 +
1.2814 +static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
1.2815 + int startlit,int counteddim[],constvalue *lastdim,
1.2816 + constvalue *enumroot,int *errorfound)
1.2817 +{
1.2818 + cell dsize,totalsize;
1.2819 + int idx,abortparse;
1.2820 +
1.2821 + assert(cur>=0 && cur<numdim);
1.2822 + assert(startlit>=0);
1.2823 + assert(cur+2<=numdim);/* there must be 2 dimensions or more to do */
1.2824 + assert(errorfound!=NULL && *errorfound==FALSE);
1.2825 + totalsize=0;
1.2826 + needtoken('{');
1.2827 + for (idx=0,abortparse=FALSE; !abortparse; idx++) {
1.2828 +
1.2829 + /* In case the major dimension is zero, we need to store the offset
1.2830 + * to the newly detected sub-array into the indirection table; i.e.
1.2831 + * this table needs to be expanded and updated.
1.2832 + * In the current design, the indirection vectors for a multi-dimensional
1.2833 + * array are adjusted after parsing all initializers. Hence, it is only
1.2834 + * necessary at this point to reserve space for an extra cell in the
1.2835 + * indirection vector.
1.2836 + */
1.2837 + if (dim[cur]==0) {
1.2838 + litinsert(0,startlit);
1.2839 + } else if (idx>=dim[cur]) {
1.2840 + error(18); /* initialization data exceeds array size */
1.2841 + break;
1.2842 + } /* if */
1.2843 + if (cur+2<numdim) {
1.2844 + dsize=initarray(ident,tag,dim,numdim,cur+1,startlit,counteddim,
1.2845 + lastdim,enumroot,errorfound);
1.2846 + } else {
1.2847 + dsize=initvector(ident,tag,dim[cur+1],TRUE,enumroot,errorfound);
1.2848 + /* The final dimension may be variable length. We need to keep the
1.2849 + * lengths of the final dimensions in order to set the indirection
1.2850 + * vectors for the next-to-last dimension.
1.2851 + */
1.2852 + append_constval(lastdim,itoh(idx),dsize,0);
1.2853 + } /* if */
1.2854 + totalsize+=dsize;
1.2855 + if (*errorfound || !matchtoken(','))
1.2856 + abortparse=TRUE;
1.2857 + } /* for */
1.2858 + needtoken('}');
1.2859 + assert(counteddim!=NULL);
1.2860 + if (counteddim[cur]>0) {
1.2861 + if (idx<counteddim[cur])
1.2862 + error(52); /* array is not fully initialized */
1.2863 + else if (idx>counteddim[cur])
1.2864 + error(18); /* initialization data exceeds declared size */
1.2865 + } /* if */
1.2866 + counteddim[cur]=idx;
1.2867 +
1.2868 + return totalsize+dim[cur]; /* size of sub-arrays + indirection vector */
1.2869 +}
1.2870 +
1.2871 +/* initvector
1.2872 + * Initialize a single dimensional array
1.2873 + */
1.2874 +static cell initvector(int ident,int tag,cell size,int fillzero,
1.2875 + constvalue *enumroot,int *errorfound)
1.2876 +{
1.2877 + cell prev1=0,prev2=0;
1.2878 + int ellips=FALSE;
1.2879 + int curlit=litidx;
1.2880 + int rtag,ctag;
1.2881 +
1.2882 + assert(ident==iARRAY || ident==iREFARRAY);
1.2883 + if (matchtoken('{')) {
1.2884 + constvalue *enumfield=(enumroot!=NULL) ? enumroot->next : NULL;
1.2885 + do {
1.2886 + int fieldlit=litidx;
1.2887 + int matchbrace,i;
1.2888 + if (matchtoken('}')) { /* to allow for trailing ',' after the initialization */
1.2889 + lexpush();
1.2890 + break;
1.2891 + } /* if */
1.2892 + if ((ellips=matchtoken(tELLIPS))!=0)
1.2893 + break;
1.2894 + /* for enumeration fields, allow another level of braces ("{...}") */
1.2895 + matchbrace=0; /* preset */
1.2896 + ellips=0;
1.2897 + if (enumfield!=NULL)
1.2898 + matchbrace=matchtoken('{');
1.2899 + for ( ;; ) {
1.2900 + prev2=prev1;
1.2901 + prev1=init(ident,&ctag,errorfound);
1.2902 + if (!matchbrace)
1.2903 + break;
1.2904 + if ((ellips=matchtoken(tELLIPS))!=0)
1.2905 + break;
1.2906 + if (!matchtoken(',')) {
1.2907 + needtoken('}');
1.2908 + break;
1.2909 + } /* for */
1.2910 + } /* for */
1.2911 + /* if this array is based on an enumeration, fill the "field" up with
1.2912 + * zeros, and toggle the tag
1.2913 + */
1.2914 + if (enumroot!=NULL && enumfield==NULL)
1.2915 + error(227); /* more initializers than enum fields */
1.2916 + rtag=tag; /* preset, may be overridden by enum field tag */
1.2917 + if (enumfield!=NULL) {
1.2918 + cell step;
1.2919 + int cmptag=enumfield->index;
1.2920 + symbol *symfield=findconst(enumfield->name,&cmptag);
1.2921 + if (cmptag>1)
1.2922 + error(91,enumfield->name); /* ambiguous constant, needs tag override */
1.2923 + assert(symfield!=NULL);
1.2924 + assert(fieldlit<litidx);
1.2925 + if (litidx-fieldlit>symfield->dim.array.length)
1.2926 + error(228); /* length of initializer exceeds size of the enum field */
1.2927 + if (ellips) {
1.2928 + step=prev1-prev2;
1.2929 + } else {
1.2930 + step=0;
1.2931 + prev1=0;
1.2932 + } /* if */
1.2933 + for (i=litidx-fieldlit; i<symfield->dim.array.length; i++) {
1.2934 + prev1+=step;
1.2935 + litadd(prev1);
1.2936 + } /* for */
1.2937 + rtag=symfield->x.tags.index; /* set the expected tag to the index tag */
1.2938 + enumfield=enumfield->next;
1.2939 + } /* if */
1.2940 + if (!matchtag(rtag,ctag,TRUE))
1.2941 + {
1.2942 + if (rtag & FUNCTAG)
1.2943 + error(100); /* error - function prototypes do not match */
1.2944 + else
1.2945 + error(213); /* warning - tag mismatch */
1.2946 + }
1.2947 + } while (matchtoken(',')); /* do */
1.2948 + needtoken('}');
1.2949 + } else {
1.2950 + init(ident,&ctag,errorfound);
1.2951 + if (!matchtag(tag,ctag,TRUE))
1.2952 + error(213); /* tagname mismatch */
1.2953 + } /* if */
1.2954 + /* fill up the literal queue with a series */
1.2955 + if (ellips) {
1.2956 + cell step=((litidx-curlit)==1) ? (cell)0 : prev1-prev2;
1.2957 + if (size==0 || (litidx-curlit)==0)
1.2958 + error(41); /* invalid ellipsis, array size unknown */
1.2959 + else if ((litidx-curlit)==(int)size)
1.2960 + error(18); /* initialization data exceeds declared size */
1.2961 + while ((litidx-curlit)<(int)size) {
1.2962 + prev1+=step;
1.2963 + litadd(prev1);
1.2964 + } /* while */
1.2965 + } /* if */
1.2966 + if (fillzero && size>0) {
1.2967 + while ((litidx-curlit)<(int)size)
1.2968 + litadd(0);
1.2969 + } /* if */
1.2970 + if (size==0) {
1.2971 + size=litidx-curlit; /* number of elements defined */
1.2972 + } else if (litidx-curlit>(int)size) { /* e.g. "myvar[3]={1,2,3,4};" */
1.2973 + error(18); /* initialization data exceeds declared size */
1.2974 + litidx=(int)size+curlit; /* avoid overflow in memory moves */
1.2975 + } /* if */
1.2976 + return size;
1.2977 +}
1.2978 +
1.2979 +/* init
1.2980 + *
1.2981 + * Evaluate one initializer.
1.2982 + */
1.2983 +static cell init(int ident,int *tag,int *errorfound)
1.2984 +{
1.2985 + cell i = 0;
1.2986 +
1.2987 + if (matchtoken(tSTRING)){
1.2988 + /* lex() automatically stores strings in the literal table (and
1.2989 + * increases "litidx") */
1.2990 + if (ident==iVARIABLE) {
1.2991 + error(6); /* must be assigned to an array */
1.2992 + litidx=1; /* reset literal queue */
1.2993 + } /* if */
1.2994 + *tag=pc_tag_string;
1.2995 + } else if (constexpr(&i,tag,NULL)){
1.2996 + litadd(i); /* store expression result in literal table */
1.2997 + } else {
1.2998 + if (errorfound!=NULL)
1.2999 + *errorfound=TRUE;
1.3000 + } /* if */
1.3001 + return i;
1.3002 +}
1.3003 +
1.3004 +/* needsub
1.3005 + *
1.3006 + * Get required array size
1.3007 + */
1.3008 +static cell needsub(int *tag,constvalue **enumroot)
1.3009 +{
1.3010 + cell val;
1.3011 + symbol *sym;
1.3012 +
1.3013 + assert(tag!=NULL);
1.3014 + *tag=0;
1.3015 + if (enumroot!=NULL)
1.3016 + *enumroot=NULL; /* preset */
1.3017 + if (matchtoken(']')) /* we have already seen "[" */
1.3018 + return 0; /* zero size (like "char msg[]") */
1.3019 +
1.3020 + constexpr(&val,tag,&sym); /* get value (must be constant expression) */
1.3021 + if (val<0) {
1.3022 + error(9); /* negative array size is invalid; assumed zero */
1.3023 + val=0;
1.3024 + } /* if */
1.3025 + needtoken(']');
1.3026 +
1.3027 + if (enumroot!=NULL) {
1.3028 + /* get the field list for an enumeration */
1.3029 + assert(*enumroot==NULL);/* should have been preset */
1.3030 + assert(sym==NULL || sym->ident==iCONSTEXPR);
1.3031 + if (sym!=NULL && (sym->usage & uENUMROOT)==uENUMROOT) {
1.3032 + assert(sym->dim.enumlist!=NULL);
1.3033 + *enumroot=sym->dim.enumlist;
1.3034 + } /* if */
1.3035 + } /* if */
1.3036 +
1.3037 + return val; /* return array size */
1.3038 +}
1.3039 +
1.3040 +/* decl_const - declare a single constant
1.3041 + *
1.3042 + */
1.3043 +static void decl_const(int vclass)
1.3044 +{
1.3045 + char constname[sNAMEMAX+1];
1.3046 + cell val;
1.3047 + char *str;
1.3048 + int tag,exprtag;
1.3049 + int symbolline;
1.3050 + symbol *sym;
1.3051 +
1.3052 + insert_docstring_separator(); /* see comment in newfunc() */
1.3053 + do {
1.3054 + tag=pc_addtag(NULL);
1.3055 + if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
1.3056 + error(20,str); /* invalid symbol name */
1.3057 + symbolline=fline; /* save line where symbol was found */
1.3058 + strcpy(constname,str); /* save symbol name */
1.3059 + needtoken('=');
1.3060 + constexpr(&val,&exprtag,NULL); /* get value */
1.3061 + /* add_constant() checks for duplicate definitions */
1.3062 + if (!matchtag(tag,exprtag,FALSE)) {
1.3063 + /* temporarily reset the line number to where the symbol was defined */
1.3064 + int orgfline=fline;
1.3065 + fline=symbolline;
1.3066 + error(213); /* tagname mismatch */
1.3067 + fline=orgfline;
1.3068 + } /* if */
1.3069 + sym=add_constant(constname,val,vclass,tag);
1.3070 + if (sym!=NULL)
1.3071 + sc_attachdocumentation(sym);/* attach any documenation to the constant */
1.3072 + } while (matchtoken(',')); /* enddo */ /* more? */
1.3073 + needtoken(tTERM);
1.3074 +}
1.3075 +
1.3076 +/*
1.3077 + * declstruct - declare a struct type
1.3078 + */
1.3079 +static void declstruct(void)
1.3080 +{
1.3081 + cell val;
1.3082 + char *str;
1.3083 + int tok;
1.3084 + pstruct_t *pstruct;
1.3085 + int size;
1.3086 +
1.3087 + /* get the explicit tag (required!) */
1.3088 + tok = lex(&val,&str);
1.3089 + if (tok != tSYMBOL)
1.3090 + {
1.3091 + error(93);
1.3092 + }
1.3093 +
1.3094 + if (pstructs_find(str) != NULL)
1.3095 + {
1.3096 + error(98);
1.3097 + }
1.3098 +
1.3099 + pstruct = pstructs_add(str);
1.3100 +
1.3101 + needtoken('{');
1.3102 + do
1.3103 + {
1.3104 + structarg_t arg;
1.3105 + if (matchtoken('}'))
1.3106 + {
1.3107 + /* Quick exit */
1.3108 + lexpush();
1.3109 + break;
1.3110 + }
1.3111 + memset(&arg, 0, sizeof(structarg_t));
1.3112 + tok = lex(&val,&str);
1.3113 + if (tok == tCONST)
1.3114 + {
1.3115 + arg.fconst = 1;
1.3116 + tok = lex(&val,&str);
1.3117 + }
1.3118 + arg.ident = 0;
1.3119 + if (tok == '&')
1.3120 + {
1.3121 + arg.ident = iREFERENCE;
1.3122 + tok = lex(&val,&str);
1.3123 + }
1.3124 + if (tok == tLABEL)
1.3125 + {
1.3126 + arg.tag = pc_addtag(str);
1.3127 + tok = lex(&val,&str);
1.3128 + }
1.3129 + if (tok != tSYMBOL)
1.3130 + {
1.3131 + error(1, "-identifier-", str);
1.3132 + continue;
1.3133 + }
1.3134 + strcpy(arg.name, str);
1.3135 + if (matchtoken('['))
1.3136 + {
1.3137 + if (arg.ident == iREFERENCE)
1.3138 + {
1.3139 + error(67, arg.name);
1.3140 + }
1.3141 + arg.ident = iARRAY;
1.3142 + do
1.3143 + {
1.3144 + constvalue *enumroot;
1.3145 + int ignore_tag;
1.3146 + if (arg.dimcount == sDIMEN_MAX)
1.3147 + {
1.3148 + error(53);
1.3149 + break;
1.3150 + }
1.3151 + size = needsub(&ignore_tag, &enumroot);
1.3152 + arg.dims[arg.dimcount++] = size;
1.3153 + } while (matchtoken('['));
1.3154 + /* Handle strings */
1.3155 + if (arg.tag == pc_tag_string && arg.dims[arg.dimcount-1])
1.3156 + {
1.3157 + arg.dims[arg.dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
1.3158 + }
1.3159 + if (arg.dimcount == 1 && !arg.dims[arg.dimcount-1])
1.3160 + {
1.3161 + arg.ident = iREFARRAY;
1.3162 + }
1.3163 + } else if (!arg.ident) {
1.3164 + arg.ident = iVARIABLE;
1.3165 + }
1.3166 + if (pstructs_addarg(pstruct, &arg) == NULL)
1.3167 + {
1.3168 + error(99, arg.name, pstruct->name);
1.3169 + }
1.3170 + } while (matchtoken(','));
1.3171 + needtoken('}');
1.3172 + matchtoken(';'); /* eat up optional semicolon */
1.3173 +}
1.3174 +
1.3175 +
1.3176 +/**
1.3177 + * dofuncenum - declare function enumerations
1.3178 + */
1.3179 +static void dofuncenum(int listmode)
1.3180 +{
1.3181 + cell val;
1.3182 + char *str;
1.3183 + // char *ptr;
1.3184 + char tagname[sNAMEMAX+1];
1.3185 + constvalue *cur;
1.3186 + funcenum_t *fenum = NULL;
1.3187 + int i;
1.3188 +
1.3189 + /* get the explicit tag (required!) */
1.3190 + int l = lex(&val,&str);
1.3191 + if (l != tSYMBOL)
1.3192 + {
1.3193 + error(93);
1.3194 + }
1.3195 +
1.3196 + /* This tag can't already exist! */
1.3197 + cur=tagname_tab.next;
1.3198 + while (cur)
1.3199 + {
1.3200 + if (strcmp(cur->name, str) == 0)
1.3201 + {
1.3202 + /* Another bad one... */
1.3203 + if (!(cur->value & FUNCTAG))
1.3204 + {
1.3205 + error(94);
1.3206 + }
1.3207 + break;
1.3208 + }
1.3209 + cur = cur->next;
1.3210 + }
1.3211 + strcpy(tagname, str);
1.3212 +
1.3213 + fenum = funcenums_add(tagname);
1.3214 +
1.3215 + if (listmode)
1.3216 + {
1.3217 + needtoken('{');
1.3218 + }
1.3219 + do
1.3220 + {
1.3221 + functag_t func;
1.3222 + if (listmode && matchtoken('}'))
1.3223 + {
1.3224 + /* Quick exit */
1.3225 + lexpush();
1.3226 + break;
1.3227 + }
1.3228 + memset(&func, 0, sizeof(func));
1.3229 + func.ret_tag = pc_addtag(NULL); /* Get the return tag */
1.3230 + l = lex(&val, &str);
1.3231 + /* :TODO:
1.3232 + * Right now, there is a problem. We can't pass non-public function pointer addresses around,
1.3233 + * because the address isn't known until the final reparse. Unfortunately, you can write code
1.3234 + * before the address is known, because Pawn's compiler isn't truly multipass.
1.3235 + *
1.3236 + * When you call a function, there's no problem, because it does not write the address.
1.3237 + * The assembly looks like this:
1.3238 + * call MyFunction
1.3239 + * Then, only at assembly time (once all passes are done), does it know the address.
1.3240 + * I do not see any solution to this because there is no way I know to inject the function name
1.3241 + * rather than the constant value. And even if we could, we'd have to change the assembler recognize that.
1.3242 + */
1.3243 + /*if (l == tSTOCK)
1.3244 + {
1.3245 + func.type = uSTOCK;
1.3246 + } else */if (l == tPUBLIC) {
1.3247 + func.type = uPUBLIC;
1.3248 + } else {
1.3249 + error(1, "-public-", str);
1.3250 + }
1.3251 + needtoken('(');
1.3252 + do
1.3253 + {
1.3254 + funcarg_t *arg = &(func.args[func.argcount]);
1.3255 +
1.3256 + /* Quick exit */
1.3257 + if (matchtoken(')'))
1.3258 + {
1.3259 + lexpush();
1.3260 + break;
1.3261 + }
1.3262 + l = lex(&val, &str);
1.3263 + if (l == '&')
1.3264 + {
1.3265 + if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
1.3266 + {
1.3267 + error(1, "-identifier-", "&");
1.3268 + }
1.3269 + arg->ident = iREFERENCE;
1.3270 + } else if (l == tCONST) {
1.3271 + if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
1.3272 + {
1.3273 + error(1, "-identifier-", "const");
1.3274 + }
1.3275 + arg->fconst=TRUE;
1.3276 + } else if (l == tLABEL) {
1.3277 + if (arg->tagcount > 0)
1.3278 + {
1.3279 + error(1, "-identifier-", "-tagname-");
1.3280 + }
1.3281 + arg->tags[arg->tagcount++] = pc_addtag(str);
1.3282 +#if 0
1.3283 + while (arg->tagcount < sTAGS_MAX)
1.3284 + {
1.3285 + if (!matchtoken('_') && !needtoken(tSYMBOL))
1.3286 + {
1.3287 + break;
1.3288 + }
1.3289 + tokeninfo(&val, &ptr);
1.3290 + arg->tags[arg->tagcount++] = pc_addtag(ptr);
1.3291 + if (matchtoken('}'))
1.3292 + {
1.3293 + break;
1.3294 + }
1.3295 + needtoken(',');
1.3296 + }
1.3297 + needtoken(':');
1.3298 +#endif
1.3299 + l=tLABEL;
1.3300 + } else if (l == tSYMBOL) {
1.3301 + if (func.argcount >= sARGS_MAX)
1.3302 + {
1.3303 + error(45);
1.3304 + }
1.3305 + if (str[0] == PUBLIC_CHAR)
1.3306 + {
1.3307 + error(56, str);
1.3308 + }
1.3309 + if (matchtoken('['))
1.3310 + {
1.3311 + cell size;
1.3312 + if (arg->ident == iREFERENCE)
1.3313 + {
1.3314 + error(67, str);
1.3315 + }
1.3316 + do
1.3317 + {
1.3318 + constvalue *enumroot;
1.3319 + int ignore_tag;
1.3320 + if (arg->dimcount == sDIMEN_MAX)
1.3321 + {
1.3322 + error(53);
1.3323 + break;
1.3324 + }
1.3325 + size = needsub(&ignore_tag, &enumroot);
1.3326 + arg->dims[arg->dimcount] = size;
1.3327 + arg->dimcount += 1;
1.3328 + } while (matchtoken('['));
1.3329 + /* Handle strings */
1.3330 + if ((arg->tagcount == 1 && arg->tags[0] == pc_tag_string)
1.3331 + && arg->dims[arg->dimcount-1])
1.3332 + {
1.3333 + arg->dims[arg->dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
1.3334 + }
1.3335 + arg->ident=iREFARRAY;
1.3336 + } else if (arg->ident == 0) {
1.3337 + arg->ident = iVARIABLE;
1.3338 + }
1.3339 +
1.3340 + if (matchtoken('='))
1.3341 + {
1.3342 + needtoken('0');
1.3343 + arg->ommittable = TRUE;
1.3344 + func.ommittable = TRUE;
1.3345 + } else if (func.ommittable) {
1.3346 + error(95);
1.3347 + }
1.3348 + func.argcount++;
1.3349 + } else if (l == tELLIPS) {
1.3350 + if (arg->ident == iVARIABLE)
1.3351 + {
1.3352 + error(10);
1.3353 + }
1.3354 + arg->ident = iVARARGS;
1.3355 + func.argcount++;
1.3356 + } else {
1.3357 + error(10);
1.3358 + }
1.3359 + } while (l == '&' || l == tLABEL || l == tCONST || l != tELLIPS && matchtoken(','));
1.3360 + needtoken(')');
1.3361 + for (i=0; i<func.argcount; i++)
1.3362 + {
1.3363 + if (func.args[i].tagcount == 0)
1.3364 + {
1.3365 + func.args[i].tags[0] = 0;
1.3366 + func.args[i].tagcount = 1;
1.3367 + }
1.3368 + }
1.3369 + functags_add(fenum, &func);
1.3370 + if (!listmode)
1.3371 + {
1.3372 + break;
1.3373 + }
1.3374 + } while (matchtoken(','));
1.3375 + if (listmode)
1.3376 + {
1.3377 + needtoken('}');
1.3378 + }
1.3379 + matchtoken(';'); /* eat an optional semicolon. nom nom nom */
1.3380 + errorset(sRESET, 0);
1.3381 +}
1.3382 +
1.3383 +/* decl_enum - declare enumerated constants
1.3384 + *
1.3385 + */
1.3386 +static void decl_enum(int vclass)
1.3387 +{
1.3388 + char enumname[sNAMEMAX+1],constname[sNAMEMAX+1];
1.3389 + cell val,value,size;
1.3390 + char *str;
1.3391 + int tag,explicittag;
1.3392 + cell increment,multiplier;
1.3393 + constvalue *enumroot;
1.3394 + symbol *enumsym;
1.3395 +
1.3396 + /* get an explicit tag, if any (we need to remember whether an explicit
1.3397 + * tag was passed, even if that explicit tag was "_:", so we cannot call
1.3398 + * pc_addtag() here
1.3399 + */
1.3400 + if (lex(&val,&str)==tLABEL) {
1.3401 + tag=pc_addtag(str);
1.3402 + explicittag=TRUE;
1.3403 + } else {
1.3404 + lexpush();
1.3405 + tag=0;
1.3406 + explicittag=FALSE;
1.3407 + } /* if */
1.3408 +
1.3409 + /* get optional enum name (also serves as a tag if no explicit tag was set) */
1.3410 + if (lex(&val,&str)==tSYMBOL) { /* read in (new) token */
1.3411 + strcpy(enumname,str); /* save enum name (last constant) */
1.3412 + if (!explicittag)
1.3413 + tag=pc_addtag(enumname);
1.3414 + } else {
1.3415 + lexpush(); /* analyze again */
1.3416 + enumname[0]='\0';
1.3417 + } /* if */
1.3418 +
1.3419 + /* get increment and multiplier */
1.3420 + increment=1;
1.3421 + multiplier=1;
1.3422 + if (matchtoken('(')) {
1.3423 + if (matchtoken(taADD)) {
1.3424 + constexpr(&increment,NULL,NULL);
1.3425 + } else if (matchtoken(taMULT)) {
1.3426 + constexpr(&multiplier,NULL,NULL);
1.3427 + } else if (matchtoken(taSHL)) {
1.3428 + constexpr(&val,NULL,NULL);
1.3429 + while (val-->0)
1.3430 + multiplier*=2;
1.3431 + } /* if */
1.3432 + needtoken(')');
1.3433 + } /* if */
1.3434 +
1.3435 + if (strlen(enumname)>0) {
1.3436 + /* already create the root symbol, so the fields can have it as their "parent" */
1.3437 + enumsym=add_constant(enumname,0,vclass,tag);
1.3438 + if (enumsym!=NULL)
1.3439 + enumsym->usage |= uENUMROOT;
1.3440 + /* start a new list for the element names */
1.3441 + if ((enumroot=(constvalue*)malloc(sizeof(constvalue)))==NULL)
1.3442 + error(123); /* insufficient memory (fatal error) */
1.3443 + memset(enumroot,0,sizeof(constvalue));
1.3444 + } else {
1.3445 + enumsym=NULL;
1.3446 + enumroot=NULL;
1.3447 + } /* if */
1.3448 +
1.3449 + needtoken('{');
1.3450 + /* go through all constants */
1.3451 + value=0; /* default starting value */
1.3452 + do {
1.3453 + int idxtag,fieldtag;
1.3454 + symbol *sym;
1.3455 + if (matchtoken('}')) { /* quick exit if '}' follows ',' */
1.3456 + lexpush();
1.3457 + break;
1.3458 + } /* if */
1.3459 + idxtag=pc_addtag(NULL); /* optional explicit item tag */
1.3460 + if (needtoken(tSYMBOL)) { /* read in (new) token */
1.3461 + tokeninfo(&val,&str); /* get the information */
1.3462 + strcpy(constname,str); /* save symbol name */
1.3463 + } else {
1.3464 + constname[0]='\0';
1.3465 + } /* if */
1.3466 + size=increment; /* default increment of 'val' */
1.3467 + fieldtag=0; /* default field tag */
1.3468 + if (matchtoken('[')) {
1.3469 + constexpr(&size,&fieldtag,NULL); /* get size */
1.3470 + needtoken(']');
1.3471 + } /* if */
1.3472 + /* :TODO: do we need a size modifier here for pc_tag_string? */
1.3473 + if (matchtoken('='))
1.3474 + constexpr(&value,NULL,NULL); /* get value */
1.3475 + /* add_constant() checks whether a variable (global or local) or
1.3476 + * a constant with the same name already exists
1.3477 + */
1.3478 + sym=add_constant(constname,value,vclass,tag);
1.3479 + if (sym==NULL)
1.3480 + continue; /* error message already given */
1.3481 + /* set the item tag and the item size, for use in indexing arrays */
1.3482 + sym->x.tags.index=idxtag;
1.3483 + sym->x.tags.field=fieldtag;
1.3484 + sym->dim.array.length=size;
1.3485 + sym->dim.array.level=0;
1.3486 + sym->dim.array.slength=0;
1.3487 + sym->parent=enumsym;
1.3488 + /* add the constant to a separate list as well */
1.3489 + if (enumroot!=NULL) {
1.3490 + sym->usage |= uENUMFIELD;
1.3491 + append_constval(enumroot,constname,value,tag);
1.3492 + } /* if */
1.3493 + if (multiplier==1)
1.3494 + value+=size;
1.3495 + else
1.3496 + value*=size*multiplier;
1.3497 + } while (matchtoken(','));
1.3498 + needtoken('}'); /* terminates the constant list */
1.3499 + matchtoken(';'); /* eat an optional ; */
1.3500 +
1.3501 + /* set the enum name to the "next" value (typically the last value plus one) */
1.3502 + if (enumsym!=NULL) {
1.3503 + assert((enumsym->usage & uENUMROOT)!=0);
1.3504 + enumsym->addr=value;
1.3505 + /* assign the constant list */
1.3506 + assert(enumroot!=NULL);
1.3507 + enumsym->dim.enumlist=enumroot;
1.3508 + sc_attachdocumentation(enumsym); /* attach any documenation to the enumeration */
1.3509 + } /* if */
1.3510 +}
1.3511 +
1.3512 +static int getstates(const char *funcname)
1.3513 +{
1.3514 + char fsaname[sNAMEMAX+1],statename[sNAMEMAX+1];
1.3515 + cell val;
1.3516 + char *str;
1.3517 + constvalue *automaton;
1.3518 + constvalue *state;
1.3519 + int fsa,islabel;
1.3520 + int *list;
1.3521 + int count,listsize,state_id;
1.3522 +
1.3523 + if (!matchtoken('<'))
1.3524 + return 0;
1.3525 + if (matchtoken('>'))
1.3526 + return -1; /* special construct: all other states (fall-back) */
1.3527 +
1.3528 + count=0;
1.3529 + listsize=0;
1.3530 + list=NULL;
1.3531 + fsa=-1;
1.3532 +
1.3533 + do {
1.3534 + if (!(islabel=matchtoken(tLABEL)) && !needtoken(tSYMBOL))
1.3535 + break;
1.3536 + tokeninfo(&val,&str);
1.3537 + assert(strlen(str)<sizeof fsaname);
1.3538 + strcpy(fsaname,str); /* assume this is the name of the automaton */
1.3539 + if (islabel || matchtoken(':')) {
1.3540 + /* token is an automaton name, add the name and get a new token */
1.3541 + if (!needtoken(tSYMBOL))
1.3542 + break;
1.3543 + tokeninfo(&val,&str);
1.3544 + assert(strlen(str)<sizeof statename);
1.3545 + strcpy(statename,str);
1.3546 + } else {
1.3547 + /* the token was the state name (part of an anynymous automaton) */
1.3548 + assert(strlen(fsaname)<sizeof statename);
1.3549 + strcpy(statename,fsaname);
1.3550 + fsaname[0]='\0';
1.3551 + } /* if */
1.3552 + if (fsa<0 || fsaname[0]!='\0') {
1.3553 + automaton=automaton_add(fsaname);
1.3554 + assert(automaton!=NULL);
1.3555 + if (fsa>=0 && automaton->index!=fsa)
1.3556 + error(83,funcname); /* multiple automatons for a single function/variable */
1.3557 + fsa=automaton->index;
1.3558 + } /* if */
1.3559 + state=state_add(statename,fsa);
1.3560 + /* add this state to the state combination list (it will be attached to the
1.3561 + * automaton later) */
1.3562 + state_buildlist(&list,&listsize,&count,(int)state->value);
1.3563 + } while (matchtoken(','));
1.3564 + needtoken('>');
1.3565 +
1.3566 + if (count>0) {
1.3567 + assert(automaton!=NULL);
1.3568 + assert(fsa>=0);
1.3569 + state_id=state_addlist(list,count,fsa);
1.3570 + assert(state_id>0);
1.3571 + } else {
1.3572 + /* error is already given */
1.3573 + state_id=0;
1.3574 + } /* if */
1.3575 + if (list!=NULL)
1.3576 + free(list);
1.3577 +
1.3578 + return state_id;
1.3579 +}
1.3580 +
1.3581 +static void attachstatelist(symbol *sym, int state_id)
1.3582 +{
1.3583 + assert(sym!=NULL);
1.3584 + if ((sym->usage & uDEFINE)!=0 && (sym->states==NULL || state_id==0))
1.3585 + error(21,sym->name); /* function already defined, either without states or the current definition has no states */
1.3586 +
1.3587 + if (state_id!=0) {
1.3588 + /* add the state list id */
1.3589 + constvalue *stateptr;
1.3590 + if (sym->states==NULL) {
1.3591 + if ((sym->states=(constvalue*)malloc(sizeof(constvalue)))==NULL)
1.3592 + error(123); /* insufficient memory (fatal error) */
1.3593 + memset(sym->states,0,sizeof(constvalue));
1.3594 + } /* if */
1.3595 + /* see whether the id already exists (add new state only if it does not
1.3596 + * yet exist
1.3597 + */
1.3598 + assert(sym->states!=NULL);
1.3599 + for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index!=state_id; stateptr=stateptr->next)
1.3600 + /* nothing */;
1.3601 + assert(state_id<=SHRT_MAX);
1.3602 + if (stateptr==NULL)
1.3603 + append_constval(sym->states,"",code_idx,(short)state_id);
1.3604 + else if (stateptr->value==0)
1.3605 + stateptr->value=code_idx;
1.3606 + else
1.3607 + error(84,sym->name);
1.3608 + /* also check for another conflicting situation: a fallback function
1.3609 + * without any states
1.3610 + */
1.3611 + if (state_id==-1 && sc_status!=statFIRST) {
1.3612 + /* in the second round, all states should have been accumulated */
1.3613 + assert(sym->states!=NULL);
1.3614 + for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index==-1; stateptr=stateptr->next)
1.3615 + /* nothing */;
1.3616 + if (stateptr==NULL)
1.3617 + error(85,sym->name); /* no states are defined for this function */
1.3618 + } /* if */
1.3619 + } /* if */
1.3620 +}
1.3621 +
1.3622 +/*
1.3623 + * Finds a function in the global symbol table or creates a new entry.
1.3624 + * It does some basic processing and error checking.
1.3625 + */
1.3626 +SC_FUNC symbol *fetchfunc(char *name,int tag)
1.3627 +{
1.3628 + symbol *sym;
1.3629 +
1.3630 + if ((sym=findglb(name,sGLOBAL))!=0) { /* already in symbol table? */
1.3631 + if (sym->ident!=iFUNCTN) {
1.3632 + error(21,name); /* yes, but not as a function */
1.3633 + return NULL; /* make sure the old symbol is not damaged */
1.3634 + } else if ((sym->usage & uNATIVE)!=0) {
1.3635 + error(21,name); /* yes, and it is a native */
1.3636 + } /* if */
1.3637 + assert(sym->vclass==sGLOBAL);
1.3638 + if ((sym->usage & uPROTOTYPED)!=0 && sym->tag!=tag)
1.3639 + error(25); /* mismatch from earlier prototype */
1.3640 + if ((sym->usage & uDEFINE)==0) {
1.3641 + /* as long as the function stays undefined, update the address and the tag */
1.3642 + if (sym->states==NULL)
1.3643 + sym->addr=code_idx;
1.3644 + sym->tag=tag;
1.3645 + } /* if */
1.3646 + } else {
1.3647 + /* don't set the "uDEFINE" flag; it may be a prototype */
1.3648 + sym=addsym(name,code_idx,iFUNCTN,sGLOBAL,tag,0);
1.3649 + assert(sym!=NULL); /* fatal error 103 must be given on error */
1.3650 + /* assume no arguments */
1.3651 + sym->dim.arglist=(arginfo*)malloc(1*sizeof(arginfo));
1.3652 + sym->dim.arglist[0].ident=0;
1.3653 + /* set library ID to NULL (only for native functions) */
1.3654 + sym->x.lib=NULL;
1.3655 + /* set the required stack size to zero (only for non-native functions) */
1.3656 + sym->x.stacksize=1; /* 1 for PROC opcode */
1.3657 + } /* if */
1.3658 + if (pc_deprecate!=NULL) {
1.3659 + assert(sym!=NULL);
1.3660 + sym->flags|=flgDEPRECATED;
1.3661 + if (sc_status==statWRITE) {
1.3662 + if (sym->documentation!=NULL) {
1.3663 + free(sym->documentation);
1.3664 + sym->documentation=NULL;
1.3665 + } /* if */
1.3666 + sym->documentation=pc_deprecate;
1.3667 + } else {
1.3668 + free(pc_deprecate);
1.3669 + } /* if */
1.3670 + pc_deprecate=NULL;
1.3671 + } /* if */
1.3672 +
1.3673 + return sym;
1.3674 +}
1.3675 +
1.3676 +/* This routine adds symbolic information for each argument.
1.3677 + */
1.3678 +static void define_args(void)
1.3679 +{
1.3680 + symbol *sym;
1.3681 +
1.3682 + /* At this point, no local variables have been declared. All
1.3683 + * local symbols are function arguments.
1.3684 + */
1.3685 + sym=loctab.next;
1.3686 + while (sym!=NULL) {
1.3687 + assert(sym->ident!=iLABEL);
1.3688 + assert(sym->vclass==sLOCAL);
1.3689 + markexpr(sLDECL,sym->name,sym->addr); /* mark for better optimization */
1.3690 + sym=sym->next;
1.3691 + } /* while */
1.3692 +}
1.3693 +
1.3694 +static int operatorname(char *name)
1.3695 +{
1.3696 + int opertok;
1.3697 + char *str;
1.3698 + cell val;
1.3699 +
1.3700 + assert(name!=NULL);
1.3701 +
1.3702 + /* check the operator */
1.3703 + opertok=lex(&val,&str);
1.3704 + switch (opertok) {
1.3705 + case '+':
1.3706 + case '-':
1.3707 + case '*':
1.3708 + case '/':
1.3709 + case '%':
1.3710 + case '>':
1.3711 + case '<':
1.3712 + case '!':
1.3713 + case '~':
1.3714 + case '=':
1.3715 + name[0]=(char)opertok;
1.3716 + name[1]='\0';
1.3717 + break;
1.3718 + case tINC:
1.3719 + strcpy(name,"++");
1.3720 + break;
1.3721 + case tDEC:
1.3722 + strcpy(name,"--");
1.3723 + break;
1.3724 + case tlEQ:
1.3725 + strcpy(name,"==");
1.3726 + break;
1.3727 + case tlNE:
1.3728 + strcpy(name,"!=");
1.3729 + break;
1.3730 + case tlLE:
1.3731 + strcpy(name,"<=");
1.3732 + break;
1.3733 + case tlGE:
1.3734 + strcpy(name,">=");
1.3735 + break;
1.3736 + default:
1.3737 + name[0]='\0';
1.3738 + error(7); /* operator cannot be redefined (or bad operator name) */
1.3739 + return 0;
1.3740 + } /* switch */
1.3741 +
1.3742 + return opertok;
1.3743 +}
1.3744 +
1.3745 +static int operatoradjust(int opertok,symbol *sym,char *opername,int resulttag)
1.3746 +{
1.3747 + int tags[2]={0,0};
1.3748 + int count=0;
1.3749 + arginfo *arg;
1.3750 + char tmpname[sNAMEMAX+1];
1.3751 + symbol *oldsym;
1.3752 +
1.3753 + if (opertok==0)
1.3754 + return TRUE;
1.3755 +
1.3756 + assert(sym!=NULL && sym->ident==iFUNCTN && sym->dim.arglist!=NULL);
1.3757 + /* count arguments and save (first two) tags */
1.3758 + while (arg=&sym->dim.arglist[count], arg->ident!=0) {
1.3759 + if (count<2) {
1.3760 + if (arg->numtags>1)
1.3761 + error(65,count+1); /* function argument may only have a single tag */
1.3762 + else if (arg->numtags==1)
1.3763 + tags[count]=arg->tags[0];
1.3764 + } /* if */
1.3765 + if (opertok=='~' && count==0) {
1.3766 + if (arg->ident!=iREFARRAY)
1.3767 + error(73,arg->name);/* must be an array argument */
1.3768 + } else {
1.3769 + //if (arg->ident!=iVARIABLE)
1.3770 + //error(66,arg->name);/* must be non-reference argument */
1.3771 + } /* if */
1.3772 + if (arg->hasdefault)
1.3773 + error(59,arg->name); /* arguments of an operator may not have a default value */
1.3774 + count++;
1.3775 + } /* while */
1.3776 +
1.3777 + /* for '!', '++' and '--', count must be 1
1.3778 + * for '-', count may be 1 or 2
1.3779 + * for '=', count must be 1, and the resulttag is also important
1.3780 + * for all other (binary) operators and the special '~' operator, count must be 2
1.3781 + */
1.3782 + switch (opertok) {
1.3783 + case '!':
1.3784 + case '=':
1.3785 + case tINC:
1.3786 + case tDEC:
1.3787 + if (count!=1)
1.3788 + error(62); /* number or placement of the operands does not fit the operator */
1.3789 + break;
1.3790 + case '-':
1.3791 + if (count!=1 && count!=2)
1.3792 + error(62); /* number or placement of the operands does not fit the operator */
1.3793 + break;
1.3794 + default:
1.3795 + if (count!=2)
1.3796 + error(62); /* number or placement of the operands does not fit the operator */
1.3797 + } /* switch */
1.3798 +
1.3799 + if (tags[0]==0 && (opertok!='=' && tags[1]==0 || opertok=='=' && resulttag==0))
1.3800 + error(64); /* cannot change predefined operators */
1.3801 +
1.3802 + /* change the operator name */
1.3803 + assert(strlen(opername)>0);
1.3804 + operator_symname(tmpname,opername,tags[0],tags[1],count,resulttag);
1.3805 + if ((oldsym=findglb(tmpname,sGLOBAL))!=NULL) {
1.3806 + int i;
1.3807 + if ((oldsym->usage & uDEFINE)!=0) {
1.3808 + char errname[2*sNAMEMAX+16];
1.3809 + funcdisplayname(errname,tmpname);
1.3810 + error(21,errname); /* symbol already defined */
1.3811 + } /* if */
1.3812 + sym->usage|=oldsym->usage; /* copy flags from the previous definition */
1.3813 + for (i=0; i<oldsym->numrefers; i++)
1.3814 + if (oldsym->refer[i]!=NULL)
1.3815 + refer_symbol(sym,oldsym->refer[i]);
1.3816 + delete_symbol(&glbtab,oldsym);
1.3817 + } /* if */
1.3818 + strcpy(sym->name,tmpname);
1.3819 + sym->hash=namehash(sym->name);/* calculate new hash */
1.3820 +
1.3821 + /* operators should return a value, except the '~' operator */
1.3822 + if (opertok!='~')
1.3823 + sym->usage |= uRETVALUE;
1.3824 +
1.3825 + return TRUE;
1.3826 +}
1.3827 +
1.3828 +static int check_operatortag(int opertok,int resulttag,char *opername)
1.3829 +{
1.3830 + assert(opername!=NULL && strlen(opername)>0);
1.3831 + switch (opertok) {
1.3832 + case '!':
1.3833 + case '<':
1.3834 + case '>':
1.3835 + case tlEQ:
1.3836 + case tlNE:
1.3837 + case tlLE:
1.3838 + case tlGE:
1.3839 + if (resulttag!=pc_addtag("bool")) {
1.3840 + error(63,opername,"bool:"); /* operator X requires a "bool:" result tag */
1.3841 + return FALSE;
1.3842 + } /* if */
1.3843 + break;
1.3844 + case '~':
1.3845 + if (resulttag!=0) {
1.3846 + error(63,opername,"_:"); /* operator "~" requires a "_:" result tag */
1.3847 + return FALSE;
1.3848 + } /* if */
1.3849 + break;
1.3850 + } /* switch */
1.3851 + return TRUE;
1.3852 +}
1.3853 +
1.3854 +static char *tag2str(char *dest,int tag)
1.3855 +{
1.3856 + tag &= TAGMASK;
1.3857 + assert(tag>=0);
1.3858 + sprintf(dest,"0%x",tag);
1.3859 + return isdigit(dest[1]) ? &dest[1] : dest;
1.3860 +}
1.3861 +
1.3862 +SC_FUNC char *operator_symname(char *symname,char *opername,int tag1,int tag2,int numtags,int resulttag)
1.3863 +{
1.3864 + char tagstr1[10], tagstr2[10];
1.3865 + int opertok;
1.3866 +
1.3867 + assert(numtags>=1 && numtags<=2);
1.3868 + opertok= (opername[1]=='\0') ? opername[0] : 0;
1.3869 + if (opertok=='=')
1.3870 + sprintf(symname,"%s%s%s",tag2str(tagstr1,resulttag),opername,tag2str(tagstr2,tag1));
1.3871 + else if (numtags==1 || opertok=='~')
1.3872 + sprintf(symname,"%s%s",opername,tag2str(tagstr1,tag1));
1.3873 + else
1.3874 + sprintf(symname,"%s%s%s",tag2str(tagstr1,tag1),opername,tag2str(tagstr2,tag2));
1.3875 + return symname;
1.3876 +}
1.3877 +
1.3878 +static int parse_funcname(char *fname,int *tag1,int *tag2,char *opname)
1.3879 +{
1.3880 + char *ptr,*name;
1.3881 + int unary;
1.3882 +
1.3883 + /* tags are only positive, so if the function name starts with a '-',
1.3884 + * the operator is an unary '-' or '--' operator.
1.3885 + */
1.3886 + if (*fname=='-') {
1.3887 + *tag1=0;
1.3888 + unary=TRUE;
1.3889 + ptr=fname;
1.3890 + } else {
1.3891 + *tag1=(int)strtol(fname,&ptr,16);
1.3892 + unary= ptr==fname; /* unary operator if it doesn't start with a tag name */
1.3893 + } /* if */
1.3894 + assert(!unary || *tag1==0);
1.3895 + assert(*ptr!='\0');
1.3896 + for (name=opname; !isdigit(*ptr); )
1.3897 + *name++ = *ptr++;
1.3898 + *name='\0';
1.3899 + *tag2=(int)strtol(ptr,NULL,16);
1.3900 + return unary;
1.3901 +}
1.3902 +
1.3903 +constvalue *find_tag_byval(int tag)
1.3904 +{
1.3905 + constvalue *tagsym;
1.3906 + tagsym=find_constval_byval(&tagname_tab,tag & ~PUBLICTAG);
1.3907 + if (tagsym==NULL)
1.3908 + tagsym=find_constval_byval(&tagname_tab,tag | PUBLICTAG);
1.3909 + return tagsym;
1.3910 +}
1.3911 +
1.3912 +SC_FUNC char *funcdisplayname(char *dest,char *funcname)
1.3913 +{
1.3914 + int tags[2];
1.3915 + char opname[10];
1.3916 + constvalue *tagsym[2];
1.3917 + int unary;
1.3918 +
1.3919 + if (isalpha(*funcname) || *funcname=='_' || *funcname==PUBLIC_CHAR || *funcname=='\0') {
1.3920 + if (dest!=funcname)
1.3921 + strcpy(dest,funcname);
1.3922 + return dest;
1.3923 + } /* if */
1.3924 +
1.3925 + unary=parse_funcname(funcname,&tags[0],&tags[1],opname);
1.3926 + tagsym[1]=find_tag_byval(tags[1]);
1.3927 + assert(tagsym[1]!=NULL);
1.3928 + if (unary) {
1.3929 + sprintf(dest,"operator%s(%s:)",opname,tagsym[1]->name);
1.3930 + } else {
1.3931 + tagsym[0]=find_tag_byval(tags[0]);
1.3932 + assert(tagsym[0]!=NULL);
1.3933 + /* special case: the assignment operator has the return value as the 2nd tag */
1.3934 + if (opname[0]=='=' && opname[1]=='\0')
1.3935 + sprintf(dest,"%s:operator%s(%s:)",tagsym[0]->name,opname,tagsym[1]->name);
1.3936 + else
1.3937 + sprintf(dest,"operator%s(%s:,%s:)",opname,tagsym[0]->name,tagsym[1]->name);
1.3938 + } /* if */
1.3939 + return dest;
1.3940 +}
1.3941 +
1.3942 +static void funcstub(int fnative)
1.3943 +{
1.3944 + int tok,tag,fpublic;
1.3945 + char *str;
1.3946 + cell val,size;
1.3947 + char symbolname[sNAMEMAX+1];
1.3948 + int idxtag[sDIMEN_MAX];
1.3949 + int dim[sDIMEN_MAX];
1.3950 + int numdim;
1.3951 + symbol *sym,*sub;
1.3952 + int opertok;
1.3953 +
1.3954 + opertok=0;
1.3955 + lastst=0;
1.3956 + litidx=0; /* clear the literal pool */
1.3957 + assert(loctab.next==NULL); /* local symbol table should be empty */
1.3958 +
1.3959 + tag=pc_addtag(NULL); /* get the tag of the return value */
1.3960 + numdim=0;
1.3961 + while (matchtoken('[')) {
1.3962 + /* the function returns an array, get this tag for the index and the array
1.3963 + * dimensions
1.3964 + */
1.3965 + if (numdim == sDIMEN_MAX) {
1.3966 + error(53); /* exceeding maximum number of dimensions */
1.3967 + return;
1.3968 + } /* if */
1.3969 + size=needsub(&idxtag[numdim],NULL); /* get size; size==0 for "var[]" */
1.3970 + if (size==0)
1.3971 + error(9); /* invalid array size */
1.3972 + #if INT_MAX < LONG_MAX
1.3973 + if (size > INT_MAX)
1.3974 + error(125); /* overflow, exceeding capacity */
1.3975 + #endif
1.3976 + dim[numdim++]=(int)size;
1.3977 + } /* while */
1.3978 +
1.3979 + if (tag == pc_tag_string && numdim && dim[numdim-1])
1.3980 + dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
1.3981 +
1.3982 + tok=lex(&val,&str);
1.3983 + fpublic=(tok==tPUBLIC) || (tok==tSYMBOL && str[0]==PUBLIC_CHAR);
1.3984 + if (fnative) {
1.3985 + if (fpublic || tok==tSTOCK || tok==tSTATIC || tok==tSYMBOL && *str==PUBLIC_CHAR)
1.3986 + error(42); /* invalid combination of class specifiers */
1.3987 + } else {
1.3988 + if (tok==tPUBLIC || tok==tSTOCK || tok==tSTATIC)
1.3989 + tok=lex(&val,&str);
1.3990 + } /* if */
1.3991 +
1.3992 + if (tok==tOPERATOR) {
1.3993 + opertok=operatorname(symbolname);
1.3994 + if (opertok==0)
1.3995 + return; /* error message already given */
1.3996 + check_operatortag(opertok,tag,symbolname);
1.3997 + } else {
1.3998 + if (tok!=tSYMBOL && freading) {
1.3999 + error(10); /* illegal function or declaration */
1.4000 + return;
1.4001 + } /* if */
1.4002 + strcpy(symbolname,str);
1.4003 + } /* if */
1.4004 + needtoken('('); /* only functions may be native/forward */
1.4005 +
1.4006 + sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
1.4007 + if (sym==NULL)
1.4008 + return;
1.4009 + if (fnative) {
1.4010 + sym->usage=(char)(uNATIVE | uRETVALUE | uDEFINE | (sym->usage & uPROTOTYPED));
1.4011 + sym->x.lib=curlibrary;
1.4012 + } else if (fpublic) {
1.4013 + sym->usage|=uPUBLIC;
1.4014 + } /* if */
1.4015 + sym->usage|=uFORWARD;
1.4016 +
1.4017 + declargs(sym,FALSE);
1.4018 + /* "declargs()" found the ")" */
1.4019 + sc_attachdocumentation(sym); /* attach any documenation to the function */
1.4020 + if (!operatoradjust(opertok,sym,symbolname,tag))
1.4021 + sym->usage &= ~uDEFINE;
1.4022 +
1.4023 + if (getstates(symbolname)!=0) {
1.4024 + if (fnative || opertok!=0)
1.4025 + error(82); /* native functions and operators may not have states */
1.4026 + else
1.4027 + error(231); /* ignoring state specifications on forward declarations */
1.4028 + } /* if */
1.4029 +
1.4030 + /* for a native operator, also need to specify an "exported" function name;
1.4031 + * for a native function, this is optional
1.4032 + */
1.4033 + if (fnative) {
1.4034 + if (opertok!=0) {
1.4035 + needtoken('=');
1.4036 + lexpush(); /* push back, for matchtoken() to retrieve again */
1.4037 + } /* if */
1.4038 + if (matchtoken('=')) {
1.4039 + /* allow number or symbol */
1.4040 + if (matchtoken(tSYMBOL)) {
1.4041 + tokeninfo(&val,&str);
1.4042 + insert_alias(sym->name,str);
1.4043 + } else {
1.4044 + constexpr(&val,NULL,NULL);
1.4045 + sym->addr=val;
1.4046 + /* At the moment, I have assumed that this syntax is only valid if
1.4047 + * val < 0. To properly mix "normal" native functions and indexed
1.4048 + * native functions, one should use negative indices anyway.
1.4049 + * Special code for a negative index in sym->addr exists in SC4.C
1.4050 + * (ffcall()) and in SC6.C (the loops for counting the number of native
1.4051 + * variables and for writing them).
1.4052 + */
1.4053 + } /* if */
1.4054 + } /* if */
1.4055 + } /* if */
1.4056 + needtoken(tTERM);
1.4057 +
1.4058 + /* attach the array to the function symbol */
1.4059 + if (numdim>0) {
1.4060 + assert(sym!=NULL);
1.4061 + sub=addvariable(symbolname,0,iARRAY,sGLOBAL,tag,dim,numdim,idxtag);
1.4062 + sub->parent=sym;
1.4063 + } /* if */
1.4064 +
1.4065 + litidx=0; /* clear the literal pool */
1.4066 + delete_symbols(&loctab,0,TRUE,TRUE);/* clear local variables queue */
1.4067 +}
1.4068 +
1.4069 +/* newfunc - begin a function
1.4070 + *
1.4071 + * This routine is called from "parse" and tries to make a function
1.4072 + * out of the following text
1.4073 + *
1.4074 + * Global references: funcstatus,lastst,litidx
1.4075 + * rettype (altered)
1.4076 + * curfunc (altered)
1.4077 + * declared (altered)
1.4078 + * glb_declared (altered)
1.4079 + * sc_alignnext (altered)
1.4080 + */
1.4081 +static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock)
1.4082 +{
1.4083 + symbol *sym;
1.4084 + int argcnt,tok,tag,funcline;
1.4085 + int opertok,opererror;
1.4086 + char symbolname[sNAMEMAX+1];
1.4087 + char *str;
1.4088 + cell val,cidx,glbdecl;
1.4089 + short filenum;
1.4090 + int state_id;
1.4091 +
1.4092 + assert(litidx==0); /* literal queue should be empty */
1.4093 + litidx=0; /* clear the literal pool (should already be empty) */
1.4094 + opertok=0;
1.4095 + lastst=0; /* no statement yet */
1.4096 + cidx=0; /* just to avoid compiler warnings */
1.4097 + glbdecl=0;
1.4098 + assert(loctab.next==NULL); /* local symbol table should be empty */
1.4099 + filenum=fcurrent; /* save file number at the start of the declaration */
1.4100 +
1.4101 + if (firstname!=NULL) {
1.4102 + assert(strlen(firstname)<=sNAMEMAX);
1.4103 + strcpy(symbolname,firstname); /* save symbol name */
1.4104 + tag=firsttag;
1.4105 + } else {
1.4106 + tag= (firsttag>=0) ? firsttag : pc_addtag(NULL);
1.4107 + tok=lex(&val,&str);
1.4108 + assert(!fpublic);
1.4109 + if (tok==tNATIVE || tok==tPUBLIC && stock)
1.4110 + error(42); /* invalid combination of class specifiers */
1.4111 + if (tok==tOPERATOR) {
1.4112 + opertok=operatorname(symbolname);
1.4113 + if (opertok==0)
1.4114 + return TRUE; /* error message already given */
1.4115 + check_operatortag(opertok,tag,symbolname);
1.4116 + } else {
1.4117 + if (tok!=tSYMBOL && freading) {
1.4118 + error(20,str); /* invalid symbol name */
1.4119 + return FALSE;
1.4120 + } /* if */
1.4121 + assert(strlen(str)<=sNAMEMAX);
1.4122 + strcpy(symbolname,str);
1.4123 + } /* if */
1.4124 + } /* if */
1.4125 + /* check whether this is a function or a variable declaration */
1.4126 + if (!matchtoken('('))
1.4127 + return FALSE;
1.4128 + /* so it is a function, proceed */
1.4129 + funcline=fline; /* save line at which the function is defined */
1.4130 + if (symbolname[0]==PUBLIC_CHAR) {
1.4131 + fpublic=TRUE; /* implicitly public function */
1.4132 + if (stock)
1.4133 + error(42); /* invalid combination of class specifiers */
1.4134 + } /* if */
1.4135 + sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
1.4136 + if (sym==NULL || (sym->usage & uNATIVE)!=0)
1.4137 + return TRUE; /* it was recognized as a function declaration, but not as a valid one */
1.4138 + if (fpublic)
1.4139 + sym->usage|=uPUBLIC;
1.4140 + if (fstatic)
1.4141 + sym->fnumber=filenum;
1.4142 + /* if the function was used before being declared, and it has a tag for the
1.4143 + * result, add a third pass (as second "skimming" parse) because the function
1.4144 + * result may have been used with user-defined operators, which have now
1.4145 + * been incorrectly flagged (as the return tag was unknown at the time of
1.4146 + * the call)
1.4147 + */
1.4148 + if ((sym->usage & (uPROTOTYPED | uREAD))==uREAD && sym->tag!=0) {
1.4149 + int curstatus=sc_status;
1.4150 + sc_status=statWRITE; /* temporarily set status to WRITE, so the warning isn't blocked */
1.4151 +#if 0 /* SourceMod - silly, should be removed in first pass, so removed */
1.4152 + error(208);
1.4153 +#endif
1.4154 + sc_status=curstatus;
1.4155 + sc_reparse=TRUE; /* must add another pass to "initial scan" phase */
1.4156 + } /* if */
1.4157 +#if 0 /* Not used for SourceMod */
1.4158 + /* we want public functions to be explicitly prototyped, as they are called
1.4159 + * from the outside
1.4160 + */
1.4161 + if (fpublic && (sym->usage & uFORWARD)==0)
1.4162 + error(235,symbolname);
1.4163 +#endif
1.4164 + /* declare all arguments */
1.4165 + argcnt=declargs(sym,TRUE);
1.4166 + opererror=!operatoradjust(opertok,sym,symbolname,tag);
1.4167 + if (strcmp(symbolname,uMAINFUNC)==0 || strcmp(symbolname,uENTRYFUNC)==0) {
1.4168 + if (argcnt>0)
1.4169 + error(5); /* "main()" and "entry()" functions may not have any arguments */
1.4170 + sym->usage|=uREAD; /* "main()" is the program's entry point: always used */
1.4171 + } /* if */
1.4172 + state_id=getstates(symbolname);
1.4173 + if (state_id>0 && (opertok!=0 || strcmp(symbolname,uMAINFUNC)==0))
1.4174 + error(82); /* operators may not have states, main() may neither */
1.4175 + attachstatelist(sym,state_id);
1.4176 + /* "declargs()" found the ")"; if a ";" appears after this, it was a
1.4177 + * prototype */
1.4178 + if (matchtoken(';')) {
1.4179 + if (sym->usage & uPUBLIC)
1.4180 + error(10);
1.4181 + sym->usage|=uFORWARD;
1.4182 + if (!sc_needsemicolon)
1.4183 + error(10); /* old style prototypes used with optional semicolumns */
1.4184 + delete_symbols(&loctab,0,TRUE,TRUE); /* prototype is done; forget everything */
1.4185 + return TRUE;
1.4186 + } /* if */
1.4187 + /* so it is not a prototype, proceed */
1.4188 + /* if this is a function that is not referred to (this can only be detected
1.4189 + * in the second stage), shut code generation off */
1.4190 + if (sc_status==statWRITE && (sym->usage & uREAD)==0 && !fpublic) {
1.4191 + sc_status=statSKIP;
1.4192 + cidx=code_idx;
1.4193 + glbdecl=glb_declared;
1.4194 + } /* if */
1.4195 + if ((sym->flags & flgDEPRECATED) != 0 && (sym->usage & uSTOCK) == 0) {
1.4196 + char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";
1.4197 + error(234,symbolname,ptr); /* deprecated (probably a public function) */
1.4198 + } /* if */
1.4199 + begcseg();
1.4200 + sym->usage|=uDEFINE; /* set the definition flag */
1.4201 + if (stock)
1.4202 + sym->usage|=uSTOCK;
1.4203 + if (opertok!=0 && opererror)
1.4204 + sym->usage &= ~uDEFINE;
1.4205 + /* if the function has states, dump the label to the start of the function */
1.4206 + if (state_id!=0) {
1.4207 + constvalue *ptr=sym->states->next;
1.4208 + while (ptr!=NULL) {
1.4209 + assert(sc_status!=statWRITE || strlen(ptr->name)>0);
1.4210 + if (ptr->index==state_id) {
1.4211 + setlabel((int)strtol(ptr->name,NULL,16));
1.4212 + break;
1.4213 + } /* if */
1.4214 + ptr=ptr->next;
1.4215 + } /* while */
1.4216 + } /* if */
1.4217 + startfunc(sym->name); /* creates stack frame */
1.4218 + insert_dbgline(funcline);
1.4219 + setline(FALSE);
1.4220 + if (sc_alignnext) {
1.4221 + alignframe(sc_dataalign);
1.4222 + sc_alignnext=FALSE;
1.4223 + } /* if */
1.4224 + declared=0; /* number of local cells */
1.4225 + resetstacklist();
1.4226 + resetheaplist();
1.4227 + rettype=(sym->usage & uRETVALUE); /* set "return type" variable */
1.4228 + curfunc=sym;
1.4229 + define_args(); /* add the symbolic info for the function arguments */
1.4230 + #if !defined SC_LIGHT
1.4231 + if (matchtoken('{')) {
1.4232 + lexpush();
1.4233 + } else {
1.4234 + /* Insert a separator so that comments following the statement will not
1.4235 + * be attached to this function; they should be attached to the next
1.4236 + * function. This is not a problem for functions having a compound block,
1.4237 + * because the closing brace is an explicit "end token" for the function.
1.4238 + * With single statement functions, the preprocessor may overread the
1.4239 + * source code before the parser determines an "end of statement".
1.4240 + */
1.4241 + insert_docstring_separator();
1.4242 + } /* if */
1.4243 + #endif
1.4244 + sc_curstates=state_id;/* set state id, for accessing global state variables */
1.4245 + statement(NULL,FALSE);
1.4246 + sc_curstates=0;
1.4247 + if ((rettype & uRETVALUE)!=0)
1.4248 + sym->usage|=uRETVALUE;
1.4249 + if (declared!=0) {
1.4250 + /* This happens only in a very special (and useless) case, where a function
1.4251 + * has only a single statement in its body (no compound block) and that
1.4252 + * statement declares a new variable
1.4253 + */
1.4254 + popstacklist(1);
1.4255 + declared=0;
1.4256 + } /* if */
1.4257 + if ((lastst!=tRETURN) && (lastst!=tGOTO)){
1.4258 + ldconst(0,sPRI);
1.4259 + ffret(strcmp(sym->name,uENTRYFUNC)!=0);
1.4260 + if ((sym->usage & uRETVALUE)!=0) {
1.4261 + char symname[2*sNAMEMAX+16]; /* allow space for user defined operators */
1.4262 + funcdisplayname(symname,sym->name);
1.4263 + error(209,symname); /* function should return a value */
1.4264 + } /* if */
1.4265 + } /* if */
1.4266 + endfunc();
1.4267 + sym->codeaddr=code_idx;
1.4268 + sc_attachdocumentation(sym); /* attach collected documenation to the function */
1.4269 + if (litidx) { /* if there are literals defined */
1.4270 + glb_declared+=litidx;
1.4271 + begdseg(); /* flip to DATA segment */
1.4272 + dumplits(); /* dump literal strings */
1.4273 + litidx=0;
1.4274 + } /* if */
1.4275 + testsymbols(&loctab,0,TRUE,TRUE); /* test for unused arguments and labels */
1.4276 + delete_symbols(&loctab,0,TRUE,TRUE); /* clear local variables queue */
1.4277 + assert(loctab.next==NULL);
1.4278 + curfunc=NULL;
1.4279 + if (sc_status==statSKIP) {
1.4280 + sc_status=statWRITE;
1.4281 + code_idx=cidx;
1.4282 + glb_declared=glbdecl;
1.4283 + } /* if */
1.4284 + return TRUE;
1.4285 +}
1.4286 +
1.4287 +static int argcompare(arginfo *a1,arginfo *a2)
1.4288 +{
1.4289 + int result,level,i;
1.4290 +
1.4291 +#if 0 /* SourceMod uses case insensitive args for forwards */
1.4292 + result= strcmp(a1->name,a2->name)==0; /* name */
1.4293 +#else
1.4294 + result=1;
1.4295 +#endif
1.4296 + if (result)
1.4297 + result= a1->ident==a2->ident; /* type/class */
1.4298 + if (result)
1.4299 + result= a1->usage==a2->usage; /* "const" flag */
1.4300 + if (result)
1.4301 + result= a1->numtags==a2->numtags; /* tags (number and names) */
1.4302 + for (i=0; result && i<a1->numtags; i++)
1.4303 + result= a1->tags[i]==a2->tags[i];
1.4304 + if (result)
1.4305 + result= a1->numdim==a2->numdim; /* array dimensions & index tags */
1.4306 + for (level=0; result && level<a1->numdim; level++)
1.4307 + result= a1->dim[level]==a2->dim[level];
1.4308 + for (level=0; result && level<a1->numdim; level++)
1.4309 + result= a1->idxtag[level]==a2->idxtag[level];
1.4310 + if (result)
1.4311 + result= a1->hasdefault==a2->hasdefault; /* availability of default value */
1.4312 + if (a1->hasdefault) {
1.4313 + if (a1->ident==iREFARRAY) {
1.4314 + if (result)
1.4315 + result= a1->defvalue.array.size==a2->defvalue.array.size;
1.4316 + if (result)
1.4317 + result= a1->defvalue.array.arraysize==a2->defvalue.array.arraysize;
1.4318 + /* ??? should also check contents of the default array (these troubles
1.4319 + * go away in a 2-pass compiler that forbids double declarations, but
1.4320 + * Pawn currently does not forbid them) */
1.4321 + } else {
1.4322 + if (result) {
1.4323 + if ((a1->hasdefault & uSIZEOF)!=0 || (a1->hasdefault & uTAGOF)!=0 || (a1->hasdefault & uCOUNTOF)!=0)
1.4324 + result= a1->hasdefault==a2->hasdefault
1.4325 + && strcmp(a1->defvalue.size.symname,a2->defvalue.size.symname)==0
1.4326 + && a1->defvalue.size.level==a2->defvalue.size.level;
1.4327 + else
1.4328 + result= a1->defvalue.val==a2->defvalue.val;
1.4329 + } /* if */
1.4330 + } /* if */
1.4331 + if (result)
1.4332 + result= a1->defvalue_tag==a2->defvalue_tag;
1.4333 + } /* if */
1.4334 + return result;
1.4335 +}
1.4336 +
1.4337 +/* declargs()
1.4338 + *
1.4339 + * This routine adds an entry in the local symbol table for each argument
1.4340 + * found in the argument list. It returns the number of arguments.
1.4341 + */
1.4342 +static int declargs(symbol *sym,int chkshadow)
1.4343 +{
1.4344 + #define MAXTAGS 16
1.4345 + char *ptr;
1.4346 + int argcnt,oldargcnt,tok,tags[MAXTAGS],numtags;
1.4347 + cell val;
1.4348 + arginfo arg, *arglist;
1.4349 + char name[sNAMEMAX+1];
1.4350 + int ident,fpublic,fconst;
1.4351 + int idx;
1.4352 +
1.4353 + /* if the function is already defined earlier, get the number of arguments
1.4354 + * of the existing definition
1.4355 + */
1.4356 + oldargcnt=0;
1.4357 + if ((sym->usage & uPROTOTYPED)!=0)
1.4358 + while (sym->dim.arglist[oldargcnt].ident!=0)
1.4359 + oldargcnt++;
1.4360 + argcnt=0; /* zero aruments up to now */
1.4361 + ident=iVARIABLE;
1.4362 + numtags=0;
1.4363 + fconst=FALSE;
1.4364 + fpublic= (sym->usage & (uPUBLIC|uSTOCK))!=0;
1.4365 + /* the '(' parantheses has already been parsed */
1.4366 + if (!matchtoken(')')){
1.4367 + do { /* there are arguments; process them */
1.4368 + /* any legal name increases argument count (and stack offset) */
1.4369 + tok=lex(&val,&ptr);
1.4370 + switch (tok) {
1.4371 + case 0:
1.4372 + /* nothing */
1.4373 + break;
1.4374 + case '&':
1.4375 + if (ident!=iVARIABLE || numtags>0)
1.4376 + error(1,"-identifier-","&");
1.4377 + ident=iREFERENCE;
1.4378 + break;
1.4379 + case tCONST:
1.4380 + if (ident!=iVARIABLE || numtags>0)
1.4381 + error(1,"-identifier-","const");
1.4382 + fconst=TRUE;
1.4383 + break;
1.4384 + case tLABEL:
1.4385 + if (numtags>0)
1.4386 + error(1,"-identifier-","-tagname-");
1.4387 + tags[0]=pc_addtag(ptr);
1.4388 + numtags=1;
1.4389 + break;
1.4390 + case '{':
1.4391 + if (numtags>0)
1.4392 + error(1,"-identifier-","-tagname-");
1.4393 + numtags=0;
1.4394 + while (numtags<MAXTAGS) {
1.4395 + if (!matchtoken('_') && !needtoken(tSYMBOL))
1.4396 + break;
1.4397 + tokeninfo(&val,&ptr);
1.4398 + tags[numtags++]=pc_addtag(ptr);
1.4399 + if (matchtoken('}'))
1.4400 + break;
1.4401 + needtoken(',');
1.4402 + } /* for */
1.4403 + needtoken(':');
1.4404 + tok=tLABEL; /* for outer loop: flag that we have seen a tagname */
1.4405 + break;
1.4406 + case tSYMBOL:
1.4407 + if (argcnt>=sMAXARGS)
1.4408 + error(45); /* too many function arguments */
1.4409 + strcpy(name,ptr); /* save symbol name */
1.4410 + if (name[0]==PUBLIC_CHAR)
1.4411 + error(56,name); /* function arguments cannot be public */
1.4412 + if (numtags==0)
1.4413 + tags[numtags++]=0; /* default tag */
1.4414 + /* Stack layout:
1.4415 + * base + 0*sizeof(cell) == previous "base"
1.4416 + * base + 1*sizeof(cell) == function return address
1.4417 + * base + 2*sizeof(cell) == number of arguments
1.4418 + * base + 3*sizeof(cell) == first argument of the function
1.4419 + * So the offset of each argument is "(argcnt+3) * sizeof(cell)".
1.4420 + */
1.4421 + doarg(name,ident,(argcnt+3)*sizeof(cell),tags,numtags,fpublic,fconst,chkshadow,&arg);
1.4422 + /* :TODO: fix this so stocks that are func pointers can't have default arguments? */
1.4423 + if ((sym->usage & uPUBLIC) && arg.hasdefault)
1.4424 + error(59,name); /* arguments of a public function may not have a default value */
1.4425 + if ((sym->usage & uPROTOTYPED)==0) {
1.4426 + /* redimension the argument list, add the entry */
1.4427 + sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
1.4428 + if (sym->dim.arglist==0)
1.4429 + error(123); /* insufficient memory */
1.4430 + memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo)); /* keep the list terminated */
1.4431 + sym->dim.arglist[argcnt]=arg;
1.4432 + } else {
1.4433 + /* check the argument with the earlier definition */
1.4434 + if (argcnt>oldargcnt || !argcompare(&sym->dim.arglist[argcnt],&arg))
1.4435 + error(25); /* function definition does not match prototype */
1.4436 + /* may need to free default array argument and the tag list */
1.4437 + if (arg.ident==iREFARRAY && arg.hasdefault)
1.4438 + free(arg.defvalue.array.data);
1.4439 + else if (arg.ident==iVARIABLE
1.4440 + && ((arg.hasdefault & uSIZEOF)!=0 || (arg.hasdefault & uTAGOF)!=0) || (arg.hasdefault & uCOUNTOF)!=0)
1.4441 + free(arg.defvalue.size.symname);
1.4442 + free(arg.tags);
1.4443 + } /* if */
1.4444 + argcnt++;
1.4445 + ident=iVARIABLE;
1.4446 + numtags=0;
1.4447 + fconst=FALSE;
1.4448 + break;
1.4449 + case tELLIPS:
1.4450 + if (ident!=iVARIABLE)
1.4451 + error(10); /* illegal function or declaration */
1.4452 + if (numtags==0)
1.4453 + tags[numtags++]=0; /* default tag */
1.4454 + if ((sym->usage & uPROTOTYPED)==0) {
1.4455 + /* redimension the argument list, add the entry iVARARGS */
1.4456 + sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
1.4457 + if (sym->dim.arglist==0)
1.4458 + error(123); /* insufficient memory */
1.4459 + memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo)); /* keep the list terminated */
1.4460 + sym->dim.arglist[argcnt].ident=iVARARGS;
1.4461 + sym->dim.arglist[argcnt].hasdefault=FALSE;
1.4462 + sym->dim.arglist[argcnt].defvalue.val=0;
1.4463 + sym->dim.arglist[argcnt].defvalue_tag=0;
1.4464 + sym->dim.arglist[argcnt].numtags=numtags;
1.4465 + sym->dim.arglist[argcnt].tags=(int*)malloc(numtags*sizeof tags[0]);
1.4466 + if (sym->dim.arglist[argcnt].tags==NULL)
1.4467 + error(123); /* insufficient memory */
1.4468 + memcpy(sym->dim.arglist[argcnt].tags,tags,numtags*sizeof tags[0]);
1.4469 + } else {
1.4470 + if (argcnt>oldargcnt || sym->dim.arglist[argcnt].ident!=iVARARGS)
1.4471 + error(25); /* function definition does not match prototype */
1.4472 + } /* if */
1.4473 + argcnt++;
1.4474 + break;
1.4475 + default:
1.4476 + error(10); /* illegal function or declaration */
1.4477 + } /* switch */
1.4478 + } while (tok=='&' || tok==tLABEL || tok==tCONST
1.4479 + || tok!=tELLIPS && matchtoken(',')); /* more? */
1.4480 + /* if the next token is not ",", it should be ")" */
1.4481 + needtoken(')');
1.4482 + } /* if */
1.4483 + /* resolve any "sizeof" arguments (now that all arguments are known) */
1.4484 + assert(sym->dim.arglist!=NULL);
1.4485 + arglist=sym->dim.arglist;
1.4486 + for (idx=0; idx<argcnt && arglist[idx].ident!=0; idx++) {
1.4487 + if ((arglist[idx].hasdefault & uSIZEOF)!=0
1.4488 + || (arglist[idx].hasdefault & uTAGOF)!=0
1.4489 + || (arglist[idx].hasdefault & uCOUNTOF)!=0) {
1.4490 + int altidx;
1.4491 + /* Find the argument with the name mentioned after the "sizeof". Note
1.4492 + * that we cannot use findloc here because we need the arginfo struct,
1.4493 + * not the symbol.
1.4494 + */
1.4495 + ptr=arglist[idx].defvalue.size.symname;
1.4496 + assert(ptr!=NULL);
1.4497 + for (altidx=0; altidx<argcnt && strcmp(ptr,arglist[altidx].name)!=0; altidx++)
1.4498 + /* nothing */;
1.4499 + if (altidx>=argcnt) {
1.4500 + error(17,ptr); /* undefined symbol */
1.4501 + } else {
1.4502 + assert(arglist[idx].defvalue.size.symname!=NULL);
1.4503 + /* check the level against the number of dimensions */
1.4504 + if (arglist[idx].defvalue.size.level>0
1.4505 + && arglist[idx].defvalue.size.level>=arglist[altidx].numdim)
1.4506 + error(28,arglist[idx].name); /* invalid subscript */
1.4507 + /* check the type of the argument whose size to take; for a iVARIABLE
1.4508 + * or a iREFERENCE, this is always 1 (so the code is redundant)
1.4509 + */
1.4510 + assert(arglist[altidx].ident!=iVARARGS);
1.4511 + if (arglist[altidx].ident!=iREFARRAY
1.4512 + && (((arglist[idx].hasdefault & uSIZEOF)!=0)
1.4513 + || (arglist[idx].hasdefault & uCOUNTOF)!=0)) {
1.4514 + if ((arglist[idx].hasdefault & uTAGOF)!=0) {
1.4515 + error(81,arglist[idx].name); /* cannot take "tagof" an indexed array */
1.4516 + } else {
1.4517 + assert(arglist[altidx].ident==iVARIABLE || arglist[altidx].ident==iREFERENCE);
1.4518 + error(223,ptr); /* redundant sizeof */
1.4519 + } /* if */
1.4520 + } /* if */
1.4521 + } /* if */
1.4522 + } /* if */
1.4523 + } /* for */
1.4524 +
1.4525 + sym->usage|=uPROTOTYPED;
1.4526 + errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/
1.4527 + return argcnt;
1.4528 +}
1.4529 +
1.4530 +/* doarg - declare one argument type
1.4531 + *
1.4532 + * this routine is called from "declargs()" and adds an entry in the local
1.4533 + * symbol table for one argument.
1.4534 + *
1.4535 + * "fpublic" indicates whether the function for this argument list is public.
1.4536 + * The arguments themselves are never public.
1.4537 + */
1.4538 +static void doarg(char *name,int ident,int offset,int tags[],int numtags,
1.4539 + int fpublic,int fconst,int chkshadow,arginfo *arg)
1.4540 +{
1.4541 + symbol *argsym;
1.4542 + constvalue *enumroot;
1.4543 + cell size;
1.4544 + int slength=0;
1.4545 +
1.4546 + strcpy(arg->name,name);
1.4547 + arg->hasdefault=FALSE; /* preset (most common case) */
1.4548 + arg->defvalue.val=0; /* clear */
1.4549 + arg->defvalue_tag=0;
1.4550 + arg->numdim=0;
1.4551 + if (matchtoken('[')) {
1.4552 + if (ident==iREFERENCE)
1.4553 + error(67,name); /* illegal declaration ("&name[]" is unsupported) */
1.4554 + do {
1.4555 + if (arg->numdim == sDIMEN_MAX) {
1.4556 + error(53); /* exceeding maximum number of dimensions */
1.4557 + return;
1.4558 + } /* if */
1.4559 + size=needsub(&arg->idxtag[arg->numdim],&enumroot);/* may be zero here, it is a pointer anyway */
1.4560 + #if INT_MAX < LONG_MAX
1.4561 + if (size > INT_MAX)
1.4562 + error(125); /* overflow, exceeding capacity */
1.4563 + #endif
1.4564 + arg->dim[arg->numdim]=(int)size;
1.4565 + arg->numdim+=1;
1.4566 + } while (matchtoken('['));
1.4567 + ident=iREFARRAY; /* "reference to array" (is a pointer) */
1.4568 + if (checktag(tags, numtags, pc_tag_string)) {
1.4569 + slength = arg->dim[arg->numdim - 1];
1.4570 + arg->dim[arg->numdim - 1] = (size + sizeof(cell) - 1) / sizeof(cell);
1.4571 + }
1.4572 + if (matchtoken('=')) {
1.4573 + assert(litidx==0); /* at the start of a function, this is reset */
1.4574 + assert(numtags>0);
1.4575 + /* Check if there is a symbol */
1.4576 + if (matchtoken(tSYMBOL)) {
1.4577 + symbol *sym;
1.4578 + char *name;
1.4579 + cell val;
1.4580 + tokeninfo(&val,&name);
1.4581 + if ((sym=findglb(name, sGLOBAL)) == NULL) {
1.4582 + error(17, name); /* undefined symbol */
1.4583 + } else {
1.4584 + arg->hasdefault=TRUE; /* argument as a default value */
1.4585 + memset(&arg->defvalue, 0, sizeof(arg->defvalue));
1.4586 + arg->defvalue.array.data=NULL;
1.4587 + arg->defvalue.array.addr=sym->addr;
1.4588 + arg->defvalue_tag=sym->tag;
1.4589 + if (sc_status==statWRITE && (sym->usage & uREAD)==0) {
1.4590 + markusage(sym, uREAD);
1.4591 + }
1.4592 + }
1.4593 + } else {
1.4594 + initials2(ident,tags[0],&size,arg->dim,arg->numdim,enumroot, 1, 0);
1.4595 + assert(size>=litidx);
1.4596 + /* allocate memory to hold the initial values */
1.4597 + arg->defvalue.array.data=(cell *)malloc(litidx*sizeof(cell));
1.4598 + if (arg->defvalue.array.data!=NULL) {
1.4599 + int i;
1.4600 + memcpy(arg->defvalue.array.data,litq,litidx*sizeof(cell));
1.4601 + arg->hasdefault=TRUE; /* argument has default value */
1.4602 + arg->defvalue.array.size=litidx;
1.4603 + arg->defvalue.array.addr=-1;
1.4604 + /* calulate size to reserve on the heap */
1.4605 + arg->defvalue.array.arraysize=1;
1.4606 + for (i=0; i<arg->numdim; i++)
1.4607 + arg->defvalue.array.arraysize*=arg->dim[i];
1.4608 + if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
1.4609 + arg->defvalue.array.arraysize = arg->defvalue.array.size;
1.4610 + } /* if */
1.4611 + litidx=0; /* reset */
1.4612 + }
1.4613 + } /* if */
1.4614 + } else {
1.4615 + if (matchtoken('=')) {
1.4616 + unsigned char size_tag_token;
1.4617 + assert(ident==iVARIABLE || ident==iREFERENCE);
1.4618 + arg->hasdefault=TRUE; /* argument has a default value */
1.4619 + size_tag_token=(unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
1.4620 + if (size_tag_token==0)
1.4621 + size_tag_token=(unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
1.4622 + if (size_tag_token==0)
1.4623 + size_tag_token=(unsigned char)(matchtoken(tCELLSOF) ? uCOUNTOF : 0);
1.4624 + if (size_tag_token!=0) {
1.4625 + int paranthese;
1.4626 + if (ident==iREFERENCE)
1.4627 + error(66,name); /* argument may not be a reference */
1.4628 + paranthese=0;
1.4629 + while (matchtoken('('))
1.4630 + paranthese++;
1.4631 + if (needtoken(tSYMBOL)) {
1.4632 + /* save the name of the argument whose size id to take */
1.4633 + char *name;
1.4634 + cell val;
1.4635 + tokeninfo(&val,&name);
1.4636 + if ((arg->defvalue.size.symname=duplicatestring(name)) == NULL)
1.4637 + error(123); /* insufficient memory */
1.4638 + arg->defvalue.size.level=0;
1.4639 + if (size_tag_token==uSIZEOF || size_tag_token==uCOUNTOF) {
1.4640 + while (matchtoken('[')) {
1.4641 + arg->defvalue.size.level+=(short)1;
1.4642 + needtoken(']');
1.4643 + } /* while */
1.4644 + } /* if */
1.4645 + if (ident==iVARIABLE) /* make sure we set this only if not a reference */
1.4646 + arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
1.4647 + } /* if */
1.4648 + while (paranthese--)
1.4649 + needtoken(')');
1.4650 + } else {
1.4651 + constexpr(&arg->defvalue.val,&arg->defvalue_tag,NULL);
1.4652 + assert(numtags>0);
1.4653 + if (!matchtag(tags[0],arg->defvalue_tag,TRUE))
1.4654 + error(213); /* tagname mismatch */
1.4655 + } /* if */
1.4656 + } /* if */
1.4657 + } /* if */
1.4658 + arg->ident=(char)ident;
1.4659 + arg->usage=(char)(fconst ? uCONST : 0);
1.4660 + arg->numtags=numtags;
1.4661 + arg->tags=(int*)malloc(numtags*sizeof tags[0]);
1.4662 + if (arg->tags==NULL)
1.4663 + error(123); /* insufficient memory */
1.4664 + memcpy(arg->tags,tags,numtags*sizeof tags[0]);
1.4665 + argsym=findloc(name);
1.4666 + if (argsym!=NULL) {
1.4667 + error(21,name); /* symbol already defined */
1.4668 + } else {
1.4669 + if (chkshadow && (argsym=findglb(name,sSTATEVAR))!=NULL && argsym->ident!=iFUNCTN)
1.4670 + error(219,name); /* variable shadows another symbol */
1.4671 + /* add details of type and address */
1.4672 + assert(numtags>0);
1.4673 + argsym=addvariable2(name,offset,ident,sLOCAL,tags[0],
1.4674 + arg->dim,arg->numdim,arg->idxtag,slength);
1.4675 + argsym->compound=0;
1.4676 + if (ident==iREFERENCE)
1.4677 + argsym->usage|=uREAD; /* because references are passed back */
1.4678 + if (fpublic)
1.4679 + argsym->usage|=uREAD; /* arguments of public functions are always "used" */
1.4680 + if (fconst)
1.4681 + argsym->usage|=uCONST;
1.4682 + } /* if */
1.4683 +}
1.4684 +
1.4685 +static int count_referrers(symbol *entry)
1.4686 +{
1.4687 + int i,count;
1.4688 +
1.4689 + count=0;
1.4690 + for (i=0; i<entry->numrefers; i++)
1.4691 + if (entry->refer[i]!=NULL)
1.4692 + count++;
1.4693 + return count;
1.4694 +}
1.4695 +
1.4696 +#if !defined SC_LIGHT
1.4697 +static int find_xmltag(char *source,char *xmltag,char *xmlparam,char *xmlvalue,
1.4698 + char **outer_start,int *outer_length,
1.4699 + char **inner_start,int *inner_length)
1.4700 +{
1.4701 + char *ptr,*inner_end;
1.4702 + int xmltag_len,xmlparam_len,xmlvalue_len;
1.4703 + int match;
1.4704 +
1.4705 + assert(source!=NULL);
1.4706 + assert(xmltag!=NULL);
1.4707 + assert(outer_start!=NULL);
1.4708 + assert(outer_length!=NULL);
1.4709 + assert(inner_start!=NULL);
1.4710 + assert(inner_length!=NULL);
1.4711 +
1.4712 + /* both NULL or both non-NULL */
1.4713 + assert(xmlvalue!=NULL && xmlparam!=NULL || xmlvalue==NULL && xmlparam==NULL);
1.4714 +
1.4715 + xmltag_len=strlen(xmltag);
1.4716 + xmlparam_len= (xmlparam!=NULL) ? strlen(xmlparam) : 0;
1.4717 + xmlvalue_len= (xmlvalue!=NULL) ? strlen(xmlvalue) : 0;
1.4718 + ptr=source;
1.4719 + /* find an opening '<' */
1.4720 + while ((ptr=strchr(ptr,'<'))!=NULL) {
1.4721 + *outer_start=ptr; /* be optimistic... */
1.4722 + match=FALSE; /* ...and pessimistic at the same time */
1.4723 + ptr++; /* skip '<' */
1.4724 + while (*ptr!='\0' && *ptr<=' ')
1.4725 + ptr++; /* skip white space */
1.4726 + if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
1.4727 + /* xml tag found, optionally check the parameter */
1.4728 + ptr+=xmltag_len;
1.4729 + while (*ptr!='\0' && *ptr<=' ')
1.4730 + ptr++; /* skip white space */
1.4731 + if (xmlparam!=NULL) {
1.4732 + if (strncmp(ptr,xmlparam,xmlparam_len)==0 && (*(ptr+xmlparam_len)<=' ' || *(ptr+xmlparam_len)=='=')) {
1.4733 + ptr+=xmlparam_len;
1.4734 + while (*ptr!='\0' && *ptr<=' ')
1.4735 + ptr++; /* skip white space */
1.4736 + if (*ptr=='=') {
1.4737 + ptr++; /* skip '=' */
1.4738 + while (*ptr!='\0' && *ptr<=' ')
1.4739 + ptr++; /* skip white space */
1.4740 + if (*ptr=='"' || *ptr=='\'')
1.4741 + ptr++; /* skip " or ' */
1.4742 + assert(xmlvalue!=NULL);
1.4743 + if (strncmp(ptr,xmlvalue,xmlvalue_len)==0
1.4744 + && (*(ptr+xmlvalue_len)<=' '
1.4745 + || *(ptr+xmlvalue_len)=='>'
1.4746 + || *(ptr+xmlvalue_len)=='"'
1.4747 + || *(ptr+xmlvalue_len)=='\''))
1.4748 + match=TRUE; /* found it */
1.4749 + } /* if */
1.4750 + } /* if */
1.4751 + } else {
1.4752 + match=TRUE; /* don't check the parameter */
1.4753 + } /* if */
1.4754 + } /* if */
1.4755 + if (match) {
1.4756 + /* now find the end of the opening tag */
1.4757 + while (*ptr!='\0' && *ptr!='>')
1.4758 + ptr++;
1.4759 + if (*ptr=='>')
1.4760 + ptr++;
1.4761 + while (*ptr!='\0' && *ptr<=' ')
1.4762 + ptr++; /* skip white space */
1.4763 + *inner_start=ptr;
1.4764 + /* find the start of the closing tag (assume no nesting) */
1.4765 + while ((ptr=strchr(ptr,'<'))!=NULL) {
1.4766 + inner_end=ptr;
1.4767 + ptr++; /* skip '<' */
1.4768 + while (*ptr!='\0' && *ptr<=' ')
1.4769 + ptr++; /* skip white space */
1.4770 + if (*ptr=='/') {
1.4771 + ptr++; /* skip / */
1.4772 + while (*ptr!='\0' && *ptr<=' ')
1.4773 + ptr++; /* skip white space */
1.4774 + if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
1.4775 + /* find the end of the closing tag */
1.4776 + while (*ptr!='\0' && *ptr!='>')
1.4777 + ptr++;
1.4778 + if (*ptr=='>')
1.4779 + ptr++;
1.4780 + /* set the lengths of the inner and outer segment */
1.4781 + assert(*inner_start!=NULL);
1.4782 + *inner_length=(int)(inner_end-*inner_start);
1.4783 + assert(*outer_start!=NULL);
1.4784 + *outer_length=(int)(ptr-*outer_start);
1.4785 + break; /* break out of the loop */
1.4786 + } /* if */
1.4787 + } /* if */
1.4788 + } /* while */
1.4789 + return TRUE;
1.4790 + } /* if */
1.4791 + } /* while */
1.4792 + return FALSE; /* not found */
1.4793 +}
1.4794 +
1.4795 +static char *xmlencode(char *dest,char *source)
1.4796 +{
1.4797 + char temp[2*sNAMEMAX+20],*ptr;
1.4798 +
1.4799 + /* replace < by < and such; normally, such a symbol occurs at most once in
1.4800 + * a symbol name (e.g. "operator<")
1.4801 + */
1.4802 + ptr=temp;
1.4803 + while (*source!='\0') {
1.4804 + switch (*source) {
1.4805 + case '<':
1.4806 + strcpy(ptr,"<");
1.4807 + ptr+=4;
1.4808 + break;
1.4809 + case '>':
1.4810 + strcpy(ptr,">");
1.4811 + ptr+=4;
1.4812 + break;
1.4813 + case '&':
1.4814 + strcpy(ptr,"&");
1.4815 + ptr+=5;
1.4816 + break;
1.4817 + default:
1.4818 + *ptr++=*source;
1.4819 + } /* switch */
1.4820 + source++;
1.4821 + } /* while */
1.4822 + *ptr='\0';
1.4823 + strcpy(dest,temp);
1.4824 + return dest;
1.4825 +}
1.4826 +
1.4827 +static void make_report(symbol *root,FILE *log,char *sourcefile)
1.4828 +{
1.4829 + char symname[_MAX_PATH];
1.4830 + int i,arg;
1.4831 + symbol *sym,*ref;
1.4832 + constvalue *tagsym;
1.4833 + constvalue *enumroot;
1.4834 + char *ptr;
1.4835 +
1.4836 + /* adapt the installation directory */
1.4837 + strcpy(symname,sc_rootpath);
1.4838 + #if DIRSEP_CHAR=='\\'
1.4839 + while ((ptr=strchr(symname,':'))!=NULL)
1.4840 + *ptr='|';
1.4841 + while ((ptr=strchr(symname,DIRSEP_CHAR))!=NULL)
1.4842 + *ptr='/';
1.4843 + #endif
1.4844 +
1.4845 + /* the XML header */
1.4846 + fprintf(log,"<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n");
1.4847 + fprintf(log,"<?xml-stylesheet href=\"file:///%s/xml/pawndoc.xsl\" type=\"text/xsl\"?>\n",symname);
1.4848 + fprintf(log,"<doc source=\"%s\">\n",sourcefile);
1.4849 + ptr=strrchr(sourcefile,DIRSEP_CHAR);
1.4850 + if (ptr!=NULL)
1.4851 + ptr++;
1.4852 + else
1.4853 + ptr=sourcefile;
1.4854 + fprintf(log,"\t<assembly>\n\t\t<name>%s</name>\n\t</assembly>\n",ptr);
1.4855 +
1.4856 + /* attach the global documentation, if any */
1.4857 + if (sc_documentation!=NULL) {
1.4858 + fprintf(log,"\n\t<!-- general -->\n");
1.4859 + fprintf(log,"\t<general>\n\t\t");
1.4860 + fputs(sc_documentation,log);
1.4861 + fprintf(log,"\n\t</general>\n\n");
1.4862 + } /* if */
1.4863 +
1.4864 + /* use multiple passes to print constants variables and functions in
1.4865 + * separate sections
1.4866 + */
1.4867 + fprintf(log,"\t<members>\n");
1.4868 +
1.4869 + fprintf(log,"\n\t\t<!-- enumerations -->\n");
1.4870 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.4871 + if (sym->parent!=NULL)
1.4872 + continue; /* hierarchical data type */
1.4873 + assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
1.4874 + || sym->ident==iARRAY || sym->ident==iFUNCTN);
1.4875 + if (sym->ident!=iCONSTEXPR || (sym->usage & uENUMROOT)==0)
1.4876 + continue;
1.4877 + if ((sym->usage & uREAD)==0)
1.4878 + continue;
1.4879 + fprintf(log,"\t\t<member name=\"T:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
1.4880 + if (sym->tag!=0) {
1.4881 + tagsym=find_tag_byval(sym->tag);
1.4882 + assert(tagsym!=NULL);
1.4883 + fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
1.4884 + } /* if */
1.4885 + /* browse through all fields */
1.4886 + if ((enumroot=sym->dim.enumlist)!=NULL) {
1.4887 + enumroot=enumroot->next; /* skip root */
1.4888 + while (enumroot!=NULL) {
1.4889 + fprintf(log,"\t\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,enumroot->name),enumroot->value);
1.4890 + /* find the constant with this name and get the tag */
1.4891 + ref=findglb(enumroot->name,sGLOBAL);
1.4892 + if (ref!=NULL) {
1.4893 + if (ref->x.tags.index!=0) {
1.4894 + tagsym=find_tag_byval(ref->x.tags.index);
1.4895 + assert(tagsym!=NULL);
1.4896 + fprintf(log,"\t\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
1.4897 + } /* if */
1.4898 + if (ref->dim.array.length!=1)
1.4899 + fprintf(log,"\t\t\t\t<size value=\"%ld\"/>\n",(long)ref->dim.array.length);
1.4900 + } /* if */
1.4901 + fprintf(log,"\t\t\t</member>\n");
1.4902 + enumroot=enumroot->next;
1.4903 + } /* while */
1.4904 + } /* if */
1.4905 + assert(sym->refer!=NULL);
1.4906 + for (i=0; i<sym->numrefers; i++) {
1.4907 + if ((ref=sym->refer[i])!=NULL)
1.4908 + fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
1.4909 + } /* for */
1.4910 + if (sym->documentation!=NULL)
1.4911 + fprintf(log,"\t\t\t%s\n",sym->documentation);
1.4912 + fprintf(log,"\t\t</member>\n");
1.4913 + } /* for */
1.4914 +
1.4915 + fprintf(log,"\n\t\t<!-- constants -->\n");
1.4916 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.4917 + if (sym->parent!=NULL)
1.4918 + continue; /* hierarchical data type */
1.4919 + assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
1.4920 + || sym->ident==iARRAY || sym->ident==iFUNCTN);
1.4921 + if (sym->ident!=iCONSTEXPR)
1.4922 + continue;
1.4923 + if ((sym->usage & uREAD)==0 || (sym->usage & (uENUMFIELD | uENUMROOT))!=0)
1.4924 + continue;
1.4925 + fprintf(log,"\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
1.4926 + if (sym->tag!=0) {
1.4927 + tagsym=find_tag_byval(sym->tag);
1.4928 + assert(tagsym!=NULL);
1.4929 + fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
1.4930 + } /* if */
1.4931 + assert(sym->refer!=NULL);
1.4932 + for (i=0; i<sym->numrefers; i++) {
1.4933 + if ((ref=sym->refer[i])!=NULL)
1.4934 + fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
1.4935 + } /* for */
1.4936 + if (sym->documentation!=NULL)
1.4937 + fprintf(log,"\t\t\t%s\n",sym->documentation);
1.4938 + fprintf(log,"\t\t</member>\n");
1.4939 + } /* for */
1.4940 +
1.4941 + fprintf(log,"\n\t\t<!-- variables -->\n");
1.4942 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.4943 + if (sym->parent!=NULL)
1.4944 + continue; /* hierarchical data type */
1.4945 + if (sym->ident!=iVARIABLE && sym->ident!=iARRAY)
1.4946 + continue;
1.4947 + fprintf(log,"\t\t<member name=\"F:%s\">\n",funcdisplayname(symname,sym->name));
1.4948 + if (sym->tag!=0) {
1.4949 + tagsym=find_tag_byval(sym->tag);
1.4950 + assert(tagsym!=NULL);
1.4951 + fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
1.4952 + } /* if */
1.4953 + assert(sym->refer!=NULL);
1.4954 + if ((sym->usage & uPUBLIC)!=0)
1.4955 + fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
1.4956 + for (i=0; i<sym->numrefers; i++) {
1.4957 + if ((ref=sym->refer[i])!=NULL)
1.4958 + fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
1.4959 + } /* for */
1.4960 + if (sym->documentation!=NULL)
1.4961 + fprintf(log,"\t\t\t%s\n",sym->documentation);
1.4962 + fprintf(log,"\t\t</member>\n");
1.4963 + } /* for */
1.4964 +
1.4965 + fprintf(log,"\n\t\t<!-- functions -->\n");
1.4966 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.4967 + if (sym->parent!=NULL)
1.4968 + continue; /* hierarchical data type */
1.4969 + if (sym->ident!=iFUNCTN)
1.4970 + continue;
1.4971 + if ((sym->usage & (uREAD | uNATIVE))==uNATIVE)
1.4972 + continue; /* unused native function */
1.4973 + funcdisplayname(symname,sym->name);
1.4974 + xmlencode(symname,symname);
1.4975 + fprintf(log,"\t\t<member name=\"M:%s\" syntax=\"%s(",symname,symname);
1.4976 + /* print only the names of the parameters between the parentheses */
1.4977 + assert(sym->dim.arglist!=NULL);
1.4978 + for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
1.4979 + int dim;
1.4980 + if (arg>0)
1.4981 + fprintf(log,", ");
1.4982 + switch (sym->dim.arglist[arg].ident) {
1.4983 + case iVARIABLE:
1.4984 + fprintf(log,"%s",sym->dim.arglist[arg].name);
1.4985 + break;
1.4986 + case iREFERENCE:
1.4987 + fprintf(log,"&%s",sym->dim.arglist[arg].name);
1.4988 + break;
1.4989 + case iREFARRAY:
1.4990 + fprintf(log,"%s",sym->dim.arglist[arg].name);
1.4991 + for (dim=0; dim<sym->dim.arglist[arg].numdim;dim++)
1.4992 + fprintf(log,"[]");
1.4993 + break;
1.4994 + case iVARARGS:
1.4995 + fprintf(log,"...");
1.4996 + break;
1.4997 + } /* switch */
1.4998 + } /* for */
1.4999 + /* ??? should also print an "array return" size */
1.5000 + fprintf(log,")\">\n");
1.5001 + if (sym->tag!=0) {
1.5002 + tagsym=find_tag_byval(sym->tag);
1.5003 + assert(tagsym!=NULL);
1.5004 + fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
1.5005 + } /* if */
1.5006 + /* check whether this function is called from the outside */
1.5007 + if ((sym->usage & uNATIVE)!=0)
1.5008 + fprintf(log,"\t\t\t<attribute name=\"native\"/>\n");
1.5009 + if ((sym->usage & uPUBLIC)!=0)
1.5010 + fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
1.5011 + if (strcmp(sym->name,uMAINFUNC)==0 || strcmp(sym->name,uENTRYFUNC)==0)
1.5012 + fprintf(log,"\t\t\t<attribute name=\"entry\"/>\n");
1.5013 + if ((sym->usage & uNATIVE)==0)
1.5014 + fprintf(log,"\t\t\t<stacksize value=\"%ld\"/>\n",(long)sym->x.stacksize);
1.5015 + if (sym->states!=NULL) {
1.5016 + constvalue *stlist=sym->states->next;
1.5017 + assert(stlist!=NULL); /* there should be at least one state item */
1.5018 + while (stlist!=NULL && stlist->index==-1)
1.5019 + stlist=stlist->next;
1.5020 + assert(stlist!=NULL); /* state id should be found */
1.5021 + i=state_getfsa(stlist->index);
1.5022 + assert(i>=0); /* automaton 0 exists */
1.5023 + stlist=automaton_findid(i);
1.5024 + assert(stlist!=NULL); /* automaton should be found */
1.5025 + fprintf(log,"\t\t\t<automaton name=\"%s\"/>\n", strlen(stlist->name)>0 ? stlist->name : "(anonymous)");
1.5026 + //??? dump state decision table
1.5027 + } /* if */
1.5028 + assert(sym->refer!=NULL);
1.5029 + for (i=0; i<sym->numrefers; i++)
1.5030 + if ((ref=sym->refer[i])!=NULL)
1.5031 + fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
1.5032 + /* print all symbols that are required for this function to compile */
1.5033 + for (ref=root->next; ref!=NULL; ref=ref->next) {
1.5034 + if (ref==sym)
1.5035 + continue;
1.5036 + for (i=0; i<ref->numrefers; i++)
1.5037 + if (ref->refer[i]==sym)
1.5038 + fprintf(log,"\t\t\t<dependency name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
1.5039 + } /* for */
1.5040 + /* print parameter list, with tag & const information, plus descriptions */
1.5041 + assert(sym->dim.arglist!=NULL);
1.5042 + for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
1.5043 + int dim,paraminfo;
1.5044 + char *outer_start,*inner_start;
1.5045 + int outer_length,inner_length;
1.5046 + if (sym->dim.arglist[arg].ident==iVARARGS)
1.5047 + fprintf(log,"\t\t\t<param name=\"...\">\n");
1.5048 + else
1.5049 + fprintf(log,"\t\t\t<param name=\"%s\">\n",sym->dim.arglist[arg].name);
1.5050 + /* print the tag name(s) for each parameter */
1.5051 + assert(sym->dim.arglist[arg].numtags>0);
1.5052 + assert(sym->dim.arglist[arg].tags!=NULL);
1.5053 + paraminfo=(sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0)
1.5054 + || sym->dim.arglist[arg].ident==iREFERENCE
1.5055 + || sym->dim.arglist[arg].ident==iREFARRAY;
1.5056 + if (paraminfo)
1.5057 + fprintf(log,"\t\t\t\t<paraminfo>");
1.5058 + if (sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0) {
1.5059 + assert(paraminfo);
1.5060 + if (sym->dim.arglist[arg].numtags>1)
1.5061 + fprintf(log," {");
1.5062 + for (i=0; i<sym->dim.arglist[arg].numtags; i++) {
1.5063 + if (i>0)
1.5064 + fprintf(log,",");
1.5065 + tagsym=find_tag_byval(sym->dim.arglist[arg].tags[i]);
1.5066 + assert(tagsym!=NULL);
1.5067 + fprintf(log,"%s",tagsym->name);
1.5068 + } /* for */
1.5069 + if (sym->dim.arglist[arg].numtags>1)
1.5070 + fprintf(log,"}");
1.5071 + } /* if */
1.5072 + switch (sym->dim.arglist[arg].ident) {
1.5073 + case iREFERENCE:
1.5074 + fprintf(log," &");
1.5075 + break;
1.5076 + case iREFARRAY:
1.5077 + fprintf(log," ");
1.5078 + for (dim=0; dim<sym->dim.arglist[arg].numdim; dim++) {
1.5079 + if (sym->dim.arglist[arg].dim[dim]==0) {
1.5080 + fprintf(log,"[]");
1.5081 + } else {
1.5082 + //??? find index tag
1.5083 + fprintf(log,"[%d]",sym->dim.arglist[arg].dim[dim]);
1.5084 + } /* if */
1.5085 + } /* for */
1.5086 + break;
1.5087 + } /* switch */
1.5088 + if (paraminfo)
1.5089 + fprintf(log," </paraminfo>\n");
1.5090 + /* print the user description of the parameter (parse through
1.5091 + * sym->documentation)
1.5092 + */
1.5093 + if (sym->documentation!=NULL
1.5094 + && find_xmltag(sym->documentation, "param", "name", sym->dim.arglist[arg].name,
1.5095 + &outer_start, &outer_length, &inner_start, &inner_length))
1.5096 + {
1.5097 + char *tail;
1.5098 + fprintf(log,"\t\t\t\t%.*s\n",inner_length,inner_start);
1.5099 + /* delete from documentation string */
1.5100 + tail=outer_start+outer_length;
1.5101 + memmove(outer_start,tail,strlen(tail)+1);
1.5102 + } /* if */
1.5103 + fprintf(log,"\t\t\t</param>\n");
1.5104 + } /* for */
1.5105 + if (sym->documentation!=NULL)
1.5106 + fprintf(log,"\t\t\t%s\n",sym->documentation);
1.5107 + fprintf(log,"\t\t</member>\n");
1.5108 + } /* for */
1.5109 +
1.5110 + fprintf(log,"\n\t</members>\n");
1.5111 + fprintf(log,"</doc>\n");
1.5112 +}
1.5113 +#endif
1.5114 +
1.5115 +/* Every symbol has a referrer list, that contains the functions that use
1.5116 + * the symbol. Now, if function "apple" is accessed by functions "banana" and
1.5117 + * "citron", but neither function "banana" nor "citron" are used by anyone
1.5118 + * else, then, by inference, function "apple" is not used either.
1.5119 + */
1.5120 +static void reduce_referrers(symbol *root)
1.5121 +{
1.5122 + int i,restart;
1.5123 + symbol *sym,*ref;
1.5124 +
1.5125 + do {
1.5126 + restart=0;
1.5127 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.5128 + if (sym->parent!=NULL)
1.5129 + continue; /* hierarchical data type */
1.5130 + if (sym->ident==iFUNCTN
1.5131 + && (sym->usage & uNATIVE)==0
1.5132 + && (sym->usage & uPUBLIC)==0 && strcmp(sym->name,uMAINFUNC)!=0 && strcmp(sym->name,uENTRYFUNC)!=0
1.5133 + && count_referrers(sym)==0)
1.5134 + {
1.5135 + sym->usage&=~(uREAD | uWRITTEN); /* erase usage bits if there is no referrer */
1.5136 + /* find all symbols that are referred by this symbol */
1.5137 + for (ref=root->next; ref!=NULL; ref=ref->next) {
1.5138 + if (ref->parent!=NULL)
1.5139 + continue; /* hierarchical data type */
1.5140 + assert(ref->refer!=NULL);
1.5141 + for (i=0; i<ref->numrefers && ref->refer[i]!=sym; i++)
1.5142 + /* nothing */;
1.5143 + if (i<ref->numrefers) {
1.5144 + assert(ref->refer[i]==sym);
1.5145 + ref->refer[i]=NULL;
1.5146 + restart++;
1.5147 + } /* if */
1.5148 + } /* for */
1.5149 + } else if ((sym->ident==iVARIABLE || sym->ident==iARRAY)
1.5150 + && (sym->usage & uPUBLIC)==0
1.5151 + && sym->parent==NULL
1.5152 + && count_referrers(sym)==0)
1.5153 + {
1.5154 + sym->usage&=~(uREAD | uWRITTEN); /* erase usage bits if there is no referrer */
1.5155 + } /* if */
1.5156 + } /* for */
1.5157 + /* after removing a symbol, check whether more can be removed */
1.5158 + } while (restart>0);
1.5159 +}
1.5160 +
1.5161 +#if !defined SC_LIGHT
1.5162 +static long max_stacksize_recurse(symbol *sourcesym,symbol *sym,long basesize,int *pubfuncparams,int *recursion)
1.5163 +{
1.5164 + long size,maxsize;
1.5165 + int i;
1.5166 +
1.5167 + assert(sym!=NULL);
1.5168 + assert(sym->ident==iFUNCTN);
1.5169 + assert((sym->usage & uNATIVE)==0);
1.5170 + assert(recursion!=NULL);
1.5171 +
1.5172 + maxsize=sym->x.stacksize;
1.5173 + for (i=0; i<sym->numrefers; i++) {
1.5174 + if (sym->refer[i]!=NULL) {
1.5175 + assert(sym->refer[i]->ident==iFUNCTN);
1.5176 + assert((sym->refer[i]->usage & uNATIVE)==0); /* a native function cannot refer to a user-function */
1.5177 + if (sym->refer[i]==sourcesym) { /* recursion detection */
1.5178 + *recursion=1;
1.5179 + break; /* recursion was detected, quit loop */
1.5180 + } /* if */
1.5181 + size=max_stacksize_recurse(sourcesym,sym->refer[i],sym->x.stacksize,pubfuncparams,recursion);
1.5182 + if (maxsize<size)
1.5183 + maxsize=size;
1.5184 + } /* if */
1.5185 + } /* for */
1.5186 +
1.5187 + if ((sym->usage & uPUBLIC)!=0) {
1.5188 + /* Find out how many parameters a public function has, then see if this
1.5189 + * is bigger than some maximum
1.5190 + */
1.5191 + arginfo *arg=sym->dim.arglist;
1.5192 + int count=0;
1.5193 + assert(arg!=0);
1.5194 + while (arg->ident!=0) {
1.5195 + count++;
1.5196 + arg++;
1.5197 + } /* while */
1.5198 + assert(pubfuncparams!=0);
1.5199 + if (count>*pubfuncparams)
1.5200 + *pubfuncparams=count;
1.5201 + } /* if */
1.5202 +
1.5203 + return maxsize+basesize;
1.5204 +}
1.5205 +
1.5206 +static symbol *save_symbol;
1.5207 +
1.5208 +static long max_stacksize(symbol *root,int *recursion)
1.5209 +{
1.5210 + /* Loop over all non-native functions. For each function, loop
1.5211 + * over all of its referrers, accumulating the stack requirements.
1.5212 + * Detect (indirect) recursion with a "mark-and-sweep" algorithm.
1.5213 + * I (mis-)use the "compound" field of the symbol structure for
1.5214 + * the marker, as this field is unused for functions.
1.5215 + *
1.5216 + * Note that the stack is shared with the heap. A host application
1.5217 + * may "eat" cells from the heap as well, through amx_Allot(). The
1.5218 + * stack requirements are thus only an estimate.
1.5219 + */
1.5220 + long size,maxsize;
1.5221 + int maxparams;
1.5222 + symbol *sym;
1.5223 +
1.5224 + assert(root!=NULL);
1.5225 + assert(recursion!=NULL);
1.5226 + #if !defined NDEBUG
1.5227 + for (sym=root->next; sym!=NULL; sym=sym->next)
1.5228 + if (sym->ident==iFUNCTN)
1.5229 + assert(sym->compound==0);
1.5230 + #endif
1.5231 +
1.5232 + maxsize=0;
1.5233 + maxparams=0;
1.5234 + *recursion=0; /* assume no recursion */
1.5235 + for (sym=root->next; sym!=NULL; sym=sym->next) {
1.5236 + /* drop out if this is not a user-implemented function */
1.5237 + if (sym->ident!=iFUNCTN || (sym->usage & uNATIVE)!=0)
1.5238 + continue;
1.5239 + /* accumulate stack size for this symbol */
1.5240 + save_symbol = sym;
1.5241 + size=max_stacksize_recurse(sym,sym,0L,&maxparams,recursion);
1.5242 + assert(size>=0);
1.5243 + if (maxsize<size)
1.5244 + maxsize=size;
1.5245 + } /* for */
1.5246 +
1.5247 + maxsize++; /* +1 because a zero cell is always pushed on top
1.5248 + * of the stack to catch stack overwrites */
1.5249 + return maxsize+(maxparams+1);/* +1 because # of parameters is always pushed on entry */
1.5250 +}
1.5251 +#endif
1.5252 +
1.5253 +/* testsymbols - test for unused local or global variables
1.5254 + *
1.5255 + * "Public" functions are excluded from the check, since these
1.5256 + * may be exported to other object modules.
1.5257 + * Labels are excluded from the check if the argument 'testlabs'
1.5258 + * is 0. Thus, labels are not tested until the end of the function.
1.5259 + * Constants may also be excluded (convenient for global constants).
1.5260 + *
1.5261 + * When the nesting level drops below "level", the check stops.
1.5262 + *
1.5263 + * The function returns whether there is an "entry" point for the file.
1.5264 + * This flag will only be 1 when browsing the global symbol table.
1.5265 + */
1.5266 +static int testsymbols(symbol *root,int level,int testlabs,int testconst)
1.5267 +{
1.5268 + char symname[2*sNAMEMAX+16];
1.5269 + int entry=FALSE;
1.5270 +
1.5271 + symbol *sym=root->next;
1.5272 + while (sym!=NULL && sym->compound>=level) {
1.5273 + switch (sym->ident) {
1.5274 + case iLABEL:
1.5275 + if (testlabs) {
1.5276 + if ((sym->usage & uDEFINE)==0) {
1.5277 + error(19,sym->name); /* not a label: ... */
1.5278 + } else if ((sym->usage & uREAD)==0) {
1.5279 + errorset(sSETPOS,sym->lnumber);
1.5280 + error(203,sym->name); /* symbol isn't used: ... */
1.5281 + } /* if */
1.5282 + } /* if */
1.5283 + break;
1.5284 + case iFUNCTN:
1.5285 + if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK | uPUBLIC))==uDEFINE) {
1.5286 + funcdisplayname(symname,sym->name);
1.5287 + if (strlen(symname)>0)
1.5288 + error(203,symname); /* symbol isn't used ... (and not public/native/stock) */
1.5289 + } /* if */
1.5290 + if ((sym->usage & uPUBLIC)!=0 || strcmp(sym->name,uMAINFUNC)==0)
1.5291 + entry=TRUE; /* there is an entry point */
1.5292 + /* also mark the function to the debug information */
1.5293 + if (((sym->usage & uREAD)!=0 || (sym->usage & uPUBLIC)!=0) && (sym->usage & uNATIVE)==0)
1.5294 + insert_dbgsymbol(sym);
1.5295 + break;
1.5296 + case iCONSTEXPR:
1.5297 + if (testconst && (sym->usage & uREAD)==0) {
1.5298 + errorset(sSETPOS,sym->lnumber);
1.5299 + error(203,sym->name); /* symbol isn't used: ... */
1.5300 + } /* if */
1.5301 + break;
1.5302 + default:
1.5303 + /* a variable */
1.5304 + if (sym->parent!=NULL)
1.5305 + break; /* hierarchical data type */
1.5306 + if ((sym->usage & (uWRITTEN | uREAD | uSTOCK))==0) {
1.5307 + errorset(sSETPOS,sym->lnumber);
1.5308 + error(203,sym->name); /* symbol isn't used (and not stock) */
1.5309 + } else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC))==0) {
1.5310 + errorset(sSETPOS,sym->lnumber);
1.5311 + error(204,sym->name); /* value assigned to symbol is never used */
1.5312 +#if 0 // ??? not sure whether it is a good idea to force people use "const"
1.5313 + } else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST))==0 && sym->ident==iREFARRAY) {
1.5314 + errorset(sSETPOS,sym->lnumber);
1.5315 + error(214,sym->name); /* make array argument "const" */
1.5316 +#endif
1.5317 + } /* if */
1.5318 + /* also mark the variable (local or global) to the debug information */
1.5319 + if ((sym->usage & (uWRITTEN | uREAD))!=0 && (sym->usage & uNATIVE)==0)
1.5320 + insert_dbgsymbol(sym);
1.5321 + } /* if */
1.5322 + sym=sym->next;
1.5323 + } /* while */
1.5324 +
1.5325 + return entry;
1.5326 +}
1.5327 +
1.5328 +static cell calc_array_datasize(symbol *sym, cell *offset)
1.5329 +{
1.5330 + cell length;
1.5331 +
1.5332 + assert(sym!=NULL);
1.5333 + assert(sym->ident==iARRAY || sym->ident==iREFARRAY);
1.5334 + length=sym->dim.array.length;
1.5335 + if (sym->dim.array.level > 0) {
1.5336 + cell sublength=calc_array_datasize(finddepend(sym),offset);
1.5337 + if (offset!=NULL)
1.5338 + *offset=length*(*offset+sizeof(cell));
1.5339 + if (sublength>0)
1.5340 + length*=length*sublength;
1.5341 + else
1.5342 + length=0;
1.5343 + } else {
1.5344 + if (offset!=NULL)
1.5345 + *offset=0;
1.5346 + } /* if */
1.5347 + return length;
1.5348 +}
1.5349 +
1.5350 +static void destructsymbols(symbol *root,int level)
1.5351 +{
1.5352 + cell offset=0;
1.5353 + int savepri=FALSE;
1.5354 + symbol *sym=root->next;
1.5355 + while (sym!=NULL && sym->compound>=level) {
1.5356 + if (sym->ident==iVARIABLE || sym->ident==iARRAY) {
1.5357 + char symbolname[16];
1.5358 + symbol *opsym;
1.5359 + cell elements;
1.5360 + /* check that the '~' operator is defined for this tag */
1.5361 + operator_symname(symbolname,"~",sym->tag,0,1,0);
1.5362 + if ((opsym=findglb(symbolname,sGLOBAL))!=NULL) {
1.5363 + /* save PRI, in case of a return statment */
1.5364 + if (!savepri) {
1.5365 + pushreg(sPRI); /* right-hand operand is in PRI */
1.5366 + savepri=TRUE;
1.5367 + } /* if */
1.5368 + /* if the variable is an array, get the number of elements */
1.5369 + if (sym->ident==iARRAY) {
1.5370 + elements=calc_array_datasize(sym,&offset);
1.5371 + /* "elements" can be zero when the variable is declared like
1.5372 + * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
1.5373 + * one should declare all dimensions!
1.5374 + */
1.5375 + if (elements==0)
1.5376 + error(46,sym->name); /* array size is unknown */
1.5377 + } else {
1.5378 + elements=1;
1.5379 + offset=0;
1.5380 + } /* if */
1.5381 + pushval(elements);
1.5382 + /* call the '~' operator */
1.5383 + address(sym,sPRI);
1.5384 + addconst(offset); /* add offset to array data to the address */
1.5385 + pushreg(sPRI);
1.5386 + pushval(2 /* *sizeof(cell)*/ );/* 2 parameters */
1.5387 + assert(opsym->ident==iFUNCTN);
1.5388 + ffcall(opsym,NULL,1);
1.5389 + if (sc_status!=statSKIP)
1.5390 + markusage(opsym,uREAD); /* do not mark as "used" when this call itself is skipped */
1.5391 + if ((opsym->usage & uNATIVE)!=0 && opsym->x.lib!=NULL)
1.5392 + opsym->x.lib->value += 1; /* increment "usage count" of the library */
1.5393 + } /* if */
1.5394 + } /* if */
1.5395 + sym=sym->next;
1.5396 + } /* while */
1.5397 + /* restore PRI, if it was saved */
1.5398 + if (savepri)
1.5399 + popreg(sPRI);
1.5400 +}
1.5401 +
1.5402 +static constvalue *insert_constval(constvalue *prev,constvalue *next,const char *name,cell val,
1.5403 + int index)
1.5404 +{
1.5405 + constvalue *cur;
1.5406 +
1.5407 + if ((cur=(constvalue*)malloc(sizeof(constvalue)))==NULL)
1.5408 + error(123); /* insufficient memory (fatal error) */
1.5409 + memset(cur,0,sizeof(constvalue));
1.5410 + if (name!=NULL) {
1.5411 + assert(strlen(name)<sNAMEMAX);
1.5412 + strcpy(cur->name,name);
1.5413 + } /* if */
1.5414 + cur->value=val;
1.5415 + cur->index=index;
1.5416 + cur->next=next;
1.5417 + prev->next=cur;
1.5418 + return cur;
1.5419 +}
1.5420 +
1.5421 +SC_FUNC constvalue *append_constval(constvalue *table,const char *name,cell val,int index)
1.5422 +{
1.5423 + constvalue *cur,*prev;
1.5424 +
1.5425 + /* find the end of the constant table */
1.5426 + for (prev=table, cur=table->next; cur!=NULL; prev=cur, cur=cur->next)
1.5427 + /* nothing */;
1.5428 + return insert_constval(prev,NULL,name,val,index);
1.5429 +}
1.5430 +
1.5431 +SC_FUNC constvalue *find_constval(constvalue *table,char *name,int index)
1.5432 +{
1.5433 + constvalue *ptr = table->next;
1.5434 +
1.5435 + while (ptr!=NULL) {
1.5436 + if (strcmp(name,ptr->name)==0 && ptr->index==index)
1.5437 + return ptr;
1.5438 + ptr=ptr->next;
1.5439 + } /* while */
1.5440 + return NULL;
1.5441 +}
1.5442 +
1.5443 +static constvalue *find_constval_byval(constvalue *table,cell val)
1.5444 +{
1.5445 + constvalue *ptr = table->next;
1.5446 +
1.5447 + while (ptr!=NULL) {
1.5448 + if (ptr->value==val)
1.5449 + return ptr;
1.5450 + ptr=ptr->next;
1.5451 + } /* while */
1.5452 + return NULL;
1.5453 +}
1.5454 +
1.5455 +#if 0 /* never used */
1.5456 +static int delete_constval(constvalue *table,char *name)
1.5457 +{
1.5458 + constvalue *prev = table;
1.5459 + constvalue *cur = prev->next;
1.5460 +
1.5461 + while (cur!=NULL) {
1.5462 + if (strcmp(name,cur->name)==0) {
1.5463 + prev->next=cur->next;
1.5464 + free(cur);
1.5465 + return TRUE;
1.5466 + } /* if */
1.5467 + prev=cur;
1.5468 + cur=cur->next;
1.5469 + } /* while */
1.5470 + return FALSE;
1.5471 +}
1.5472 +#endif
1.5473 +
1.5474 +SC_FUNC void delete_consttable(constvalue *table)
1.5475 +{
1.5476 + constvalue *cur=table->next, *next;
1.5477 +
1.5478 + while (cur!=NULL) {
1.5479 + next=cur->next;
1.5480 + free(cur);
1.5481 + cur=next;
1.5482 + } /* while */
1.5483 + memset(table,0,sizeof(constvalue));
1.5484 +}
1.5485 +
1.5486 +/* add_constant
1.5487 + *
1.5488 + * Adds a symbol to the symbol table. Returns NULL on failure.
1.5489 + */
1.5490 +SC_FUNC symbol *add_constant(char *name,cell val,int vclass,int tag)
1.5491 +{
1.5492 + symbol *sym;
1.5493 +
1.5494 + /* Test whether a global or local symbol with the same name exists. Since
1.5495 + * constants are stored in the symbols table, this also finds previously
1.5496 + * defind constants. */
1.5497 + sym=findglb(name,sSTATEVAR);
1.5498 + if (!sym)
1.5499 + sym=findloc(name);
1.5500 + if (sym) {
1.5501 + int redef=0;
1.5502 + if (sym->ident!=iCONSTEXPR)
1.5503 + redef=1; /* redefinition a function/variable to a constant is not allowed */
1.5504 + if ((sym->usage & uENUMFIELD)!=0) {
1.5505 + /* enum field, special case if it has a different tag and the new symbol is also an enum field */
1.5506 + constvalue *tagid;
1.5507 + symbol *tagsym;
1.5508 + if (sym->tag==tag)
1.5509 + redef=1; /* enumeration field is redefined (same tag) */
1.5510 + tagid=find_tag_byval(tag);
1.5511 + if (tagid==NULL) {
1.5512 + redef=1; /* new constant does not have a tag */
1.5513 + } else {
1.5514 + tagsym=findconst(tagid->name,NULL);
1.5515 + if (tagsym==NULL || (tagsym->usage & uENUMROOT)==0)
1.5516 + redef=1; /* new constant is not an enumeration field */
1.5517 + } /* if */
1.5518 + /* in this particular case (enumeration field that is part of a different
1.5519 + * enum, and non-conflicting with plain constants) we want to be able to
1.5520 + * redefine it
1.5521 + */
1.5522 + if (!redef)
1.5523 + goto redef_enumfield;
1.5524 + } else if (sym->tag!=tag) {
1.5525 + redef=1; /* redefinition of a constant (non-enum) to a different tag is not allowed */
1.5526 + } /* if */
1.5527 + if (redef) {
1.5528 + error(21,name); /* symbol already defined */
1.5529 + return NULL;
1.5530 + } else if (sym->addr!=val) {
1.5531 + error(201,name); /* redefinition of constant (different value) */
1.5532 + sym->addr=val; /* set new value */
1.5533 + } /* if */
1.5534 + /* silently ignore redefinitions of constants with the same value & tag */
1.5535 + return sym;
1.5536 + } /* if */
1.5537 +
1.5538 + /* constant doesn't exist yet (or is allowed to be redefined) */
1.5539 +redef_enumfield:
1.5540 + sym=addsym(name,val,iCONSTEXPR,vclass,tag,uDEFINE);
1.5541 + assert(sym!=NULL); /* fatal error 103 must be given on error */
1.5542 + if (sc_status == statIDLE)
1.5543 + sym->usage |= uPREDEF;
1.5544 + return sym;
1.5545 +}
1.5546 +
1.5547 +/* statement - The Statement Parser
1.5548 + *
1.5549 + * This routine is called whenever the parser needs to know what statement
1.5550 + * it encounters (i.e. whenever program syntax requires a statement).
1.5551 + */
1.5552 +static void statement(int *lastindent,int allow_decl)
1.5553 +{
1.5554 + int tok,save;
1.5555 + cell val;
1.5556 + char *st;
1.5557 +
1.5558 + if (!freading) {
1.5559 + error(36); /* empty statement */
1.5560 + return;
1.5561 + } /* if */
1.5562 + errorset(sRESET,0);
1.5563 +
1.5564 + tok=lex(&val,&st);
1.5565 + if (tok!='{') {
1.5566 + insert_dbgline(fline);
1.5567 + setline(TRUE);
1.5568 + } /* if */
1.5569 + /* lex() has set stmtindent */
1.5570 + if (lastindent!=NULL && tok!=tLABEL) {
1.5571 + if (*lastindent>=0 && *lastindent!=stmtindent && !indent_nowarn && sc_tabsize>0)
1.5572 + error(217); /* loose indentation */
1.5573 + *lastindent=stmtindent;
1.5574 + indent_nowarn=FALSE; /* if warning was blocked, re-enable it */
1.5575 + } /* if */
1.5576 + switch (tok) {
1.5577 + case 0:
1.5578 + /* nothing */
1.5579 + break;
1.5580 + case tNEW:
1.5581 + if (allow_decl) {
1.5582 + autozero=1;
1.5583 + declloc(FALSE);
1.5584 + lastst=tNEW;
1.5585 + } else {
1.5586 + error(3); /* declaration only valid in a block */
1.5587 + } /* if */
1.5588 + break;
1.5589 + case tDECL:
1.5590 + if (allow_decl) {
1.5591 + autozero=0;
1.5592 + declloc(FALSE);
1.5593 + lastst=tDECL;
1.5594 + } else {
1.5595 + error(3); /* declaration only valid in a block */
1.5596 + } /* if */
1.5597 + break;
1.5598 + case tSTATIC:
1.5599 + if (allow_decl) {
1.5600 + declloc(TRUE);
1.5601 + lastst=tNEW;
1.5602 + } else {
1.5603 + error(3); /* declaration only valid in a block */
1.5604 + } /* if */
1.5605 + break;
1.5606 + case '{':
1.5607 + case tBEGIN:
1.5608 + save=fline;
1.5609 + if (!matchtoken('}')) /* {} is the empty statement */
1.5610 + compound(save==fline,tok);
1.5611 + /* lastst (for "last statement") does not change */
1.5612 + break;
1.5613 + case ';':
1.5614 + error(36); /* empty statement */
1.5615 + break;
1.5616 + case tIF:
1.5617 + lastst=doif();
1.5618 + break;
1.5619 + case tWHILE:
1.5620 + lastst=dowhile();
1.5621 + break;
1.5622 + case tDO:
1.5623 + lastst=dodo();
1.5624 + break;
1.5625 + case tFOR:
1.5626 + lastst=dofor();
1.5627 + break;
1.5628 + case tSWITCH:
1.5629 + doswitch();
1.5630 + lastst=tSWITCH;
1.5631 + break;
1.5632 + case tCASE:
1.5633 + case tDEFAULT:
1.5634 + error(14); /* not in switch */
1.5635 + break;
1.5636 + case tGOTO:
1.5637 + dogoto();
1.5638 + lastst=tGOTO;
1.5639 + break;
1.5640 + case tLABEL:
1.5641 + dolabel();
1.5642 + lastst=tLABEL;
1.5643 + break;
1.5644 + case tRETURN:
1.5645 + doreturn();
1.5646 + lastst=tRETURN;
1.5647 + break;
1.5648 + case tBREAK:
1.5649 + dobreak();
1.5650 + lastst=tBREAK;
1.5651 + break;
1.5652 + case tCONTINUE:
1.5653 + docont();
1.5654 + lastst=tCONTINUE;
1.5655 + break;
1.5656 + case tEXIT:
1.5657 + doexit();
1.5658 + lastst=tEXIT;
1.5659 + break;
1.5660 + case tASSERT:
1.5661 + doassert();
1.5662 + lastst=tASSERT;
1.5663 + break;
1.5664 + case tSLEEP:
1.5665 + dosleep();
1.5666 + lastst=tSLEEP;
1.5667 + break;
1.5668 + case tSTATE:
1.5669 + dostate();
1.5670 + lastst=tSTATE;
1.5671 + break;
1.5672 + case tCONST:
1.5673 + decl_const(sLOCAL);
1.5674 + break;
1.5675 + case tENUM:
1.5676 + decl_enum(sLOCAL);
1.5677 + break;
1.5678 + default: /* non-empty expression */
1.5679 + sc_allowproccall=optproccall;
1.5680 + lexpush(); /* analyze token later */
1.5681 + doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE);
1.5682 + needtoken(tTERM);
1.5683 + lastst=tEXPR;
1.5684 + sc_allowproccall=FALSE;
1.5685 + } /* switch */
1.5686 +}
1.5687 +
1.5688 +static void compound(int stmt_sameline,int starttok)
1.5689 +{
1.5690 + int indent=-1;
1.5691 + cell save_decl=declared;
1.5692 + int count_stmt=0;
1.5693 + int block_start=fline; /* save line where the compound block started */
1.5694 + int endtok;
1.5695 +
1.5696 + pushstacklist();
1.5697 + pushheaplist();
1.5698 + /* if there is more text on this line, we should adjust the statement indent */
1.5699 + if (stmt_sameline) {
1.5700 + int i;
1.5701 + const unsigned char *p=lptr;
1.5702 + /* go back to the opening brace */
1.5703 + while (*p!=starttok) {
1.5704 + assert(p>pline);
1.5705 + p--;
1.5706 + } /* while */
1.5707 + assert(*p==starttok); /* it should be found */
1.5708 + /* go forward, skipping white-space */
1.5709 + p++;
1.5710 + while (*p<=' ' && *p!='\0')
1.5711 + p++;
1.5712 + assert(*p!='\0'); /* a token should be found */
1.5713 + stmtindent=0;
1.5714 + for (i=0; i<(int)(p-pline); i++)
1.5715 + if (pline[i]=='\t' && sc_tabsize>0)
1.5716 + stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize);
1.5717 + else
1.5718 + stmtindent++;
1.5719 + } /* if */
1.5720 +
1.5721 + endtok=(starttok=='{') ? '}' : tEND;
1.5722 + nestlevel+=1; /* increase compound statement level */
1.5723 + while (matchtoken(endtok)==0){/* repeat until compound statement is closed */
1.5724 + if (!freading){
1.5725 + error(30,block_start); /* compound block not closed at end of file */
1.5726 + break;
1.5727 + } else {
1.5728 + if (count_stmt>0 && (lastst==tRETURN || lastst==tBREAK || lastst==tCONTINUE || lastst==tENDLESS))
1.5729 + error(225); /* unreachable code */
1.5730 + statement(&indent,TRUE); /* do a statement */
1.5731 + count_stmt++;
1.5732 + } /* if */
1.5733 + } /* while */
1.5734 + if (lastst!=tRETURN)
1.5735 + destructsymbols(&loctab,nestlevel);
1.5736 + if (lastst!=tRETURN && lastst!=tGOTO) {
1.5737 + popheaplist();
1.5738 + popstacklist(1);
1.5739 + } else {
1.5740 + popheaplist();
1.5741 + popstacklist(0);
1.5742 + }
1.5743 + testsymbols(&loctab,nestlevel,FALSE,TRUE); /* look for unused block locals */
1.5744 + declared=save_decl;
1.5745 + delete_symbols(&loctab,nestlevel,FALSE,TRUE); /* erase local symbols, but
1.5746 + * retain block local labels
1.5747 + * (within the function) */
1.5748 + nestlevel-=1; /* decrease compound statement level */
1.5749 +}
1.5750 +
1.5751 +/* doexpr
1.5752 + *
1.5753 + * Global references: stgidx (referred to only)
1.5754 + */
1.5755 +static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
1.5756 + int *tag,symbol **symptr,int chkfuncresult)
1.5757 +{
1.5758 + return doexpr2(comma,chkeffect,allowarray,mark_endexpr,tag,symptr,chkfuncresult,NULL);
1.5759 +}
1.5760 +
1.5761 +/* doexpr2
1.5762 + *
1.5763 + * Global references: stgidx (referred to only)
1.5764 + */
1.5765 +static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
1.5766 + int *tag,symbol **symptr,int chkfuncresult,value *lval)
1.5767 +{
1.5768 + int index,ident;
1.5769 + int localstaging=FALSE;
1.5770 + cell val;
1.5771 +
1.5772 + if (!staging) {
1.5773 + stgset(TRUE); /* start stage-buffering */
1.5774 + localstaging=TRUE;
1.5775 + assert(stgidx==0);
1.5776 + } /* if */
1.5777 + index=stgidx;
1.5778 + errorset(sEXPRMARK,0);
1.5779 + do {
1.5780 + /* on second round through, mark the end of the previous expression */
1.5781 + if (index!=stgidx)
1.5782 + markexpr(sEXPR,NULL,0);
1.5783 + sideeffect=FALSE;
1.5784 + ident=expression(&val,tag,symptr,chkfuncresult,lval);
1.5785 + if (!allowarray && (ident==iARRAY || ident==iREFARRAY))
1.5786 + error(33,"-unknown-"); /* array must be indexed */
1.5787 + if (chkeffect && !sideeffect)
1.5788 + error(215); /* expression has no effect */
1.5789 + sc_allowproccall=FALSE; /* cannot use "procedure call" syntax anymore */
1.5790 + } while (comma && matchtoken(',')); /* more? */
1.5791 + if (mark_endexpr)
1.5792 + markexpr(sEXPR,NULL,0); /* optionally, mark the end of the expression */
1.5793 + errorset(sEXPRRELEASE,0);
1.5794 + if (localstaging) {
1.5795 + stgout(index);
1.5796 + stgset(FALSE); /* stop staging */
1.5797 + } /* if */
1.5798 + return ident;
1.5799 +}
1.5800 +
1.5801 +/* constexpr
1.5802 + */
1.5803 +SC_FUNC int constexpr(cell *val,int *tag,symbol **symptr)
1.5804 +{
1.5805 + int ident,index;
1.5806 + cell cidx;
1.5807 +
1.5808 + stgset(TRUE); /* start stage-buffering */
1.5809 + stgget(&index,&cidx); /* mark position in code generator */
1.5810 + errorset(sEXPRMARK,0);
1.5811 + ident=expression(val,tag,symptr,FALSE,NULL);
1.5812 + stgdel(index,cidx); /* scratch generated code */
1.5813 + stgset(FALSE); /* stop stage-buffering */
1.5814 + if (ident!=iCONSTEXPR) {
1.5815 + error(8); /* must be constant expression */
1.5816 + if (val!=NULL)
1.5817 + *val=0;
1.5818 + if (tag!=NULL)
1.5819 + *tag=0;
1.5820 + if (symptr!=NULL)
1.5821 + *symptr=NULL;
1.5822 + } /* if */
1.5823 + errorset(sEXPRRELEASE,0);
1.5824 + return (ident==iCONSTEXPR);
1.5825 +}
1.5826 +
1.5827 +/* test
1.5828 + *
1.5829 + * In the case a "simple assignment" operator ("=") is used within a test,
1.5830 + * the warning "possibly unintended assignment" is displayed. This routine
1.5831 + * sets the global variable "sc_intest" to true, it is restored upon termination.
1.5832 + * In the case the assignment was intended, use parentheses around the
1.5833 + * expression to avoid the warning; primary() sets "sc_intest" to 0.
1.5834 + *
1.5835 + * Global references: sc_intest (altered, but restored upon termination)
1.5836 + */
1.5837 +static int test(int label,int parens,int invert)
1.5838 +{
1.5839 + int index,tok;
1.5840 + cell cidx;
1.5841 + int ident,tag;
1.5842 + int endtok;
1.5843 + cell constval;
1.5844 + symbol *sym;
1.5845 + int localstaging=FALSE;
1.5846 +
1.5847 + if (!staging) {
1.5848 + stgset(TRUE); /* start staging */
1.5849 + localstaging=TRUE;
1.5850 + #if !defined NDEBUG
1.5851 + stgget(&index,&cidx); /* should start at zero if started locally */
1.5852 + assert(index==0);
1.5853 + #endif
1.5854 + } /* if */
1.5855 +
1.5856 + PUSHSTK_I(sc_intest);
1.5857 + sc_intest=TRUE;
1.5858 + endtok=0;
1.5859 + if (parens!=TEST_PLAIN) {
1.5860 + if (matchtoken('('))
1.5861 + endtok=')';
1.5862 + else if (parens==TEST_THEN)
1.5863 + endtok=tTHEN;
1.5864 + else if (parens==TEST_DO)
1.5865 + endtok=tDO;
1.5866 + } /* if */
1.5867 + do {
1.5868 + stgget(&index,&cidx); /* mark position (of last expression) in
1.5869 + * code generator */
1.5870 + ident=expression(&constval,&tag,&sym,TRUE,NULL);
1.5871 + tok=matchtoken(',');
1.5872 + if (tok)
1.5873 + markexpr(sEXPR,NULL,0);
1.5874 + } while (tok); /* do */
1.5875 + if (endtok!=0)
1.5876 + needtoken(endtok);
1.5877 + if (ident==iARRAY || ident==iREFARRAY) {
1.5878 + char *ptr=(sym->name!=NULL) ? sym->name : "-unknown-";
1.5879 + error(33,ptr); /* array must be indexed */
1.5880 + } /* if */
1.5881 + if (ident==iCONSTEXPR) { /* constant expression */
1.5882 + int testtype=0;
1.5883 + sc_intest=(short)POPSTK_I();/* restore stack */
1.5884 + stgdel(index,cidx);
1.5885 + if (constval) { /* code always executed */
1.5886 + error(206); /* redundant test: always non-zero */
1.5887 + testtype=tENDLESS;
1.5888 + } else {
1.5889 + error(205); /* redundant code: never executed */
1.5890 + jumplabel(label);
1.5891 + } /* if */
1.5892 + if (localstaging) {
1.5893 + stgout(0); /* write "jumplabel" code */
1.5894 + stgset(FALSE); /* stop staging */
1.5895 + } /* if */
1.5896 + return testtype;
1.5897 + } /* if */
1.5898 + if (tag!=0 && tag!=pc_addtag("bool"))
1.5899 + if (check_userop(lneg,tag,0,1,NULL,&tag))
1.5900 + invert= !invert; /* user-defined ! operator inverted result */
1.5901 + if (invert)
1.5902 + jmp_ne0(label); /* jump to label if true (different from 0) */
1.5903 + else
1.5904 + jmp_eq0(label); /* jump to label if false (equal to 0) */
1.5905 + markexpr(sEXPR,NULL,0); /* end expression (give optimizer a chance) */
1.5906 + sc_intest=(short)POPSTK_I(); /* double typecast to avoid warning with Microsoft C */
1.5907 + if (localstaging) {
1.5908 + stgout(0); /* output queue from the very beginning (see
1.5909 + * assert() when localstaging is set to TRUE) */
1.5910 + stgset(FALSE); /* stop staging */
1.5911 + } /* if */
1.5912 + return 0;
1.5913 +}
1.5914 +
1.5915 +static int doif(void)
1.5916 +{
1.5917 + int flab1,flab2;
1.5918 + int ifindent;
1.5919 + int lastst_true;
1.5920 +
1.5921 + ifindent=stmtindent; /* save the indent of the "if" instruction */
1.5922 + flab1=getlabel(); /* get label number for false branch */
1.5923 + test(flab1,TEST_THEN,FALSE); /* get expression, branch to flab1 if false */
1.5924 + statement(NULL,FALSE); /* if true, do a statement */
1.5925 + if (!matchtoken(tELSE)) { /* if...else ? */
1.5926 + setlabel(flab1); /* no, simple if..., print false label */
1.5927 + } else {
1.5928 + lastst_true=lastst; /* save last statement of the "true" branch */
1.5929 + /* to avoid the "dangling else" error, we want a warning if the "else"
1.5930 + * has a lower indent than the matching "if" */
1.5931 + if (stmtindent<ifindent && sc_tabsize>0)
1.5932 + error(217); /* loose indentation */
1.5933 + flab2=getlabel();
1.5934 + if ((lastst!=tRETURN) && (lastst!=tGOTO))
1.5935 + jumplabel(flab2); /* "true" branch jumps around "else" clause, unless the "true" branch statement already jumped */
1.5936 + setlabel(flab1); /* print false label */
1.5937 + statement(NULL,FALSE); /* do "else" clause */
1.5938 + setlabel(flab2); /* print true label */
1.5939 + /* if both the "true" branch and the "false" branch ended with the same
1.5940 + * kind of statement, set the last statement id to that kind, rather than
1.5941 + * to the generic tIF; this allows for better "unreachable code" checking
1.5942 + */
1.5943 + if (lastst==lastst_true)
1.5944 + return lastst;
1.5945 + } /* if */
1.5946 + return tIF;
1.5947 +}
1.5948 +
1.5949 +static int dowhile(void)
1.5950 +{
1.5951 + int wq[wqSIZE]; /* allocate local queue */
1.5952 + int save_endlessloop,retcode;
1.5953 +
1.5954 + save_endlessloop=endlessloop;
1.5955 + addwhile(wq); /* add entry to queue for "break" */
1.5956 + setlabel(wq[wqLOOP]); /* loop label */
1.5957 + /* The debugger uses the "break" opcode to be able to "break" out of
1.5958 + * a loop. To make sure that each loop has a break opcode, even for the
1.5959 + * tiniest loop, set it below the top of the loop
1.5960 + */
1.5961 + setline(TRUE);
1.5962 + endlessloop=test(wq[wqEXIT],TEST_DO,FALSE);/* branch to wq[wqEXIT] if false */
1.5963 + statement(NULL,FALSE); /* if so, do a statement */
1.5964 + jumplabel(wq[wqLOOP]); /* and loop to "while" start */
1.5965 + setlabel(wq[wqEXIT]); /* exit label */
1.5966 + delwhile(); /* delete queue entry */
1.5967 +
1.5968 + retcode=endlessloop ? tENDLESS : tWHILE;
1.5969 + endlessloop=save_endlessloop;
1.5970 + return retcode;
1.5971 +}
1.5972 +
1.5973 +/*
1.5974 + * Note that "continue" will in this case not jump to the top of the loop, but
1.5975 + * to the end: just before the TRUE-or-FALSE testing code.
1.5976 + */
1.5977 +static int dodo(void)
1.5978 +{
1.5979 + int wq[wqSIZE],top;
1.5980 + int save_endlessloop,retcode;
1.5981 +
1.5982 + save_endlessloop=endlessloop;
1.5983 + addwhile(wq); /* see "dowhile" for more info */
1.5984 + top=getlabel(); /* make a label first */
1.5985 + setlabel(top); /* loop label */
1.5986 + statement(NULL,FALSE);
1.5987 + needtoken(tWHILE);
1.5988 + setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
1.5989 + setline(TRUE);
1.5990 + endlessloop=test(wq[wqEXIT],TEST_OPT,FALSE);
1.5991 + jumplabel(top);
1.5992 + setlabel(wq[wqEXIT]);
1.5993 + delwhile();
1.5994 + needtoken(tTERM);
1.5995 +
1.5996 + retcode=endlessloop ? tENDLESS : tDO;
1.5997 + endlessloop=save_endlessloop;
1.5998 + return retcode;
1.5999 +}
1.6000 +
1.6001 +static int dofor(void)
1.6002 +{
1.6003 + int wq[wqSIZE],skiplab;
1.6004 + cell save_decl;
1.6005 + int save_nestlevel,save_endlessloop;
1.6006 + int index,endtok;
1.6007 + int *ptr;
1.6008 +
1.6009 + save_decl=declared;
1.6010 + save_nestlevel=nestlevel;
1.6011 + save_endlessloop=endlessloop;
1.6012 + pushstacklist();
1.6013 +
1.6014 + addwhile(wq);
1.6015 + skiplab=getlabel();
1.6016 + endtok= matchtoken('(') ? ')' : tDO;
1.6017 + if (matchtoken(';')==0) {
1.6018 + /* new variable declarations are allowed here */
1.6019 + if (matchtoken(tNEW)) {
1.6020 + /* The variable in expr1 of the for loop is at a
1.6021 + * 'compound statement' level of it own.
1.6022 + */
1.6023 + nestlevel++;
1.6024 + autozero=1;
1.6025 + declloc(FALSE); /* declare local variable */
1.6026 + } else {
1.6027 + doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE); /* expression 1 */
1.6028 + needtoken(';');
1.6029 + } /* if */
1.6030 + } /* if */
1.6031 + /* Adjust the "declared" field in the "while queue", in case that
1.6032 + * local variables were declared in the first expression of the
1.6033 + * "for" loop. These are deleted in separately, so a "break" or a "continue"
1.6034 + * must ignore these fields.
1.6035 + */
1.6036 + ptr=readwhile();
1.6037 + assert(ptr!=NULL);
1.6038 + /*ptr[wqBRK]=(int)declared;
1.6039 + *ptr[wqCONT]=(int)declared;
1.6040 + */
1.6041 + ptr[wqBRK] = stackusage->list_id;
1.6042 + ptr[wqCONT] = stackusage->list_id;
1.6043 + jumplabel(skiplab); /* skip expression 3 1st time */
1.6044 + setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
1.6045 + setline(TRUE);
1.6046 + /* Expressions 2 and 3 are reversed in the generated code: expression 3
1.6047 + * precedes expression 2. When parsing, the code is buffered and marks for
1.6048 + * the start of each expression are insterted in the buffer.
1.6049 + */
1.6050 + assert(!staging);
1.6051 + stgset(TRUE); /* start staging */
1.6052 + assert(stgidx==0);
1.6053 + index=stgidx;
1.6054 + stgmark(sSTARTREORDER);
1.6055 + stgmark((char)(sEXPRSTART+0)); /* mark start of 2nd expression in stage */
1.6056 + setlabel(skiplab); /* jump to this point after 1st expression */
1.6057 + if (matchtoken(';')) {
1.6058 + endlessloop=1;
1.6059 + } else {
1.6060 + endlessloop=test(wq[wqEXIT],TEST_PLAIN,FALSE);/* expression 2 (jump to wq[wqEXIT] if false) */
1.6061 + needtoken(';');
1.6062 + } /* if */
1.6063 + stgmark((char)(sEXPRSTART+1)); /* mark start of 3th expression in stage */
1.6064 + if (!matchtoken(endtok)) {
1.6065 + doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE); /* expression 3 */
1.6066 + needtoken(endtok);
1.6067 + } /* if */
1.6068 + stgmark(sENDREORDER); /* mark end of reversed evaluation */
1.6069 + stgout(index);
1.6070 + stgset(FALSE); /* stop staging */
1.6071 + statement(NULL,FALSE);
1.6072 + jumplabel(wq[wqLOOP]);
1.6073 + setlabel(wq[wqEXIT]);
1.6074 + delwhile();
1.6075 +
1.6076 + assert(nestlevel>=save_nestlevel);
1.6077 + if (nestlevel>save_nestlevel) {
1.6078 + /* Clean up the space and the symbol table for the local
1.6079 + * variable in "expr1".
1.6080 + */
1.6081 + destructsymbols(&loctab,nestlevel);
1.6082 + popstacklist(1);
1.6083 + testsymbols(&loctab,nestlevel,FALSE,TRUE); /* look for unused block locals */
1.6084 + declared=save_decl;
1.6085 + delete_symbols(&loctab,nestlevel,FALSE,TRUE);
1.6086 + nestlevel=save_nestlevel; /* reset 'compound statement' nesting level */
1.6087 + } else {
1.6088 + popstacklist(0);
1.6089 + } /* if */
1.6090 +
1.6091 + index=endlessloop ? tENDLESS : tFOR;
1.6092 + endlessloop=save_endlessloop;
1.6093 + return index;
1.6094 +}
1.6095 +
1.6096 +/* The switch statement is incompatible with its C sibling:
1.6097 + * 1. the cases are not drop through
1.6098 + * 2. only one instruction may appear below each case, use a compound
1.6099 + * instruction to execute multiple instructions
1.6100 + * 3. the "case" keyword accepts a comma separated list of values to
1.6101 + * match
1.6102 + *
1.6103 + * SWITCH param
1.6104 + * PRI = expression result
1.6105 + * param = table offset (code segment)
1.6106 + *
1.6107 + */
1.6108 +static void doswitch(void)
1.6109 +{
1.6110 + int lbl_table,lbl_exit,lbl_case;
1.6111 + int swdefault,casecount;
1.6112 + int tok,endtok;
1.6113 + cell val;
1.6114 + char *str;
1.6115 + constvalue caselist = { NULL, "", 0, 0}; /* case list starts empty */
1.6116 + constvalue *cse,*csp;
1.6117 + char labelname[sNAMEMAX+1];
1.6118 +
1.6119 + endtok= matchtoken('(') ? ')' : tDO;
1.6120 + doexpr(TRUE,FALSE,FALSE,FALSE,NULL,NULL,TRUE);/* evaluate switch expression */
1.6121 + needtoken(endtok);
1.6122 + /* generate the code for the switch statement, the label is the address
1.6123 + * of the case table (to be generated later).
1.6124 + */
1.6125 + lbl_table=getlabel();
1.6126 + lbl_case=0; /* just to avoid a compiler warning */
1.6127 + ffswitch(lbl_table);
1.6128 +
1.6129 + if (matchtoken(tBEGIN)) {
1.6130 + endtok=tEND;
1.6131 + } else {
1.6132 + endtok='}';
1.6133 + needtoken('{');
1.6134 + } /* if */
1.6135 + lbl_exit=getlabel(); /* get label number for jumping out of switch */
1.6136 + swdefault=FALSE;
1.6137 + casecount=0;
1.6138 + do {
1.6139 + tok=lex(&val,&str); /* read in (new) token */
1.6140 + switch (tok) {
1.6141 + case tCASE:
1.6142 + if (swdefault!=FALSE)
1.6143 + error(15); /* "default" case must be last in switch statement */
1.6144 + lbl_case=getlabel();
1.6145 + PUSHSTK_I(sc_allowtags);
1.6146 + sc_allowtags=FALSE; /* do not allow tagnames here */
1.6147 + do {
1.6148 + casecount++;
1.6149 +
1.6150 + /* ??? enforce/document that, in a switch, a statement cannot start
1.6151 + * with a label. Then, you can search for:
1.6152 + * * the first semicolon (marks the end of a statement)
1.6153 + * * an opening brace (marks the start of a compound statement)
1.6154 + * and search for the right-most colon before that statement
1.6155 + * Now, by replacing the ':' by a special COLON token, you can
1.6156 + * parse all expressions until that special token.
1.6157 + */
1.6158 +
1.6159 + constexpr(&val,NULL,NULL);
1.6160 + /* Search the insertion point (the table is kept in sorted order, so
1.6161 + * that advanced abstract machines can sift the case table with a
1.6162 + * binary search). Check for duplicate case values at the same time.
1.6163 + */
1.6164 + for (csp=&caselist, cse=caselist.next;
1.6165 + cse!=NULL && cse->value<val;
1.6166 + csp=cse, cse=cse->next)
1.6167 + /* nothing */;
1.6168 + if (cse!=NULL && cse->value==val)
1.6169 + error(40,val); /* duplicate "case" label */
1.6170 + /* Since the label is stored as a string in the "constvalue", the
1.6171 + * size of an identifier must be at least 8, as there are 8
1.6172 + * hexadecimal digits in a 32-bit number.
1.6173 + */
1.6174 + #if sNAMEMAX < 8
1.6175 + #error Length of identifier (sNAMEMAX) too small.
1.6176 + #endif
1.6177 + assert(csp!=NULL);
1.6178 + assert(csp->next==cse);
1.6179 + insert_constval(csp,cse,itoh(lbl_case),val,0);
1.6180 + if (matchtoken(tDBLDOT)) {
1.6181 + error(1, ":", "..");
1.6182 + } /* if */
1.6183 + } while (matchtoken(','));
1.6184 + needtoken(':'); /* ':' ends the case */
1.6185 + sc_allowtags=(short)POPSTK_I(); /* reset */
1.6186 + setlabel(lbl_case);
1.6187 + statement(NULL,FALSE);
1.6188 + jumplabel(lbl_exit);
1.6189 + break;
1.6190 + case tDEFAULT:
1.6191 + if (swdefault!=FALSE)
1.6192 + error(16); /* multiple defaults in switch */
1.6193 + lbl_case=getlabel();
1.6194 + setlabel(lbl_case);
1.6195 + needtoken(':');
1.6196 + swdefault=TRUE;
1.6197 + statement(NULL,FALSE);
1.6198 + /* Jump to lbl_exit, even thouh this is the last clause in the
1.6199 + * switch, because the jump table is generated between the last
1.6200 + * clause of the switch and the exit label.
1.6201 + */
1.6202 + jumplabel(lbl_exit);
1.6203 + break;
1.6204 + default:
1.6205 + if (tok!=endtok) {
1.6206 + error(2);
1.6207 + indent_nowarn=TRUE; /* disable this check */
1.6208 + tok=endtok; /* break out of the loop after an error */
1.6209 + } /* if */
1.6210 + } /* switch */
1.6211 + } while (tok!=endtok);
1.6212 +
1.6213 + #if !defined NDEBUG
1.6214 + /* verify that the case table is sorted (unfortunatly, duplicates can
1.6215 + * occur; there really shouldn't be duplicate cases, but the compiler
1.6216 + * may not crash or drop into an assertion for a user error). */
1.6217 + for (cse=caselist.next; cse!=NULL && cse->next!=NULL; cse=cse->next)
1.6218 + assert(cse->value <= cse->next->value);
1.6219 + #endif
1.6220 + /* generate the table here, before lbl_exit (general jump target) */
1.6221 + setlabel(lbl_table);
1.6222 + assert(swdefault==FALSE || swdefault==TRUE);
1.6223 + if (swdefault==FALSE) {
1.6224 + /* store lbl_exit as the "none-matched" label in the switch table */
1.6225 + strcpy(labelname,itoh(lbl_exit));
1.6226 + } else {
1.6227 + /* lbl_case holds the label of the "default" clause */
1.6228 + strcpy(labelname,itoh(lbl_case));
1.6229 + } /* if */
1.6230 + ffcase(casecount,labelname,TRUE);
1.6231 + /* generate the rest of the table */
1.6232 + for (cse=caselist.next; cse!=NULL; cse=cse->next)
1.6233 + ffcase(cse->value,cse->name,FALSE);
1.6234 +
1.6235 + setlabel(lbl_exit);
1.6236 + delete_consttable(&caselist); /* clear list of case labels */
1.6237 +}
1.6238 +
1.6239 +static void doassert(void)
1.6240 +{
1.6241 + int flab1,index;
1.6242 + cell cidx;
1.6243 +
1.6244 + if ((sc_debug & sCHKBOUNDS)!=0) {
1.6245 + flab1=getlabel(); /* get label number for "OK" branch */
1.6246 + test(flab1,TEST_PLAIN,TRUE);/* get expression and branch to flab1 if true */
1.6247 + insert_dbgline(fline); /* make sure we can find the correct line number */
1.6248 + ffabort(xASSERTION);
1.6249 + setlabel(flab1);
1.6250 + } else {
1.6251 + stgset(TRUE); /* start staging */
1.6252 + stgget(&index,&cidx); /* mark position in code generator */
1.6253 + do {
1.6254 + expression(NULL,NULL,NULL,FALSE,NULL);
1.6255 + stgdel(index,cidx); /* just scrap the code */
1.6256 + } while (matchtoken(','));
1.6257 + stgset(FALSE); /* stop staging */
1.6258 + } /* if */
1.6259 + needtoken(tTERM);
1.6260 +}
1.6261 +
1.6262 +static void dogoto(void)
1.6263 +{
1.6264 + char *st;
1.6265 + cell val;
1.6266 + symbol *sym;
1.6267 +
1.6268 + /* if we were inside an endless loop, assume that we jump out of it */
1.6269 + endlessloop=0;
1.6270 +
1.6271 + if (lex(&val,&st)==tSYMBOL) {
1.6272 + sym=fetchlab(st);
1.6273 + jumplabel((int)sym->addr);
1.6274 + sym->usage|=uREAD; /* set "uREAD" bit */
1.6275 + // ??? if the label is defined (check sym->usage & uDEFINE), check
1.6276 + // sym->compound (nesting level of the label) against nestlevel;
1.6277 + // if sym->compound < nestlevel, call the destructor operator
1.6278 + } else {
1.6279 + error(20,st); /* illegal symbol name */
1.6280 + } /* if */
1.6281 + needtoken(tTERM);
1.6282 +}
1.6283 +
1.6284 +static void dolabel(void)
1.6285 +{
1.6286 + char *st;
1.6287 + cell val;
1.6288 + symbol *sym;
1.6289 +
1.6290 + tokeninfo(&val,&st); /* retrieve label name again */
1.6291 + if (find_constval(&tagname_tab,st,0)!=NULL)
1.6292 + error(221,st); /* label name shadows tagname */
1.6293 + sym=fetchlab(st);
1.6294 + setlabel((int)sym->addr);
1.6295 + /* since one can jump around variable declarations or out of compound
1.6296 + * blocks, the stack must be manually adjusted
1.6297 + */
1.6298 + //:TODO: This is actually generated, egads!
1.6299 + //We have to support this and LCTRL/SCTRL
1.6300 + setstk(-declared*sizeof(cell));
1.6301 + sym->usage|=uDEFINE; /* label is now defined */
1.6302 +}
1.6303 +
1.6304 +/* fetchlab
1.6305 + *
1.6306 + * Finds a label from the (local) symbol table or adds one to it.
1.6307 + * Labels are local in scope.
1.6308 + *
1.6309 + * Note: The "_usage" bit is set to zero. The routines that call "fetchlab()"
1.6310 + * must set this bit accordingly.
1.6311 + */
1.6312 +static symbol *fetchlab(char *name)
1.6313 +{
1.6314 + symbol *sym;
1.6315 +
1.6316 + sym=findloc(name); /* labels are local in scope */
1.6317 + if (sym){
1.6318 + if (sym->ident!=iLABEL)
1.6319 + error(19,sym->name); /* not a label: ... */
1.6320 + } else {
1.6321 + sym=addsym(name,getlabel(),iLABEL,sLOCAL,0,0);
1.6322 + assert(sym!=NULL); /* fatal error 103 must be given on error */
1.6323 + sym->x.declared=(int)declared;
1.6324 + sym->compound=nestlevel;
1.6325 + } /* if */
1.6326 + return sym;
1.6327 +}
1.6328 +
1.6329 +/* doreturn
1.6330 + *
1.6331 + * Global references: rettype (altered)
1.6332 + */
1.6333 +static void doreturn(void)
1.6334 +{
1.6335 + int tag,ident;
1.6336 + int level;
1.6337 + symbol *sym,*sub;
1.6338 +
1.6339 + if (!matchtoken(tTERM)) {
1.6340 + /* "return <value>" */
1.6341 + if ((rettype & uRETNONE)!=0)
1.6342 + error(78); /* mix "return;" and "return value;" */
1.6343 + ident=doexpr(TRUE,FALSE,TRUE,FALSE,&tag,&sym,TRUE);
1.6344 + needtoken(tTERM);
1.6345 + /* see if this function already has a sub type (an array attached) */
1.6346 + sub=finddepend(curfunc);
1.6347 + assert(sub==NULL || sub->ident==iREFARRAY);
1.6348 + if ((rettype & uRETVALUE)!=0) {
1.6349 + int retarray=(ident==iARRAY || ident==iREFARRAY);
1.6350 + /* there was an earlier "return" statement in this function */
1.6351 + if (sub==NULL && retarray || sub!=NULL && !retarray)
1.6352 + error(79); /* mixing "return array;" and "return value;" */
1.6353 + if (retarray && (curfunc->usage & uPUBLIC)!=0)
1.6354 + error(90,curfunc->name); /* public function may not return array */
1.6355 + } /* if */
1.6356 + rettype|=uRETVALUE; /* function returns a value */
1.6357 + /* check tagname with function tagname */
1.6358 + assert(curfunc!=NULL);
1.6359 + if (!matchtag_string(ident, tag) && !matchtag(curfunc->tag,tag,TRUE))
1.6360 + error(213); /* tagname mismatch */
1.6361 + if (ident==iARRAY || ident==iREFARRAY) {
1.6362 + int dim[sDIMEN_MAX],numdim;
1.6363 + cell arraysize;
1.6364 + assert(sym!=NULL);
1.6365 + if (sub!=NULL) {
1.6366 + assert(sub->ident==iREFARRAY);
1.6367 + /* this function has an array attached already; check that the current
1.6368 + * "return" statement returns exactly the same array
1.6369 + */
1.6370 + level=sym->dim.array.level;
1.6371 + if (sub->dim.array.level!=level) {
1.6372 + error(48); /* array dimensions must match */
1.6373 + } else {
1.6374 + for (numdim=0; numdim<=level; numdim++) {
1.6375 + dim[numdim]=(int)sub->dim.array.length;
1.6376 + if (sym->dim.array.length!=dim[numdim])
1.6377 + error(47); /* array sizes must match */
1.6378 + if (numdim<level) {
1.6379 + sym=finddepend(sym);
1.6380 + sub=finddepend(sub);
1.6381 + assert(sym!=NULL && sub!=NULL);
1.6382 + /* ^^^ both arrays have the same dimensions (this was checked
1.6383 + * earlier) so the dependend should always be found
1.6384 + */
1.6385 + } /* if */
1.6386 + } /* for */
1.6387 + } /* if */
1.6388 + } else {
1.6389 + int idxtag[sDIMEN_MAX];
1.6390 + int argcount;
1.6391 + /* this function does not yet have an array attached; clone the
1.6392 + * returned symbol beneath the current function
1.6393 + */
1.6394 + sub=sym;
1.6395 + assert(sub!=NULL);
1.6396 + level=sub->dim.array.level;
1.6397 + for (numdim=0; numdim<=level; numdim++) {
1.6398 + dim[numdim]=(int)sub->dim.array.length;
1.6399 + idxtag[numdim]=sub->x.tags.index;
1.6400 + if (numdim<level) {
1.6401 + sub=finddepend(sub);
1.6402 + assert(sub!=NULL);
1.6403 + } /* if */
1.6404 + /* check that all dimensions are known */
1.6405 + if (dim[numdim]<=0)
1.6406 + error(46,sym->name);
1.6407 + } /* for */
1.6408 + /* the address of the array is stored in a hidden parameter; the address
1.6409 + * of this parameter is 1 + the number of parameters (times the size of
1.6410 + * a cell) + the size of the stack frame and the return address
1.6411 + * base + 0*sizeof(cell) == previous "base"
1.6412 + * base + 1*sizeof(cell) == function return address
1.6413 + * base + 2*sizeof(cell) == number of arguments
1.6414 + * base + 3*sizeof(cell) == first argument of the function
1.6415 + * ...
1.6416 + * base + ((n-1)+3)*sizeof(cell) == last argument of the function
1.6417 + * base + (n+3)*sizeof(cell) == hidden parameter with array address
1.6418 + */
1.6419 + assert(curfunc!=NULL);
1.6420 + assert(curfunc->dim.arglist!=NULL);
1.6421 + for (argcount=0; curfunc->dim.arglist[argcount].ident!=0; argcount++)
1.6422 + /* nothing */;
1.6423 + sub=addvariable(curfunc->name,(argcount+3)*sizeof(cell),iREFARRAY,sGLOBAL,curfunc->tag,dim,numdim,idxtag);
1.6424 + sub->parent=curfunc;
1.6425 + } /* if */
1.6426 + /* get the hidden parameter, copy the array (the array is on the heap;
1.6427 + * it stays on the heap for the moment, and it is removed -usually- at
1.6428 + * the end of the expression/statement, see expression() in SC3.C)
1.6429 + */
1.6430 + address(sub,sALT); /* ALT = destination */
1.6431 + arraysize=calc_arraysize(dim,numdim,0);
1.6432 + memcopy(arraysize*sizeof(cell)); /* source already in PRI */
1.6433 + /* moveto1(); is not necessary, callfunction() does a popreg() */
1.6434 + } /* if */
1.6435 + } else {
1.6436 + /* this return statement contains no expression */
1.6437 + ldconst(0,sPRI);
1.6438 + if ((rettype & uRETVALUE)!=0) {
1.6439 + char symname[2*sNAMEMAX+16]; /* allow space for user defined operators */
1.6440 + assert(curfunc!=NULL);
1.6441 + funcdisplayname(symname,curfunc->name);
1.6442 + error(209,symname); /* function should return a value */
1.6443 + } /* if */
1.6444 + rettype|=uRETNONE; /* function does not return anything */
1.6445 + } /* if */
1.6446 + destructsymbols(&loctab,0); /* call destructor for *all* locals */
1.6447 + genheapfree(-1);
1.6448 + genstackfree(-1); /* free everything on the stack */
1.6449 + ffret(strcmp(curfunc->name,uENTRYFUNC)!=0);
1.6450 +}
1.6451 +
1.6452 +static void dobreak(void)
1.6453 +{
1.6454 + int *ptr;
1.6455 +
1.6456 + endlessloop=0; /* if we were inside an endless loop, we just jumped out */
1.6457 + ptr=readwhile(); /* readwhile() gives an error if not in loop */
1.6458 + needtoken(tTERM);
1.6459 + if (ptr==NULL)
1.6460 + return;
1.6461 + destructsymbols(&loctab,nestlevel);
1.6462 + genstackfree(ptr[wqBRK]);
1.6463 + jumplabel(ptr[wqEXIT]);
1.6464 +}
1.6465 +
1.6466 +static void docont(void)
1.6467 +{
1.6468 + int *ptr;
1.6469 +
1.6470 + ptr=readwhile(); /* readwhile() gives an error if not in loop */
1.6471 + needtoken(tTERM);
1.6472 + if (ptr==NULL)
1.6473 + return;
1.6474 + destructsymbols(&loctab,nestlevel);
1.6475 + genstackfree(ptr[wqCONT]);
1.6476 + genheapfree(ptr[wqCONT]);
1.6477 + jumplabel(ptr[wqLOOP]);
1.6478 +}
1.6479 +
1.6480 +SC_FUNC void exporttag(int tag)
1.6481 +{
1.6482 + /* find the tag by value in the table, then set the top bit to mark it
1.6483 + * "public"
1.6484 + */
1.6485 + if (tag!=0 && (tag & PUBLICTAG)==0) {
1.6486 + constvalue *ptr;
1.6487 + for (ptr=tagname_tab.next; ptr!=NULL && tag!=(int)(ptr->value & TAGMASK); ptr=ptr->next)
1.6488 + /* nothing */;
1.6489 + if (ptr!=NULL)
1.6490 + ptr->value |= PUBLICTAG;
1.6491 + } /* if */
1.6492 +}
1.6493 +
1.6494 +static void doexit(void)
1.6495 +{
1.6496 + int tag=0;
1.6497 +
1.6498 + if (matchtoken(tTERM)==0){
1.6499 + doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
1.6500 + needtoken(tTERM);
1.6501 + } else {
1.6502 + ldconst(0,sPRI);
1.6503 + } /* if */
1.6504 + ldconst(tag,sALT);
1.6505 + exporttag(tag);
1.6506 + destructsymbols(&loctab,0); /* call destructor for *all* locals */
1.6507 + ffabort(xEXIT);
1.6508 +}
1.6509 +
1.6510 +static void dosleep(void)
1.6511 +{
1.6512 + int tag=0;
1.6513 +
1.6514 + if (matchtoken(tTERM)==0){
1.6515 + doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
1.6516 + needtoken(tTERM);
1.6517 + } else {
1.6518 + ldconst(0,sPRI);
1.6519 + } /* if */
1.6520 + ldconst(tag,sALT);
1.6521 + exporttag(tag);
1.6522 + ffabort(xSLEEP);
1.6523 +
1.6524 + /* for stack usage checking, mark the use of the sleep instruction */
1.6525 + pc_memflags |= suSLEEP_INSTR;
1.6526 +}
1.6527 +
1.6528 +static void dostate(void)
1.6529 +{
1.6530 + char name[sNAMEMAX+1];
1.6531 + constvalue *automaton;
1.6532 + constvalue *state;
1.6533 + constvalue *stlist;
1.6534 + int flabel;
1.6535 + symbol *sym;
1.6536 + #if !defined SC_LIGHT
1.6537 + int length,index,listid,listindex,stateindex;
1.6538 + char *doc;
1.6539 + #endif
1.6540 +
1.6541 + /* check for an optional condition */
1.6542 + if (matchtoken('(')) {
1.6543 + flabel=getlabel(); /* get label number for "false" branch */
1.6544 + pc_docexpr=TRUE; /* attach expression as a documentation string */
1.6545 + test(flabel,TEST_PLAIN,FALSE);/* get expression, branch to flabel if false */
1.6546 + pc_docexpr=FALSE;
1.6547 + needtoken(')');
1.6548 + } else {
1.6549 + flabel=-1;
1.6550 + } /* if */
1.6551 +
1.6552 + if (!sc_getstateid(&automaton,&state)) {
1.6553 + delete_autolisttable();
1.6554 + return;
1.6555 + } /* if */
1.6556 + needtoken(tTERM);
1.6557 +
1.6558 + /* store the new state id */
1.6559 + assert(state!=NULL);
1.6560 + ldconst(state->value,sPRI);
1.6561 + assert(automaton!=NULL);
1.6562 + assert(automaton->index==0 && automaton->name[0]=='\0' || automaton->index>0);
1.6563 + storereg(automaton->value,sPRI);
1.6564 +
1.6565 + /* find the optional entry() function for the state */
1.6566 + sym=findglb(uENTRYFUNC,sGLOBAL);
1.6567 + if (sc_status==statWRITE && sym!=NULL && sym->ident==iFUNCTN && sym->states!=NULL) {
1.6568 + for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
1.6569 + assert(strlen(stlist->name)!=0);
1.6570 + if (state_getfsa(stlist->index)==automaton->index && state_inlist(stlist->index,(int)state->value))
1.6571 + break; /* found! */
1.6572 + } /* for */
1.6573 + assert(stlist==NULL || state_inlist(stlist->index,state->value));
1.6574 + if (stlist!=NULL) {
1.6575 + /* the label to jump to is in stlist->name */
1.6576 + ffcall(sym,stlist->name,0);
1.6577 + } /* if */
1.6578 + } /* if */
1.6579 +
1.6580 + if (flabel>=0)
1.6581 + setlabel(flabel); /* condition was false, jump around the state switch */
1.6582 +
1.6583 + #if !defined SC_LIGHT
1.6584 + /* mark for documentation */
1.6585 + if (sc_status==statFIRST) {
1.6586 + char *str;
1.6587 + /* get the last list id attached to the function, this contains the source states */
1.6588 + assert(curfunc!=NULL);
1.6589 + if (curfunc->states!=NULL) {
1.6590 + stlist=curfunc->states->next;
1.6591 + assert(stlist!=NULL);
1.6592 + while (stlist->next!=NULL)
1.6593 + stlist=stlist->next;
1.6594 + listid=stlist->index;
1.6595 + } else {
1.6596 + listid=-1;
1.6597 + } /* if */
1.6598 + listindex=0;
1.6599 + length=strlen(name)+70; /* +70 for the fixed part "<transition ... />\n" */
1.6600 + /* see if there are any condition strings to attach */
1.6601 + for (index=0; (str=get_autolist(index))!=NULL; index++)
1.6602 + length+=strlen(str);
1.6603 + if ((doc=(char*)malloc(length*sizeof(char)))!=NULL) {
1.6604 + do {
1.6605 + sprintf(doc,"<transition target=\"%s\"",name);
1.6606 + if (listid>=0) {
1.6607 + /* get the source state */
1.6608 + stateindex=state_listitem(listid,listindex);
1.6609 + state=state_findid(stateindex);
1.6610 + assert(state!=NULL);
1.6611 + sprintf(doc+strlen(doc)," source=\"%s\"",state->name);
1.6612 + } /* if */
1.6613 + if (get_autolist(0)!=NULL) {
1.6614 + /* add the condition */
1.6615 + strcat(doc," condition=\"");
1.6616 + for (index=0; (str=get_autolist(index))!=NULL; index++) {
1.6617 + /* remove the ')' token that may be appended before detecting that the expression has ended */
1.6618 + if (*str!=')' || *(str+1)!='\0' || get_autolist(index+1)!=NULL)
1.6619 + strcat(doc,str);
1.6620 + } /* for */
1.6621 + strcat(doc,"\"");
1.6622 + } /* if */
1.6623 + strcat(doc,"/>\n");
1.6624 + insert_docstring(doc);
1.6625 + } while (listid>=0 && ++listindex<state_count(listid));
1.6626 + free(doc);
1.6627 + } /* if */
1.6628 + } /* if */
1.6629 + #endif
1.6630 + delete_autolisttable();
1.6631 +}
1.6632 +
1.6633 +
1.6634 +static void addwhile(int *ptr)
1.6635 +{
1.6636 + int k;
1.6637 +
1.6638 + ptr[wqBRK]=stackusage->list_id; /* stack pointer (for "break") */
1.6639 + ptr[wqCONT]=stackusage->list_id; /* for "continue", possibly adjusted later */
1.6640 + ptr[wqLOOP]=getlabel();
1.6641 + ptr[wqEXIT]=getlabel();
1.6642 + if (wqptr>=(wq+wqTABSZ-wqSIZE))
1.6643 + error(122,"loop table"); /* loop table overflow (too many active loops)*/
1.6644 + k=0;
1.6645 + while (k<wqSIZE){ /* copy "ptr" to while queue table */
1.6646 + *wqptr=*ptr;
1.6647 + wqptr+=1;
1.6648 + ptr+=1;
1.6649 + k+=1;
1.6650 + } /* while */
1.6651 +}
1.6652 +
1.6653 +static void delwhile(void)
1.6654 +{
1.6655 + if (wqptr>wq)
1.6656 + wqptr-=wqSIZE;
1.6657 +}
1.6658 +
1.6659 +static int *readwhile(void)
1.6660 +{
1.6661 + if (wqptr<=wq){
1.6662 + error(24); /* out of context */
1.6663 + return NULL;
1.6664 + } else {
1.6665 + return (wqptr-wqSIZE);
1.6666 + } /* if */
1.6667 +}
1.6668 +
