/* Pawn compiler
*
* Function and variable definition and declaration, statement parser.
*
* Copyright (c) ITB CompuPhase, 1997-2006
*
* This software is provided "as-is", without any express or implied warranty.
* In no event will the authors be held liable for any damages arising from
* the use of this software.
*
* Permission is granted to anyone to use this software for any purpose,
* including commercial applications, and to alter it and redistribute it
* freely, subject to the following restrictions:
*
* 1. The origin of this software must not be misrepresented; you must not
* claim that you wrote the original software. If you use this software in
* a product, an acknowledgment in the product documentation would be
* appreciated but is not required.
* 2. Altered source versions must be plainly marked as such, and must not be
* misrepresented as being the original software.
* 3. This notice may not be removed or altered from any source distribution.
*
* Version: $Id$
*/
#include <assert.h>
#include <ctype.h>
#include <limits.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#if defined __WIN32__ || defined _WIN32 || defined __MSDOS__
#include <conio.h>
#include <io.h>
#endif
#if defined LINUX || defined __FreeBSD__ || defined __OpenBSD__ || defined DARWIN
#include <sclinux.h>
#include <binreloc.h> /* from BinReloc, see www.autopackage.org */
#include <unistd.h>
#endif
#if defined FORTIFY
#include <alloc/fortify.h>
#endif
#if defined __BORLANDC__ || defined __WATCOMC__
#include <dos.h>
static unsigned total_drives; /* dummy variable */
#define dos_setdrive(i) _dos_setdrive(i,&total_drives)
#elif defined _MSC_VER && defined _WIN32
#include <direct.h> /* for _chdrive() */
#define dos_setdrive(i) _chdrive(i)
#endif
#if defined __BORLANDC__
#include <dir.h> /* for chdir() */
#elif defined __WATCOMC__
#include <direct.h> /* for chdir() */
#endif
#if defined __WIN32__ || defined _WIN32 || defined _Windows
#include <windows.h>
#endif
#include <time.h>
#include "lstring.h"
#include "sc.h"
#include <sourcemod_version.h>
#include "sctracker.h"
#include "sp_symhash.h"
#define VERSION_STR "3.2.3636"
#define VERSION_INT 0x0302
int pc_anytag = 0;
int pc_functag = 0;
int pc_tag_string = 0;
static void resetglobals(void);
static void initglobals(void);
static char *get_extension(char *filename);
static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
char *rname,char *codepage);
static void setconfig(char *root);
static void setcaption(void);
static void about(void);
static void setconstants(void);
static void parse(void);
static void dumplits(void);
static void dumpzero(int count);
static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst);
static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,
int stock,int fconst);
static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct);
static int declloc(int fstatic);
static void decl_const(int table);
static void declstruct();
static void decl_enum(int table);
static cell needsub(int *tag,constvalue **enumroot);
static void initials(int ident,int tag,cell *size,int dim[],int numdim,
constvalue *enumroot);
static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
int startlit,int counteddim[],constvalue *lastdim,
constvalue *enumroot,int *errorfound);
static cell initvector(int ident,int tag,cell size,int fillzero,
constvalue *enumroot,int *errorfound);
static cell init(int ident,int *tag,int *errorfound);
static int getstates(const char *funcname);
static void attachstatelist(symbol *sym, int state_id);
static void funcstub(int fnative);
static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock);
static int declargs(symbol *sym,int chkshadow);
static void doarg(char *name,int ident,int offset,int tags[],int numtags,
int fpublic,int fconst,int chkshadow,arginfo *arg);
static void make_report(symbol *root,FILE *log,char *sourcefile);
static void reduce_referrers(symbol *root);
static long max_stacksize(symbol *root,int *recursion);
static int testsymbols(symbol *root,int level,int testlabs,int testconst);
static void destructsymbols(symbol *root,int level);
static constvalue *find_constval_byval(constvalue *table,cell val);
static symbol *fetchlab(char *name);
static void statement(int *lastindent,int allow_decl);
static void compound(int stmt_sameline,int starttok);
static int test(int label,int parens,int invert);
static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
int *tag,symbol **symptr,int chkfuncresult);
static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
int *tag,symbol **symptr,int chkfuncresult,value *lval);
static void doassert(void);
static void doexit(void);
static int doif(void);
static int dowhile(void);
static int dodo(void);
static int dofor(void);
static void doswitch(void);
static void dogoto(void);
static void dolabel(void);
static void doreturn(void);
static void dofuncenum(int listmode);
static void dobreak(void);
static void docont(void);
static void dosleep(void);
static void dostate(void);
static void addwhile(int *ptr);
static void delwhile(void);
static int *readwhile(void);
static void inst_datetime_defines(void);
static void inst_binary_name(char *binfname);
enum {
TEST_PLAIN, /* no parentheses */
TEST_THEN, /* '(' <expr> ')' or <expr> 'then' */
TEST_DO, /* '(' <expr> ')' or <expr> 'do' */
TEST_OPT, /* '(' <expr> ')' or <expr> */
};
static int norun = 0; /* the compiler never ran */
static int autozero = 1; /* if 1 will zero out the variable, if 0 omit the zeroing */
static int lastst = 0; /* last executed statement type */
static int nestlevel = 0; /* number of active (open) compound statements */
static int endlessloop= 0; /* nesting level of endless loop */
static int rettype = 0; /* the type that a "return" expression should have */
static int skipinput = 0; /* number of lines to skip from the first input file */
static int optproccall = TRUE; /* support "procedure call" */
static int verbosity = 1; /* verbosity level, 0=quiet, 1=normal, 2=verbose */
static int sc_reparse = 0; /* needs 3th parse because of changed prototypes? */
static int sc_parsenum = 0; /* number of the extra parses */
static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
static int *wqptr; /* pointer to next entry */
#if !defined SC_LIGHT
static char sc_rootpath[_MAX_PATH];
static char *sc_documentation=NULL;/* main documentation */
#endif
#if defined __WIN32__ || defined _WIN32 || defined _Windows
static HWND hwndFinish = 0;
#endif
int glbstringread = 0;
char g_tmpfile[_MAX_PATH] = {0};
/* "main" of the compiler
*/
#if defined __cplusplus
extern "C"
#endif
int pc_compile(int argc, char *argv[])
{
int entry,i,jmpcode;
int retcode;
char incfname[_MAX_PATH];
char reportname[_MAX_PATH];
char codepage[MAXCODEPAGE+1];
FILE *binf;
void *inpfmark;
int lcl_packstr,lcl_needsemicolon,lcl_tabsize;
#if !defined SC_LIGHT
int hdrsize=0;
#endif
char *ptr;
/* set global variables to their initial value */
binf=NULL;
initglobals();
errorset(sRESET,0);
errorset(sEXPRRELEASE,0);
lexinit();
/* make sure that we clean up on a fatal error; do this before the first
* call to error(). */
if ((jmpcode=setjmp(errbuf))!=0)
goto cleanup;
sp_Globals = NewHashTable();
if (!sp_Globals)
error(123);
/* allocate memory for fixed tables */
inpfname=(char*)malloc(_MAX_PATH);
if (inpfname==NULL)
error(123); /* insufficient memory */
litq=(cell*)malloc(litmax*sizeof(cell));
if (litq==NULL)
error(123); /* insufficient memory */
if (!phopt_init())
error(123); /* insufficient memory */
setopt(argc,argv,outfname,errfname,incfname,reportname,codepage);
strcpy(binfname,outfname);
ptr=get_extension(binfname);
if (ptr!=NULL && stricmp(ptr,".asm")==0)
set_extension(binfname,".smx",TRUE);
else
set_extension(binfname,".smx",FALSE);
/* set output names that depend on the input name */
if (sc_listing)
set_extension(outfname,".lst",TRUE);
else
set_extension(outfname,".asm",TRUE);
if (strlen(errfname)!=0)
remove(errfname); /* delete file on startup */
else if (verbosity>0)
setcaption();
setconfig(argv[0]); /* the path to the include and codepage files */
sc_ctrlchar_org=sc_ctrlchar;
lcl_packstr=sc_packstr;
lcl_needsemicolon=sc_needsemicolon;
lcl_tabsize=sc_tabsize;
#if !defined NO_CODEPAGE
if (!cp_set(codepage)) /* set codepage */
error(128); /* codepage mapping file not found */
#endif
/* optionally create a temporary input file that is a collection of all
* input files
*/
assert(get_sourcefile(0)!=NULL); /* there must be at least one source file */
if (get_sourcefile(1)!=NULL) {
/* there are at least two or more source files */
char *tname,*sname;
FILE *ftmp,*fsrc;
int fidx;
#if defined __WIN32__ || defined _WIN32
tname=_tempnam(NULL,"pawn");
#elif defined __MSDOS__ || defined _Windows
tname=tempnam(NULL,"pawn");
#elif defined(MACOS) && !defined(__MACH__)
/* tempnam is not supported for the Macintosh CFM build. */
error(124,get_sourcefile(1));
tname=NULL;
sname=NULL;
#else
tname=tempnam(NULL,"pawn");
#endif
ftmp=(FILE*)pc_createsrc(tname);
for (fidx=0; (sname=get_sourcefile(fidx))!=NULL; fidx++) {
unsigned char tstring[128];
fsrc=(FILE*)pc_opensrc(sname);
if (fsrc==NULL) {
pc_closesrc(ftmp);
remove(tname);
strcpy(inpfname,sname); /* avoid invalid filename */
error(120,sname);
} /* if */
pc_writesrc(ftmp,(unsigned char*)"#file \"");
pc_writesrc(ftmp,(unsigned char*)sname);
pc_writesrc(ftmp,(unsigned char*)"\"\n");
while (!pc_eofsrc(fsrc) && pc_readsrc(fsrc,tstring,sizeof tstring)) {
pc_writesrc(ftmp,tstring);
} /* while */
pc_closesrc(fsrc);
} /* for */
pc_closesrc(ftmp);
strcpy(inpfname,tname);
strcpy(g_tmpfile,tname);
free(tname);
} else {
strcpy(inpfname,get_sourcefile(0));
} /* if */
inpf_org=(FILE*)pc_opensrc(inpfname);
if (inpf_org==NULL)
error(120,inpfname);
freading=TRUE;
outf=(FILE*)pc_openasm(outfname); /* first write to assembler file (may be temporary) */
if (outf==NULL)
error(121,outfname);
/* immediately open the binary file, for other programs to check */
if (sc_asmfile || sc_listing) {
binf=NULL;
} else {
binf=(FILE*)pc_openbin(binfname);
if (binf==NULL)
error(121,binfname);
} /* if */
setconstants(); /* set predefined constants and tagnames */
for (i=0; i<skipinput; i++) /* skip lines in the input file */
if (pc_readsrc(inpf_org,pline,sLINEMAX)!=NULL)
fline++; /* keep line number up to date */
skipinput=fline;
sc_status=statFIRST;
/* write starting options (from the command line or the configuration file) */
if (sc_listing) {
char string[150];
sprintf(string,"#pragma ctrlchar 0x%02x\n"
"#pragma pack %s\n"
"#pragma semicolon %s\n"
"#pragma tabsize %d\n",
sc_ctrlchar,
sc_packstr ? "true" : "false",
sc_needsemicolon ? "true" : "false",
sc_tabsize);
pc_writeasm(outf,string);
setfiledirect(inpfname);
} /* if */
/* do the first pass through the file (or possibly two or more "first passes") */
sc_parsenum=0;
inpfmark=pc_getpossrc(inpf_org);
do {
/* reset "defined" flag of all functions and global variables */
reduce_referrers(&glbtab);
delete_symbols(&glbtab,0,TRUE,FALSE);
#if !defined NO_DEFINE
delete_substtable();
inst_datetime_defines();
inst_binary_name(binfname);
#endif
resetglobals();
pstructs_free();
funcenums_free();
sc_ctrlchar=sc_ctrlchar_org;
sc_packstr=lcl_packstr;
sc_needsemicolon=lcl_needsemicolon;
sc_tabsize=lcl_tabsize;
errorset(sRESET,0);
/* reset the source file */
inpf=inpf_org;
freading=TRUE;
pc_resetsrc(inpf,inpfmark); /* reset file position */
fline=skipinput; /* reset line number */
sc_reparse=FALSE; /* assume no extra passes */
sc_status=statFIRST; /* resetglobals() resets it to IDLE */
if (strlen(incfname)>0) {
if (strcmp(incfname,sDEF_PREFIX)==0) {
plungefile(incfname,FALSE,TRUE); /* parse "default.inc" */
} else {
if (!plungequalifiedfile(incfname)) /* parse "prefix" include file */
error(120,incfname); /* cannot read from ... (fatal error) */
} /* if */
} /* if */
preprocess(); /* fetch first line */
parse(); /* process all input */
sc_parsenum++;
} while (sc_reparse);
/* second (or third) pass */
sc_status=statWRITE; /* set, to enable warnings */
state_conflict(&glbtab);
/* write a report, if requested */
#if !defined SC_LIGHT
if (sc_makereport) {
FILE *frep=stdout;
if (strlen(reportname)>0)
frep=fopen(reportname,"wb"); /* avoid translation of \n to \r\n in DOS/Windows */
if (frep!=NULL) {
make_report(&glbtab,frep,get_sourcefile(0));
if (strlen(reportname)>0)
fclose(frep);
} /* if */
if (sc_documentation!=NULL) {
free(sc_documentation);
sc_documentation=NULL;
} /* if */
} /* if */
#endif
if (sc_listing)
goto cleanup;
/* ??? for re-parsing the listing file instead of the original source
* file (and doing preprocessing twice):
* - close input file, close listing file
* - re-open listing file for reading (inpf)
* - open assembler file (outf)
*/
/* reset "defined" flag of all functions and global variables */
reduce_referrers(&glbtab);
delete_symbols(&glbtab,0,TRUE,FALSE);
funcenums_free();
pstructs_free();
#if !defined NO_DEFINE
delete_substtable();
inst_datetime_defines();
inst_binary_name(binfname);
#endif
resetglobals();
sc_ctrlchar=sc_ctrlchar_org;
sc_packstr=lcl_packstr;
sc_needsemicolon=lcl_needsemicolon;
sc_tabsize=lcl_tabsize;
errorset(sRESET,0);
/* reset the source file */
inpf=inpf_org;
freading=TRUE;
pc_resetsrc(inpf,inpfmark); /* reset file position */
fline=skipinput; /* reset line number */
lexinit(); /* clear internal flags of lex() */
sc_status=statWRITE; /* allow to write --this variable was reset by resetglobals() */
writeleader(&glbtab);
insert_dbgfile(inpfname);
if (strlen(incfname)>0) {
if (strcmp(incfname,sDEF_PREFIX)==0)
plungefile(incfname,FALSE,TRUE); /* parse "default.inc" (again) */
else
plungequalifiedfile(incfname); /* parse implicit include file (again) */
} /* if */
preprocess(); /* fetch first line */
parse(); /* process all input */
/* inpf is already closed when readline() attempts to pop of a file */
writetrailer(); /* write remaining stuff */
entry=testsymbols(&glbtab,0,TRUE,FALSE); /* test for unused or undefined
* functions and variables */
if (!entry)
error(13); /* no entry point (no public functions) */
cleanup:
if (inpf!=NULL) /* main source file is not closed, do it now */
pc_closesrc(inpf);
/* write the binary file (the file is already open) */
if (!(sc_asmfile || sc_listing) && errnum==0 && jmpcode==0) {
assert(binf!=NULL);
pc_resetasm(outf); /* flush and loop back, for reading */
#if !defined SC_LIGHT
hdrsize=
#endif
assemble(binf,outf); /* assembler file is now input */
} /* if */
if (outf!=NULL) {
pc_closeasm(outf,!(sc_asmfile || sc_listing));
outf=NULL;
} /* if */
if (binf!=NULL) {
pc_closebin(binf,errnum!=0);
binf=NULL;
} /* if */
#if !defined SC_LIGHT
if (errnum==0 && strlen(errfname)==0) {
#if 0 //bug in compiler -- someone's script caused this function to infrecurs
int recursion;
long stacksize=max_stacksize(&glbtab,&recursion);
#endif
int flag_exceed=0;
if (pc_amxlimit>0) {
long totalsize=hdrsize+code_idx;
if (pc_amxram==0)
totalsize+=(glb_declared+pc_stksize)*sizeof(cell);
if (totalsize>=pc_amxlimit)
flag_exceed=1;
} /* if */
if (pc_amxram>0 && (glb_declared+pc_stksize)*sizeof(cell)>=(unsigned long)pc_amxram)
flag_exceed=1;
if (!norun && (sc_debug & sSYMBOLIC)!=0 || verbosity>=2 || flag_exceed) {
pc_printf("Header size: %8ld bytes\n", (long)hdrsize);
pc_printf("Code size: %8ld bytes\n", (long)code_idx);
pc_printf("Data size: %8ld bytes\n", (long)glb_declared*sizeof(cell));
pc_printf("Stack/heap size: %8ld bytes; ", (long)pc_stksize*sizeof(cell));
#if 0
pc_printf("estimated max. usage");
if (recursion)
pc_printf(": unknown, due to recursion\n");
else if ((pc_memflags & suSLEEP_INSTR)!=0)
pc_printf(": unknown, due to the \"sleep\" instruction\n");
else
pc_printf("=%ld cells (%ld bytes)\n",stacksize,stacksize*sizeof(cell));
#endif
pc_printf("Total requirements:%8ld bytes\n", (long)hdrsize+(long)code_idx+(long)glb_declared*sizeof(cell)+(long)pc_stksize*sizeof(cell));
} /* if */
if (flag_exceed)
error(126,pc_amxlimit+pc_amxram); /* this causes a jump back to label "cleanup" */
} /* if */
#endif
if (g_tmpfile[0] != '\0') {
remove(g_tmpfile);
}
if (inpfname!=NULL) {
free(inpfname);
} /* if */
if (litq!=NULL)
free(litq);
phopt_cleanup();
stgbuffer_cleanup();
clearstk();
assert(jmpcode!=0 || loctab.next==NULL);/* on normal flow, local symbols
* should already have been deleted */
delete_symbols(&loctab,0,TRUE,TRUE); /* delete local variables if not yet
* done (i.e. on a fatal error) */
delete_symbols(&glbtab,0,TRUE,TRUE);
DestroyHashTable(sp_Globals);
delete_consttable(&tagname_tab);
delete_consttable(&libname_tab);
delete_consttable(&sc_automaton_tab);
delete_consttable(&sc_state_tab);
state_deletetable();
delete_aliastable();
delete_pathtable();
delete_sourcefiletable();
delete_dbgstringtable();
funcenums_free();
pstructs_free();
#if !defined NO_DEFINE
delete_substtable();
#endif
#if !defined SC_LIGHT
delete_docstringtable();
if (sc_documentation!=NULL)
free(sc_documentation);
#endif
delete_autolisttable();
if (errnum!=0) {
if (strlen(errfname)==0)
pc_printf("\n%d Error%s.\n",errnum,(errnum>1) ? "s" : "");
retcode=1;
} else if (warnnum!=0){
if (strlen(errfname)==0)
pc_printf("\n%d Warning%s.\n",warnnum,(warnnum>1) ? "s" : "");
retcode=0; /* use "0", so that MAKE and similar tools continue */
} else {
retcode=jmpcode;
if (retcode==0 && verbosity>=2)
pc_printf("\nDone.\n");
} /* if */
#if defined __WIN32__ || defined _WIN32 || defined _Windows
if (IsWindow(hwndFinish))
PostMessageA(hwndFinish,RegisterWindowMessageA("PawnNotify"),retcode,0L);
#endif
#if defined FORTIFY
Fortify_ListAllMemory();
#endif
return retcode;
}
#if defined __cplusplus
extern "C"
#endif
int pc_addconstant(char *name,cell value,int tag)
{
errorset(sFORCESET,0); /* make sure error engine is silenced */
sc_status=statIDLE;
add_constant(name,value,sGLOBAL,tag);
return 1;
}
static void inst_binary_name(char *binfname)
{
size_t i, len;
char *binptr;
char newpath[512], newname[512];
binptr = NULL;
len = strlen(binfname);
for (i = len - 1; i >= 0 && i < len; i--)
{
if (binfname[i] == '/'
#if defined WIN32 || defined _WIN32
|| binfname[i] == '\\'
#endif
)
{
binptr = &binfname[i + 1];
break;
}
}
if (binptr == NULL)
{
binptr = binfname;
}
snprintf(newpath, sizeof(newpath), "\"%s\"", binfname);
snprintf(newname, sizeof(newname), "\"%s\"", binptr);
insert_subst("__BINARY_PATH__", newpath, 15);
insert_subst("__BINARY_NAME__", newname, 15);
}
static void inst_datetime_defines(void)
{
char date[64];
char ltime[64];
time_t td;
struct tm *curtime;
time(&td);
curtime = localtime(&td);
strftime(date, 31, "\"%m/%d/%Y\"", curtime);
strftime(ltime, 31, "\"%H:%M:%S\"", curtime);
insert_subst("__DATE__", date, 8);
insert_subst("__TIME__", ltime, 8);
}
#if defined __cplusplus
extern "C"
#endif
int pc_addtag(char *name)
{
cell val;
constvalue *ptr;
int last,tag;
if (name==NULL) {
/* no tagname was given, check for one */
if (lex(&val,&name)!=tLABEL) {
lexpush();
return 0; /* untagged */
} /* if */
} /* if */
assert(strchr(name,':')==NULL); /* colon should already have been stripped */
last=0;
ptr=tagname_tab.next;
while (ptr!=NULL) {
tag=(int)(ptr->value & TAGMASK);
if (strcmp(name,ptr->name)==0)
return tag; /* tagname is known, return its sequence number */
tag &= (int)~FIXEDTAG;
tag &= (int)~FUNCTAG;
if (tag>last)
last=tag;
ptr=ptr->next;
} /* while */
/* tagname currently unknown, add it */
tag=last+1; /* guaranteed not to exist already */
if (isupper(*name))
tag |= (int)FIXEDTAG;
append_constval(&tagname_tab,name,(cell)tag,0);
return tag;
}
int pc_addfunctag(char *name)
{
cell val;
constvalue *ptr;
int last,tag;
if (name==NULL) {
/* no tagname was given, check for one */
if (lex(&val,&name)!=tLABEL) {
lexpush();
return 0; /* untagged */
} /* if */
} /* if */
assert(strchr(name,':')==NULL); /* colon should already have been stripped */
last=0;
ptr=tagname_tab.next;
while (ptr!=NULL) {
tag=(int)(ptr->value & TAGMASK);
if (strcmp(name,ptr->name)==0)
return tag; /* tagname is known, return its sequence number */
tag &= (int)~FIXEDTAG;
tag &= (int)~FUNCTAG;
if (tag>last)
last=tag;
ptr=ptr->next;
} /* while */
/* tagname currently unknown, add it */
tag=last+1; /* guaranteed not to exist already */
if (isupper(*name))
tag |= (int)FIXEDTAG;
tag |= (int)FUNCTAG;
append_constval(&tagname_tab,name,(cell)tag,0);
return tag;
}
static void resetglobals(void)
{
/* reset the subset of global variables that is modified by the first pass */
curfunc=NULL; /* pointer to current function */
lastst=0; /* last executed statement type */
nestlevel=0; /* number of active (open) compound statements */
rettype=0; /* the type that a "return" expression should have */
litidx=0; /* index to literal table */
stgidx=0; /* index to the staging buffer */
sc_labnum=0; /* top value of (internal) labels */
staging=0; /* true if staging output */
declared=0; /* number of local cells declared */
glb_declared=0; /* number of global cells declared */
code_idx=0; /* number of bytes with generated code */
ntv_funcid=0; /* incremental number of native function */
curseg=0; /* 1 if currently parsing CODE, 2 if parsing DATA */
freading=FALSE; /* no input file ready yet */
fline=0; /* the line number in the current file */
fnumber=0; /* the file number in the file table (debugging) */
fcurrent=0; /* current file being processed (debugging) */
sc_intest=FALSE; /* true if inside a test */
sideeffect=0; /* true if an expression causes a side-effect */
stmtindent=0; /* current indent of the statement */
indent_nowarn=FALSE; /* do not skip warning "217 loose indentation" */
sc_allowtags=TRUE; /* allow/detect tagnames */
sc_status=statIDLE;
sc_allowproccall=FALSE;
pc_addlibtable=TRUE; /* by default, add a "library table" to the output file */
sc_alignnext=FALSE;
pc_docexpr=FALSE;
pc_deprecate=NULL;
sc_curstates=0;
pc_memflags=0;
}
static void initglobals(void)
{
resetglobals();
sc_asmfile=FALSE; /* do not create .ASM file */
sc_listing=FALSE; /* do not create .LST file */
skipinput=0; /* number of lines to skip from the first input file */
sc_ctrlchar=CTRL_CHAR;/* the escape character */
litmax=sDEF_LITMAX; /* current size of the literal table */
errnum=0; /* number of errors */
warnnum=0; /* number of warnings */
optproccall=FALSE; /* sourcemod: do not support "procedure call" */
verbosity=1; /* verbosity level, no copyright banner */
sc_debug=sCHKBOUNDS|sSYMBOLIC; /* sourcemod: full debug stuff */
pc_optimize=sOPTIMIZE_DEFAULT; /* sourcemod: full optimization */
sc_packstr=TRUE; /* strings are packed by default */
sc_compress=FALSE; /* always disable compact encoding! */
sc_needsemicolon=FALSE;/* semicolon required to terminate expressions? */
sc_dataalign=sizeof(cell);
pc_stksize=sDEF_AMXSTACK;/* default stack size */
pc_amxlimit=0; /* no limit on size of the abstract machine */
pc_amxram=0; /* no limit on data size of the abstract machine */
sc_tabsize=8; /* assume a TAB is 8 spaces */
sc_rationaltag=0; /* assume no support for rational numbers */
rational_digits=0; /* number of fractional digits */
outfname[0]='\0'; /* output file name */
errfname[0]='\0'; /* error file name */
inpf=NULL; /* file read from */
inpfname=NULL; /* pointer to name of the file currently read from */
outf=NULL; /* file written to */
litq=NULL; /* the literal queue */
glbtab.next=NULL; /* clear global variables/constants table */
loctab.next=NULL; /* " local " / " " */
tagname_tab.next=NULL;/* tagname table */
libname_tab.next=NULL;/* library table (#pragma library "..." syntax) */
pline[0]='\0'; /* the line read from the input file */
lptr=NULL; /* points to the current position in "pline" */
curlibrary=NULL; /* current library */
inpf_org=NULL; /* main source file */
wqptr=wq; /* initialize while queue pointer */
#if !defined SC_LIGHT
sc_documentation=NULL;
sc_makereport=FALSE; /* do not generate a cross-reference report */
#endif
}
static char *get_extension(char *filename)
{
char *ptr;
assert(filename!=NULL);
ptr=strrchr(filename,'.');
if (ptr!=NULL) {
/* ignore extension on a directory or at the start of the filename */
if (strchr(ptr,DIRSEP_CHAR)!=NULL || ptr==filename || *(ptr-1)==DIRSEP_CHAR)
ptr=NULL;
} /* if */
return ptr;
}
/* set_extension
* Set the default extension, or force an extension. To erase the
* extension of a filename, set "extension" to an empty string.
*/
SC_FUNC void set_extension(char *filename,char *extension,int force)
{
char *ptr;
assert(extension!=NULL && (*extension=='\0' || *extension=='.'));
assert(filename!=NULL);
ptr=get_extension(filename);
if (force && ptr!=NULL)
*ptr='\0'; /* set zero terminator at the position of the period */
if (force || ptr==NULL)
strcat(filename,extension);
}
static const char *option_value(const char *optptr)
{
return (*(optptr+1)=='=' || *(optptr+1)==':') ? optptr+2 : optptr+1;
}
static int toggle_option(const char *optptr, int option)
{
switch (*option_value(optptr)) {
case '\0':
option=!option;
break;
case '-':
option=FALSE;
break;
case '+':
option=TRUE;
break;
default:
about();
} /* switch */
return option;
}
/* Parsing command line options is indirectly recursive: parseoptions()
* calls parserespf() to handle options in a a response file and
* parserespf() calls parseoptions() at its turn after having created
* an "option list" from the contents of the file.
*/
static void parserespf(char *filename,char *oname,char *ename,char *pname,
char *rname, char *codepage);
static void parseoptions(int argc,char **argv,char *oname,char *ename,char *pname,
char *rname, char *codepage)
{
char str[_MAX_PATH],*name;
const char *ptr;
int arg,i,isoption;
for (arg=1; arg<argc; arg++) {
#if DIRSEP_CHAR=='/'
isoption= argv[arg][0]=='-';
#else
isoption= argv[arg][0]=='/' || argv[arg][0]=='-';
#endif
if (isoption) {
ptr=&argv[arg][1];
switch (*ptr) {
case 'A':
i=atoi(option_value(ptr));
if ((i % sizeof(cell))==0)
sc_dataalign=i;
else
about();
break;
case 'a':
if (*(ptr+1)!='\0')
about();
sc_asmfile=TRUE; /* skip last pass of making binary file */
if (verbosity>1)
verbosity=1;
break;
#if 0 /* not allowed in SourceMod */
case 'C':
#if AMX_COMPACTMARGIN > 2
sc_compress=toggle_option(ptr,sc_compress);
#else
about();
#endif
break;
#endif
case 'c':
strlcpy(codepage,option_value(ptr),MAXCODEPAGE); /* set name of codepage */
break;
#if defined dos_setdrive
case 'D': /* set active directory */
ptr=option_value(ptr);
if (ptr[1]==':')
dos_setdrive(toupper(*ptr)-'A'+1); /* set active drive */
chdir(ptr);
break;
#endif
#if 0 /* not allowed to change for SourceMod */
case 'd':
switch (*option_value(ptr)) {
case '0':
sc_debug=0;
break;
case '1':
sc_debug=sCHKBOUNDS; /* assertions and bounds checking */
break;
case '2':
sc_debug=sCHKBOUNDS | sSYMBOLIC; /* also symbolic info */
break;
case '3':
sc_debug=sCHKBOUNDS | sSYMBOLIC;
pc_optimize=sOPTIMIZE_NONE;
/* also avoid peephole optimization */
break;
default:
about();
} /* switch */
break;
#endif
case 'e':
strlcpy(ename,option_value(ptr),_MAX_PATH); /* set name of error file */
break;
#if defined __WIN32__ || defined _WIN32 || defined _Windows
case 'H':
hwndFinish=(HWND)atoi(option_value(ptr));
if (!IsWindow(hwndFinish))
hwndFinish=(HWND)0;
break;
#endif
case 'i':
strlcpy(str,option_value(ptr),sizeof str); /* set name of include directory */
i=strlen(str);
if (i>0) {
if (str[i-1]!=DIRSEP_CHAR) {
str[i]=DIRSEP_CHAR;
str[i+1]='\0';
} /* if */
insert_path(str);
} /* if */
break;
case 'l':
if (*(ptr+1)!='\0')
about();
sc_listing=TRUE; /* skip second pass & code generation */
break;
case 'o':
strlcpy(oname,option_value(ptr),_MAX_PATH); /* set name of (binary) output file */
break;
case 'O':
pc_optimize=*option_value(ptr) - '0';
if (pc_optimize<sOPTIMIZE_NONE || pc_optimize>=sOPTIMIZE_NUMBER || pc_optimize==sOPTIMIZE_NOMACRO)
about();
break;
case 'p':
strlcpy(pname,option_value(ptr),_MAX_PATH); /* set name of implicit include file */
break;
#if !defined SC_LIGHT
case 'r':
strlcpy(rname,option_value(ptr),_MAX_PATH); /* set name of report file */
sc_makereport=TRUE;
if (strlen(rname)>0) {
set_extension(rname,".xml",FALSE);
} else if ((name=get_sourcefile(0))!=NULL) {
assert(strlen(rname)==0);
assert(strlen(name)<_MAX_PATH);
if ((ptr=strrchr(name,DIRSEP_CHAR))!=NULL)
ptr++; /* strip path */
else
ptr=name;
assert(strlen(ptr)<_MAX_PATH);
strcpy(rname,ptr);
set_extension(rname,".xml",TRUE);
} /* if */
break;
#endif
case 'S':
i=atoi(option_value(ptr));
if (i>32)
pc_stksize=(cell)i; /* stack size has minimum size */
else
about();
break;
case 's':
skipinput=atoi(option_value(ptr));
break;
case 't':
sc_tabsize=atoi(option_value(ptr));
break;
case 'v':
verbosity= isdigit(*option_value(ptr)) ? atoi(option_value(ptr)) : 2;
if (sc_asmfile && verbosity>1)
verbosity=1;
break;
case 'w':
i=(int)strtol(option_value(ptr),(char **)&ptr,10);
if (*ptr=='-')
pc_enablewarning(i,0);
else if (*ptr=='+')
pc_enablewarning(i,1);
else if (*ptr=='\0')
pc_enablewarning(i,2);
break;
case 'X':
if (*(ptr+1)=='D') {
i=atoi(option_value(ptr+1));
if (i>64)
pc_amxram=(cell)i; /* abstract machine data/stack has minimum size */
else
about();
} else {
i=atoi(option_value(ptr));
if (i>64)
pc_amxlimit=(cell)i;/* abstract machine has minimum size */
else
about();
} /* if */
break;
case '\\': /* use \ instead for escape characters */
sc_ctrlchar='\\';
break;
case '^': /* use ^ instead for escape characters */
sc_ctrlchar='^';
break;
case ';':
sc_needsemicolon=toggle_option(ptr,sc_needsemicolon);
break;
#if 0 /* not allowed to change in SourceMod */
case '(':
optproccall=!toggle_option(ptr,!optproccall);
break;
#endif
default: /* wrong option */
about();
} /* switch */
} else if (argv[arg][0]=='@') {
#if !defined SC_LIGHT
parserespf(&argv[arg][1],oname,ename,pname,rname,codepage);
#endif
} else if ((ptr=strchr(argv[arg],'='))!=NULL) {
i=(int)(ptr-argv[arg]);
if (i>sNAMEMAX) {
i=sNAMEMAX;
error(200,argv[arg],sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
} /* if */
strlcpy(str,argv[arg],i+1); /* str holds symbol name */
i=atoi(ptr+1);
add_constant(str,i,sGLOBAL,0);
} else {
strlcpy(str,argv[arg],sizeof(str)-5); /* -5 because default extension is ".sp" */
set_extension(str,".sp",FALSE);
insert_sourcefile(str);
/* The output name is the first input name with a different extension,
* but it is stored in a different directory
*/
if (strlen(oname)==0) {
if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
ptr++; /* strip path */
else
ptr=str;
assert(strlen(ptr)<_MAX_PATH);
strcpy(oname,ptr);
} /* if */
set_extension(oname,".asm",TRUE);
#if !defined SC_LIGHT
if (sc_makereport && strlen(rname)==0) {
if ((ptr=strrchr(str,DIRSEP_CHAR))!=NULL)
ptr++; /* strip path */
else
ptr=str;
assert(strlen(ptr)<_MAX_PATH);
strcpy(rname,ptr);
set_extension(rname,".xml",TRUE);
} /* if */
#endif
} /* if */
} /* for */
}
#if !defined SC_LIGHT
static void parserespf(char *filename,char *oname,char *ename,char *pname,
char *rname,char *codepage)
{
#define MAX_OPTIONS 100
FILE *fp;
char *string, *ptr, **argv;
int argc;
long size;
if ((fp=fopen(filename,"r"))==NULL)
error(120,filename); /* error reading input file */
/* load the complete file into memory */
fseek(fp,0L,SEEK_END);
size=ftell(fp);
fseek(fp,0L,SEEK_SET);
assert(size<INT_MAX);
if ((string=(char *)malloc((int)size+1))==NULL)
error(123); /* insufficient memory */
/* fill with zeros; in MS-DOS, fread() may collapse CR/LF pairs to
* a single '\n', so the string size may be smaller than the file
* size. */
memset(string,0,(int)size+1);
fread(string,1,(int)size,fp);
fclose(fp);
/* allocate table for option pointers */
if ((argv=(char **)malloc(MAX_OPTIONS*sizeof(char*)))==NULL)
error(123); /* insufficient memory */
/* fill the options table */
ptr=strtok(string," \t\r\n");
for (argc=1; argc<MAX_OPTIONS && ptr!=NULL; argc++) {
/* note: the routine skips argv[0], for compatibility with main() */
argv[argc]=ptr;
ptr=strtok(NULL," \t\r\n");
} /* for */
if (ptr!=NULL)
error(122,"option table"); /* table overflow */
/* parse the option table */
parseoptions(argc,argv,oname,ename,pname,rname,codepage);
/* free allocated memory */
free(argv);
free(string);
}
#endif
static void setopt(int argc,char **argv,char *oname,char *ename,char *pname,
char *rname,char *codepage)
{
delete_sourcefiletable(); /* make sure it is empty */
*oname='\0';
*ename='\0';
*pname='\0';
*rname='\0';
*codepage='\0';
strcpy(pname,sDEF_PREFIX);
#if 0 /* needed to test with BoundsChecker for DOS (it does not pass
* through arguments) */
insert_sourcefile("test.p");
strcpy(oname,"test.asm");
#endif
#if !defined SC_LIGHT
/* first parse a "config" file with default options */
if (argv[0]!=NULL) {
char cfgfile[_MAX_PATH];
char *ext;
strcpy(cfgfile,argv[0]);
if ((ext=strrchr(cfgfile,DIRSEP_CHAR))!=NULL) {
*(ext+1)='\0'; /* strip the program filename */
strcat(cfgfile,"pawn.cfg");
} else {
strcpy(cfgfile,"pawn.cfg");
} /* if */
if (access(cfgfile,4)==0)
parserespf(cfgfile,oname,ename,pname,rname,codepage);
} /* if */
#endif
parseoptions(argc,argv,oname,ename,pname,rname,codepage);
if (get_sourcefile(0)==NULL)
about();
}
#if defined __BORLANDC__ || defined __WATCOMC__
#pragma argsused
#endif
static void setconfig(char *root)
{
#if defined macintosh
insert_path(":include:");
#else
char path[_MAX_PATH];
char *ptr,*base;
int len;
/* add the default "include" directory */
#if defined __WIN32__ || defined _WIN32
GetModuleFileNameA(NULL,path,_MAX_PATH);
#elif defined LINUX || defined __FreeBSD__ || defined __OpenBSD__
/* see www.autopackage.org for the BinReloc module */
br_init_lib(NULL);
ptr=br_find_exe("spcomp");
strlcpy(path,ptr,sizeof path);
free(ptr);
#else
if (root!=NULL)
strlcpy(path,root,sizeof path); /* path + filename (hopefully) */
#endif
#if defined __MSDOS__
/* strip the options (appended to the path + filename) */
if ((ptr=strpbrk(path," \t/"))!=NULL)
*ptr='\0';
#endif
/* terminate just behind last \ or : */
if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL || (ptr=strchr(path,':'))!=NULL) {
/* If there is no "\" or ":", the string probably does not contain the
* path; so we just don't add it to the list in that case
*/
*(ptr+1)='\0';
base=ptr;
strcat(path,"include");
len=strlen(path);
path[len]=DIRSEP_CHAR;
path[len+1]='\0';
/* see if it exists */
if (access(path,0)!=0 && *base==DIRSEP_CHAR) {
/* There is no "include" directory below the directory where the compiler
* is found. This typically means that the compiler is in a "bin" sub-directory
* and the "include" is below the *parent*. So find the parent...
*/
*base='\0';
if ((ptr=strrchr(path,DIRSEP_CHAR))!=NULL) {
*(ptr+1)='\0';
strcat(path,"include");
len=strlen(path);
path[len]=DIRSEP_CHAR;
path[len+1]='\0';
} else {
*base=DIRSEP_CHAR;
} /* if */
} /* if */
insert_path(path);
/* same for the codepage root */
#if !defined NO_CODEPAGE
*ptr='\0';
if (!cp_path(path,"codepage"))
error(129,path); /* codepage path */
#endif
/* also copy the root path (for the XML documentation) */
#if !defined SC_LIGHT
*ptr='\0';
strcpy(sc_rootpath,path);
#endif
} /* if */
#endif /* macintosh */
}
static void setcaption(void)
{
pc_printf("SourcePawn Compiler " SM_FULL_VERSION "\n");
pc_printf("Copyright (c) 1997-2006, ITB CompuPhase, (C)2004-2008 AlliedModders, LLC\n\n");
}
static void about(void)
{
if (strlen(errfname)==0) {
setcaption();
pc_printf("Usage: spcomp <filename> [filename...] [options]\n\n");
pc_printf("Options:\n");
pc_printf(" -A<num> alignment in bytes of the data segment and the stack\n");
pc_printf(" -a output assembler code\n");
#if 0 /* not toggleable in SourceMod */
pc_printf(" -C[+/-] compact encoding for output file (default=%c)\n", sc_compress ? '+' : '-');
#endif
pc_printf(" -c<name> codepage name or number; e.g. 1252 for Windows Latin-1\n");
#if defined dos_setdrive
pc_printf(" -Dpath active directory path\n");
#endif
#if 0 /* not used for SourceMod */
pc_printf(" -d<num> debugging level (default=-d%d)\n",sc_debug);
pc_printf(" 0 no symbolic information, no run-time checks\n");
pc_printf(" 1 run-time checks, no symbolic information\n");
pc_printf(" 2 full debug information and dynamic checking\n");
pc_printf(" 3 same as -d2, but implies -O0\n");
#endif
pc_printf(" -e<name> set name of error file (quiet compile)\n");
#if defined __WIN32__ || defined _WIN32 || defined _Windows
pc_printf(" -H<hwnd> window handle to send a notification message on finish\n");
#endif
pc_printf(" -i<name> path for include files\n");
pc_printf(" -l create list file (preprocess only)\n");
pc_printf(" -o<name> set base name of (P-code) output file\n");
pc_printf(" -O<num> optimization level (default=-O%d)\n",pc_optimize);
pc_printf(" 0 no optimization\n");
#if 0 /* not used for SourceMod */
pc_printf(" 1 JIT-compatible optimizations only\n");
#endif
pc_printf(" 2 full optimizations\n");
pc_printf(" -p<name> set name of \"prefix\" file\n");
#if !defined SC_LIGHT
pc_printf(" -r[name] write cross reference report to console or to specified file\n");
#endif
pc_printf(" -S<num> stack/heap size in cells (default=%d)\n",(int)pc_stksize);
pc_printf(" -s<num> skip lines from the input file\n");
pc_printf(" -t<num> TAB indent size (in character positions, default=%d)\n",sc_tabsize);
pc_printf(" -v<num> verbosity level; 0=quiet, 1=normal, 2=verbose (default=%d)\n",verbosity);
pc_printf(" -w<num> disable a specific warning by its number\n");
pc_printf(" -X<num> abstract machine size limit in bytes\n");
pc_printf(" -XD<num> abstract machine data/stack size limit in bytes\n");
pc_printf(" -\\ use '\\' for escape characters\n");
pc_printf(" -^ use '^' for escape characters\n");
pc_printf(" -;[+/-] require a semicolon to end each statement (default=%c)\n", sc_needsemicolon ? '+' : '-');
#if 0 /* not allowed in SourceMod */
pc_printf(" -([+/-] require parantheses for function invocation (default=%c)\n", optproccall ? '-' : '+');
#endif
pc_printf(" sym=val define constant \"sym\" with value \"val\"\n");
pc_printf(" sym= define constant \"sym\" with value 0\n");
#if defined __WIN32__ || defined _WIN32 || defined _Windows || defined __MSDOS__
pc_printf("\nOptions may start with a dash or a slash; the options \"-d0\" and \"/d0\" are\n");
pc_printf("equivalent.\n");
#endif
pc_printf("\nOptions with a value may optionally separate the value from the option letter\n");
pc_printf("with a colon (\":\") or an equal sign (\"=\"). That is, the options \"-d0\", \"-d=0\"\n");
pc_printf("and \"-d:0\" are all equivalent.\n");
} /* if */
norun = 1;
longjmp(errbuf,3); /* user abort */
}
static void setconstants(void)
{
int debug;
assert(sc_status==statIDLE);
append_constval(&tagname_tab,"_",0,0);/* "untagged" */
append_constval(&tagname_tab,"bool",1,0);
pc_anytag = pc_addtag("any");
pc_functag = pc_addfunctag("Function");
pc_tag_string = pc_addtag("String");
add_constant("true",1,sGLOBAL,1); /* boolean flags */
add_constant("false",0,sGLOBAL,1);
add_constant("EOS",0,sGLOBAL,0); /* End Of String, or '\0' */
#if PAWN_CELL_SIZE==16
add_constant("cellbits",16,sGLOBAL,0);
#if defined _I16_MAX
add_constant("cellmax",_I16_MAX,sGLOBAL,0);
add_constant("cellmin",_I16_MIN,sGLOBAL,0);
#else
add_constant("cellmax",SHRT_MAX,sGLOBAL,0);
add_constant("cellmin",SHRT_MIN,sGLOBAL,0);
#endif
#elif PAWN_CELL_SIZE==32
add_constant("cellbits",32,sGLOBAL,0);
#if defined _I32_MAX
add_constant("cellmax",_I32_MAX,sGLOBAL,0);
add_constant("cellmin",_I32_MIN,sGLOBAL,0);
#else
add_constant("cellmax",LONG_MAX,sGLOBAL,0);
add_constant("cellmin",LONG_MIN,sGLOBAL,0);
#endif
#elif PAWN_CELL_SIZE==64
#if !defined _I64_MIN
#define _I64_MIN (-9223372036854775807ULL - 1)
#define _I64_MAX 9223372036854775807ULL
#endif
add_constant("cellbits",64,sGLOBAL,0);
add_constant("cellmax",_I64_MAX,sGLOBAL,0);
add_constant("cellmin",_I64_MIN,sGLOBAL,0);
#else
#error Unsupported cell size
#endif
add_constant("charbits",sCHARBITS,sGLOBAL,0);
add_constant("charmin",0,sGLOBAL,0);
add_constant("charmax",~(-1 << sCHARBITS) - 1,sGLOBAL,0);
add_constant("ucharmax",(1 << (sizeof(cell)-1)*8)-1,sGLOBAL,0);
add_constant("__Pawn",VERSION_INT,sGLOBAL,0);
debug=0;
if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC))==(sCHKBOUNDS | sSYMBOLIC))
debug=2;
else if ((sc_debug & sCHKBOUNDS)==sCHKBOUNDS)
debug=1;
add_constant("debug",debug,sGLOBAL,0);
append_constval(&sc_automaton_tab,"",0,0); /* anonymous automaton */
}
static int getclassspec(int initialtok,int *fpublic,int *fstatic,int *fstock,int *fconst)
{
int tok,err;
cell val;
char *str;
assert(fconst!=NULL);
assert(fstock!=NULL);
assert(fstatic!=NULL);
assert(fpublic!=NULL);
*fconst=FALSE;
*fstock=FALSE;
*fstatic=FALSE;
*fpublic=FALSE;
switch (initialtok) {
case tCONST:
*fconst=TRUE;
break;
case tSTOCK:
*fstock=TRUE;
break;
case tSTATIC:
*fstatic=TRUE;
break;
case tPUBLIC:
*fpublic=TRUE;
break;
} /* switch */
err=0;
do {
tok=lex(&val,&str); /* read in (new) token */
switch (tok) {
case tCONST:
if (*fconst)
err=42; /* invalid combination of class specifiers */
*fconst=TRUE;
break;
case tSTOCK:
if (*fstock)
err=42; /* invalid combination of class specifiers */
*fstock=TRUE;
break;
case tSTATIC:
if (*fstatic)
err=42; /* invalid combination of class specifiers */
*fstatic=TRUE;
break;
case tPUBLIC:
if (*fpublic)
err=42; /* invalid combination of class specifiers */
*fpublic=TRUE;
break;
default:
lexpush();
tok=0; /* force break out of loop */
} /* switch */
} while (tok && err==0);
/* extra checks */
if (*fstatic && *fpublic) {
err=42; /* invalid combination of class specifiers */
*fstatic=*fpublic=FALSE;
} /* if */
if (err)
error(err);
return err==0;
}
/* parse - process all input text
*
* At this level, only static declarations and function definitions are legal.
*/
static void parse(void)
{
int tok,fconst,fstock,fstatic,fpublic;
cell val;
char *str;
while (freading){
/* first try whether a declaration possibly is native or public */
tok=lex(&val,&str); /* read in (new) token */
switch (tok) {
case 0:
/* ignore zero's */
break;
case tNEW:
if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst))
declglb(NULL,0,fpublic,fstatic,fstock,fconst);
break;
case tSTATIC:
/* This can be a static function or a static global variable; we know
* which of the two as soon as we have parsed up to the point where an
* opening paranthesis of a function would be expected. To back out after
* deciding it was a declaration of a static variable after all, we have
* to store the symbol name and tag.
*/
if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
assert(!fpublic);
declfuncvar(fpublic,fstatic,fstock,fconst);
} /* if */
break;
case tCONST:
decl_const(sGLOBAL);
break;
case tENUM:
decl_enum(sGLOBAL);
break;
case tFUNCENUM:
dofuncenum(TRUE);
break;
case tFUNCTAG:
dofuncenum(FALSE);
break;
case tSTRUCT:
declstruct();
break;
case tPUBLIC:
/* This can be a public function or a public variable; see the comment
* above (for static functions/variables) for details.
*/
if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
assert(!fstatic);
declfuncvar(fpublic,fstatic,fstock,fconst);
} /* if */
break;
case tSTOCK:
/* This can be a stock function or a stock *global*) variable; see the
* comment above (for static functions/variables) for details.
*/
if (getclassspec(tok,&fpublic,&fstatic,&fstock,&fconst)) {
assert(fstock);
declfuncvar(fpublic,fstatic,fstock,fconst);
} /* if */
break;
case tLABEL:
case tSYMBOL:
case tOPERATOR:
lexpush();
if (!newfunc(NULL,-1,FALSE,FALSE,FALSE)) {
error(10); /* illegal function or declaration */
lexclr(TRUE); /* drop the rest of the line */
litidx=0; /* drop the literal queue too */
} /* if */
break;
case tNATIVE:
funcstub(TRUE); /* create a dummy function */
break;
case tFORWARD:
funcstub(FALSE);
break;
case '}':
error(54); /* unmatched closing brace */
break;
case '{':
error(55); /* start of function body without function header */
break;
default:
if (freading) {
error(10); /* illegal function or declaration */
lexclr(TRUE); /* drop the rest of the line */
litidx=0; /* drop any literal arrays (strings) */
} /* if */
} /* switch */
} /* while */
}
/* dumplits
*
* Dump the literal pool (strings etc.)
*
* Global references: litidx (referred to only)
*/
static void dumplits(void)
{
int j,k;
if (sc_status==statSKIP)
return;
k=0;
while (k<litidx){
/* should be in the data segment */
assert(curseg==2);
defstorage();
j=16; /* 16 values per line */
while (j && k<litidx){
outval(litq[k], FALSE);
stgwrite(" ");
k++;
j--;
if (j==0 || k>=litidx)
stgwrite("\n"); /* force a newline after 10 dumps */
/* Note: stgwrite() buffers a line until it is complete. It recognizes
* the end of line as a sequence of "\n\0", so something like "\n\t"
* so should not be passed to stgwrite().
*/
} /* while */
} /* while */
}
/* dumpzero
*
* Dump zero's for default initial values
*/
static void dumpzero(int count)
{
int i;
if (sc_status==statSKIP || count<=0)
return;
assert(curseg==2);
defstorage();
i=0;
while (count-- > 0) {
outval(0, FALSE);
i=(i+1) % 16;
stgwrite((i==0 || count==0) ? "\n" : " ");
if (i==0 && count>0)
defstorage();
} /* while */
}
static void aligndata(int numbytes)
{
assert(numbytes % sizeof(cell) == 0); /* alignment must be a multiple of
* the cell size */
assert(numbytes!=0);
if ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0) {
while ((((glb_declared+litidx)*sizeof(cell)) % numbytes)!=0)
litadd(0);
} /* if */
}
#if !defined SC_LIGHT
/* sc_attachdocumentation()
* appends documentation comments to the passed-in symbol, or to a global
* string if "sym" is NULL.
*/
void sc_attachdocumentation(symbol *sym)
{
int line;
size_t length;
char *str,*doc;
if (!sc_makereport || sc_status!=statFIRST || sc_parsenum>0) {
/* just clear the entire table */
delete_docstringtable();
return;
} /* if */
/* in the case of state functions, multiple documentation sections may
* appear; we should concatenate these
* (with forward declarations, this is also already the case, so the assertion
* below is invalid)
*/
// assert(sym==NULL || sym->documentation==NULL || sym->states!=NULL);
/* first check the size */
length=0;
for (line=0; (str=get_docstring(line))!=NULL && *str!=sDOCSEP; line++) {
if (length>0)
length++; /* count 1 extra for a separating space */
length+=strlen(str);
} /* for */
if (sym==NULL && sc_documentation!=NULL) {
length += strlen(sc_documentation) + 1 + 4; /* plus 4 for "<p/>" */
assert(length>strlen(sc_documentation));
} /* if */
if (length>0) {
/* allocate memory for the documentation */
if (sym!=NULL && sym->documentation!=NULL)
length+=strlen(sym->documentation) + 1 + 4;/* plus 4 for "<p/>" */
doc=(char*)malloc((length+1)*sizeof(char));
if (doc!=NULL) {
/* initialize string or concatenate */
if (sym==NULL && sc_documentation!=NULL) {
strcpy(doc,sc_documentation);
strcat(doc,"<p/>");
} else if (sym!=NULL && sym->documentation!=NULL) {
strcpy(doc,sym->documentation);
strcat(doc,"<p/>");
free(sym->documentation);
sym->documentation=NULL;
} else {
doc[0]='\0';
} /* if */
/* collect all documentation */
while ((str=get_docstring(0))!=NULL && *str!=sDOCSEP) {
if (doc[0]!='\0')
strcat(doc," ");
strcat(doc,str);
delete_docstring(0);
} /* while */
if (str!=NULL) {
/* also delete the separator */
assert(*str==sDOCSEP);
delete_docstring(0);
} /* if */
if (sym!=NULL) {
assert(sym->documentation==NULL);
sym->documentation=doc;
} else {
if (sc_documentation!=NULL)
free(sc_documentation);
sc_documentation=doc;
} /* if */
} /* if */
} else {
/* delete an empty separator, if present */
if ((str=get_docstring(0))!=NULL && *str==sDOCSEP)
delete_docstring(0);
} /* if */
}
static void insert_docstring_separator(void)
{
char sep[2]={sDOCSEP,'\0'};
insert_docstring(sep);
}
#else
#define sc_attachdocumentation(s) (void)(s)
#define insert_docstring_separator()
#endif
static void declfuncvar(int fpublic,int fstatic,int fstock,int fconst)
{
char name[sNAMEMAX+11];
int tok,tag=0;
char *str;
cell val;
int invalidfunc;
pstruct_t *pstruct = NULL;
tok=lex(&val,&str);
if (tok == tLABEL) {
pstruct=pstructs_find(str);
tag=pc_addtag(str);
} else {
lexpush();
}
tok=lex(&val,&str);
/* if we arrived here, this may not be a declaration of a native function
* or variable
*/
if (tok==tNATIVE) {
error(42); /* invalid combination of class specifiers */
return;
} /* if */
if (tok!=tSYMBOL && tok!=tOPERATOR) {
lexpush();
needtoken(tSYMBOL);
lexclr(TRUE); /* drop the rest of the line */
litidx=0; /* drop the literal queue too */
return;
} /* if */
if (tok==tOPERATOR) {
lexpush(); /* push "operator" keyword back (for later analysis) */
if (!newfunc(NULL,tag,fpublic,fstatic,fstock)) {
error(10); /* illegal function or declaration */
lexclr(TRUE); /* drop the rest of the line */
litidx=0; /* drop the literal queue too */
} /* if */
} else {
/* so tok is tSYMBOL */
assert(strlen(str)<=sNAMEMAX);
strcpy(name,str);
/* only variables can be "const" or both "public" and "stock" */
invalidfunc= fconst || (fpublic && fstock);
if (invalidfunc || !newfunc(name,tag,fpublic,fstatic,fstock)) {
/* if not a function, try a global variable */
if (pstruct) {
declstructvar(name,fpublic,pstruct);
} else {
declglb(name,tag,fpublic,fstatic,fstock,fconst);
}
} /* if */
} /* if */
}
/* declstruct - declare global struct symbols
*
* global references: glb_declared (altered)
*/
static void declstructvar(char *firstname,int fpublic, pstruct_t *pstruct)
{
char name[sNAMEMAX+1];
int tok,i;
cell val;
char *str;
int cur_litidx = 0;
cell *values, *found;
int usage;
symbol *mysym,*sym;
strcpy(name, firstname);
values = (cell *)malloc(pstruct->argcount * sizeof(cell));
found = (cell *)malloc(pstruct->argcount * sizeof(cell));
memset(found, 0, sizeof(cell) * pstruct->argcount);
//:TODO: Make this work with stock
/**
* Lastly, very lastly, we will insert a copy of this variable.
* This is soley to expose the pubvar.
*/
usage = uREAD|uCONST|uSTRUCT;
if (fpublic)
{
usage |= uPUBLIC;
}
mysym = NULL;
for (sym=glbtab.next; sym!=NULL; sym=sym->next)
{
if (strcmp(name, sym->name) == 0)
{
if ((sym->usage & uSTRUCT) && sym->vclass == sGLOBAL)
{
if (sym->usage & uDEFINE)
{
error(21, name);
} else {
if (sym->usage & uPUBLIC && !fpublic)
{
error(42);
}
}
} else {
error(21, name);
}
mysym = sym;
break;
}
}
if (!mysym)
{
mysym=addsym(name, 0, iVARIABLE, sGLOBAL, pc_addtag(pstruct->name), usage);
}
if (!matchtoken('='))
{
matchtoken(';');
/* Mark it as undefined instead */
mysym->usage = uSTOCK|uSTRUCT;
return;
} else {
mysym->usage = usage;
}
needtoken('{');
do
{
structarg_t *arg;
/* Detect early exit */
if (matchtoken('}'))
{
lexpush();
break;
}
tok=lex(&val,&str);
if (tok != tSYMBOL)
{
error(1, "-identifier-", str);
continue;
}
arg=pstructs_getarg(pstruct,str);
if (arg == NULL)
{
error(96, str, sym->name);
}
needtoken('=');
cur_litidx = litidx;
tok=lex(&val,&str);
if (!arg)
{
continue;
}
if (tok == tSTRING)
{
assert(litidx != 0);
if (arg->dimcount != 1)
{
error(48);
} else if (arg->tag != pc_tag_string) {
error(213);
}
values[arg->index] = glb_declared * sizeof(cell);
glb_declared += (litidx-cur_litidx);
found[arg->index] = 1;
} else if (tok == tNUMBER || tok == tRATIONAL) {
/* eat optional 'f' */
matchtoken('f');
if (arg->ident != iVARIABLE && arg->ident != iREFERENCE)
{
error(23);
} else {
if (arg->tag == pc_addtag("Float") && tok == tNUMBER ||
arg->tag == 0 && tok == tRATIONAL)
{
error(213);
}
if (arg->ident == iVARIABLE)
{
values[arg->index] = val;
} else if (arg->ident == iREFERENCE) {
values[arg->index] = glb_declared * sizeof(cell);
glb_declared += 1;
litadd(val);
cur_litidx = litidx;
}
found[arg->index] = 1;
}
} else if (tok == tSYMBOL) {
for (sym=glbtab.next; sym!=NULL; sym=sym->next)
{
if (sym->vclass != sGLOBAL)
{
continue;
}
if (strcmp(sym->name, str) == 0)
{
if (arg->ident == iREFERENCE && sym->ident != iVARIABLE)
{
error(97, str);
} else if (arg->ident == iARRAY) {
if (sym->ident != iARRAY)
{
error(97, str);
} else {
/* :TODO: We should check dimension sizes here... */
}
} else if (arg->ident == iREFARRAY) {
if (sym->ident != iARRAY)
{
error(97, str);
}
/* :TODO: Check dimension sizes! */
} else {
error(97, str);
}
if (sym->tag != arg->tag)
{
error(213);
}
sym->usage |= uREAD;
values[arg->index] = sym->addr;
found[arg->index] = 1;
refer_symbol(sym, mysym);
break;
}
}
if (!sym)
{
error(17, str);
}
} else {
error(1, "-identifier-", str);
}
} while (matchtoken(','));
needtoken('}');
matchtoken(';'); /* eat up optional semicolon */
for (i=0; i<pstruct->argcount; i++)
{
if (!found[i])
{
structarg_t *arg = pstruct->args[i];
if (arg->ident == iREFARRAY)
{
values[arg->index] = glb_declared * sizeof(cell);
glb_declared += 1;
litadd(0);
cur_litidx = litidx;
} else if (arg->ident == iVARIABLE) {
values[arg->index] = 0;
} else {
/* :TODO: broken for iARRAY! (unused tho) */
}
}
}
mysym->addr = glb_declared * sizeof(cell);
glb_declared += pstruct->argcount;
for (i=0; i<pstruct->argcount; i++)
{
litadd(values[i]);
}
begdseg();
dumplits();
litidx=0;
free(found);
free(values);
}
/* declglb - declare global symbols
*
* Declare a static (global) variable. Global variables are stored in
* the DATA segment.
*
* global references: glb_declared (altered)
*/
static void declglb(char *firstname,int firsttag,int fpublic,int fstatic,int fstock,int fconst)
{
int ident,tag,ispublic;
int idxtag[sDIMEN_MAX];
char name[sNAMEMAX+1];
cell val,size,cidx;
ucell address;
int glb_incr;
char *str;
int dim[sDIMEN_MAX];
int numdim;
int slength=0;
short filenum;
symbol *sym;
constvalue *enumroot;
#if !defined NDEBUG
cell glbdecl=0;
#endif
assert(!fpublic || !fstatic); /* may not both be set */
insert_docstring_separator(); /* see comment in newfunc() */
filenum=fcurrent; /* save file number at the start of the declaration */
do {
size=1; /* single size (no array) */
numdim=0; /* no dimensions */
ident=iVARIABLE;
if (firstname!=NULL) {
assert(strlen(firstname)<=sNAMEMAX);
strcpy(name,firstname); /* save symbol name */
tag=firsttag;
firstname=NULL;
} else {
tag=pc_addtag(NULL);
if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
error(20,str); /* invalid symbol name */
assert(strlen(str)<=sNAMEMAX);
strcpy(name,str); /* save symbol name */
} /* if */
ispublic=fpublic;
if (name[0]==PUBLIC_CHAR) {
ispublic=TRUE; /* implicitly public variable */
assert(!fstatic);
} /* if */
while (matchtoken('[')) {
ident=iARRAY;
if (numdim == sDIMEN_MAX) {
error(53); /* exceeding maximum number of dimensions */
return;
} /* if */
size=needsub(&idxtag[numdim],&enumroot); /* get size; size==0 for "var[]" */
#if INT_MAX < LONG_MAX
if (size > INT_MAX)
error(125); /* overflow, exceeding capacity */
#endif
#if 0 /* We don't actually care */
if (ispublic)
error(56,name); /* arrays cannot be public */
#endif
dim[numdim++]=(int)size;
} /* while */
if (ident == iARRAY && tag == pc_tag_string && dim[numdim-1]) {
slength=dim[numdim-1];
dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
}
assert(sc_curstates==0);
sc_curstates=getstates(name);
if (sc_curstates<0) {
error(85,name); /* empty state list on declaration */
sc_curstates=0;
} else if (sc_curstates>0 && ispublic) {
error(88,name); /* public variables may not have states */
sc_curstates=0;
} /* if */
sym=findconst(name,NULL);
if (sym==NULL) {
sym=findglb(name,sSTATEVAR);
/* if a global variable without states is found and this declaration has
* states, the declaration is okay
*/
if (sym!=NULL && sym->states==NULL && sc_curstates>0)
sym=NULL; /* set to NULL, we found the global variable */
if (sc_curstates>0 && findglb(name,sGLOBAL)!=NULL)
error(233,name); /* state variable shadows a global variable */
} /* if */
/* we have either:
* a) not found a matching variable (or rejected it, because it was a shadow)
* b) found a global variable and we were looking for that global variable
* c) found a state variable in the automaton that we were looking for
*/
assert(sym==NULL
|| sym->states==NULL && sc_curstates==0
|| sym->states!=NULL && sym->next!=NULL && sym->states->next->index==sc_curstates);
/* a state variable may only have a single id in its list (so either this
* variable has no states, or it has a single list)
*/
assert(sym==NULL || sym->states==NULL || sym->states->next->next==NULL);
/* it is okay for the (global) variable to exist, as long as it belongs to
* a different automaton
*/
if (sym!=NULL && (sym->usage & uDEFINE)!=0)
error(21,name); /* symbol already defined */
/* if this variable is never used (which can be detected only in the
* second stage), shut off code generation
*/
cidx=0; /* only to avoid a compiler warning */
if (sc_status==statWRITE && sym!=NULL && (sym->usage & (uREAD | uWRITTEN))==0) {
sc_status=statSKIP;
cidx=code_idx;
#if !defined NDEBUG
glbdecl=glb_declared;
#endif
} /* if */
begdseg(); /* real (initialized) data in data segment */
assert(litidx==0); /* literal queue should be empty */
if (sc_alignnext) {
litidx=0;
aligndata(sc_dataalign);
dumplits(); /* dump the literal queue */
sc_alignnext=FALSE;
litidx=0; /* global initial data is dumped, so restart at zero */
} /* if */
assert(litidx==0); /* literal queue should be empty (again) */
initials(ident,tag,&size,dim,numdim,enumroot);/* stores values in the literal queue */
if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
slength = glbstringread;
}
assert(size>=litidx);
if (numdim==1)
dim[0]=(int)size;
/* before dumping the initial values (or zeros) check whether this variable
* overlaps another
*/
if (sc_curstates>0) {
unsigned char *map;
if (litidx!=0)
error(89,name); /* state variables may not be initialized */
/* find an appropriate address for the state variable */
/* assume that it cannot be found */
address=sizeof(cell)*glb_declared;
glb_incr=(int)size;
/* use a memory map in which every cell occupies one bit */
if (glb_declared>0 && (map=(unsigned char*)malloc((glb_declared+7)/8))!=NULL) {
int fsa=state_getfsa(sc_curstates);
symbol *sweep;
cell sweepsize,addr;
memset(map,0,(glb_declared+7)/8);
assert(fsa>=0);
/* fill in all variables belonging to this automaton */
for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
continue; /* hierarchical type, or no states, or same as this variable */
if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
continue; /* a function or a constant */
if ((sweep->usage & uDEFINE)==0)
continue; /* undefined variable, ignore */
if (fsa!=state_getfsa(sweep->states->next->index))
continue; /* wrong automaton */
/* when arrived here, this is a global variable, with states and
* belonging to the same automaton as the variable we are declaring
*/
sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
assert(sweep->addr % sizeof(cell) == 0);
addr=sweep->addr/sizeof(cell);
/* mark this address range */
while (sweepsize-->0) {
map[addr/8] |= (unsigned char)(1 << (addr % 8));
addr++;
} /* while */
} /* for */
/* go over it again, clearing any ranges that have conflicts */
for (sweep=glbtab.next; sweep!=NULL; sweep=sweep->next) {
if (sweep->parent!=NULL || sweep->states==NULL || sweep==sym)
continue; /* hierarchical type, or no states, or same as this variable */
if (sweep->ident!=iVARIABLE && sweep->ident!=iARRAY)
continue; /* a function or a constant */
if ((sweep->usage & uDEFINE)==0)
continue; /* undefined variable, ignore */
if (fsa!=state_getfsa(sweep->states->next->index))
continue; /* wrong automaton */
/* when arrived here, this is a global variable, with states and
* belonging to the same automaton as the variable we are declaring
*/
/* if the lists of states of the existing variable and the new
* variable have a non-empty intersection, this is not a suitable
* overlap point -> wipe the address range
*/
if (state_conflict_id(sc_curstates,sweep->states->next->index)) {
sweepsize=(sweep->ident==iVARIABLE) ? 1 : array_totalsize(sweep);
assert(sweep->addr % sizeof(cell) == 0);
addr=sweep->addr/sizeof(cell);
/* mark this address range */
while (sweepsize-->0) {
map[addr/8] &= (unsigned char)(~(1 << (addr % 8)));
addr++;
} /* while */
} /* if */
} /* for */
/* now walk through the map and find a starting point that is big enough */
sweepsize=0;
for (addr=0; addr<glb_declared; addr++) {
if ((map[addr/8] & (1 << (addr % 8)))==0)
continue;
for (sweepsize=addr+1; sweepsize<glb_declared; sweepsize++) {
if ((map[sweepsize/8] & (1 << (sweepsize % 8)))==0)
break; /* zero bit found, skip this range */
if (sweepsize-addr>=size)
break; /* fitting range found, no need to search further */
} /* for */
if (sweepsize-addr>=size)
break; /* fitting range found, no need to search further */
addr=sweepsize;
} /* for */
free(map);
if (sweepsize-addr>=size) {
address=sizeof(cell)*addr; /* fitting range found, set it */
glb_incr=0;
} /* if */
} /* if */
} else {
address=sizeof(cell)*glb_declared;
glb_incr=(int)size;
} /* if */
if (size != CELL_MAX && address==sizeof(cell)*glb_declared) {
dumplits(); /* dump the literal queue */
dumpzero((int)size-litidx);
} /* if */
litidx=0;
if (sym==NULL) { /* define only if not yet defined */
sym=addvariable2(name,address,ident,sGLOBAL,tag,dim,numdim,idxtag,slength);
if (sc_curstates>0)
attachstatelist(sym,sc_curstates);
} else { /* if declared but not yet defined, adjust the variable's address */
assert(sym->states==NULL && sc_curstates==0
|| sym->states->next!=NULL && sym->states->next->index==sc_curstates && sym->states->next->next==NULL);
sym->addr=address;
sym->codeaddr=code_idx;
sym->usage|=uDEFINE;
} /* if */
assert(sym!=NULL);
sc_curstates=0;
if (ispublic)
sym->usage|=uPUBLIC|uREAD;
if (fconst)
sym->usage|=uCONST;
if (fstock)
sym->usage|=uSTOCK;
if (fstatic)
sym->fnumber=filenum;
sc_attachdocumentation(sym);/* attach any documenation to the variable */
if (sc_status==statSKIP) {
sc_status=statWRITE;
code_idx=cidx;
assert(glb_declared==glbdecl);
} else {
glb_declared+=glb_incr; /* add total number of cells (if added to the end) */
} /* if */
} while (matchtoken(',')); /* enddo */ /* more? */
needtoken(tTERM); /* if not comma, must be semicolumn */
}
/* declloc - declare local symbols
*
* Declare local (automatic) variables. Since these variables are relative
* to the STACK, there is no switch to the DATA segment. These variables
* cannot be initialized either.
*
* global references: declared (altered)
* funcstatus (referred to only)
*/
static int declloc(int fstatic)
{
int ident,tag;
int idxtag[sDIMEN_MAX];
char name[sNAMEMAX+1];
symbol *sym;
constvalue *enumroot=NULL;
cell val,size;
char *str;
value lval = {0};
int cur_lit=0;
int dim[sDIMEN_MAX];
int numdim;
int fconst;
int staging_start;
int slength = 0;
fconst=matchtoken(tCONST);
do {
ident=iVARIABLE;
size=1;
slength=0;
numdim=0; /* no dimensions */
tag=pc_addtag(NULL);
if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
error(20,str); /* invalid symbol name */
assert(strlen(str)<=sNAMEMAX);
strcpy(name,str); /* save symbol name */
if (name[0]==PUBLIC_CHAR)
error(56,name); /* local variables cannot be public */
/* Note: block locals may be named identical to locals at higher
* compound blocks (as with standard C); so we must check (and add)
* the "nesting level" of local variables to verify the
* multi-definition of symbols.
*/
if ((sym=findloc(name))!=NULL && sym->compound==nestlevel)
error(21,name); /* symbol already defined */
/* Although valid, a local variable whose name is equal to that
* of a global variable or to that of a local variable at a lower
* level might indicate a bug.
*/
if ((sym=findloc(name))!=NULL && sym->compound!=nestlevel || findglb(name,sGLOBAL)!=NULL)
error(219,name); /* variable shadows another symbol */
if (matchtoken('[')) {
int _index;
cell _code;
int dim_ident;
symbol *dim_sym;
value dim_val;
int all_constant = 1;
int _staging = staging;
if (!_staging)
stgset(TRUE);
stgget(&_index, &_code);
do {
if (numdim == sDIMEN_MAX) {
error(53); /* exceeding maximum number of dimensions */
return (all_constant ? iARRAY : iREFARRAY);
} else if (numdim) { /* if */
/* If we have a dimension on the stack, push it */
pushreg(sPRI);
}
if (matchtoken(']')) {
idxtag[numdim] = 0;
dim[numdim] = 0;
numdim++;
continue;
}
dim_ident = doexpr2(TRUE,FALSE,FALSE,FALSE,&idxtag[numdim],&dim_sym,0,&dim_val);
if (dim_ident == iVARIABLE || dim_ident == iEXPRESSION || dim_ident == iARRAYCELL) {
all_constant = 0;
dim[numdim] = 0;
} else if (dim_ident == iCONSTEXPR) {
dim[numdim] = dim_val.constval;
/* :TODO: :URGENT: Make sure this still works */
if (dim_sym && dim_sym->usage & uENUMROOT)
enumroot = dim_sym->dim.enumlist;
idxtag[numdim] = dim_sym ? dim_sym->tag : 0;
#if INT_MAX < LONG_MAX
if (dim[numdim] > INT_MAX)
error(125); /* overflow, exceeding capacity */
#endif
} else {
error(29); /* invalid expression, assumed 0 */
}
numdim++;
needtoken(']');
} while (matchtoken('['));
if (all_constant) {
/* Change the last dimension to be based on chars instead if we have a string */
if (tag == pc_tag_string && numdim && dim[numdim-1]) {
slength = dim[numdim-1];
dim[numdim-1] = (dim[numdim-1] + sizeof(cell)-1) / sizeof(cell);
}
/* Scrap the code generated */
ident = iARRAY;
stgdel(_index, _code);
} else {
if (tag == pc_tag_string && numdim) {
stradjust(sPRI);
}
pushreg(sPRI);
/* No idea why this is here, but it throws away dimension info which
would otherwise be used by addvariable2 below.
memset(dim, 0, sizeof(int)*sDIMEN_MAX);
*/
ident = iREFARRAY;
genarray(numdim, autozero);
}
stgout(_index);
if (!_staging)
stgset(FALSE);
}
if (getstates(name))
error(88,name); /* local variables may not have states */
if (ident==iARRAY || fstatic) {
if (sc_alignnext) {
aligndata(sc_dataalign);
sc_alignnext=FALSE;
} /* if */
cur_lit=litidx; /* save current index in the literal table */
if (numdim && !dim[numdim-1])
size = 0;
initials(ident,tag,&size,dim,numdim,enumroot);
if (tag == pc_tag_string && (numdim == 1) && !dim[numdim-1]) {
slength = glbstringread;
}
if (size==0)
return ident; /* error message already given */
if (numdim==1)
dim[0]=(int)size;
}
/* reserve memory (on the stack) for the variable */
if (fstatic) {
/* write zeros for uninitialized fields */
while (litidx<cur_lit+size)
litadd(0);
sym=addvariable2(name,(cur_lit+glb_declared)*sizeof(cell),ident,sSTATIC,
tag,dim,numdim,idxtag,slength);
} else if (ident!=iREFARRAY) {
declared+=(int)size; /* variables are put on stack, adjust "declared" */
sym=addvariable2(name,-declared*sizeof(cell),ident,sLOCAL,tag,
dim,numdim,idxtag,slength);
if (ident==iVARIABLE) {
assert(!staging);
stgset(TRUE); /* start stage-buffering */
assert(stgidx==0);
staging_start=stgidx;
} /* if */
markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
modstk(-(int)size*sizeof(cell));
markstack(MEMUSE_STATIC, size);
assert(curfunc!=NULL);
assert((curfunc->usage & uNATIVE)==0);
if (curfunc->x.stacksize<declared+1)
curfunc->x.stacksize=declared+1; /* +1 for PROC opcode */
} else if (ident==iREFARRAY) {
declared+=1; /* one cell for address */
sym=addvariable(name,-declared*sizeof(cell),ident,sLOCAL,tag,dim,numdim,idxtag);
//markexpr(sLDECL,name,-declared*sizeof(cell)); /* mark for better optimization */
/* genarray() pushes the address onto the stack, so we don't need to call modstk() here! */
markheap(MEMUSE_DYNAMIC, 0);
markstack(MEMUSE_STATIC, 1);
assert(curfunc != NULL && ((curfunc->usage & uNATIVE) == 0));
if (curfunc->x.stacksize<declared+1)
curfunc->x.stacksize=declared+1; /* +1 for PROC opcode */
} /* if */
/* now that we have reserved memory for the variable, we can proceed
* to initialize it */
assert(sym!=NULL); /* we declared it, it must be there */
sym->compound=nestlevel; /* for multiple declaration/shadowing check */
if (fconst)
sym->usage|=uCONST;
if (!fstatic) { /* static variables already initialized */
if (ident==iVARIABLE) {
/* simple variable, also supports initialization */
int ctag = tag; /* set to "tag" by default */
int explicit_init=FALSE;/* is the variable explicitly initialized? */
int cident=ident;
if (matchtoken('=')) {
if (!autozero)
error(10);
cident=doexpr(FALSE,FALSE,FALSE,FALSE,&ctag,NULL,TRUE);
explicit_init=TRUE;
} else {
if (autozero)
ldconst(0,sPRI); /* uninitialized variable, set to zero */
} /* if */
if (autozero) {
/* now try to save the value (still in PRI) in the variable */
lval.sym=sym;
lval.ident=iVARIABLE;
lval.constval=0;
lval.tag=tag;
check_userop(NULL,ctag,lval.tag,2,NULL,&ctag);
store(&lval);
markexpr(sEXPR,NULL,0); /* full expression ends after the store */
}
assert(staging); /* end staging phase (optimize expression) */
stgout(staging_start);
stgset(FALSE);
if (!matchtag_string(cident, ctag) && !matchtag(tag,ctag,TRUE))
{
if (tag & FUNCTAG)
error(100); /* error - function prototypes do not match */
else
error(213); /* warning - tag mismatch */
}
/* if the variable was not explicitly initialized, reset the
* "uWRITTEN" flag that store() set */
if (!explicit_init)
sym->usage &= ~uWRITTEN;
} else if (ident!=iREFARRAY) {
/* an array */
assert(cur_lit>=0 && cur_lit<=litidx && litidx<=litmax);
assert(size>0 && size>=sym->dim.array.length);
assert(numdim>1 || size==sym->dim.array.length);
if (autozero) {
/* final literal values that are zero make no sense to put in the literal
* pool, because values get zero-initialized anyway; we check for this,
* because users often explicitly initialize strings to ""
*/
while (litidx>cur_lit && litq[litidx-1]==0)
litidx--;
/* if the array is not completely filled, set all values to zero first */
if (litidx-cur_lit<size && (ucell)size<CELL_MAX)
fillarray(sym,size*sizeof(cell),0);
}
if (cur_lit<litidx) {
/* check whether the complete array is set to a single value; if
* it is, more compact code can be generated */
cell first=litq[cur_lit];
int i;
for (i=cur_lit; i<litidx && litq[i]==first; i++)
/* nothing */;
if (i==litidx) {
/* all values are the same */
fillarray(sym,(litidx-cur_lit)*sizeof(cell),first);
litidx=cur_lit; /* reset literal table */
} else {
/* copy the literals to the array */
ldconst((cur_lit+glb_declared)*sizeof(cell),sPRI);
copyarray(sym,(litidx-cur_lit)*sizeof(cell));
} /* if */
} /* if */
} /* if */
} /* if */
} while (matchtoken(',')); /* enddo */ /* more? */
needtoken(tTERM); /* if not comma, must be semicolumn */
return ident;
}
/* this function returns the maximum value for a cell in case of an error
* (invalid dimension).
*/
static cell calc_arraysize(int dim[],int numdim,int cur)
{
cell subsize;
ucell newsize;
/* the return value is in cells, not bytes */
assert(cur>=0 && cur<=numdim);
if (cur==numdim)
return 0;
subsize=calc_arraysize(dim,numdim,cur+1);
newsize=dim[cur]+dim[cur]*subsize;
if ((ucell)subsize>=CELL_MAX || newsize>=CELL_MAX || newsize*sizeof(cell)>=CELL_MAX)
return CELL_MAX;
return newsize;
}
static cell gen_indirection_vecs(array_info_t *ar, int dim, cell cur_offs)
{
int i;
cell write_offs = cur_offs;
cell *data_offs = ar->data_offs;
cur_offs += ar->dim_list[dim];
/**
* Dimension n-x where x > 2 will have sub-vectors.
* Otherwise, we just need to reference the data section.
*/
if (ar->dim_count > 2 && dim < ar->dim_count - 2)
{
/**
* For each index at this dimension, write offstes to our sub-vectors.
* After we write one sub-vector, we generate its sub-vectors recursively.
* At the end, we're given the next offset we can use.
*/
for (i = 0; i < ar->dim_list[dim]; i++)
{
ar->base[write_offs] = (cur_offs - write_offs) * sizeof(cell);
write_offs++;
ar->cur_dims[dim] = i;
cur_offs = gen_indirection_vecs(ar, dim + 1, cur_offs);
}
} else if (ar->dim_count > 1) {
/**
* In this section, there are no sub-vectors, we need to write offsets
* to the data. This is separate so the data stays in one big chunk.
* The data offset will increment by the size of the last dimension,
* because that is where the data is finally computed as. But the last
* dimension can be of variable size, so we have to detect that.
*/
if (ar->dim_list[dim + 1] == 0)
{
int vec_start = 0;
/**
* Using the precalculated offsets, compute an index into the last
* dimension array.
*/
for (i = 0; i < dim; i++)
{
vec_start += ar->cur_dims[i] * ar->dim_offs_precalc[i];
}
/**
* Now, vec_start points to a vector of last dimension offsets for
* the preceding dimension combination(s).
* I.e. (1,2,i,j) in [3][4][5][] will be:
* j = 1*(4*5) + 2*(5) + i, and the parenthetical expressions are
* precalculated for us so we can easily generalize here.
*/
for (i = 0; i < ar->dim_list[dim]; i++)
{
ar->base[write_offs] = (*data_offs - write_offs) * sizeof(cell);
write_offs++;
*data_offs = *data_offs + ar->lastdim_list[vec_start + i];
}
} else {
/**
* The last dimension size is constant. There's no extra work to
* compute the last dimension size.
*/
for (i = 0; i < ar->dim_list[dim]; i++)
{
ar->base[write_offs] = (*data_offs - write_offs) * sizeof(cell);
write_offs++;
*data_offs = *data_offs + ar->dim_list[dim + 1];
}
}
}
return cur_offs;
}
static cell calc_indirection(const int dim_list[], int dim_count, int dim)
{
cell size = dim_list[dim];
if (dim < dim_count - 2)
{
size += dim_list[dim] * calc_indirection(dim_list, dim_count, dim + 1);
}
return size;
}
static void adjust_indirectiontables(int dim[],int numdim,int cur,cell increment,
int startlit,constvalue *lastdim,int *skipdim)
{
/* Find how many cells the indirection table will be */
cell tbl_size;
int *dyn_list = NULL;
int cur_dims[sDIMEN_MAX];
cell dim_offset_precalc[sDIMEN_MAX];
array_info_t ar;
if (numdim == 1)
{
return;
}
tbl_size = calc_indirection(dim, numdim, 0);
memset(cur_dims, 0, sizeof(cur_dims));
/**
* Flatten the last dimension array list -- this makes
* things MUCH easier in the indirection calculator.
*/
if (lastdim)
{
int i;
constvalue *ld = lastdim->next;
/* Get the total number of last dimensions. */
for (i = 0; ld != NULL; i++, ld = ld->next)
{
/* Nothing */
}
/* Store them in an array instead of a linked list. */
dyn_list = (int *)malloc(sizeof(int) * i);
for (i = 0, ld = lastdim->next;
ld != NULL;
i++, ld = ld->next)
{
dyn_list[i] = ld->value;
}
/**
* Pre-calculate all of the offsets. This speeds up and simplifies
* the indirection process. For example, if we have an array like:
* [a][b][c][d][], and given (A,B,C), we want to find the size of
* the last dimension [A][B][C][i], we must do:
*
* list[A*(b*c*d) + B*(c*d) + C*(d) + i]
*
* Generalizing this algorithm in the indirection process is expensive,
* so we lessen the need for nested loops by pre-computing the parts:
* (b*c*d), (c*d), and (d).
*
* In other words, finding the offset to dimension N at index I is
* I * (S[N+1] * S[N+2] ... S[N+n-1]) where S[] is the size of dimension
* function, and n is the index of the last dimension.
*/
for (i = 0; i < numdim - 1; i++)
{
int j;
dim_offset_precalc[i] = 1;
for (j = i + 1; j < numdim - 1; j++)
{
dim_offset_precalc[i] *= dim[j];
}
}
ar.dim_offs_precalc = dim_offset_precalc;
ar.lastdim_list = dyn_list;
} else {
ar.dim_offs_precalc = NULL;
ar.lastdim_list = NULL;
}
ar.base = &litq[startlit];
ar.data_offs = &tbl_size;
ar.dim_list = dim;
ar.dim_count = numdim;
ar.cur_dims = cur_dims;
gen_indirection_vecs(&ar, 0, 0);
free(dyn_list);
}
/* initials
*
* Initialize global objects and local arrays.
* size==array cells (count), if 0 on input, the routine counts the number of elements
* tag==required tagname id (not the returned tag)
*
* Global references: litidx (altered)
*/
static void initials2(int ident,int tag,cell *size,int dim[],int numdim,
constvalue *enumroot, int eq_match_override, int curlit_override)
{
int ctag;
cell tablesize;
int curlit=(curlit_override == -1) ? litidx : curlit_override;
int err=0;
if (eq_match_override == -1) {
eq_match_override = matchtoken('=');
}
if (!eq_match_override) {
assert(ident!=iARRAY || numdim>0);
if (ident==iARRAY && dim[numdim-1]==0) {
/* declared as "myvar[];" which is senseless (note: this *does* make
* sense in the case of a iREFARRAY, which is a function parameter)
*/
error(9); /* array has zero length -> invalid size */
} /* if */
if (ident==iARRAY) {
assert(numdim>0 && numdim<=sDIMEN_MAX);
*size=calc_arraysize(dim,numdim,0);
if (*size==(cell)CELL_MAX) {
error(9); /* array is too big -> invalid size */
return;
} /* if */
/* first reserve space for the indirection vectors of the array, then
* adjust it to contain the proper values
* (do not use dumpzero(), as it bypasses the literal queue)
*/
for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
litadd(0);
if (dim[numdim-1]!=0) /* error 9 has already been given */
adjust_indirectiontables(dim,numdim,0,0,curlit,NULL,NULL);
} /* if */
return;
} /* if */
if (ident==iVARIABLE) {
assert(*size==1);
init(ident,&ctag,NULL);
if (!matchtag(tag,ctag,TRUE))
{
if (tag & FUNCTAG)
error(100); /* error - function prototypes do not match */
else
error(213); /* warning - tag mismatch */
}
} else {
assert(numdim>0);
if (numdim==1) {
*size=initvector(ident,tag,dim[0],FALSE,enumroot,NULL);
} else {
int errorfound=FALSE;
int counteddim[sDIMEN_MAX];
int idx;
constvalue lastdim={NULL,"",0,0}; /* sizes of the final dimension */
int skipdim=0;
if (dim[numdim-1]!=0)
*size=calc_arraysize(dim,numdim,0); /* calc. full size, if known */
/* already reserve space for the indirection tables (for an array with
* known dimensions)
* (do not use dumpzero(), as it bypasses the literal queue)
*/
for (tablesize=calc_arraysize(dim,numdim-1,0); tablesize>0; tablesize--)
litadd(0);
/* now initialize the sub-arrays */
memset(counteddim,0,sizeof counteddim);
initarray(ident,tag,dim,numdim,0,curlit,counteddim,&lastdim,enumroot,&errorfound);
/* check the specified array dimensions with the initializer counts */
for (idx=0; idx<numdim-1; idx++) {
if (dim[idx]==0) {
dim[idx]=counteddim[idx];
} else if (counteddim[idx]<dim[idx]) {
error(52); /* array is not fully initialized */
err++;
} else if (counteddim[idx]>dim[idx]) {
error(18); /* initialization data exceeds declared size */
err++;
} /* if */
} /* for */
if (numdim>1 && dim[numdim-1]==0) {
/* also look whether, by any chance, all "counted" final dimensions are
* the same value; if so, we can store this
*/
constvalue *ld=lastdim.next;
int d,match;
for (d=0; d<dim[numdim-2]; d++) {
assert(ld!=NULL);
assert(strtol(ld->name,NULL,16)==d);
if (d==0)
match=ld->value;
else if (match!=ld->value)
break;
ld=ld->next;
} /* for */
if (d==dim[numdim-2])
dim[numdim-1]=match;
} /* if */
/* after all arrays have been initalized, we know the (major) dimensions
* of the array and we can properly adjust the indirection vectors
*/
if (err==0)
adjust_indirectiontables(dim,numdim,0,0,curlit,&lastdim,&skipdim);
delete_consttable(&lastdim); /* clear list of minor dimension sizes */
} /* if */
} /* if */
if (*size==0)
*size=litidx-curlit; /* number of elements defined */
}
static void initials(int ident,int tag,cell *size,int dim[],int numdim,
constvalue *enumroot)
{
initials2(ident, tag, size, dim, numdim, enumroot, -1, -1);
}
static cell initarray(int ident,int tag,int dim[],int numdim,int cur,
int startlit,int counteddim[],constvalue *lastdim,
constvalue *enumroot,int *errorfound)
{
cell dsize,totalsize;
int idx,abortparse;
assert(cur>=0 && cur<numdim);
assert(startlit>=0);
assert(cur+2<=numdim);/* there must be 2 dimensions or more to do */
assert(errorfound!=NULL && *errorfound==FALSE);
totalsize=0;
needtoken('{');
for (idx=0,abortparse=FALSE; !abortparse; idx++) {
/* In case the major dimension is zero, we need to store the offset
* to the newly detected sub-array into the indirection table; i.e.
* this table needs to be expanded and updated.
* In the current design, the indirection vectors for a multi-dimensional
* array are adjusted after parsing all initializers. Hence, it is only
* necessary at this point to reserve space for an extra cell in the
* indirection vector.
*/
if (dim[cur]==0) {
litinsert(0,startlit);
} else if (idx>=dim[cur]) {
error(18); /* initialization data exceeds array size */
break;
} /* if */
if (cur+2<numdim) {
dsize=initarray(ident,tag,dim,numdim,cur+1,startlit,counteddim,
lastdim,enumroot,errorfound);
} else {
dsize=initvector(ident,tag,dim[cur+1],TRUE,enumroot,errorfound);
/* The final dimension may be variable length. We need to keep the
* lengths of the final dimensions in order to set the indirection
* vectors for the next-to-last dimension.
*/
append_constval(lastdim,itoh(idx),dsize,0);
} /* if */
totalsize+=dsize;
if (*errorfound || !matchtoken(','))
abortparse=TRUE;
} /* for */
needtoken('}');
assert(counteddim!=NULL);
if (counteddim[cur]>0) {
if (idx<counteddim[cur])
error(52); /* array is not fully initialized */
else if (idx>counteddim[cur])
error(18); /* initialization data exceeds declared size */
} /* if */
counteddim[cur]=idx;
return totalsize+dim[cur]; /* size of sub-arrays + indirection vector */
}
/* initvector
* Initialize a single dimensional array
*/
static cell initvector(int ident,int tag,cell size,int fillzero,
constvalue *enumroot,int *errorfound)
{
cell prev1=0,prev2=0;
int ellips=FALSE;
int curlit=litidx;
int rtag,ctag;
assert(ident==iARRAY || ident==iREFARRAY);
if (matchtoken('{')) {
constvalue *enumfield=(enumroot!=NULL) ? enumroot->next : NULL;
do {
int fieldlit=litidx;
int matchbrace,i;
if (matchtoken('}')) { /* to allow for trailing ',' after the initialization */
lexpush();
break;
} /* if */
if ((ellips=matchtoken(tELLIPS))!=0)
break;
/* for enumeration fields, allow another level of braces ("{...}") */
matchbrace=0; /* preset */
ellips=0;
if (enumfield!=NULL)
matchbrace=matchtoken('{');
for ( ;; ) {
prev2=prev1;
prev1=init(ident,&ctag,errorfound);
if (!matchbrace)
break;
if ((ellips=matchtoken(tELLIPS))!=0)
break;
if (!matchtoken(',')) {
needtoken('}');
break;
} /* for */
} /* for */
/* if this array is based on an enumeration, fill the "field" up with
* zeros, and toggle the tag
*/
if (enumroot!=NULL && enumfield==NULL)
error(227); /* more initializers than enum fields */
rtag=tag; /* preset, may be overridden by enum field tag */
if (enumfield!=NULL) {
cell step;
int cmptag=enumfield->index;
symbol *symfield=findconst(enumfield->name,&cmptag);
if (cmptag>1)
error(91,enumfield->name); /* ambiguous constant, needs tag override */
assert(symfield!=NULL);
assert(fieldlit<litidx);
if (litidx-fieldlit>symfield->dim.array.length)
error(228); /* length of initializer exceeds size of the enum field */
if (ellips) {
step=prev1-prev2;
} else {
step=0;
prev1=0;
} /* if */
for (i=litidx-fieldlit; i<symfield->dim.array.length; i++) {
prev1+=step;
litadd(prev1);
} /* for */
rtag=symfield->x.tags.index; /* set the expected tag to the index tag */
enumfield=enumfield->next;
} /* if */
if (!matchtag(rtag,ctag,TRUE))
{
if (rtag & FUNCTAG)
error(100); /* error - function prototypes do not match */
else
error(213); /* warning - tag mismatch */
}
} while (matchtoken(',')); /* do */
needtoken('}');
} else {
init(ident,&ctag,errorfound);
if (!matchtag(tag,ctag,TRUE))
error(213); /* tagname mismatch */
} /* if */
/* fill up the literal queue with a series */
if (ellips) {
cell step=((litidx-curlit)==1) ? (cell)0 : prev1-prev2;
if (size==0 || (litidx-curlit)==0)
error(41); /* invalid ellipsis, array size unknown */
else if ((litidx-curlit)==(int)size)
error(18); /* initialization data exceeds declared size */
while ((litidx-curlit)<(int)size) {
prev1+=step;
litadd(prev1);
} /* while */
} /* if */
if (fillzero && size>0) {
while ((litidx-curlit)<(int)size)
litadd(0);
} /* if */
if (size==0) {
size=litidx-curlit; /* number of elements defined */
} else if (litidx-curlit>(int)size) { /* e.g. "myvar[3]={1,2,3,4};" */
error(18); /* initialization data exceeds declared size */
litidx=(int)size+curlit; /* avoid overflow in memory moves */
} /* if */
return size;
}
/* init
*
* Evaluate one initializer.
*/
static cell init(int ident,int *tag,int *errorfound)
{
cell i = 0;
if (matchtoken(tSTRING)){
/* lex() automatically stores strings in the literal table (and
* increases "litidx") */
if (ident==iVARIABLE) {
error(6); /* must be assigned to an array */
litidx=1; /* reset literal queue */
} /* if */
*tag=pc_tag_string;
} else if (constexpr(&i,tag,NULL)){
litadd(i); /* store expression result in literal table */
} else {
if (errorfound!=NULL)
*errorfound=TRUE;
} /* if */
return i;
}
/* needsub
*
* Get required array size
*/
static cell needsub(int *tag,constvalue **enumroot)
{
cell val;
symbol *sym;
assert(tag!=NULL);
*tag=0;
if (enumroot!=NULL)
*enumroot=NULL; /* preset */
if (matchtoken(']')) /* we have already seen "[" */
return 0; /* zero size (like "char msg[]") */
constexpr(&val,tag,&sym); /* get value (must be constant expression) */
if (val<0) {
error(9); /* negative array size is invalid; assumed zero */
val=0;
} /* if */
needtoken(']');
if (enumroot!=NULL) {
/* get the field list for an enumeration */
assert(*enumroot==NULL);/* should have been preset */
assert(sym==NULL || sym->ident==iCONSTEXPR);
if (sym!=NULL && (sym->usage & uENUMROOT)==uENUMROOT) {
assert(sym->dim.enumlist!=NULL);
*enumroot=sym->dim.enumlist;
} /* if */
} /* if */
return val; /* return array size */
}
/* decl_const - declare a single constant
*
*/
static void decl_const(int vclass)
{
char constname[sNAMEMAX+1];
cell val;
char *str;
int tag,exprtag;
int symbolline;
symbol *sym;
insert_docstring_separator(); /* see comment in newfunc() */
do {
tag=pc_addtag(NULL);
if (lex(&val,&str)!=tSYMBOL) /* read in (new) token */
error(20,str); /* invalid symbol name */
symbolline=fline; /* save line where symbol was found */
strcpy(constname,str); /* save symbol name */
needtoken('=');
constexpr(&val,&exprtag,NULL); /* get value */
/* add_constant() checks for duplicate definitions */
if (!matchtag(tag,exprtag,FALSE)) {
/* temporarily reset the line number to where the symbol was defined */
int orgfline=fline;
fline=symbolline;
error(213); /* tagname mismatch */
fline=orgfline;
} /* if */
sym=add_constant(constname,val,vclass,tag);
if (sym!=NULL)
sc_attachdocumentation(sym);/* attach any documenation to the constant */
} while (matchtoken(',')); /* enddo */ /* more? */
needtoken(tTERM);
}
/*
* declstruct - declare a struct type
*/
static void declstruct(void)
{
cell val;
char *str;
int tok;
pstruct_t *pstruct;
int size;
/* get the explicit tag (required!) */
tok = lex(&val,&str);
if (tok != tSYMBOL)
{
error(93);
}
if (pstructs_find(str) != NULL)
{
error(98);
}
pstruct = pstructs_add(str);
needtoken('{');
do
{
structarg_t arg;
if (matchtoken('}'))
{
/* Quick exit */
lexpush();
break;
}
memset(&arg, 0, sizeof(structarg_t));
tok = lex(&val,&str);
if (tok == tCONST)
{
arg.fconst = 1;
tok = lex(&val,&str);
}
arg.ident = 0;
if (tok == '&')
{
arg.ident = iREFERENCE;
tok = lex(&val,&str);
}
if (tok == tLABEL)
{
arg.tag = pc_addtag(str);
tok = lex(&val,&str);
}
if (tok != tSYMBOL)
{
error(1, "-identifier-", str);
continue;
}
strcpy(arg.name, str);
if (matchtoken('['))
{
if (arg.ident == iREFERENCE)
{
error(67, arg.name);
}
arg.ident = iARRAY;
do
{
constvalue *enumroot;
int ignore_tag;
if (arg.dimcount == sDIMEN_MAX)
{
error(53);
break;
}
size = needsub(&ignore_tag, &enumroot);
arg.dims[arg.dimcount++] = size;
} while (matchtoken('['));
/* Handle strings */
if (arg.tag == pc_tag_string && arg.dims[arg.dimcount-1])
{
arg.dims[arg.dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
}
if (arg.dimcount == 1 && !arg.dims[arg.dimcount-1])
{
arg.ident = iREFARRAY;
}
} else if (!arg.ident) {
arg.ident = iVARIABLE;
}
if (pstructs_addarg(pstruct, &arg) == NULL)
{
error(99, arg.name, pstruct->name);
}
} while (matchtoken(','));
needtoken('}');
matchtoken(';'); /* eat up optional semicolon */
}
/**
* dofuncenum - declare function enumerations
*/
static void dofuncenum(int listmode)
{
cell val;
char *str;
// char *ptr;
char tagname[sNAMEMAX+1];
constvalue *cur;
funcenum_t *fenum = NULL;
int i;
int newStyleTag = 0;
int isNewStyle = 0;
/* get the explicit tag (required!) */
int l = lex(&val,&str);
if (l != tSYMBOL)
{
if (listmode == FALSE && l == tPUBLIC)
{
isNewStyle = 1;
newStyleTag = pc_addtag(NULL);
l = lex(&val, &str);
if (l != tSYMBOL)
{
error(93);
}
}
else
{
error(93);
}
}
/* This tag can't already exist! */
cur=tagname_tab.next;
while (cur)
{
if (strcmp(cur->name, str) == 0)
{
/* Another bad one... */
if (!(cur->value & FUNCTAG))
{
error(94);
}
break;
}
cur = cur->next;
}
strcpy(tagname, str);
fenum = funcenums_add(tagname);
if (listmode)
{
needtoken('{');
}
do
{
functag_t func;
if (listmode && matchtoken('}'))
{
/* Quick exit */
lexpush();
break;
}
memset(&func, 0, sizeof(func));
if (!isNewStyle)
{
func.ret_tag = pc_addtag(NULL); /* Get the return tag */
l = lex(&val, &str);
/* :TODO:
* Right now, there is a problem. We can't pass non-public function pointer addresses around,
* because the address isn't known until the final reparse. Unfortunately, you can write code
* before the address is known, because Pawn's compiler isn't truly multipass.
*
* When you call a function, there's no problem, because it does not write the address.
* The assembly looks like this:
* call MyFunction
* Then, only at assembly time (once all passes are done), does it know the address.
* I do not see any solution to this because there is no way I know to inject the function name
* rather than the constant value. And even if we could, we'd have to change the assembler recognize that.
*/
if (l == tPUBLIC) {
func.type = uPUBLIC;
} else {
error(1, "-public-", str);
}
}
else
{
func.ret_tag = newStyleTag;
func.type = uPUBLIC;
}
needtoken('(');
do
{
funcarg_t *arg = &(func.args[func.argcount]);
/* Quick exit */
if (matchtoken(')'))
{
lexpush();
break;
}
l = lex(&val, &str);
if (l == '&')
{
if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
{
error(1, "-identifier-", "&");
}
arg->ident = iREFERENCE;
} else if (l == tCONST) {
if ((arg->ident != iVARIABLE && arg->ident != 0) || arg->tagcount > 0)
{
error(1, "-identifier-", "const");
}
arg->fconst=TRUE;
} else if (l == tLABEL) {
if (arg->tagcount > 0)
{
error(1, "-identifier-", "-tagname-");
}
arg->tags[arg->tagcount++] = pc_addtag(str);
#if 0
while (arg->tagcount < sTAGS_MAX)
{
if (!matchtoken('_') && !needtoken(tSYMBOL))
{
break;
}
tokeninfo(&val, &ptr);
arg->tags[arg->tagcount++] = pc_addtag(ptr);
if (matchtoken('}'))
{
break;
}
needtoken(',');
}
needtoken(':');
#endif
l=tLABEL;
} else if (l == tSYMBOL) {
if (func.argcount >= sARGS_MAX)
{
error(45);
}
if (str[0] == PUBLIC_CHAR)
{
error(56, str);
}
if (matchtoken('['))
{
cell size;
if (arg->ident == iREFERENCE)
{
error(67, str);
}
do
{
constvalue *enumroot;
int ignore_tag;
if (arg->dimcount == sDIMEN_MAX)
{
error(53);
break;
}
size = needsub(&ignore_tag, &enumroot);
arg->dims[arg->dimcount] = size;
arg->dimcount += 1;
} while (matchtoken('['));
/* Handle strings */
if ((arg->tagcount == 1 && arg->tags[0] == pc_tag_string)
&& arg->dims[arg->dimcount-1])
{
arg->dims[arg->dimcount-1] = (size + sizeof(cell)-1) / sizeof(cell);
}
arg->ident=iREFARRAY;
} else if (arg->ident == 0) {
arg->ident = iVARIABLE;
}
if (matchtoken('='))
{
needtoken('0');
arg->ommittable = TRUE;
func.ommittable = TRUE;
} else if (func.ommittable) {
error(95);
}
func.argcount++;
} else if (l == tELLIPS) {
if (arg->ident == iVARIABLE)
{
error(10);
}
arg->ident = iVARARGS;
func.argcount++;
} else {
error(10);
}
} while (l == '&' || l == tLABEL || l == tCONST || l != tELLIPS && matchtoken(','));
needtoken(')');
for (i=0; i<func.argcount; i++)
{
if (func.args[i].tagcount == 0)
{
func.args[i].tags[0] = 0;
func.args[i].tagcount = 1;
}
}
functags_add(fenum, &func);
if (!listmode)
{
break;
}
} while (matchtoken(','));
if (listmode)
{
needtoken('}');
}
matchtoken(';'); /* eat an optional semicolon. nom nom nom */
errorset(sRESET, 0);
}
/* decl_enum - declare enumerated constants
*
*/
static void decl_enum(int vclass)
{
char enumname[sNAMEMAX+1],constname[sNAMEMAX+1];
cell val,value,size;
char *str;
int tag,explicittag;
cell increment,multiplier;
constvalue *enumroot;
symbol *enumsym;
/* get an explicit tag, if any (we need to remember whether an explicit
* tag was passed, even if that explicit tag was "_:", so we cannot call
* pc_addtag() here
*/
if (lex(&val,&str)==tLABEL) {
tag=pc_addtag(str);
explicittag=TRUE;
} else {
lexpush();
tag=0;
explicittag=FALSE;
} /* if */
/* get optional enum name (also serves as a tag if no explicit tag was set) */
if (lex(&val,&str)==tSYMBOL) { /* read in (new) token */
strcpy(enumname,str); /* save enum name (last constant) */
if (!explicittag)
tag=pc_addtag(enumname);
} else {
lexpush(); /* analyze again */
enumname[0]='\0';
} /* if */
/* get increment and multiplier */
increment=1;
multiplier=1;
if (matchtoken('(')) {
if (matchtoken(taADD)) {
constexpr(&increment,NULL,NULL);
} else if (matchtoken(taMULT)) {
constexpr(&multiplier,NULL,NULL);
} else if (matchtoken(taSHL)) {
constexpr(&val,NULL,NULL);
while (val-->0)
multiplier*=2;
} /* if */
needtoken(')');
} /* if */
if (strlen(enumname)>0) {
/* already create the root symbol, so the fields can have it as their "parent" */
enumsym=add_constant(enumname,0,vclass,tag);
if (enumsym!=NULL)
enumsym->usage |= uENUMROOT;
/* start a new list for the element names */
if ((enumroot=(constvalue*)malloc(sizeof(constvalue)))==NULL)
error(123); /* insufficient memory (fatal error) */
memset(enumroot,0,sizeof(constvalue));
} else {
enumsym=NULL;
enumroot=NULL;
} /* if */
needtoken('{');
/* go through all constants */
value=0; /* default starting value */
do {
int idxtag,fieldtag;
symbol *sym;
if (matchtoken('}')) { /* quick exit if '}' follows ',' */
lexpush();
break;
} /* if */
idxtag=pc_addtag(NULL); /* optional explicit item tag */
if (needtoken(tSYMBOL)) { /* read in (new) token */
tokeninfo(&val,&str); /* get the information */
strcpy(constname,str); /* save symbol name */
} else {
constname[0]='\0';
} /* if */
size=increment; /* default increment of 'val' */
fieldtag=0; /* default field tag */
if (matchtoken('[')) {
constexpr(&size,&fieldtag,NULL); /* get size */
needtoken(']');
} /* if */
/* :TODO: do we need a size modifier here for pc_tag_string? */
if (matchtoken('='))
constexpr(&value,NULL,NULL); /* get value */
/* add_constant() checks whether a variable (global or local) or
* a constant with the same name already exists
*/
sym=add_constant(constname,value,vclass,tag);
if (sym==NULL)
continue; /* error message already given */
/* set the item tag and the item size, for use in indexing arrays */
sym->x.tags.index=idxtag;
sym->x.tags.field=fieldtag;
sym->dim.array.length=size;
sym->dim.array.level=0;
sym->dim.array.slength=0;
sym->parent=enumsym;
/* add the constant to a separate list as well */
if (enumroot!=NULL) {
sym->usage |= uENUMFIELD;
append_constval(enumroot,constname,value,tag);
} /* if */
if (multiplier==1)
value+=size;
else
value*=size*multiplier;
} while (matchtoken(','));
needtoken('}'); /* terminates the constant list */
matchtoken(';'); /* eat an optional ; */
/* set the enum name to the "next" value (typically the last value plus one) */
if (enumsym!=NULL) {
assert((enumsym->usage & uENUMROOT)!=0);
enumsym->addr=value;
/* assign the constant list */
assert(enumroot!=NULL);
enumsym->dim.enumlist=enumroot;
sc_attachdocumentation(enumsym); /* attach any documenation to the enumeration */
} /* if */
}
static int getstates(const char *funcname)
{
char fsaname[sNAMEMAX+1],statename[sNAMEMAX+1];
cell val;
char *str;
constvalue *automaton;
constvalue *state;
int fsa,islabel;
int *list;
int count,listsize,state_id;
if (!matchtoken('<'))
return 0;
if (matchtoken('>'))
return -1; /* special construct: all other states (fall-back) */
count=0;
listsize=0;
list=NULL;
fsa=-1;
do {
if (!(islabel=matchtoken(tLABEL)) && !needtoken(tSYMBOL))
break;
tokeninfo(&val,&str);
assert(strlen(str)<sizeof fsaname);
strcpy(fsaname,str); /* assume this is the name of the automaton */
if (islabel || matchtoken(':')) {
/* token is an automaton name, add the name and get a new token */
if (!needtoken(tSYMBOL))
break;
tokeninfo(&val,&str);
assert(strlen(str)<sizeof statename);
strcpy(statename,str);
} else {
/* the token was the state name (part of an anynymous automaton) */
assert(strlen(fsaname)<sizeof statename);
strcpy(statename,fsaname);
fsaname[0]='\0';
} /* if */
if (fsa<0 || fsaname[0]!='\0') {
automaton=automaton_add(fsaname);
assert(automaton!=NULL);
if (fsa>=0 && automaton->index!=fsa)
error(83,funcname); /* multiple automatons for a single function/variable */
fsa=automaton->index;
} /* if */
state=state_add(statename,fsa);
/* add this state to the state combination list (it will be attached to the
* automaton later) */
state_buildlist(&list,&listsize,&count,(int)state->value);
} while (matchtoken(','));
needtoken('>');
if (count>0) {
assert(automaton!=NULL);
assert(fsa>=0);
state_id=state_addlist(list,count,fsa);
assert(state_id>0);
} else {
/* error is already given */
state_id=0;
} /* if */
if (list!=NULL)
free(list);
return state_id;
}
static void attachstatelist(symbol *sym, int state_id)
{
assert(sym!=NULL);
if ((sym->usage & uDEFINE)!=0 && (sym->states==NULL || state_id==0))
error(21,sym->name); /* function already defined, either without states or the current definition has no states */
if (state_id!=0) {
/* add the state list id */
constvalue *stateptr;
if (sym->states==NULL) {
if ((sym->states=(constvalue*)malloc(sizeof(constvalue)))==NULL)
error(123); /* insufficient memory (fatal error) */
memset(sym->states,0,sizeof(constvalue));
} /* if */
/* see whether the id already exists (add new state only if it does not
* yet exist
*/
assert(sym->states!=NULL);
for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index!=state_id; stateptr=stateptr->next)
/* nothing */;
assert(state_id<=SHRT_MAX);
if (stateptr==NULL)
append_constval(sym->states,"",code_idx,(short)state_id);
else if (stateptr->value==0)
stateptr->value=code_idx;
else
error(84,sym->name);
/* also check for another conflicting situation: a fallback function
* without any states
*/
if (state_id==-1 && sc_status!=statFIRST) {
/* in the second round, all states should have been accumulated */
assert(sym->states!=NULL);
for (stateptr=sym->states->next; stateptr!=NULL && stateptr->index==-1; stateptr=stateptr->next)
/* nothing */;
if (stateptr==NULL)
error(85,sym->name); /* no states are defined for this function */
} /* if */
} /* if */
}
/*
* Finds a function in the global symbol table or creates a new entry.
* It does some basic processing and error checking.
*/
SC_FUNC symbol *fetchfunc(char *name,int tag)
{
symbol *sym;
if ((sym=findglb(name,sGLOBAL))!=0) { /* already in symbol table? */
if (sym->ident!=iFUNCTN) {
error(21,name); /* yes, but not as a function */
return NULL; /* make sure the old symbol is not damaged */
} else if ((sym->usage & uNATIVE)!=0) {
error(21,name); /* yes, and it is a native */
} /* if */
assert(sym->vclass==sGLOBAL);
if ((sym->usage & uPROTOTYPED)!=0 && sym->tag!=tag)
error(25); /* mismatch from earlier prototype */
if ((sym->usage & uDEFINE)==0) {
/* as long as the function stays undefined, update the address and the tag */
if (sym->states==NULL)
sym->addr=code_idx;
sym->tag=tag;
} /* if */
} else {
/* don't set the "uDEFINE" flag; it may be a prototype */
sym=addsym(name,code_idx,iFUNCTN,sGLOBAL,tag,0);
assert(sym!=NULL); /* fatal error 103 must be given on error */
/* assume no arguments */
sym->dim.arglist=(arginfo*)malloc(1*sizeof(arginfo));
sym->dim.arglist[0].ident=0;
/* set library ID to NULL (only for native functions) */
sym->x.lib=NULL;
/* set the required stack size to zero (only for non-native functions) */
sym->x.stacksize=1; /* 1 for PROC opcode */
} /* if */
if (pc_deprecate!=NULL) {
assert(sym!=NULL);
sym->flags|=flgDEPRECATED;
if (sc_status==statWRITE) {
if (sym->documentation!=NULL) {
free(sym->documentation);
sym->documentation=NULL;
} /* if */
sym->documentation=pc_deprecate;
} else {
free(pc_deprecate);
} /* if */
pc_deprecate=NULL;
} /* if */
return sym;
}
/* This routine adds symbolic information for each argument.
*/
static void define_args(void)
{
symbol *sym;
/* At this point, no local variables have been declared. All
* local symbols are function arguments.
*/
sym=loctab.next;
while (sym!=NULL) {
assert(sym->ident!=iLABEL);
assert(sym->vclass==sLOCAL);
markexpr(sLDECL,sym->name,sym->addr); /* mark for better optimization */
sym=sym->next;
} /* while */
}
static int operatorname(char *name)
{
int opertok;
char *str;
cell val;
assert(name!=NULL);
/* check the operator */
opertok=lex(&val,&str);
switch (opertok) {
case '+':
case '-':
case '*':
case '/':
case '%':
case '>':
case '<':
case '!':
case '~':
case '=':
name[0]=(char)opertok;
name[1]='\0';
break;
case tINC:
strcpy(name,"++");
break;
case tDEC:
strcpy(name,"--");
break;
case tlEQ:
strcpy(name,"==");
break;
case tlNE:
strcpy(name,"!=");
break;
case tlLE:
strcpy(name,"<=");
break;
case tlGE:
strcpy(name,">=");
break;
default:
name[0]='\0';
error(7); /* operator cannot be redefined (or bad operator name) */
return 0;
} /* switch */
return opertok;
}
static int operatoradjust(int opertok,symbol *sym,char *opername,int resulttag)
{
int tags[2]={0,0};
int count=0;
arginfo *arg;
char tmpname[sNAMEMAX+1];
symbol *oldsym;
if (opertok==0)
return TRUE;
assert(sym!=NULL && sym->ident==iFUNCTN && sym->dim.arglist!=NULL);
/* count arguments and save (first two) tags */
while (arg=&sym->dim.arglist[count], arg->ident!=0) {
if (count<2) {
if (arg->numtags>1)
error(65,count+1); /* function argument may only have a single tag */
else if (arg->numtags==1)
tags[count]=arg->tags[0];
} /* if */
if (opertok=='~' && count==0) {
if (arg->ident!=iREFARRAY)
error(73,arg->name);/* must be an array argument */
} else {
//if (arg->ident!=iVARIABLE)
//error(66,arg->name);/* must be non-reference argument */
} /* if */
if (arg->hasdefault)
error(59,arg->name); /* arguments of an operator may not have a default value */
count++;
} /* while */
/* for '!', '++' and '--', count must be 1
* for '-', count may be 1 or 2
* for '=', count must be 1, and the resulttag is also important
* for all other (binary) operators and the special '~' operator, count must be 2
*/
switch (opertok) {
case '!':
case '=':
case tINC:
case tDEC:
if (count!=1)
error(62); /* number or placement of the operands does not fit the operator */
break;
case '-':
if (count!=1 && count!=2)
error(62); /* number or placement of the operands does not fit the operator */
break;
default:
if (count!=2)
error(62); /* number or placement of the operands does not fit the operator */
} /* switch */
if (tags[0]==0 && (opertok!='=' && tags[1]==0 || opertok=='=' && resulttag==0))
error(64); /* cannot change predefined operators */
/* change the operator name */
assert(strlen(opername)>0);
operator_symname(tmpname,opername,tags[0],tags[1],count,resulttag);
if ((oldsym=findglb(tmpname,sGLOBAL))!=NULL) {
int i;
if ((oldsym->usage & uDEFINE)!=0) {
char errname[2*sNAMEMAX+16];
funcdisplayname(errname,tmpname);
error(21,errname); /* symbol already defined */
} /* if */
sym->usage|=oldsym->usage; /* copy flags from the previous definition */
for (i=0; i<oldsym->numrefers; i++)
if (oldsym->refer[i]!=NULL)
refer_symbol(sym,oldsym->refer[i]);
delete_symbol(&glbtab,oldsym);
} /* if */
RemoveFromHashTable(sp_Globals, sym);
strcpy(sym->name,tmpname);
sym->hash=NameHash(sym->name);/* calculate new hash */
AddToHashTable(sp_Globals, sym);
/* operators should return a value, except the '~' operator */
if (opertok!='~')
sym->usage |= uRETVALUE;
return TRUE;
}
static int check_operatortag(int opertok,int resulttag,char *opername)
{
assert(opername!=NULL && strlen(opername)>0);
switch (opertok) {
case '!':
case '<':
case '>':
case tlEQ:
case tlNE:
case tlLE:
case tlGE:
if (resulttag!=pc_addtag("bool")) {
error(63,opername,"bool:"); /* operator X requires a "bool:" result tag */
return FALSE;
} /* if */
break;
case '~':
if (resulttag!=0) {
error(63,opername,"_:"); /* operator "~" requires a "_:" result tag */
return FALSE;
} /* if */
break;
} /* switch */
return TRUE;
}
static char *tag2str(char *dest,int tag)
{
tag &= TAGMASK;
assert(tag>=0);
sprintf(dest,"0%x",tag);
return isdigit(dest[1]) ? &dest[1] : dest;
}
SC_FUNC char *operator_symname(char *symname,char *opername,int tag1,int tag2,int numtags,int resulttag)
{
char tagstr1[10], tagstr2[10];
int opertok;
assert(numtags>=1 && numtags<=2);
opertok= (opername[1]=='\0') ? opername[0] : 0;
if (opertok=='=')
sprintf(symname,"%s%s%s",tag2str(tagstr1,resulttag),opername,tag2str(tagstr2,tag1));
else if (numtags==1 || opertok=='~')
sprintf(symname,"%s%s",opername,tag2str(tagstr1,tag1));
else
sprintf(symname,"%s%s%s",tag2str(tagstr1,tag1),opername,tag2str(tagstr2,tag2));
return symname;
}
static int parse_funcname(char *fname,int *tag1,int *tag2,char *opname)
{
char *ptr,*name;
int unary;
/* tags are only positive, so if the function name starts with a '-',
* the operator is an unary '-' or '--' operator.
*/
if (*fname=='-') {
*tag1=0;
unary=TRUE;
ptr=fname;
} else {
*tag1=(int)strtol(fname,&ptr,16);
unary= ptr==fname; /* unary operator if it doesn't start with a tag name */
} /* if */
assert(!unary || *tag1==0);
assert(*ptr!='\0');
for (name=opname; !isdigit(*ptr); )
*name++ = *ptr++;
*name='\0';
*tag2=(int)strtol(ptr,NULL,16);
return unary;
}
constvalue *find_tag_byval(int tag)
{
constvalue *tagsym;
tagsym=find_constval_byval(&tagname_tab,tag & ~PUBLICTAG);
if (tagsym==NULL)
tagsym=find_constval_byval(&tagname_tab,tag | PUBLICTAG);
return tagsym;
}
SC_FUNC char *funcdisplayname(char *dest,char *funcname)
{
int tags[2];
char opname[10];
constvalue *tagsym[2];
int unary;
if (isalpha(*funcname) || *funcname=='_' || *funcname==PUBLIC_CHAR || *funcname=='\0') {
if (dest!=funcname)
strcpy(dest,funcname);
return dest;
} /* if */
unary=parse_funcname(funcname,&tags[0],&tags[1],opname);
tagsym[1]=find_tag_byval(tags[1]);
assert(tagsym[1]!=NULL);
if (unary) {
sprintf(dest,"operator%s(%s:)",opname,tagsym[1]->name);
} else {
tagsym[0]=find_tag_byval(tags[0]);
assert(tagsym[0]!=NULL);
/* special case: the assignment operator has the return value as the 2nd tag */
if (opname[0]=='=' && opname[1]=='\0')
sprintf(dest,"%s:operator%s(%s:)",tagsym[0]->name,opname,tagsym[1]->name);
else
sprintf(dest,"operator%s(%s:,%s:)",opname,tagsym[0]->name,tagsym[1]->name);
} /* if */
return dest;
}
static void funcstub(int fnative)
{
int tok,tag,fpublic;
char *str;
cell val,size;
char symbolname[sNAMEMAX+1];
int idxtag[sDIMEN_MAX];
int dim[sDIMEN_MAX];
int numdim;
symbol *sym,*sub;
int opertok;
opertok=0;
lastst=0;
litidx=0; /* clear the literal pool */
assert(loctab.next==NULL); /* local symbol table should be empty */
tag=pc_addtag(NULL); /* get the tag of the return value */
numdim=0;
while (matchtoken('[')) {
/* the function returns an array, get this tag for the index and the array
* dimensions
*/
if (numdim == sDIMEN_MAX) {
error(53); /* exceeding maximum number of dimensions */
return;
} /* if */
size=needsub(&idxtag[numdim],NULL); /* get size; size==0 for "var[]" */
if (size==0)
error(9); /* invalid array size */
#if INT_MAX < LONG_MAX
if (size > INT_MAX)
error(125); /* overflow, exceeding capacity */
#endif
dim[numdim++]=(int)size;
} /* while */
if (tag == pc_tag_string && numdim && dim[numdim-1])
dim[numdim-1] = (size + sizeof(cell)-1) / sizeof(cell);
tok=lex(&val,&str);
fpublic=(tok==tPUBLIC) || (tok==tSYMBOL && str[0]==PUBLIC_CHAR);
if (fnative) {
if (fpublic || tok==tSTOCK || tok==tSTATIC || tok==tSYMBOL && *str==PUBLIC_CHAR)
error(42); /* invalid combination of class specifiers */
} else {
if (tok==tPUBLIC || tok==tSTOCK || tok==tSTATIC)
tok=lex(&val,&str);
} /* if */
if (tok==tOPERATOR) {
opertok=operatorname(symbolname);
if (opertok==0)
return; /* error message already given */
check_operatortag(opertok,tag,symbolname);
} else {
if (tok!=tSYMBOL && freading) {
error(10); /* illegal function or declaration */
return;
} /* if */
strcpy(symbolname,str);
} /* if */
needtoken('('); /* only functions may be native/forward */
sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
if (sym==NULL)
return;
if (fnative) {
sym->usage=(char)(uNATIVE | uRETVALUE | uDEFINE | (sym->usage & uPROTOTYPED));
sym->x.lib=curlibrary;
} else if (fpublic) {
sym->usage|=uPUBLIC;
} /* if */
sym->usage|=uFORWARD;
declargs(sym,FALSE);
/* "declargs()" found the ")" */
sc_attachdocumentation(sym); /* attach any documenation to the function */
if (!operatoradjust(opertok,sym,symbolname,tag))
sym->usage &= ~uDEFINE;
if (getstates(symbolname)!=0) {
if (fnative || opertok!=0)
error(82); /* native functions and operators may not have states */
else
error(231); /* ignoring state specifications on forward declarations */
} /* if */
/* for a native operator, also need to specify an "exported" function name;
* for a native function, this is optional
*/
if (fnative) {
if (opertok!=0) {
needtoken('=');
lexpush(); /* push back, for matchtoken() to retrieve again */
} /* if */
if (matchtoken('=')) {
/* allow number or symbol */
if (matchtoken(tSYMBOL)) {
tokeninfo(&val,&str);
insert_alias(sym->name,str);
} else {
constexpr(&val,NULL,NULL);
sym->addr=val;
/* At the moment, I have assumed that this syntax is only valid if
* val < 0. To properly mix "normal" native functions and indexed
* native functions, one should use negative indices anyway.
* Special code for a negative index in sym->addr exists in SC4.C
* (ffcall()) and in SC6.C (the loops for counting the number of native
* variables and for writing them).
*/
} /* if */
} /* if */
} /* if */
needtoken(tTERM);
/* attach the array to the function symbol */
if (numdim>0) {
assert(sym!=NULL);
sub=addvariable(symbolname,0,iARRAY,sGLOBAL,tag,dim,numdim,idxtag);
sub->parent=sym;
} /* if */
litidx=0; /* clear the literal pool */
delete_symbols(&loctab,0,TRUE,TRUE);/* clear local variables queue */
}
/* newfunc - begin a function
*
* This routine is called from "parse" and tries to make a function
* out of the following text
*
* Global references: funcstatus,lastst,litidx
* rettype (altered)
* curfunc (altered)
* declared (altered)
* glb_declared (altered)
* sc_alignnext (altered)
*/
static int newfunc(char *firstname,int firsttag,int fpublic,int fstatic,int stock)
{
symbol *sym;
int argcnt,tok,tag,funcline;
int opertok,opererror;
char symbolname[sNAMEMAX+1];
char *str;
cell val,cidx,glbdecl;
short filenum;
int state_id;
assert(litidx==0); /* literal queue should be empty */
litidx=0; /* clear the literal pool (should already be empty) */
opertok=0;
lastst=0; /* no statement yet */
cidx=0; /* just to avoid compiler warnings */
glbdecl=0;
assert(loctab.next==NULL); /* local symbol table should be empty */
filenum=fcurrent; /* save file number at the start of the declaration */
if (firstname!=NULL) {
assert(strlen(firstname)<=sNAMEMAX);
strcpy(symbolname,firstname); /* save symbol name */
tag=firsttag;
} else {
tag= (firsttag>=0) ? firsttag : pc_addtag(NULL);
tok=lex(&val,&str);
assert(!fpublic);
if (tok==tNATIVE || tok==tPUBLIC && stock)
error(42); /* invalid combination of class specifiers */
if (tok==tOPERATOR) {
opertok=operatorname(symbolname);
if (opertok==0)
return TRUE; /* error message already given */
check_operatortag(opertok,tag,symbolname);
} else {
if (tok!=tSYMBOL && freading) {
error(20,str); /* invalid symbol name */
return FALSE;
} /* if */
assert(strlen(str)<=sNAMEMAX);
strcpy(symbolname,str);
} /* if */
} /* if */
/* check whether this is a function or a variable declaration */
if (!matchtoken('('))
return FALSE;
/* so it is a function, proceed */
funcline=fline; /* save line at which the function is defined */
if (symbolname[0]==PUBLIC_CHAR) {
fpublic=TRUE; /* implicitly public function */
if (stock)
error(42); /* invalid combination of class specifiers */
} /* if */
sym=fetchfunc(symbolname,tag);/* get a pointer to the function entry */
if (sym==NULL || (sym->usage & uNATIVE)!=0)
return TRUE; /* it was recognized as a function declaration, but not as a valid one */
if (fpublic)
sym->usage|=uPUBLIC;
if (fstatic)
sym->fnumber=filenum;
/* if the function was used before being declared, and it has a tag for the
* result, add a third pass (as second "skimming" parse) because the function
* result may have been used with user-defined operators, which have now
* been incorrectly flagged (as the return tag was unknown at the time of
* the call)
*/
if ((sym->usage & (uPROTOTYPED | uREAD))==uREAD && sym->tag!=0) {
int curstatus=sc_status;
sc_status=statWRITE; /* temporarily set status to WRITE, so the warning isn't blocked */
#if 0 /* SourceMod - silly, should be removed in first pass, so removed */
error(208);
#endif
sc_status=curstatus;
sc_reparse=TRUE; /* must add another pass to "initial scan" phase */
} /* if */
#if 0 /* Not used for SourceMod */
/* we want public functions to be explicitly prototyped, as they are called
* from the outside
*/
if (fpublic && (sym->usage & uFORWARD)==0)
error(235,symbolname);
#endif
/* declare all arguments */
argcnt=declargs(sym,TRUE);
opererror=!operatoradjust(opertok,sym,symbolname,tag);
if (strcmp(symbolname,uMAINFUNC)==0 || strcmp(symbolname,uENTRYFUNC)==0) {
if (argcnt>0)
error(5); /* "main()" and "entry()" functions may not have any arguments */
sym->usage|=uREAD; /* "main()" is the program's entry point: always used */
} /* if */
state_id=getstates(symbolname);
if (state_id>0 && (opertok!=0 || strcmp(symbolname,uMAINFUNC)==0))
error(82); /* operators may not have states, main() may neither */
attachstatelist(sym,state_id);
/* "declargs()" found the ")"; if a ";" appears after this, it was a
* prototype */
if (matchtoken(';')) {
if (sym->usage & uPUBLIC)
error(10);
sym->usage|=uFORWARD;
if (!sc_needsemicolon)
error(10); /* old style prototypes used with optional semicolumns */
delete_symbols(&loctab,0,TRUE,TRUE); /* prototype is done; forget everything */
return TRUE;
} /* if */
/* so it is not a prototype, proceed */
/* if this is a function that is not referred to (this can only be detected
* in the second stage), shut code generation off */
if (sc_status==statWRITE && (sym->usage & uREAD)==0 && !fpublic) {
sc_status=statSKIP;
cidx=code_idx;
glbdecl=glb_declared;
} /* if */
if ((sym->flags & flgDEPRECATED) != 0 && (sym->usage & uSTOCK) == 0) {
char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";
error(234,symbolname,ptr); /* deprecated (probably a public function) */
} /* if */
begcseg();
sym->usage|=uDEFINE; /* set the definition flag */
if (stock)
sym->usage|=uSTOCK;
if (opertok!=0 && opererror)
sym->usage &= ~uDEFINE;
/* if the function has states, dump the label to the start of the function */
if (state_id!=0) {
constvalue *ptr=sym->states->next;
while (ptr!=NULL) {
assert(sc_status!=statWRITE || strlen(ptr->name)>0);
if (ptr->index==state_id) {
setlabel((int)strtol(ptr->name,NULL,16));
break;
} /* if */
ptr=ptr->next;
} /* while */
} /* if */
startfunc(sym->name); /* creates stack frame */
insert_dbgline(funcline);
setline(FALSE);
if (sc_alignnext) {
alignframe(sc_dataalign);
sc_alignnext=FALSE;
} /* if */
declared=0; /* number of local cells */
resetstacklist();
resetheaplist();
rettype=(sym->usage & uRETVALUE); /* set "return type" variable */
curfunc=sym;
define_args(); /* add the symbolic info for the function arguments */
#if !defined SC_LIGHT
if (matchtoken('{')) {
lexpush();
} else {
/* Insert a separator so that comments following the statement will not
* be attached to this function; they should be attached to the next
* function. This is not a problem for functions having a compound block,
* because the closing brace is an explicit "end token" for the function.
* With single statement functions, the preprocessor may overread the
* source code before the parser determines an "end of statement".
*/
insert_docstring_separator();
} /* if */
#endif
sc_curstates=state_id;/* set state id, for accessing global state variables */
statement(NULL,FALSE);
sc_curstates=0;
if ((rettype & uRETVALUE)!=0)
sym->usage|=uRETVALUE;
if (declared!=0) {
/* This happens only in a very special (and useless) case, where a function
* has only a single statement in its body (no compound block) and that
* statement declares a new variable
*/
popstacklist(1);
declared=0;
} /* if */
if ((lastst!=tRETURN) && (lastst!=tGOTO)){
ldconst(0,sPRI);
ffret(strcmp(sym->name,uENTRYFUNC)!=0);
if ((sym->usage & uRETVALUE)!=0) {
char symname[2*sNAMEMAX+16]; /* allow space for user defined operators */
funcdisplayname(symname,sym->name);
error(209,symname); /* function should return a value */
} /* if */
} /* if */
endfunc();
sym->codeaddr=code_idx;
sc_attachdocumentation(sym); /* attach collected documenation to the function */
if (litidx) { /* if there are literals defined */
glb_declared+=litidx;
begdseg(); /* flip to DATA segment */
dumplits(); /* dump literal strings */
litidx=0;
} /* if */
testsymbols(&loctab,0,TRUE,TRUE); /* test for unused arguments and labels */
delete_symbols(&loctab,0,TRUE,TRUE); /* clear local variables queue */
assert(loctab.next==NULL);
curfunc=NULL;
if (sc_status==statSKIP) {
sc_status=statWRITE;
code_idx=cidx;
glb_declared=glbdecl;
} /* if */
return TRUE;
}
static int argcompare(arginfo *a1,arginfo *a2)
{
int result,level,i;
#if 0 /* SourceMod uses case insensitive args for forwards */
result= strcmp(a1->name,a2->name)==0; /* name */
#else
result=1;
#endif
if (result)
result= a1->ident==a2->ident; /* type/class */
if (result)
result= a1->usage==a2->usage; /* "const" flag */
if (result)
result= a1->numtags==a2->numtags; /* tags (number and names) */
for (i=0; result && i<a1->numtags; i++)
result= a1->tags[i]==a2->tags[i];
if (result)
result= a1->numdim==a2->numdim; /* array dimensions & index tags */
for (level=0; result && level<a1->numdim; level++)
result= a1->dim[level]==a2->dim[level];
for (level=0; result && level<a1->numdim; level++)
result= a1->idxtag[level]==a2->idxtag[level];
if (result)
result= a1->hasdefault==a2->hasdefault; /* availability of default value */
if (a1->hasdefault) {
if (a1->ident==iREFARRAY) {
if (result)
result= a1->defvalue.array.size==a2->defvalue.array.size;
if (result)
result= a1->defvalue.array.arraysize==a2->defvalue.array.arraysize;
/* ??? should also check contents of the default array (these troubles
* go away in a 2-pass compiler that forbids double declarations, but
* Pawn currently does not forbid them) */
} else {
if (result) {
if ((a1->hasdefault & uSIZEOF)!=0 || (a1->hasdefault & uTAGOF)!=0 || (a1->hasdefault & uCOUNTOF)!=0)
result= a1->hasdefault==a2->hasdefault
&& strcmp(a1->defvalue.size.symname,a2->defvalue.size.symname)==0
&& a1->defvalue.size.level==a2->defvalue.size.level;
else
result= a1->defvalue.val==a2->defvalue.val;
} /* if */
} /* if */
if (result)
result= a1->defvalue_tag==a2->defvalue_tag;
} /* if */
return result;
}
/* declargs()
*
* This routine adds an entry in the local symbol table for each argument
* found in the argument list. It returns the number of arguments.
*/
static int declargs(symbol *sym,int chkshadow)
{
#define MAXTAGS 16
char *ptr;
int argcnt,oldargcnt,tok,tags[MAXTAGS],numtags;
cell val;
arginfo arg, *arglist;
char name[sNAMEMAX+1];
int ident,fpublic,fconst;
int idx;
/* if the function is already defined earlier, get the number of arguments
* of the existing definition
*/
oldargcnt=0;
if ((sym->usage & uPROTOTYPED)!=0)
while (sym->dim.arglist[oldargcnt].ident!=0)
oldargcnt++;
argcnt=0; /* zero aruments up to now */
ident=iVARIABLE;
numtags=0;
fconst=FALSE;
fpublic= (sym->usage & (uPUBLIC|uSTOCK))!=0;
/* the '(' parantheses has already been parsed */
if (!matchtoken(')')){
do { /* there are arguments; process them */
/* any legal name increases argument count (and stack offset) */
tok=lex(&val,&ptr);
switch (tok) {
case 0:
/* nothing */
break;
case '&':
if (ident!=iVARIABLE || numtags>0)
error(1,"-identifier-","&");
ident=iREFERENCE;
break;
case tCONST:
if (ident!=iVARIABLE || numtags>0)
error(1,"-identifier-","const");
fconst=TRUE;
break;
case tLABEL:
if (numtags>0)
error(1,"-identifier-","-tagname-");
tags[0]=pc_addtag(ptr);
numtags=1;
break;
case '{':
if (numtags>0)
error(1,"-identifier-","-tagname-");
numtags=0;
while (numtags<MAXTAGS) {
if (!matchtoken('_') && !needtoken(tSYMBOL))
break;
tokeninfo(&val,&ptr);
tags[numtags++]=pc_addtag(ptr);
if (matchtoken('}'))
break;
needtoken(',');
} /* for */
needtoken(':');
tok=tLABEL; /* for outer loop: flag that we have seen a tagname */
break;
case tSYMBOL:
if (argcnt>=sMAXARGS)
error(45); /* too many function arguments */
strcpy(name,ptr); /* save symbol name */
if (name[0]==PUBLIC_CHAR)
error(56,name); /* function arguments cannot be public */
if (numtags==0)
tags[numtags++]=0; /* default tag */
/* Stack layout:
* base + 0*sizeof(cell) == previous "base"
* base + 1*sizeof(cell) == function return address
* base + 2*sizeof(cell) == number of arguments
* base + 3*sizeof(cell) == first argument of the function
* So the offset of each argument is "(argcnt+3) * sizeof(cell)".
*/
doarg(name,ident,(argcnt+3)*sizeof(cell),tags,numtags,fpublic,fconst,chkshadow,&arg);
/* :TODO: fix this so stocks that are func pointers can't have default arguments? */
if ((sym->usage & uPUBLIC) && arg.hasdefault)
error(59,name); /* arguments of a public function may not have a default value */
if ((sym->usage & uPROTOTYPED)==0) {
/* redimension the argument list, add the entry */
sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
if (sym->dim.arglist==0)
error(123); /* insufficient memory */
memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo)); /* keep the list terminated */
sym->dim.arglist[argcnt]=arg;
} else {
/* check the argument with the earlier definition */
if (argcnt>oldargcnt || !argcompare(&sym->dim.arglist[argcnt],&arg))
error(25); /* function definition does not match prototype */
/* may need to free default array argument and the tag list */
if (arg.ident==iREFARRAY && arg.hasdefault)
free(arg.defvalue.array.data);
else if (arg.ident==iVARIABLE
&& ((arg.hasdefault & uSIZEOF)!=0 || (arg.hasdefault & uTAGOF)!=0) || (arg.hasdefault & uCOUNTOF)!=0)
free(arg.defvalue.size.symname);
free(arg.tags);
} /* if */
argcnt++;
ident=iVARIABLE;
numtags=0;
fconst=FALSE;
break;
case tELLIPS:
if (ident!=iVARIABLE)
error(10); /* illegal function or declaration */
if (numtags==0)
tags[numtags++]=0; /* default tag */
if ((sym->usage & uPROTOTYPED)==0) {
/* redimension the argument list, add the entry iVARARGS */
sym->dim.arglist=(arginfo*)realloc(sym->dim.arglist,(argcnt+2)*sizeof(arginfo));
if (sym->dim.arglist==0)
error(123); /* insufficient memory */
memset(&sym->dim.arglist[argcnt+1],0,sizeof(arginfo)); /* keep the list terminated */
sym->dim.arglist[argcnt].ident=iVARARGS;
sym->dim.arglist[argcnt].hasdefault=FALSE;
sym->dim.arglist[argcnt].defvalue.val=0;
sym->dim.arglist[argcnt].defvalue_tag=0;
sym->dim.arglist[argcnt].numtags=numtags;
sym->dim.arglist[argcnt].tags=(int*)malloc(numtags*sizeof tags[0]);
if (sym->dim.arglist[argcnt].tags==NULL)
error(123); /* insufficient memory */
memcpy(sym->dim.arglist[argcnt].tags,tags,numtags*sizeof tags[0]);
} else {
if (argcnt>oldargcnt || sym->dim.arglist[argcnt].ident!=iVARARGS)
error(25); /* function definition does not match prototype */
} /* if */
argcnt++;
break;
default:
error(10); /* illegal function or declaration */
} /* switch */
} while (tok=='&' || tok==tLABEL || tok==tCONST
|| tok!=tELLIPS && matchtoken(',')); /* more? */
/* if the next token is not ",", it should be ")" */
needtoken(')');
} /* if */
/* resolve any "sizeof" arguments (now that all arguments are known) */
assert(sym->dim.arglist!=NULL);
arglist=sym->dim.arglist;
for (idx=0; idx<argcnt && arglist[idx].ident!=0; idx++) {
if ((arglist[idx].hasdefault & uSIZEOF)!=0
|| (arglist[idx].hasdefault & uTAGOF)!=0
|| (arglist[idx].hasdefault & uCOUNTOF)!=0) {
int altidx;
/* Find the argument with the name mentioned after the "sizeof". Note
* that we cannot use findloc here because we need the arginfo struct,
* not the symbol.
*/
ptr=arglist[idx].defvalue.size.symname;
assert(ptr!=NULL);
for (altidx=0; altidx<argcnt && strcmp(ptr,arglist[altidx].name)!=0; altidx++)
/* nothing */;
if (altidx>=argcnt) {
error(17,ptr); /* undefined symbol */
} else {
assert(arglist[idx].defvalue.size.symname!=NULL);
/* check the level against the number of dimensions */
if (arglist[idx].defvalue.size.level>0
&& arglist[idx].defvalue.size.level>=arglist[altidx].numdim)
error(28,arglist[idx].name); /* invalid subscript */
/* check the type of the argument whose size to take; for a iVARIABLE
* or a iREFERENCE, this is always 1 (so the code is redundant)
*/
assert(arglist[altidx].ident!=iVARARGS);
if (arglist[altidx].ident!=iREFARRAY
&& (((arglist[idx].hasdefault & uSIZEOF)!=0)
|| (arglist[idx].hasdefault & uCOUNTOF)!=0)) {
if ((arglist[idx].hasdefault & uTAGOF)!=0) {
error(81,arglist[idx].name); /* cannot take "tagof" an indexed array */
} else {
assert(arglist[altidx].ident==iVARIABLE || arglist[altidx].ident==iREFERENCE);
error(223,ptr); /* redundant sizeof */
} /* if */
} /* if */
} /* if */
} /* if */
} /* for */
sym->usage|=uPROTOTYPED;
errorset(sRESET,0); /* reset error flag (clear the "panic mode")*/
return argcnt;
}
/* doarg - declare one argument type
*
* this routine is called from "declargs()" and adds an entry in the local
* symbol table for one argument.
*
* "fpublic" indicates whether the function for this argument list is public.
* The arguments themselves are never public.
*/
static void doarg(char *name,int ident,int offset,int tags[],int numtags,
int fpublic,int fconst,int chkshadow,arginfo *arg)
{
symbol *argsym;
constvalue *enumroot;
cell size;
int slength=0;
strcpy(arg->name,name);
arg->hasdefault=FALSE; /* preset (most common case) */
arg->defvalue.val=0; /* clear */
arg->defvalue_tag=0;
arg->numdim=0;
if (matchtoken('[')) {
if (ident==iREFERENCE)
error(67,name); /* illegal declaration ("&name[]" is unsupported) */
do {
if (arg->numdim == sDIMEN_MAX) {
error(53); /* exceeding maximum number of dimensions */
return;
} /* if */
size=needsub(&arg->idxtag[arg->numdim],&enumroot);/* may be zero here, it is a pointer anyway */
#if INT_MAX < LONG_MAX
if (size > INT_MAX)
error(125); /* overflow, exceeding capacity */
#endif
arg->dim[arg->numdim]=(int)size;
arg->numdim+=1;
} while (matchtoken('['));
ident=iREFARRAY; /* "reference to array" (is a pointer) */
#if 0 /* For SM, multiple tags including string don't make sense,
so just check the first tag. Done manually so the string
tag isn't matched with the any tag. */
if (checktag(tags, numtags, pc_tag_string)) {
#endif
assert(tags!=0);
assert(numtags>0);
if (tags[0] == pc_tag_string) {
slength = arg->dim[arg->numdim - 1];
arg->dim[arg->numdim - 1] = (size + sizeof(cell) - 1) / sizeof(cell);
}
if (matchtoken('=')) {
assert(litidx==0); /* at the start of a function, this is reset */
assert(numtags>0);
/* Check if there is a symbol */
if (matchtoken(tSYMBOL)) {
symbol *sym;
char *name;
cell val;
tokeninfo(&val,&name);
if ((sym=findglb(name, sGLOBAL)) == NULL) {
error(17, name); /* undefined symbol */
} else {
arg->hasdefault=TRUE; /* argument as a default value */
memset(&arg->defvalue, 0, sizeof(arg->defvalue));
arg->defvalue.array.data=NULL;
arg->defvalue.array.addr=sym->addr;
arg->defvalue_tag=sym->tag;
if (sc_status==statWRITE && (sym->usage & uREAD)==0) {
markusage(sym, uREAD);
}
}
} else {
initials2(ident,tags[0],&size,arg->dim,arg->numdim,enumroot, 1, 0);
assert(size>=litidx);
/* allocate memory to hold the initial values */
arg->defvalue.array.data=(cell *)malloc(litidx*sizeof(cell));
if (arg->defvalue.array.data!=NULL) {
int i;
memcpy(arg->defvalue.array.data,litq,litidx*sizeof(cell));
arg->hasdefault=TRUE; /* argument has default value */
arg->defvalue.array.size=litidx;
arg->defvalue.array.addr=-1;
/* calulate size to reserve on the heap */
arg->defvalue.array.arraysize=1;
for (i=0; i<arg->numdim; i++)
arg->defvalue.array.arraysize*=arg->dim[i];
if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
arg->defvalue.array.arraysize = arg->defvalue.array.size;
} /* if */
litidx=0; /* reset */
}
} /* if */
} else {
if (matchtoken('=')) {
unsigned char size_tag_token;
assert(ident==iVARIABLE || ident==iREFERENCE);
arg->hasdefault=TRUE; /* argument has a default value */
size_tag_token=(unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
if (size_tag_token==0)
size_tag_token=(unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
if (size_tag_token==0)
size_tag_token=(unsigned char)(matchtoken(tCELLSOF) ? uCOUNTOF : 0);
if (size_tag_token!=0) {
int paranthese;
if (ident==iREFERENCE)
error(66,name); /* argument may not be a reference */
paranthese=0;
while (matchtoken('('))
paranthese++;
if (needtoken(tSYMBOL)) {
/* save the name of the argument whose size id to take */
char *name;
cell val;
tokeninfo(&val,&name);
if ((arg->defvalue.size.symname=duplicatestring(name)) == NULL)
error(123); /* insufficient memory */
arg->defvalue.size.level=0;
if (size_tag_token==uSIZEOF || size_tag_token==uCOUNTOF) {
while (matchtoken('[')) {
arg->defvalue.size.level+=(short)1;
needtoken(']');
} /* while */
} /* if */
if (ident==iVARIABLE) /* make sure we set this only if not a reference */
arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
} /* if */
while (paranthese--)
needtoken(')');
} else {
constexpr(&arg->defvalue.val,&arg->defvalue_tag,NULL);
assert(numtags>0);
if (!matchtag(tags[0],arg->defvalue_tag,TRUE))
error(213); /* tagname mismatch */
} /* if */
} /* if */
} /* if */
arg->ident=(char)ident;
arg->usage=(char)(fconst ? uCONST : 0);
arg->numtags=numtags;
arg->tags=(int*)malloc(numtags*sizeof tags[0]);
if (arg->tags==NULL)
error(123); /* insufficient memory */
memcpy(arg->tags,tags,numtags*sizeof tags[0]);
argsym=findloc(name);
if (argsym!=NULL) {
error(21,name); /* symbol already defined */
} else {
if (chkshadow && (argsym=findglb(name,sSTATEVAR))!=NULL && argsym->ident!=iFUNCTN)
error(219,name); /* variable shadows another symbol */
/* add details of type and address */
assert(numtags>0);
argsym=addvariable2(name,offset,ident,sLOCAL,tags[0],
arg->dim,arg->numdim,arg->idxtag,slength);
argsym->compound=0;
if (ident==iREFERENCE)
argsym->usage|=uREAD; /* because references are passed back */
if (fpublic)
argsym->usage|=uREAD; /* arguments of public functions are always "used" */
if (fconst)
argsym->usage|=uCONST;
} /* if */
}
static int count_referrers(symbol *entry)
{
int i,count;
count=0;
for (i=0; i<entry->numrefers; i++)
if (entry->refer[i]!=NULL)
count++;
return count;
}
#if !defined SC_LIGHT
static int find_xmltag(char *source,char *xmltag,char *xmlparam,char *xmlvalue,
char **outer_start,int *outer_length,
char **inner_start,int *inner_length)
{
char *ptr,*inner_end;
int xmltag_len,xmlparam_len,xmlvalue_len;
int match;
assert(source!=NULL);
assert(xmltag!=NULL);
assert(outer_start!=NULL);
assert(outer_length!=NULL);
assert(inner_start!=NULL);
assert(inner_length!=NULL);
/* both NULL or both non-NULL */
assert(xmlvalue!=NULL && xmlparam!=NULL || xmlvalue==NULL && xmlparam==NULL);
xmltag_len=strlen(xmltag);
xmlparam_len= (xmlparam!=NULL) ? strlen(xmlparam) : 0;
xmlvalue_len= (xmlvalue!=NULL) ? strlen(xmlvalue) : 0;
ptr=source;
/* find an opening '<' */
while ((ptr=strchr(ptr,'<'))!=NULL) {
*outer_start=ptr; /* be optimistic... */
match=FALSE; /* ...and pessimistic at the same time */
ptr++; /* skip '<' */
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
/* xml tag found, optionally check the parameter */
ptr+=xmltag_len;
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (xmlparam!=NULL) {
if (strncmp(ptr,xmlparam,xmlparam_len)==0 && (*(ptr+xmlparam_len)<=' ' || *(ptr+xmlparam_len)=='=')) {
ptr+=xmlparam_len;
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (*ptr=='=') {
ptr++; /* skip '=' */
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (*ptr=='"' || *ptr=='\'')
ptr++; /* skip " or ' */
assert(xmlvalue!=NULL);
if (strncmp(ptr,xmlvalue,xmlvalue_len)==0
&& (*(ptr+xmlvalue_len)<=' '
|| *(ptr+xmlvalue_len)=='>'
|| *(ptr+xmlvalue_len)=='"'
|| *(ptr+xmlvalue_len)=='\''))
match=TRUE; /* found it */
} /* if */
} /* if */
} else {
match=TRUE; /* don't check the parameter */
} /* if */
} /* if */
if (match) {
/* now find the end of the opening tag */
while (*ptr!='\0' && *ptr!='>')
ptr++;
if (*ptr=='>')
ptr++;
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
*inner_start=ptr;
/* find the start of the closing tag (assume no nesting) */
while ((ptr=strchr(ptr,'<'))!=NULL) {
inner_end=ptr;
ptr++; /* skip '<' */
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (*ptr=='/') {
ptr++; /* skip / */
while (*ptr!='\0' && *ptr<=' ')
ptr++; /* skip white space */
if (strncmp(ptr,xmltag,xmltag_len)==0 && (*(ptr+xmltag_len)<=' ' || *(ptr+xmltag_len)=='>')) {
/* find the end of the closing tag */
while (*ptr!='\0' && *ptr!='>')
ptr++;
if (*ptr=='>')
ptr++;
/* set the lengths of the inner and outer segment */
assert(*inner_start!=NULL);
*inner_length=(int)(inner_end-*inner_start);
assert(*outer_start!=NULL);
*outer_length=(int)(ptr-*outer_start);
break; /* break out of the loop */
} /* if */
} /* if */
} /* while */
return TRUE;
} /* if */
} /* while */
return FALSE; /* not found */
}
static char *xmlencode(char *dest,char *source)
{
char temp[2*sNAMEMAX+20],*ptr;
/* replace < by < and such; normally, such a symbol occurs at most once in
* a symbol name (e.g. "operator<")
*/
ptr=temp;
while (*source!='\0') {
switch (*source) {
case '<':
strcpy(ptr,"<");
ptr+=4;
break;
case '>':
strcpy(ptr,">");
ptr+=4;
break;
case '&':
strcpy(ptr,"&");
ptr+=5;
break;
default:
*ptr++=*source;
} /* switch */
source++;
} /* while */
*ptr='\0';
strcpy(dest,temp);
return dest;
}
static void make_report(symbol *root,FILE *log,char *sourcefile)
{
char symname[_MAX_PATH];
int i,arg;
symbol *sym,*ref;
constvalue *tagsym;
constvalue *enumroot;
char *ptr;
/* adapt the installation directory */
strcpy(symname,sc_rootpath);
#if DIRSEP_CHAR=='\\'
while ((ptr=strchr(symname,':'))!=NULL)
*ptr='|';
while ((ptr=strchr(symname,DIRSEP_CHAR))!=NULL)
*ptr='/';
#endif
/* the XML header */
fprintf(log,"<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n");
fprintf(log,"<?xml-stylesheet href=\"file:///%s/xml/pawndoc.xsl\" type=\"text/xsl\"?>\n",symname);
fprintf(log,"<doc source=\"%s\">\n",sourcefile);
ptr=strrchr(sourcefile,DIRSEP_CHAR);
if (ptr!=NULL)
ptr++;
else
ptr=sourcefile;
fprintf(log,"\t<assembly>\n\t\t<name>%s</name>\n\t</assembly>\n",ptr);
/* attach the global documentation, if any */
if (sc_documentation!=NULL) {
fprintf(log,"\n\t<!-- general -->\n");
fprintf(log,"\t<general>\n\t\t");
fputs(sc_documentation,log);
fprintf(log,"\n\t</general>\n\n");
} /* if */
/* use multiple passes to print constants variables and functions in
* separate sections
*/
fprintf(log,"\t<members>\n");
fprintf(log,"\n\t\t<!-- enumerations -->\n");
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->parent!=NULL)
continue; /* hierarchical data type */
assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
|| sym->ident==iARRAY || sym->ident==iFUNCTN);
if (sym->ident!=iCONSTEXPR || (sym->usage & uENUMROOT)==0)
continue;
if ((sym->usage & uREAD)==0)
continue;
fprintf(log,"\t\t<member name=\"T:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
if (sym->tag!=0) {
tagsym=find_tag_byval(sym->tag);
assert(tagsym!=NULL);
fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
} /* if */
/* browse through all fields */
if ((enumroot=sym->dim.enumlist)!=NULL) {
enumroot=enumroot->next; /* skip root */
while (enumroot!=NULL) {
fprintf(log,"\t\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,enumroot->name),enumroot->value);
/* find the constant with this name and get the tag */
ref=findglb(enumroot->name,sGLOBAL);
if (ref!=NULL) {
if (ref->x.tags.index!=0) {
tagsym=find_tag_byval(ref->x.tags.index);
assert(tagsym!=NULL);
fprintf(log,"\t\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
} /* if */
if (ref->dim.array.length!=1)
fprintf(log,"\t\t\t\t<size value=\"%ld\"/>\n",(long)ref->dim.array.length);
} /* if */
fprintf(log,"\t\t\t</member>\n");
enumroot=enumroot->next;
} /* while */
} /* if */
assert(sym->refer!=NULL);
for (i=0; i<sym->numrefers; i++) {
if ((ref=sym->refer[i])!=NULL)
fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
} /* for */
if (sym->documentation!=NULL)
fprintf(log,"\t\t\t%s\n",sym->documentation);
fprintf(log,"\t\t</member>\n");
} /* for */
fprintf(log,"\n\t\t<!-- constants -->\n");
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->parent!=NULL)
continue; /* hierarchical data type */
assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE
|| sym->ident==iARRAY || sym->ident==iFUNCTN);
if (sym->ident!=iCONSTEXPR)
continue;
if ((sym->usage & uREAD)==0 || (sym->usage & (uENUMFIELD | uENUMROOT))!=0)
continue;
fprintf(log,"\t\t<member name=\"C:%s\" value=\"%ld\">\n",funcdisplayname(symname,sym->name),sym->addr);
if (sym->tag!=0) {
tagsym=find_tag_byval(sym->tag);
assert(tagsym!=NULL);
fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
} /* if */
assert(sym->refer!=NULL);
for (i=0; i<sym->numrefers; i++) {
if ((ref=sym->refer[i])!=NULL)
fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
} /* for */
if (sym->documentation!=NULL)
fprintf(log,"\t\t\t%s\n",sym->documentation);
fprintf(log,"\t\t</member>\n");
} /* for */
fprintf(log,"\n\t\t<!-- variables -->\n");
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->parent!=NULL)
continue; /* hierarchical data type */
if (sym->ident!=iVARIABLE && sym->ident!=iARRAY)
continue;
fprintf(log,"\t\t<member name=\"F:%s\">\n",funcdisplayname(symname,sym->name));
if (sym->tag!=0) {
tagsym=find_tag_byval(sym->tag);
assert(tagsym!=NULL);
fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
} /* if */
assert(sym->refer!=NULL);
if ((sym->usage & uPUBLIC)!=0)
fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
for (i=0; i<sym->numrefers; i++) {
if ((ref=sym->refer[i])!=NULL)
fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
} /* for */
if (sym->documentation!=NULL)
fprintf(log,"\t\t\t%s\n",sym->documentation);
fprintf(log,"\t\t</member>\n");
} /* for */
fprintf(log,"\n\t\t<!-- functions -->\n");
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->parent!=NULL)
continue; /* hierarchical data type */
if (sym->ident!=iFUNCTN)
continue;
if ((sym->usage & (uREAD | uNATIVE))==uNATIVE)
continue; /* unused native function */
funcdisplayname(symname,sym->name);
xmlencode(symname,symname);
fprintf(log,"\t\t<member name=\"M:%s\" syntax=\"%s(",symname,symname);
/* print only the names of the parameters between the parentheses */
assert(sym->dim.arglist!=NULL);
for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
int dim;
if (arg>0)
fprintf(log,", ");
switch (sym->dim.arglist[arg].ident) {
case iVARIABLE:
fprintf(log,"%s",sym->dim.arglist[arg].name);
break;
case iREFERENCE:
fprintf(log,"&%s",sym->dim.arglist[arg].name);
break;
case iREFARRAY:
fprintf(log,"%s",sym->dim.arglist[arg].name);
for (dim=0; dim<sym->dim.arglist[arg].numdim;dim++)
fprintf(log,"[]");
break;
case iVARARGS:
fprintf(log,"...");
break;
} /* switch */
} /* for */
/* ??? should also print an "array return" size */
fprintf(log,")\">\n");
if (sym->tag!=0) {
tagsym=find_tag_byval(sym->tag);
assert(tagsym!=NULL);
fprintf(log,"\t\t\t<tagname value=\"%s\"/>\n",tagsym->name);
} /* if */
/* check whether this function is called from the outside */
if ((sym->usage & uNATIVE)!=0)
fprintf(log,"\t\t\t<attribute name=\"native\"/>\n");
if ((sym->usage & uPUBLIC)!=0)
fprintf(log,"\t\t\t<attribute name=\"public\"/>\n");
if (strcmp(sym->name,uMAINFUNC)==0 || strcmp(sym->name,uENTRYFUNC)==0)
fprintf(log,"\t\t\t<attribute name=\"entry\"/>\n");
if ((sym->usage & uNATIVE)==0)
fprintf(log,"\t\t\t<stacksize value=\"%ld\"/>\n",(long)sym->x.stacksize);
if (sym->states!=NULL) {
constvalue *stlist=sym->states->next;
assert(stlist!=NULL); /* there should be at least one state item */
while (stlist!=NULL && stlist->index==-1)
stlist=stlist->next;
assert(stlist!=NULL); /* state id should be found */
i=state_getfsa(stlist->index);
assert(i>=0); /* automaton 0 exists */
stlist=automaton_findid(i);
assert(stlist!=NULL); /* automaton should be found */
fprintf(log,"\t\t\t<automaton name=\"%s\"/>\n", strlen(stlist->name)>0 ? stlist->name : "(anonymous)");
//??? dump state decision table
} /* if */
assert(sym->refer!=NULL);
for (i=0; i<sym->numrefers; i++)
if ((ref=sym->refer[i])!=NULL)
fprintf(log,"\t\t\t<referrer name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
/* print all symbols that are required for this function to compile */
for (ref=root->next; ref!=NULL; ref=ref->next) {
if (ref==sym)
continue;
for (i=0; i<ref->numrefers; i++)
if (ref->refer[i]==sym)
fprintf(log,"\t\t\t<dependency name=\"%s\"/>\n",xmlencode(symname,funcdisplayname(symname,ref->name)));
} /* for */
/* print parameter list, with tag & const information, plus descriptions */
assert(sym->dim.arglist!=NULL);
for (arg=0; sym->dim.arglist[arg].ident!=0; arg++) {
int dim,paraminfo;
char *outer_start,*inner_start;
int outer_length,inner_length;
if (sym->dim.arglist[arg].ident==iVARARGS)
fprintf(log,"\t\t\t<param name=\"...\">\n");
else
fprintf(log,"\t\t\t<param name=\"%s\">\n",sym->dim.arglist[arg].name);
/* print the tag name(s) for each parameter */
assert(sym->dim.arglist[arg].numtags>0);
assert(sym->dim.arglist[arg].tags!=NULL);
paraminfo=(sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0)
|| sym->dim.arglist[arg].ident==iREFERENCE
|| sym->dim.arglist[arg].ident==iREFARRAY;
if (paraminfo)
fprintf(log,"\t\t\t\t<paraminfo>");
if (sym->dim.arglist[arg].numtags>1 || sym->dim.arglist[arg].tags[0]!=0) {
assert(paraminfo);
if (sym->dim.arglist[arg].numtags>1)
fprintf(log," {");
for (i=0; i<sym->dim.arglist[arg].numtags; i++) {
if (i>0)
fprintf(log,",");
tagsym=find_tag_byval(sym->dim.arglist[arg].tags[i]);
assert(tagsym!=NULL);
fprintf(log,"%s",tagsym->name);
} /* for */
if (sym->dim.arglist[arg].numtags>1)
fprintf(log,"}");
} /* if */
switch (sym->dim.arglist[arg].ident) {
case iREFERENCE:
fprintf(log," &");
break;
case iREFARRAY:
fprintf(log," ");
for (dim=0; dim<sym->dim.arglist[arg].numdim; dim++) {
if (sym->dim.arglist[arg].dim[dim]==0) {
fprintf(log,"[]");
} else {
//??? find index tag
fprintf(log,"[%d]",sym->dim.arglist[arg].dim[dim]);
} /* if */
} /* for */
break;
} /* switch */
if (paraminfo)
fprintf(log," </paraminfo>\n");
/* print the user description of the parameter (parse through
* sym->documentation)
*/
if (sym->documentation!=NULL
&& find_xmltag(sym->documentation, "param", "name", sym->dim.arglist[arg].name,
&outer_start, &outer_length, &inner_start, &inner_length))
{
char *tail;
fprintf(log,"\t\t\t\t%.*s\n",inner_length,inner_start);
/* delete from documentation string */
tail=outer_start+outer_length;
memmove(outer_start,tail,strlen(tail)+1);
} /* if */
fprintf(log,"\t\t\t</param>\n");
} /* for */
if (sym->documentation!=NULL)
fprintf(log,"\t\t\t%s\n",sym->documentation);
fprintf(log,"\t\t</member>\n");
} /* for */
fprintf(log,"\n\t</members>\n");
fprintf(log,"</doc>\n");
}
#endif
/* Every symbol has a referrer list, that contains the functions that use
* the symbol. Now, if function "apple" is accessed by functions "banana" and
* "citron", but neither function "banana" nor "citron" are used by anyone
* else, then, by inference, function "apple" is not used either.
*/
static void reduce_referrers(symbol *root)
{
int i,restart;
symbol *sym,*ref;
do {
restart=0;
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->parent!=NULL)
continue; /* hierarchical data type */
if (sym->ident==iFUNCTN
&& (sym->usage & uNATIVE)==0
&& (sym->usage & uPUBLIC)==0 && strcmp(sym->name,uMAINFUNC)!=0 && strcmp(sym->name,uENTRYFUNC)!=0
&& count_referrers(sym)==0)
{
sym->usage&=~(uREAD | uWRITTEN); /* erase usage bits if there is no referrer */
/* find all symbols that are referred by this symbol */
for (ref=root->next; ref!=NULL; ref=ref->next) {
if (ref->parent!=NULL)
continue; /* hierarchical data type */
assert(ref->refer!=NULL);
for (i=0; i<ref->numrefers && ref->refer[i]!=sym; i++)
/* nothing */;
if (i<ref->numrefers) {
assert(ref->refer[i]==sym);
ref->refer[i]=NULL;
restart++;
} /* if */
} /* for */
} else if ((sym->ident==iVARIABLE || sym->ident==iARRAY)
&& (sym->usage & uPUBLIC)==0
&& sym->parent==NULL
&& count_referrers(sym)==0)
{
sym->usage&=~(uREAD | uWRITTEN); /* erase usage bits if there is no referrer */
} /* if */
} /* for */
/* after removing a symbol, check whether more can be removed */
} while (restart>0);
}
#if !defined SC_LIGHT
static long max_stacksize_recurse(symbol *sourcesym,symbol *sym,long basesize,int *pubfuncparams,int *recursion)
{
long size,maxsize;
int i;
assert(sym!=NULL);
assert(sym->ident==iFUNCTN);
assert((sym->usage & uNATIVE)==0);
assert(recursion!=NULL);
maxsize=sym->x.stacksize;
for (i=0; i<sym->numrefers; i++) {
if (sym->refer[i]!=NULL) {
assert(sym->refer[i]->ident==iFUNCTN);
assert((sym->refer[i]->usage & uNATIVE)==0); /* a native function cannot refer to a user-function */
if (sym->refer[i]==sourcesym) { /* recursion detection */
*recursion=1;
break; /* recursion was detected, quit loop */
} /* if */
size=max_stacksize_recurse(sourcesym,sym->refer[i],sym->x.stacksize,pubfuncparams,recursion);
if (maxsize<size)
maxsize=size;
} /* if */
} /* for */
if ((sym->usage & uPUBLIC)!=0) {
/* Find out how many parameters a public function has, then see if this
* is bigger than some maximum
*/
arginfo *arg=sym->dim.arglist;
int count=0;
assert(arg!=0);
while (arg->ident!=0) {
count++;
arg++;
} /* while */
assert(pubfuncparams!=0);
if (count>*pubfuncparams)
*pubfuncparams=count;
} /* if */
return maxsize+basesize;
}
static symbol *save_symbol;
static long max_stacksize(symbol *root,int *recursion)
{
/* Loop over all non-native functions. For each function, loop
* over all of its referrers, accumulating the stack requirements.
* Detect (indirect) recursion with a "mark-and-sweep" algorithm.
* I (mis-)use the "compound" field of the symbol structure for
* the marker, as this field is unused for functions.
*
* Note that the stack is shared with the heap. A host application
* may "eat" cells from the heap as well, through amx_Allot(). The
* stack requirements are thus only an estimate.
*/
long size,maxsize;
int maxparams;
symbol *sym;
assert(root!=NULL);
assert(recursion!=NULL);
#if !defined NDEBUG
for (sym=root->next; sym!=NULL; sym=sym->next)
if (sym->ident==iFUNCTN)
assert(sym->compound==0);
#endif
maxsize=0;
maxparams=0;
*recursion=0; /* assume no recursion */
for (sym=root->next; sym!=NULL; sym=sym->next) {
/* drop out if this is not a user-implemented function */
if (sym->ident!=iFUNCTN || (sym->usage & uNATIVE)!=0)
continue;
/* accumulate stack size for this symbol */
save_symbol = sym;
size=max_stacksize_recurse(sym,sym,0L,&maxparams,recursion);
assert(size>=0);
if (maxsize<size)
maxsize=size;
} /* for */
maxsize++; /* +1 because a zero cell is always pushed on top
* of the stack to catch stack overwrites */
return maxsize+(maxparams+1);/* +1 because # of parameters is always pushed on entry */
}
#endif
/* testsymbols - test for unused local or global variables
*
* "Public" functions are excluded from the check, since these
* may be exported to other object modules.
* Labels are excluded from the check if the argument 'testlabs'
* is 0. Thus, labels are not tested until the end of the function.
* Constants may also be excluded (convenient for global constants).
*
* When the nesting level drops below "level", the check stops.
*
* The function returns whether there is an "entry" point for the file.
* This flag will only be 1 when browsing the global symbol table.
*/
static int testsymbols(symbol *root,int level,int testlabs,int testconst)
{
char symname[2*sNAMEMAX+16];
int entry=FALSE;
symbol *sym=root->next;
while (sym!=NULL && sym->compound>=level) {
switch (sym->ident) {
case iLABEL:
if (testlabs) {
if ((sym->usage & uDEFINE)==0) {
error(19,sym->name); /* not a label: ... */
} else if ((sym->usage & uREAD)==0) {
errorset(sSETPOS,sym->lnumber);
error(203,sym->name); /* symbol isn't used: ... */
} /* if */
} /* if */
break;
case iFUNCTN:
if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK | uPUBLIC))==uDEFINE) {
funcdisplayname(symname,sym->name);
if (strlen(symname)>0)
error(203,symname); /* symbol isn't used ... (and not public/native/stock) */
} /* if */
if ((sym->usage & uPUBLIC)!=0 || strcmp(sym->name,uMAINFUNC)==0)
entry=TRUE; /* there is an entry point */
/* also mark the function to the debug information */
if (((sym->usage & uREAD)!=0 || (sym->usage & uPUBLIC)!=0) && (sym->usage & uNATIVE)==0)
insert_dbgsymbol(sym);
break;
case iCONSTEXPR:
if (testconst && (sym->usage & uREAD)==0) {
errorset(sSETPOS,sym->lnumber);
error(203,sym->name); /* symbol isn't used: ... */
} /* if */
break;
default:
/* a variable */
if (sym->parent!=NULL)
break; /* hierarchical data type */
if ((sym->usage & (uWRITTEN | uREAD | uSTOCK))==0) {
errorset(sSETPOS,sym->lnumber);
error(203,sym->name); /* symbol isn't used (and not stock) */
} else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC))==0) {
errorset(sSETPOS,sym->lnumber);
error(204,sym->name); /* value assigned to symbol is never used */
#if 0 // ??? not sure whether it is a good idea to force people use "const"
} else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST))==0 && sym->ident==iREFARRAY) {
errorset(sSETPOS,sym->lnumber);
error(214,sym->name); /* make array argument "const" */
#endif
} /* if */
/* also mark the variable (local or global) to the debug information */
if ((sym->usage & (uWRITTEN | uREAD))!=0 && (sym->usage & uNATIVE)==0)
insert_dbgsymbol(sym);
} /* if */
sym=sym->next;
} /* while */
return entry;
}
static cell calc_array_datasize(symbol *sym, cell *offset)
{
cell length;
assert(sym!=NULL);
assert(sym->ident==iARRAY || sym->ident==iREFARRAY);
length=sym->dim.array.length;
if (sym->dim.array.level > 0) {
cell sublength=calc_array_datasize(finddepend(sym),offset);
if (offset!=NULL)
*offset=length*(*offset+sizeof(cell));
if (sublength>0)
length*=length*sublength;
else
length=0;
} else {
if (offset!=NULL)
*offset=0;
} /* if */
return length;
}
static void destructsymbols(symbol *root,int level)
{
cell offset=0;
int savepri=FALSE;
symbol *sym=root->next;
while (sym!=NULL && sym->compound>=level) {
if (sym->ident==iVARIABLE || sym->ident==iARRAY) {
char symbolname[16];
symbol *opsym;
cell elements;
/* check that the '~' operator is defined for this tag */
operator_symname(symbolname,"~",sym->tag,0,1,0);
if ((opsym=findglb(symbolname,sGLOBAL))!=NULL) {
/* save PRI, in case of a return statment */
if (!savepri) {
pushreg(sPRI); /* right-hand operand is in PRI */
savepri=TRUE;
} /* if */
/* if the variable is an array, get the number of elements */
if (sym->ident==iARRAY) {
elements=calc_array_datasize(sym,&offset);
/* "elements" can be zero when the variable is declared like
* new mytag: myvar[2][] = { {1, 2}, {3, 4} }
* one should declare all dimensions!
*/
if (elements==0)
error(46,sym->name); /* array size is unknown */
} else {
elements=1;
offset=0;
} /* if */
pushval(elements);
/* call the '~' operator */
address(sym,sPRI);
addconst(offset); /* add offset to array data to the address */
pushreg(sPRI);
pushval(2 /* *sizeof(cell)*/ );/* 2 parameters */
assert(opsym->ident==iFUNCTN);
ffcall(opsym,NULL,1);
if (sc_status!=statSKIP)
markusage(opsym,uREAD); /* do not mark as "used" when this call itself is skipped */
if ((opsym->usage & uNATIVE)!=0 && opsym->x.lib!=NULL)
opsym->x.lib->value += 1; /* increment "usage count" of the library */
} /* if */
} /* if */
sym=sym->next;
} /* while */
/* restore PRI, if it was saved */
if (savepri)
popreg(sPRI);
}
static constvalue *insert_constval(constvalue *prev,constvalue *next,const char *name,cell val,
int index)
{
constvalue *cur;
if ((cur=(constvalue*)malloc(sizeof(constvalue)))==NULL)
error(123); /* insufficient memory (fatal error) */
memset(cur,0,sizeof(constvalue));
if (name!=NULL) {
assert(strlen(name)<=sNAMEMAX);
strcpy(cur->name,name);
} /* if */
cur->value=val;
cur->index=index;
cur->next=next;
prev->next=cur;
return cur;
}
SC_FUNC constvalue *append_constval(constvalue *table,const char *name,cell val,int index)
{
constvalue *cur,*prev;
/* find the end of the constant table */
for (prev=table, cur=table->next; cur!=NULL; prev=cur, cur=cur->next)
/* nothing */;
return insert_constval(prev,NULL,name,val,index);
}
SC_FUNC constvalue *find_constval(constvalue *table,char *name,int index)
{
constvalue *ptr = table->next;
while (ptr!=NULL) {
if (strcmp(name,ptr->name)==0 && ptr->index==index)
return ptr;
ptr=ptr->next;
} /* while */
return NULL;
}
static constvalue *find_constval_byval(constvalue *table,cell val)
{
constvalue *ptr = table->next;
while (ptr!=NULL) {
if (ptr->value==val)
return ptr;
ptr=ptr->next;
} /* while */
return NULL;
}
#if 0 /* never used */
static int delete_constval(constvalue *table,char *name)
{
constvalue *prev = table;
constvalue *cur = prev->next;
while (cur!=NULL) {
if (strcmp(name,cur->name)==0) {
prev->next=cur->next;
free(cur);
return TRUE;
} /* if */
prev=cur;
cur=cur->next;
} /* while */
return FALSE;
}
#endif
SC_FUNC void delete_consttable(constvalue *table)
{
constvalue *cur=table->next, *next;
while (cur!=NULL) {
next=cur->next;
free(cur);
cur=next;
} /* while */
memset(table,0,sizeof(constvalue));
}
/* add_constant
*
* Adds a symbol to the symbol table. Returns NULL on failure.
*/
SC_FUNC symbol *add_constant(char *name,cell val,int vclass,int tag)
{
symbol *sym;
/* Test whether a global or local symbol with the same name exists. Since
* constants are stored in the symbols table, this also finds previously
* defind constants. */
sym=findglb(name,sSTATEVAR);
if (!sym)
sym=findloc(name);
if (sym) {
int redef=0;
if (sym->ident!=iCONSTEXPR)
redef=1; /* redefinition a function/variable to a constant is not allowed */
if ((sym->usage & uENUMFIELD)!=0) {
/* enum field, special case if it has a different tag and the new symbol is also an enum field */
constvalue *tagid;
symbol *tagsym;
if (sym->tag==tag)
redef=1; /* enumeration field is redefined (same tag) */
tagid=find_tag_byval(tag);
if (tagid==NULL) {
redef=1; /* new constant does not have a tag */
} else {
tagsym=findconst(tagid->name,NULL);
if (tagsym==NULL || (tagsym->usage & uENUMROOT)==0)
redef=1; /* new constant is not an enumeration field */
} /* if */
/* in this particular case (enumeration field that is part of a different
* enum, and non-conflicting with plain constants) we want to be able to
* redefine it
*/
if (!redef)
goto redef_enumfield;
} else if (sym->tag!=tag) {
redef=1; /* redefinition of a constant (non-enum) to a different tag is not allowed */
} /* if */
if (redef) {
error(21,name); /* symbol already defined */
return NULL;
} else if (sym->addr!=val) {
error(201,name); /* redefinition of constant (different value) */
sym->addr=val; /* set new value */
} /* if */
/* silently ignore redefinitions of constants with the same value & tag */
return sym;
} /* if */
/* constant doesn't exist yet (or is allowed to be redefined) */
redef_enumfield:
sym=addsym(name,val,iCONSTEXPR,vclass,tag,uDEFINE);
assert(sym!=NULL); /* fatal error 103 must be given on error */
if (sc_status == statIDLE)
sym->usage |= uPREDEF;
return sym;
}
/* statement - The Statement Parser
*
* This routine is called whenever the parser needs to know what statement
* it encounters (i.e. whenever program syntax requires a statement).
*/
static void statement(int *lastindent,int allow_decl)
{
int tok,save;
cell val;
char *st;
if (!freading) {
error(36); /* empty statement */
return;
} /* if */
errorset(sRESET,0);
tok=lex(&val,&st);
if (tok!='{') {
insert_dbgline(fline);
setline(TRUE);
} /* if */
/* lex() has set stmtindent */
if (lastindent!=NULL && tok!=tLABEL) {
if (*lastindent>=0 && *lastindent!=stmtindent && !indent_nowarn && sc_tabsize>0)
error(217); /* loose indentation */
*lastindent=stmtindent;
indent_nowarn=FALSE; /* if warning was blocked, re-enable it */
} /* if */
switch (tok) {
case 0:
/* nothing */
break;
case tNEW:
if (allow_decl) {
autozero=1;
declloc(FALSE);
lastst=tNEW;
} else {
error(3); /* declaration only valid in a block */
} /* if */
break;
case tDECL:
if (allow_decl) {
autozero=0;
declloc(FALSE);
lastst=tDECL;
} else {
error(3); /* declaration only valid in a block */
} /* if */
break;
case tSTATIC:
if (allow_decl) {
declloc(TRUE);
lastst=tNEW;
} else {
error(3); /* declaration only valid in a block */
} /* if */
break;
case '{':
case tBEGIN:
save=fline;
if (!matchtoken('}')) /* {} is the empty statement */
compound(save==fline,tok);
/* lastst (for "last statement") does not change */
break;
case ';':
error(36); /* empty statement */
break;
case tIF:
lastst=doif();
break;
case tWHILE:
lastst=dowhile();
break;
case tDO:
lastst=dodo();
break;
case tFOR:
lastst=dofor();
break;
case tSWITCH:
doswitch();
lastst=tSWITCH;
break;
case tCASE:
case tDEFAULT:
error(14); /* not in switch */
break;
case tGOTO:
dogoto();
lastst=tGOTO;
break;
case tLABEL:
dolabel();
lastst=tLABEL;
break;
case tRETURN:
doreturn();
lastst=tRETURN;
break;
case tBREAK:
dobreak();
lastst=tBREAK;
break;
case tCONTINUE:
docont();
lastst=tCONTINUE;
break;
case tEXIT:
doexit();
lastst=tEXIT;
break;
case tASSERT:
doassert();
lastst=tASSERT;
break;
case tSLEEP:
dosleep();
lastst=tSLEEP;
break;
case tSTATE:
dostate();
lastst=tSTATE;
break;
case tCONST:
decl_const(sLOCAL);
break;
case tENUM:
decl_enum(sLOCAL);
break;
default: /* non-empty expression */
sc_allowproccall=optproccall;
lexpush(); /* analyze token later */
doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE);
needtoken(tTERM);
lastst=tEXPR;
sc_allowproccall=FALSE;
} /* switch */
}
static void compound(int stmt_sameline,int starttok)
{
int indent=-1;
cell save_decl=declared;
int count_stmt=0;
int block_start=fline; /* save line where the compound block started */
int endtok;
pushstacklist();
pushheaplist();
/* if there is more text on this line, we should adjust the statement indent */
if (stmt_sameline) {
int i;
const unsigned char *p=lptr;
/* go back to the opening brace */
while (*p!=starttok) {
assert(p>pline);
p--;
} /* while */
assert(*p==starttok); /* it should be found */
/* go forward, skipping white-space */
p++;
while (*p<=' ' && *p!='\0')
p++;
assert(*p!='\0'); /* a token should be found */
stmtindent=0;
for (i=0; i<(int)(p-pline); i++)
if (pline[i]=='\t' && sc_tabsize>0)
stmtindent += (int)(sc_tabsize - (stmtindent+sc_tabsize) % sc_tabsize);
else
stmtindent++;
} /* if */
endtok=(starttok=='{') ? '}' : tEND;
nestlevel+=1; /* increase compound statement level */
while (matchtoken(endtok)==0){/* repeat until compound statement is closed */
if (!freading){
error(30,block_start); /* compound block not closed at end of file */
break;
} else {
if (count_stmt>0 && (lastst==tRETURN || lastst==tBREAK || lastst==tCONTINUE || lastst==tENDLESS))
error(225); /* unreachable code */
statement(&indent,TRUE); /* do a statement */
count_stmt++;
} /* if */
} /* while */
if (lastst!=tRETURN)
destructsymbols(&loctab,nestlevel);
if (lastst!=tRETURN && lastst!=tGOTO) {
popheaplist();
popstacklist(1);
} else {
popheaplist();
popstacklist(0);
}
testsymbols(&loctab,nestlevel,FALSE,TRUE); /* look for unused block locals */
declared=save_decl;
delete_symbols(&loctab,nestlevel,FALSE,TRUE); /* erase local symbols, but
* retain block local labels
* (within the function) */
nestlevel-=1; /* decrease compound statement level */
}
/* doexpr
*
* Global references: stgidx (referred to only)
*/
static int doexpr(int comma,int chkeffect,int allowarray,int mark_endexpr,
int *tag,symbol **symptr,int chkfuncresult)
{
return doexpr2(comma,chkeffect,allowarray,mark_endexpr,tag,symptr,chkfuncresult,NULL);
}
/* doexpr2
*
* Global references: stgidx (referred to only)
*/
static int doexpr2(int comma,int chkeffect,int allowarray,int mark_endexpr,
int *tag,symbol **symptr,int chkfuncresult,value *lval)
{
int index,ident;
int localstaging=FALSE;
cell val;
if (!staging) {
stgset(TRUE); /* start stage-buffering */
localstaging=TRUE;
assert(stgidx==0);
} /* if */
index=stgidx;
errorset(sEXPRMARK,0);
do {
/* on second round through, mark the end of the previous expression */
if (index!=stgidx)
markexpr(sEXPR,NULL,0);
sideeffect=FALSE;
ident=expression(&val,tag,symptr,chkfuncresult,lval);
if (!allowarray && (ident==iARRAY || ident==iREFARRAY))
error(33,"-unknown-"); /* array must be indexed */
if (chkeffect && !sideeffect)
error(215); /* expression has no effect */
sc_allowproccall=FALSE; /* cannot use "procedure call" syntax anymore */
} while (comma && matchtoken(',')); /* more? */
if (mark_endexpr)
markexpr(sEXPR,NULL,0); /* optionally, mark the end of the expression */
errorset(sEXPRRELEASE,0);
if (localstaging) {
stgout(index);
stgset(FALSE); /* stop staging */
} /* if */
return ident;
}
/* constexpr
*/
SC_FUNC int constexpr(cell *val,int *tag,symbol **symptr)
{
int ident,index;
cell cidx;
stgset(TRUE); /* start stage-buffering */
stgget(&index,&cidx); /* mark position in code generator */
errorset(sEXPRMARK,0);
ident=expression(val,tag,symptr,FALSE,NULL);
stgdel(index,cidx); /* scratch generated code */
stgset(FALSE); /* stop stage-buffering */
if (ident!=iCONSTEXPR) {
error(8); /* must be constant expression */
if (val!=NULL)
*val=0;
if (tag!=NULL)
*tag=0;
if (symptr!=NULL)
*symptr=NULL;
} /* if */
errorset(sEXPRRELEASE,0);
return (ident==iCONSTEXPR);
}
/* test
*
* In the case a "simple assignment" operator ("=") is used within a test,
* the warning "possibly unintended assignment" is displayed. This routine
* sets the global variable "sc_intest" to true, it is restored upon termination.
* In the case the assignment was intended, use parentheses around the
* expression to avoid the warning; primary() sets "sc_intest" to 0.
*
* Global references: sc_intest (altered, but restored upon termination)
*/
static int test(int label,int parens,int invert)
{
int index,tok;
cell cidx;
int ident,tag;
int endtok;
cell constval;
symbol *sym;
int localstaging=FALSE;
if (!staging) {
stgset(TRUE); /* start staging */
localstaging=TRUE;
#if !defined NDEBUG
stgget(&index,&cidx); /* should start at zero if started locally */
assert(index==0);
#endif
} /* if */
PUSHSTK_I(sc_intest);
sc_intest=TRUE;
endtok=0;
if (parens!=TEST_PLAIN) {
if (matchtoken('('))
endtok=')';
else if (parens==TEST_THEN)
endtok=tTHEN;
else if (parens==TEST_DO)
endtok=tDO;
} /* if */
do {
stgget(&index,&cidx); /* mark position (of last expression) in
* code generator */
ident=expression(&constval,&tag,&sym,TRUE,NULL);
tok=matchtoken(',');
if (tok)
markexpr(sEXPR,NULL,0);
} while (tok); /* do */
if (endtok!=0)
needtoken(endtok);
if (ident==iARRAY || ident==iREFARRAY) {
char *ptr=(sym->name!=NULL) ? sym->name : "-unknown-";
error(33,ptr); /* array must be indexed */
} /* if */
if (ident==iCONSTEXPR) { /* constant expression */
int testtype=0;
sc_intest=(short)POPSTK_I();/* restore stack */
stgdel(index,cidx);
if (constval) { /* code always executed */
error(206); /* redundant test: always non-zero */
testtype=tENDLESS;
} else {
error(205); /* redundant code: never executed */
jumplabel(label);
} /* if */
if (localstaging) {
stgout(0); /* write "jumplabel" code */
stgset(FALSE); /* stop staging */
} /* if */
return testtype;
} /* if */
if (tag!=0 && tag!=pc_addtag("bool"))
if (check_userop(lneg,tag,0,1,NULL,&tag))
invert= !invert; /* user-defined ! operator inverted result */
if (invert)
jmp_ne0(label); /* jump to label if true (different from 0) */
else
jmp_eq0(label); /* jump to label if false (equal to 0) */
markexpr(sEXPR,NULL,0); /* end expression (give optimizer a chance) */
sc_intest=(short)POPSTK_I(); /* double typecast to avoid warning with Microsoft C */
if (localstaging) {
stgout(0); /* output queue from the very beginning (see
* assert() when localstaging is set to TRUE) */
stgset(FALSE); /* stop staging */
} /* if */
return 0;
}
static int doif(void)
{
int flab1,flab2;
int ifindent;
int lastst_true;
ifindent=stmtindent; /* save the indent of the "if" instruction */
flab1=getlabel(); /* get label number for false branch */
test(flab1,TEST_THEN,FALSE); /* get expression, branch to flab1 if false */
statement(NULL,FALSE); /* if true, do a statement */
if (!matchtoken(tELSE)) { /* if...else ? */
setlabel(flab1); /* no, simple if..., print false label */
} else {
lastst_true=lastst; /* save last statement of the "true" branch */
/* to avoid the "dangling else" error, we want a warning if the "else"
* has a lower indent than the matching "if" */
if (stmtindent<ifindent && sc_tabsize>0)
error(217); /* loose indentation */
flab2=getlabel();
if ((lastst!=tRETURN) && (lastst!=tGOTO))
jumplabel(flab2); /* "true" branch jumps around "else" clause, unless the "true" branch statement already jumped */
setlabel(flab1); /* print false label */
statement(NULL,FALSE); /* do "else" clause */
setlabel(flab2); /* print true label */
/* if both the "true" branch and the "false" branch ended with the same
* kind of statement, set the last statement id to that kind, rather than
* to the generic tIF; this allows for better "unreachable code" checking
*/
if (lastst==lastst_true)
return lastst;
} /* if */
return tIF;
}
static int dowhile(void)
{
int wq[wqSIZE]; /* allocate local queue */
int save_endlessloop,retcode;
save_endlessloop=endlessloop;
addwhile(wq); /* add entry to queue for "break" */
setlabel(wq[wqLOOP]); /* loop label */
/* The debugger uses the "break" opcode to be able to "break" out of
* a loop. To make sure that each loop has a break opcode, even for the
* tiniest loop, set it below the top of the loop
*/
setline(TRUE);
endlessloop=test(wq[wqEXIT],TEST_DO,FALSE);/* branch to wq[wqEXIT] if false */
statement(NULL,FALSE); /* if so, do a statement */
jumplabel(wq[wqLOOP]); /* and loop to "while" start */
setlabel(wq[wqEXIT]); /* exit label */
delwhile(); /* delete queue entry */
retcode=endlessloop ? tENDLESS : tWHILE;
endlessloop=save_endlessloop;
return retcode;
}
/*
* Note that "continue" will in this case not jump to the top of the loop, but
* to the end: just before the TRUE-or-FALSE testing code.
*/
static int dodo(void)
{
int wq[wqSIZE],top;
int save_endlessloop,retcode;
save_endlessloop=endlessloop;
addwhile(wq); /* see "dowhile" for more info */
top=getlabel(); /* make a label first */
setlabel(top); /* loop label */
statement(NULL,FALSE);
needtoken(tWHILE);
setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
setline(TRUE);
endlessloop=test(wq[wqEXIT],TEST_OPT,FALSE);
jumplabel(top);
setlabel(wq[wqEXIT]);
delwhile();
needtoken(tTERM);
retcode=endlessloop ? tENDLESS : tDO;
endlessloop=save_endlessloop;
return retcode;
}
static int dofor(void)
{
int wq[wqSIZE],skiplab;
cell save_decl;
int save_nestlevel,save_endlessloop;
int index,endtok;
int *ptr;
save_decl=declared;
save_nestlevel=nestlevel;
save_endlessloop=endlessloop;
pushstacklist();
addwhile(wq);
skiplab=getlabel();
endtok= matchtoken('(') ? ')' : tDO;
if (matchtoken(';')==0) {
/* new variable declarations are allowed here */
if (matchtoken(tNEW)) {
/* The variable in expr1 of the for loop is at a
* 'compound statement' level of it own.
*/
nestlevel++;
autozero=1;
declloc(FALSE); /* declare local variable */
} else {
doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE); /* expression 1 */
needtoken(';');
} /* if */
} /* if */
/* Adjust the "declared" field in the "while queue", in case that
* local variables were declared in the first expression of the
* "for" loop. These are deleted in separately, so a "break" or a "continue"
* must ignore these fields.
*/
ptr=readwhile();
assert(ptr!=NULL);
/*ptr[wqBRK]=(int)declared;
*ptr[wqCONT]=(int)declared;
*/
ptr[wqBRK] = stackusage->list_id;
ptr[wqCONT] = stackusage->list_id;
jumplabel(skiplab); /* skip expression 3 1st time */
setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
setline(TRUE);
/* Expressions 2 and 3 are reversed in the generated code: expression 3
* precedes expression 2. When parsing, the code is buffered and marks for
* the start of each expression are insterted in the buffer.
*/
assert(!staging);
stgset(TRUE); /* start staging */
assert(stgidx==0);
index=stgidx;
stgmark(sSTARTREORDER);
stgmark((char)(sEXPRSTART+0)); /* mark start of 2nd expression in stage */
setlabel(skiplab); /* jump to this point after 1st expression */
if (matchtoken(';')) {
endlessloop=1;
} else {
endlessloop=test(wq[wqEXIT],TEST_PLAIN,FALSE);/* expression 2 (jump to wq[wqEXIT] if false) */
needtoken(';');
} /* if */
stgmark((char)(sEXPRSTART+1)); /* mark start of 3th expression in stage */
if (!matchtoken(endtok)) {
doexpr(TRUE,TRUE,TRUE,TRUE,NULL,NULL,FALSE); /* expression 3 */
needtoken(endtok);
} /* if */
stgmark(sENDREORDER); /* mark end of reversed evaluation */
stgout(index);
stgset(FALSE); /* stop staging */
statement(NULL,FALSE);
jumplabel(wq[wqLOOP]);
setlabel(wq[wqEXIT]);
delwhile();
assert(nestlevel>=save_nestlevel);
if (nestlevel>save_nestlevel) {
/* Clean up the space and the symbol table for the local
* variable in "expr1".
*/
destructsymbols(&loctab,nestlevel);
popstacklist(1);
testsymbols(&loctab,nestlevel,FALSE,TRUE); /* look for unused block locals */
declared=save_decl;
delete_symbols(&loctab,nestlevel,FALSE,TRUE);
nestlevel=save_nestlevel; /* reset 'compound statement' nesting level */
} else {
popstacklist(0);
} /* if */
index=endlessloop ? tENDLESS : tFOR;
endlessloop=save_endlessloop;
return index;
}
/* The switch statement is incompatible with its C sibling:
* 1. the cases are not drop through
* 2. only one instruction may appear below each case, use a compound
* instruction to execute multiple instructions
* 3. the "case" keyword accepts a comma separated list of values to
* match
*
* SWITCH param
* PRI = expression result
* param = table offset (code segment)
*
*/
static void doswitch(void)
{
int lbl_table,lbl_exit,lbl_case;
int swdefault,casecount;
int tok,endtok;
cell val;
char *str;
constvalue caselist = { NULL, "", 0, 0}; /* case list starts empty */
constvalue *cse,*csp;
char labelname[sNAMEMAX+1];
endtok= matchtoken('(') ? ')' : tDO;
doexpr(TRUE,FALSE,FALSE,FALSE,NULL,NULL,TRUE);/* evaluate switch expression */
needtoken(endtok);
/* generate the code for the switch statement, the label is the address
* of the case table (to be generated later).
*/
lbl_table=getlabel();
lbl_case=0; /* just to avoid a compiler warning */
ffswitch(lbl_table);
if (matchtoken(tBEGIN)) {
endtok=tEND;
} else {
endtok='}';
needtoken('{');
} /* if */
lbl_exit=getlabel(); /* get label number for jumping out of switch */
swdefault=FALSE;
casecount=0;
do {
tok=lex(&val,&str); /* read in (new) token */
switch (tok) {
case tCASE:
if (swdefault!=FALSE)
error(15); /* "default" case must be last in switch statement */
lbl_case=getlabel();
PUSHSTK_I(sc_allowtags);
sc_allowtags=FALSE; /* do not allow tagnames here */
do {
casecount++;
/* ??? enforce/document that, in a switch, a statement cannot start
* with a label. Then, you can search for:
* * the first semicolon (marks the end of a statement)
* * an opening brace (marks the start of a compound statement)
* and search for the right-most colon before that statement
* Now, by replacing the ':' by a special COLON token, you can
* parse all expressions until that special token.
*/
constexpr(&val,NULL,NULL);
/* Search the insertion point (the table is kept in sorted order, so
* that advanced abstract machines can sift the case table with a
* binary search). Check for duplicate case values at the same time.
*/
for (csp=&caselist, cse=caselist.next;
cse!=NULL && cse->value<val;
csp=cse, cse=cse->next)
/* nothing */;
if (cse!=NULL && cse->value==val)
error(40,val); /* duplicate "case" label */
/* Since the label is stored as a string in the "constvalue", the
* size of an identifier must be at least 8, as there are 8
* hexadecimal digits in a 32-bit number.
*/
#if sNAMEMAX < 8
#error Length of identifier (sNAMEMAX) too small.
#endif
assert(csp!=NULL);
assert(csp->next==cse);
insert_constval(csp,cse,itoh(lbl_case),val,0);
if (matchtoken(tDBLDOT)) {
error(1, ":", "..");
} /* if */
} while (matchtoken(','));
needtoken(':'); /* ':' ends the case */
sc_allowtags=(short)POPSTK_I(); /* reset */
setlabel(lbl_case);
statement(NULL,FALSE);
jumplabel(lbl_exit);
break;
case tDEFAULT:
if (swdefault!=FALSE)
error(16); /* multiple defaults in switch */
lbl_case=getlabel();
setlabel(lbl_case);
needtoken(':');
swdefault=TRUE;
statement(NULL,FALSE);
/* Jump to lbl_exit, even thouh this is the last clause in the
* switch, because the jump table is generated between the last
* clause of the switch and the exit label.
*/
jumplabel(lbl_exit);
break;
default:
if (tok!=endtok) {
error(2);
indent_nowarn=TRUE; /* disable this check */
tok=endtok; /* break out of the loop after an error */
} /* if */
} /* switch */
} while (tok!=endtok);
#if !defined NDEBUG
/* verify that the case table is sorted (unfortunatly, duplicates can
* occur; there really shouldn't be duplicate cases, but the compiler
* may not crash or drop into an assertion for a user error). */
for (cse=caselist.next; cse!=NULL && cse->next!=NULL; cse=cse->next)
assert(cse->value <= cse->next->value);
#endif
/* generate the table here, before lbl_exit (general jump target) */
setlabel(lbl_table);
assert(swdefault==FALSE || swdefault==TRUE);
if (swdefault==FALSE) {
/* store lbl_exit as the "none-matched" label in the switch table */
strcpy(labelname,itoh(lbl_exit));
} else {
/* lbl_case holds the label of the "default" clause */
strcpy(labelname,itoh(lbl_case));
} /* if */
ffcase(casecount,labelname,TRUE);
/* generate the rest of the table */
for (cse=caselist.next; cse!=NULL; cse=cse->next)
ffcase(cse->value,cse->name,FALSE);
setlabel(lbl_exit);
delete_consttable(&caselist); /* clear list of case labels */
}
static void doassert(void)
{
int flab1,index;
cell cidx;
if ((sc_debug & sCHKBOUNDS)!=0) {
flab1=getlabel(); /* get label number for "OK" branch */
test(flab1,TEST_PLAIN,TRUE);/* get expression and branch to flab1 if true */
insert_dbgline(fline); /* make sure we can find the correct line number */
ffabort(xASSERTION);
setlabel(flab1);
} else {
stgset(TRUE); /* start staging */
stgget(&index,&cidx); /* mark position in code generator */
do {
expression(NULL,NULL,NULL,FALSE,NULL);
stgdel(index,cidx); /* just scrap the code */
} while (matchtoken(','));
stgset(FALSE); /* stop staging */
} /* if */
needtoken(tTERM);
}
static void dogoto(void)
{
char *st;
cell val;
symbol *sym;
/* if we were inside an endless loop, assume that we jump out of it */
endlessloop=0;
error(4, "goto");
if (lex(&val,&st)==tSYMBOL) {
sym=fetchlab(st);
jumplabel((int)sym->addr);
sym->usage|=uREAD; /* set "uREAD" bit */
// ??? if the label is defined (check sym->usage & uDEFINE), check
// sym->compound (nesting level of the label) against nestlevel;
// if sym->compound < nestlevel, call the destructor operator
} else {
error(20,st); /* illegal symbol name */
} /* if */
needtoken(tTERM);
}
static void dolabel(void)
{
char *st;
cell val;
symbol *sym;
tokeninfo(&val,&st); /* retrieve label name again */
if (find_constval(&tagname_tab,st,0)!=NULL)
error(221,st); /* label name shadows tagname */
sym=fetchlab(st);
setlabel((int)sym->addr);
/* since one can jump around variable declarations or out of compound
* blocks, the stack must be manually adjusted
*/
//:TODO: This is actually generated, egads!
//We have to support this and LCTRL/SCTRL
setstk(-declared*sizeof(cell));
sym->usage|=uDEFINE; /* label is now defined */
}
/* fetchlab
*
* Finds a label from the (local) symbol table or adds one to it.
* Labels are local in scope.
*
* Note: The "_usage" bit is set to zero. The routines that call "fetchlab()"
* must set this bit accordingly.
*/
static symbol *fetchlab(char *name)
{
symbol *sym;
sym=findloc(name); /* labels are local in scope */
if (sym){
if (sym->ident!=iLABEL)
error(19,sym->name); /* not a label: ... */
} else {
sym=addsym(name,getlabel(),iLABEL,sLOCAL,0,0);
assert(sym!=NULL); /* fatal error 103 must be given on error */
sym->x.declared=(int)declared;
sym->compound=nestlevel;
} /* if */
return sym;
}
/* doreturn
*
* Global references: rettype (altered)
*/
static void doreturn(void)
{
int tag,ident;
int level;
symbol *sym,*sub;
if (!matchtoken(tTERM)) {
/* "return <value>" */
if ((rettype & uRETNONE)!=0)
error(78); /* mix "return;" and "return value;" */
ident=doexpr(TRUE,FALSE,TRUE,FALSE,&tag,&sym,TRUE);
needtoken(tTERM);
if (ident==iARRAY && sym==NULL) {
/* returning a literal string is not supported (it must be a variable) */
error(39);
ident=iCONSTEXPR; /* avoid handling an "array" case */
} /* if */
/* see if this function already has a sub type (an array attached) */
sub=finddepend(curfunc);
assert(sub==NULL || sub->ident==iREFARRAY);
if ((rettype & uRETVALUE)!=0) {
int retarray=(ident==iARRAY || ident==iREFARRAY);
/* there was an earlier "return" statement in this function */
if (sub==NULL && retarray || sub!=NULL && !retarray)
error(79); /* mixing "return array;" and "return value;" */
if (retarray && (curfunc->usage & uPUBLIC)!=0)
error(90,curfunc->name); /* public function may not return array */
} /* if */
rettype|=uRETVALUE; /* function returns a value */
/* check tagname with function tagname */
assert(curfunc!=NULL);
if (!matchtag_string(ident, tag) && !matchtag(curfunc->tag,tag,TRUE))
error(213); /* tagname mismatch */
if (ident==iARRAY || ident==iREFARRAY) {
int dim[sDIMEN_MAX],numdim;
cell arraysize;
assert(sym!=NULL);
if (sub!=NULL) {
assert(sub->ident==iREFARRAY);
/* this function has an array attached already; check that the current
* "return" statement returns exactly the same array
*/
level=sym->dim.array.level;
if (sub->dim.array.level!=level) {
error(48); /* array dimensions must match */
} else {
for (numdim=0; numdim<=level; numdim++) {
dim[numdim]=(int)sub->dim.array.length;
if (sym->dim.array.length!=dim[numdim])
error(47); /* array sizes must match */
if (numdim<level) {
sym=finddepend(sym);
sub=finddepend(sub);
assert(sym!=NULL && sub!=NULL);
/* ^^^ both arrays have the same dimensions (this was checked
* earlier) so the dependend should always be found
*/
} /* if */
} /* for */
} /* if */
} else {
int idxtag[sDIMEN_MAX];
int argcount, slength=0;
/* this function does not yet have an array attached; clone the
* returned symbol beneath the current function
*/
sub=sym;
assert(sub!=NULL);
level=sub->dim.array.level;
for (numdim=0; numdim<=level; numdim++) {
dim[numdim]=(int)sub->dim.array.length;
idxtag[numdim]=sub->x.tags.index;
if (numdim<level) {
sub=finddepend(sub);
assert(sub!=NULL);
} /* if */
/* check that all dimensions are known */
if (dim[numdim]<=0)
error(46,sym->name);
} /* for */
if (sym->tag==pc_tag_string && numdim!=0)
slength=dim[numdim-1];
/* the address of the array is stored in a hidden parameter; the address
* of this parameter is 1 + the number of parameters (times the size of
* a cell) + the size of the stack frame and the return address
* base + 0*sizeof(cell) == previous "base"
* base + 1*sizeof(cell) == function return address
* base + 2*sizeof(cell) == number of arguments
* base + 3*sizeof(cell) == first argument of the function
* ...
* base + ((n-1)+3)*sizeof(cell) == last argument of the function
* base + (n+3)*sizeof(cell) == hidden parameter with array address
*/
assert(curfunc!=NULL);
assert(curfunc->dim.arglist!=NULL);
for (argcount=0; curfunc->dim.arglist[argcount].ident!=0; argcount++)
/* nothing */;
sub=addvariable2(curfunc->name,(argcount+3)*sizeof(cell),iREFARRAY,sGLOBAL,curfunc->tag,dim,numdim,idxtag,slength);
sub->parent=curfunc;
} /* if */
/* get the hidden parameter, copy the array (the array is on the heap;
* it stays on the heap for the moment, and it is removed -usually- at
* the end of the expression/statement, see expression() in SC3.C)
*/
address(sub,sALT); /* ALT = destination */
arraysize=calc_arraysize(dim,numdim,0);
memcopy(arraysize*sizeof(cell)); /* source already in PRI */
/* moveto1(); is not necessary, callfunction() does a popreg() */
} /* if */
} else {
/* this return statement contains no expression */
ldconst(0,sPRI);
if ((rettype & uRETVALUE)!=0) {
char symname[2*sNAMEMAX+16]; /* allow space for user defined operators */
assert(curfunc!=NULL);
funcdisplayname(symname,curfunc->name);
error(209,symname); /* function should return a value */
} /* if */
rettype|=uRETNONE; /* function does not return anything */
} /* if */
destructsymbols(&loctab,0); /* call destructor for *all* locals */
genheapfree(-1);
genstackfree(-1); /* free everything on the stack */
ffret(strcmp(curfunc->name,uENTRYFUNC)!=0);
}
static void dobreak(void)
{
int *ptr;
endlessloop=0; /* if we were inside an endless loop, we just jumped out */
ptr=readwhile(); /* readwhile() gives an error if not in loop */
needtoken(tTERM);
if (ptr==NULL)
return;
destructsymbols(&loctab,nestlevel);
genstackfree(ptr[wqBRK]);
jumplabel(ptr[wqEXIT]);
}
static void docont(void)
{
int *ptr;
ptr=readwhile(); /* readwhile() gives an error if not in loop */
needtoken(tTERM);
if (ptr==NULL)
return;
destructsymbols(&loctab,nestlevel);
genstackfree(ptr[wqCONT]);
genheapfree(ptr[wqCONT]);
jumplabel(ptr[wqLOOP]);
}
SC_FUNC void exporttag(int tag)
{
/* find the tag by value in the table, then set the top bit to mark it
* "public"
*/
if (tag!=0 && (tag & PUBLICTAG)==0) {
constvalue *ptr;
for (ptr=tagname_tab.next; ptr!=NULL && tag!=(int)(ptr->value & TAGMASK); ptr=ptr->next)
/* nothing */;
if (ptr!=NULL)
ptr->value |= PUBLICTAG;
} /* if */
}
static void doexit(void)
{
int tag=0;
if (matchtoken(tTERM)==0){
doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
needtoken(tTERM);
} else {
ldconst(0,sPRI);
} /* if */
ldconst(tag,sALT);
exporttag(tag);
destructsymbols(&loctab,0); /* call destructor for *all* locals */
ffabort(xEXIT);
}
static void dosleep(void)
{
int tag=0;
if (matchtoken(tTERM)==0){
doexpr(TRUE,FALSE,FALSE,TRUE,&tag,NULL,TRUE);
needtoken(tTERM);
} else {
ldconst(0,sPRI);
} /* if */
ldconst(tag,sALT);
exporttag(tag);
ffabort(xSLEEP);
/* for stack usage checking, mark the use of the sleep instruction */
pc_memflags |= suSLEEP_INSTR;
}
static void dostate(void)
{
char name[sNAMEMAX+1];
constvalue *automaton;
constvalue *state;
constvalue *stlist;
int flabel;
symbol *sym;
#if !defined SC_LIGHT
int length,index,listid,listindex,stateindex;
char *doc;
#endif
/* check for an optional condition */
if (matchtoken('(')) {
flabel=getlabel(); /* get label number for "false" branch */
pc_docexpr=TRUE; /* attach expression as a documentation string */
test(flabel,TEST_PLAIN,FALSE);/* get expression, branch to flabel if false */
pc_docexpr=FALSE;
needtoken(')');
} else {
flabel=-1;
} /* if */
if (!sc_getstateid(&automaton,&state)) {
delete_autolisttable();
return;
} /* if */
needtoken(tTERM);
/* store the new state id */
assert(state!=NULL);
ldconst(state->value,sPRI);
assert(automaton!=NULL);
assert(automaton->index==0 && automaton->name[0]=='\0' || automaton->index>0);
storereg(automaton->value,sPRI);
/* find the optional entry() function for the state */
sym=findglb(uENTRYFUNC,sGLOBAL);
if (sc_status==statWRITE && sym!=NULL && sym->ident==iFUNCTN && sym->states!=NULL) {
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
assert(strlen(stlist->name)!=0);
if (state_getfsa(stlist->index)==automaton->index && state_inlist(stlist->index,(int)state->value))
break; /* found! */
} /* for */
assert(stlist==NULL || state_inlist(stlist->index,state->value));
if (stlist!=NULL) {
/* the label to jump to is in stlist->name */
ffcall(sym,stlist->name,0);
} /* if */
} /* if */
if (flabel>=0)
setlabel(flabel); /* condition was false, jump around the state switch */
#if !defined SC_LIGHT
/* mark for documentation */
if (sc_status==statFIRST) {
char *str;
/* get the last list id attached to the function, this contains the source states */
assert(curfunc!=NULL);
if (curfunc->states!=NULL) {
stlist=curfunc->states->next;
assert(stlist!=NULL);
while (stlist->next!=NULL)
stlist=stlist->next;
listid=stlist->index;
} else {
listid=-1;
} /* if */
listindex=0;
length=strlen(name)+70; /* +70 for the fixed part "<transition ... />\n" */
/* see if there are any condition strings to attach */
for (index=0; (str=get_autolist(index))!=NULL; index++)
length+=strlen(str);
if ((doc=(char*)malloc(length*sizeof(char)))!=NULL) {
do {
sprintf(doc,"<transition target=\"%s\"",name);
if (listid>=0) {
/* get the source state */
stateindex=state_listitem(listid,listindex);
state=state_findid(stateindex);
assert(state!=NULL);
sprintf(doc+strlen(doc)," source=\"%s\"",state->name);
} /* if */
if (get_autolist(0)!=NULL) {
/* add the condition */
strcat(doc," condition=\"");
for (index=0; (str=get_autolist(index))!=NULL; index++) {
/* remove the ')' token that may be appended before detecting that the expression has ended */
if (*str!=')' || *(str+1)!='\0' || get_autolist(index+1)!=NULL)
strcat(doc,str);
} /* for */
strcat(doc,"\"");
} /* if */
strcat(doc,"/>\n");
insert_docstring(doc);
} while (listid>=0 && ++listindex<state_count(listid));
free(doc);
} /* if */
} /* if */
#endif
delete_autolisttable();
}
static void addwhile(int *ptr)
{
int k;
ptr[wqBRK]=stackusage->list_id; /* stack pointer (for "break") */
ptr[wqCONT]=stackusage->list_id; /* for "continue", possibly adjusted later */
ptr[wqLOOP]=getlabel();
ptr[wqEXIT]=getlabel();
if (wqptr>=(wq+wqTABSZ-wqSIZE))
error(122,"loop table"); /* loop table overflow (too many active loops)*/
k=0;
while (k<wqSIZE){ /* copy "ptr" to while queue table */
*wqptr=*ptr;
wqptr+=1;
ptr+=1;
k+=1;
} /* while */
}
static void delwhile(void)
{
if (wqptr>wq)
wqptr-=wqSIZE;
}
static int *readwhile(void)
{
if (wqptr<=wq){
error(24); /* out of context */
return NULL;
} else {
return (wqptr-wqSIZE);
} /* if */
}