sourcemod-central: sourcepawn/compiler/sc2.c@490b01aa0683 (annotated)

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

author	Nicholas Hastings <skamonkey@gmail.com>
	Wed Aug 14 14:20:57 2013 -0400 (2013-08-14)
changeset 4008	490b01aa0683
parent 3951	c3f26df2183f
child 4181	b81d517c5a08
permissions	-rw-r--r--