sourcemod-central: sourcepawn/compiler/sc1.c@64238b77e22f (annotated)

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

author	David Anderson <dvander@alliedmods.net>
	Mon Aug 12 01:33:04 2013 +0100 (2013-08-12)
changeset 4003	64238b77e22f
parent 3951	c3f26df2183f
child 4177	14bb936ba41f
permissions	-rw-r--r--