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

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

author	Scott Ehlert <ds@alliedmods.net>
	Thu Apr 05 10:55:40 2007 +0000 (2007-04-05)
changeset 669	ce01c2eb020c
parent 510	546acad59370
child 841	fbb99b522344
permissions	-rw-r--r--