/************************************************/
/*						*/
/*		small-c compiler		*/
/*						*/
/*		  by Ron Cain			*/
/*	      and James Van Zandt		*/
/*						*/
/************************************************/

#define VERSION "     2 August 1984"
/*	history...
		2 Aug 84  Allocating symbol table and literal
			pool from heap.
		31 Jul 84  No GLOBAL directives for macros.
		30 Jul 84  Input file extension capitalized.
 		29 Jul 84  Displaying input file names.
		28 Jul 84  Getting file names and options from
			command line.
		14 Jul 84  outdec() is now recursive & smaller.
			raise() not called, since ZMAC converts
			to upper case. When profiling, the
			appropriate GLOBAL statements are
			automagically emitted.
		28 Jun 84  Adding CR after GLOBAL statement.
		25 Jun 84  In addglb(), generating GLOBAL
	statement. Generating 9 character labels (so 1st 8
	characters in a c symbol name are significant).
	Allowing 800 bytes of literals per function.
		2 Sept 83  In doreturn(), changed 'ccleavin'
	to 'ccleavi'.  Introduced 'leave'. 'numeric' &
	'outbyte' optimized. Optimized: 'nch', 'gch', 'keepch',
	'streq', 'astreq', 'raise'.
		1 Sept 83  Initializing firstfct & lastfct
	after calling ask().  Trace & profile enabled together.
		27 Aug 83  Allowing 3 bytes for call count.
		26 Aug 83  renamed: leaving => ccleavi,
	registe => ccregis. Added code to link the call count
	cells (main, header, trailer, newfunction).
		22 Aug 83  converted "," to "'", corrected
	loading of name pointer.
		21 Aug 83  Trace and profile are available.
	Using clibv.h & a:float.h
		1 Aug 83  6 function names are now
	"nospread", A now set to # words on stack rather
	than adding another parameter. 
		29 Mar 83  "callfunction" now reserves
	symsize bytes rather than namesize bytes for sym.
	When "printf" is called, the top word on the stack
	points to the first argument.
		7 Mar 83  "callfunction" now adds pointer
	to first argument for nospread functions. "nospread"
	introduced (returns true only for "printf").
		10 Nov 82  Rewrote "an" for speed.
		24 Oct 82  In "preprocess", searching macro
	table only with strings beginning with alpha. (Allows
	long numeric literals.) Rewrote "alpha" for speed.
		10 Oct 82  Updated date in signon message.
	Coersing function values to proper type.
		4 Sept 82  Generating colons again.
		3 Sep 82  "#includ"ing floating point
	library.
		30 Aug 82  Changed "number" calling sequence
	back. Colons are optional.
		12 Aug 82  Changed "number" calling sequence.
		11 Aug 82  Allowing typed function
	declarations.
		7 Aug 82  Correct length of double in
	local variables, preserving calling addr when
	calling through TOS & using double argument.
		5 Aug 82 Started installing floating point
		3 Aug 82	generating no colons
	after labels. Generating only 7 character labels.
		20 Jul 82	Removed the unused
	variable "iptr".
		18 Jul 82	Changed comment
	recognizer per J. E. Hendrix (ddj n56 p6).
		17 Jul 82	Implemented \" and
	\' sequences.  Corrected newfunc & getarg per
	P. L. Woods (ddj n52 p32) & J. E. Hendrix (ddj n56 p6).
		14 Jul 82	"#include"ing
	clibv.asm & c80v-2.c
		28 Jun 82	Skipping first byte
	in macro table, so index won't be zero.
		27 Jun 82	Masking out high
	order bits of characters extracted from
	a symbol table entry.
		21 Jun 82	Dumping literals
	at end of each function, per Rodney Black
	(DDJ n61 p51).
		19 Jun 82	Updated symtabsiz.
	Updated dumpglbs to handle new symbol table.
	Placing macro names in global symbol table,
	using smaller macro table.
		16 Jun 82	using hash table
	for global symbols.
		18 Apr 81	Changed names so
	first 5 characters are unique:
	heir10 => heira		heir11 => heirb
	input2 => inpt2		errorsum => errsum
*/
#include iolib.h
#include float.h

#define BANNER  "* * *  Small-C  V1.2  * * *"

#define AUTHOR "       By Ron Cain  and  James Van Zandt"

/*	Define system dependent parameters	*/

/*	Stand-alone definitions			*/

#define NULL 0
#define EOL 13

/*	UNIX definitions (if not stand-alone)	*/

/* #include <stdio.h>	*/
/* #define EOL 10	*/

/*	Define the symbol table parameters	*/

#define	SYMSIZ	14
#define	SYMTBSZ	8008
/*			=14*(NUMGLBS+60)	*/
#define NUMGLBS 512
#define MASKGLBS 511
/*			formerly 300 globals	*/
#define	STARTGLB symtab
#define	ENDGLB	STARTGLB+NUMGLBS*SYMSIZ
#define	STARTLOC ENDGLB+SYMSIZ
#define	ENDLOC	symtab+SYMTBSZ-SYMSIZ

/*	Define symbol table entry format	*/

#define	name	0
#define	ident	9
#define	type	10
#define	storage	11
#define	offset	12

/*	System wide name size (for symbols)	*/

#define	namesize 9
#define namemax  8

/*	Define possible entries for "ident"	*/

#define	variable 1
#define	array	2
#define	pointer	3
#define	function 4
#define MACRO 5
			/* added 6/19/82, JRVZ */

/*	Define possible entries for "type"	*/

#define	cchar	1
#define	cint	2
#define DOUBLE	3

/*	Define possible entries for "storage"	*/

#define	statik	1
#define	stkloc	2

/*	Define the "while" statement queue	*/

#define	wqtabsz	100
#define	wqsiz	4
#define	wqmax	wq+wqtabsz-wqsiz

/*	Define entry offsets in while queue	*/

#define	wqsym	0
#define	wqsp	1
#define	wqloop	2
#define	wqlab	3

/*	Define the literal pool			*/

#define	litabsz 1000
/*		formerly 2000			*/
#define	litmax	litabsz-1

/*	Define the input line			*/

#define	linesize 80
#define	linemax	linesize-1
#define	mpmax	linemax

/*	Define the macro (define) pool		*/

#define	macqsize 500
/*			formerly 1000   JRVZ 6/19/82  */
#define	macmax	macqsize-1

/*	Define statement types (tokens)		*/

#define	stif	1
#define	stwhile	2
#define	streturn 3
#define	stbreak	4
#define	stcont	5
#define	stasm	6
#define	stexp	7

/* Define how to carve up a name too long for the assembler */

#define ASMPREF	8
#define ASMSUFF	0

/*	Now reserve some storage words		*/

char	*symtab;		/* symbol table */
char	*glbptr,*locptr;	/* ptrs to next entries */

int	wq[wqtabsz];		/* while queue */
int	*wqptr;			/* ptr to next entry */

char	*litq;			/* literal pool */
int	litptr;			/* ptr to next entry */

char	macq[macqsize];		/* macro string buffer */
int	macptr;			/* and its index */

char	line[linesize];		/* parsing buffer */
char	mline[linesize];	/* temp macro buffer */
int	lptr,mptr;		/* ptrs into each */

/*	Misc storage	*/

int	nxtlab,		/* next avail label # */
	litlab,		/* label # assigned to literal pool */
	Zsp,		/* compiler relative stk ptr */
	undeclared,	/* # function arguments
			not yet declared  jrvz 8/6/82 */
	ncmp,		/* # open compound statements */
	errcnt,		/* # errors in compilation */
	errstop,	/* stop on error			gtf 7/17/80 */
	eof,		/* set non-zero on final input eof */
	input,		/* iob # for input file */
	output,		/* iob # for output file (if any) */
	inpt2,		/* iob # for "include" file */
	glbflag,	/* non-zero if internal globals */
	ctext,		/* non-zero to intermix c-source */
	cmode,		/* non-zero while parsing c-code */
			/* zero when passing assembly code */
	lastst,		/* last executed statement type */
	mainflg,	/* output is to be first asm filegtf 4/9/80 */
	saveout,	/* holds output ptr when diverted to console	   */
			/*				gtf 7/16/80 */
	fnstart,	/* line# of start of current fn.gtf 7/2/80 */
	lineno,		/* line# in current file	gtf 7/2/80 */
	infunc,		/* "inside function" flag	gtf 7/2/80 */
	savestart,	/* copy of fnstart "	"	gtf 7/16/80 */
	saveline,	/* copy of lineno  "	"	gtf 7/16/80 */
	saveinfn,	/* copy of infunc  "	"	gtf 7/16/80 */
	trace,		/* nonzero if traceback info needed
						jrvz 8/21/83	*/
	profile,	/* nonzero if profile needed	  */
	caller,		/* stack offset for caller links...
		local[caller] points to name of current fct
		local[caller-1] points to link for calling fct,
		where local[0] is 1st word on stack after ret addr  */
	firstfct,	/* label for 1st function */
	lastfct,	/* label for most recent fct  jrvz 8/83 */
	fname;		/* label for name of current fct  */
char   *currfn,		/* ptr to symtab entry for current fn.	gtf 7/17/80 */
       *savecurr;	/* copy of currfn for #include		gtf 7/17/80 */
char	quote[2];	/* literal string for '"' */
char	*cptr;		/* work ptr to any char buffer */

/*	>>>>> start cc1 <<<<<<		*/

/*					*/
/*	Compiler begins execution here	*/
/*					*/
main()
	{
	litq=alloc(litabsz);	/* literal pool */
	symtab=alloc(SYMTBSZ);	/* allocate symbol table */
	glbptr=STARTGLB;
	while(glbptr<ENDGLB){
		*glbptr=0;
		glbptr=glbptr+SYMSIZ;
	}
	glbptr=STARTGLB+SYMSIZ*5; /* clear global symbols */
	locptr=STARTLOC;	/* clear local symbols */
	wqptr=wq;		/* clear while queue */
	litptr=		/* clear literal pool */
  	Zsp =		/* stack ptr (relative) */
	errcnt=		/* no errors */
	errstop=	/* keep going after an error		gtf 7/17/80 */
	eof=		/* not eof yet */
	input=		/* no input file */
	inpt2=		/* or include file */
	output=		/* no open units */
	saveout=	/* no diverted output */
	ncmp=		/* no open compound states */
	lastst=		/* not first file to asm  gtf 4/9/80 */
	fnstart=	/* current "function" started
				at line 0 gtf 7/2/80 */
	lineno=		/* no lines read from file		gtf 7/2/80 */
	infunc=		/* not in function now			gtf 7/2/80 */
	quote[1]=
	0;		/*  ...all set to zero.... */
	quote[0]='"';		/* fake a quote literal */
	currfn=NULL;	/* no function yet			gtf 7/2/80 */
	macptr=		/* clear macro pool   jrvz 6/28/82 */
	cmode=1;	/* enable preprocessing */
	/*				*/
	/*	compiler body		*/
	/*				*/
	ask();			/* get user options */
	lastfct=firstfct=getlabel(); /* jrvz 8/26/83 */
	openout();		/* get an output file */
	openin();		/* and initial input file */
	header();		/* intro code */
	parse(); 		/* process ALL input */
/*	dumplits();		deleted 6/21/82  jrvz */
	dumpglbs();		/* define static variables */
	trailer();		/* follow-up code */
	closeout();		/* close the output (if any) */
	errsummary();		/* summarize errors */
	return;			/* then exit to system */
	}

/*					*/
/*	Abort compilation		*/
/*		gtf 7/17/80		*/
abort()
{
	if(inpt2)
		endinclude();
	if(input)
		fclose(input);
	closeout();
	toconsole();
	pl("Compilation aborted.");  nl();
	exit();
/* end abort */}

/*					*/
/*	Process all input text		*/
/*					*/
/* At this level, only static declarations, */
/*	defines, includes, and function */
/*	definitions are legal...	*/
parse()
	{
	while (eof==0)		/* do until no more input */
		{
		if(amatch("char",4)){declglb(cchar);ns();}
		else if(amatch("int",3)){declglb(cint);ns();}
		else if(amatch("double",6))  /* jrvz 8/5/82 */
			{declglb(DOUBLE);ns();}
		else if(match("#asm"))doasm();
		else if(match("#include"))doinclude();
		else if(match("#define"))addmac();
		else newfunc();
		blanks();	/* force eof if pending */
		}
	}
/*					*/
/*	Dump the literal pool		*/
/*					*/
dumplits()
	{int j,k;
	if (litptr==0) return;	/* if nothing there, exit...*/
	printlabel(litlab);col(); /* print literal label */
	k=0;			/* init an index... */
	while (k<litptr)	/* 	to loop with */
		{defbyte();	/* pseudo-op to define byte */
		j=10;		/* max bytes per line */
		while(j--)
			{outdec((litq[k++]&255));
			/* now masking with 255 instead of 127
			so floating constants can be put
			in the literal pool  jrvz 9/4/82 */
			if ((j==0) | (k>=litptr))
				{nl();		/* need <cr> */
				break;
				}
			outbyte(',');	/* separate bytes */
			}
		}
	}
/*					*/
/*	Dump all static variables	*/
/*					*/
dumpglbs()
	{
	int i,j;
	if(glbflag==0)return;	/* don't if user said no */
	cptr=STARTGLB;
	i=NUMGLBS;
	while(i--){  /* 6/19/82  jrvz */
	    if(*cptr){
		if((cptr[ident]!=function)
		&(cptr[ident]!=MACRO))  /* 6/19/82  jrvz */
			/* do if anything but function
				or macro */
			{outname(cptr);col();
				/* output name as label... */
			defstorage();	/* define storage */
			j=((cptr[offset]&255)+
				((cptr[offset+1]&255)<<8));
					/* calc # bytes */
			if((cptr[type]==cint)|
				(cptr[ident]==pointer))
				j=j+j;
			else if(cptr[type]==DOUBLE)
				j=j*6;  /* jrvz 8/5/82 */
			outdec(j);	/* need that many */
			nl();
			}
		}
	    cptr=cptr+SYMSIZ;
	    }
	}
/*					*/
/*	Report errors for user		*/
/*					*/
errsummary()
	{
	/* see if anything left hanging... */
	if (ncmp) error("missing closing bracket");
		/* open compound statement ... */
	nl();
	outstr("There were ");
	outdec(errcnt);	/* total # errors */
	outstr(" errors in compilation.");
	nl();
	}

int argcnt,		/* # arguments on command line */
filenum,	/* next argument to be used */
argv[20];	/* pointers to arguments in args[] */
char *args;	/* stored arguments */

nextarg(n,s,size) /* places in s the n-th argument (up to "size"
		bytes). If successful, returns s. Returns -1
		if the n-th argument doesn't exist. */
int n; char *s; int size;
{	char *str;
	int i;

	if(n<0|n>=argcnt) return -1;
	i=0;
	str=argv[n];
	while(++i<size)
		{if((*s++=*str++)==NULL) break;
		}
	return s;
}
ask()		/* fetch arguments */
{	char *count,	/* *count is # characters in command line */
	c,	/* an option character */
	*ptr,	/* *ptr is next character in command line */
	*lastc,	/* points to last character in command line */
	*next;	/* where the next byte goes in args[] */

	kill();			/* clear input line */
	pl(BANNER);		/* print banner */
	nl();
	pl(AUTHOR);
/*	nl();nl();
	pl("Distributed by: The Code Works(tm)");
	pl("                Box 550, Goleta, CA 93017");
*/
	nl();
	pl(VERSION);
	nl();
	nl();
	nxtlab =0;	/* start numbers at lowest possible */
		/* initialize the options */
	ctext=0;	/* don't include the C text as comments */
	glbflag=1;	/* define globals */
	mainflg=1;	/* this file contains main() */
	errstop=0;	/* don't stop after errors */
	profile=trace=0; /* no profile or tracing */
	count=128;	/* CP/M command buffer */
	ptr=count+1;
	lastc=ptr+*count;
	*lastc=' ';		/* place a sentinal */
	args=alloc(*count);	/* allocate the buffer */
	argv[0]=args;
	next=args;
	argcnt=0;
	while(++ptr<lastc)
		{if(*ptr==' ') continue;
		if(*ptr=='-')		/* option */
			{c=*++ptr;
			if(c=='C') ctext=1;
			else if(c=='G') glbflag=0;
			else if(c=='M') mainflg=0;
			else if(c=='E') errstop=1;
			else if(c=='P') profile=trace=1;
			while(++*ptr!=' ') {}
			}
		else			/* file name */
			{argv[argcnt++]=next;
			while(*ptr!=' ') *next++=*ptr++;
			*next++=NULL;
			}
		}
	litlab=getlabel();	/* first label=literal pool */ 
	kill();			/* erase line */
}
 
/*					*/
/*	Get output filename		*/
/*					*/
openout()
	{kill();		/* erase line */
	filenum=output=0;	/* start with none */
	if(nextarg(filenum,line,16)==-1) return;
	append(line,".asm");
	if((output=fopen(line,"w"))==NULL) /* if given, open */
		{output=0;	/* can't open */
		error("Can't open output file!");
		}
	kill();			/* erase line */
}

/*					*/
/*	Get (next) input file		*/
/*					*/
openin()
{
	input=0;		/* none to start with */
	while(input==0){	/* any above 1 allowed */
		kill();		/* clear line */
		if(eof)break;	/* if user said none */
		if(nextarg(filenum++,line,16)==-1)
			{eof=1;break;} /* none given... */
		append(line,".C");
		pl(line); pl("\n");
		if((input=fopen(line,"r"))!=NULL)
			newfile();	/* gtf 7/16/80 */
		else {	input=0;	/* can't open it */
			pl("CAN'T OPEN ");
			}
		}
	kill();		/* erase line */
	}

append(s,t) char *s,*t;	/* append t to s */
{	while(*s) ++s;		/* scan to end of s */
	while(*s++=*t++){}	/* append t */
}

/*					*/
/*	Reset line count, etc.		*/
/*			gtf 7/16/80	*/
newfile()
{
	lineno  = 0;	/* no lines read */
	fnstart = 0;	/* no fn. start yet. */
	currfn  = NULL;	/* because no fn. yet */
	infunc  = 0;	/* therefore not in fn. */
/* end newfile */}

/*					*/
/*	Open an include file		*/
/*					*/
doinclude()
{
	blanks();	/* skip over to name */

	toconsole();					/* gtf 7/16/80 */
	outstr("#include "); outstr(line+lptr); nl();
	tofile();

	if(inpt2)					/* gtf 7/16/80 */
		error("Cannot nest include files");
	else if((inpt2=fopen(line+lptr,"r"))==NULL)
		{inpt2=0;
		error("Open failure on include file");
		}
	else {	saveline = lineno;
		savecurr = currfn;
		saveinfn = infunc;
		savestart= fnstart;
		newfile();
		}
	kill();		/* clear rest of line */
			/* so next read will come from */
			/* new file (if open */
}

/*					*/
/*	Close an include file		*/
/*			gtf 7/16/80	*/
endinclude()
{
	toconsole();
	outstr("#end include"); nl();
	tofile();

	inpt2  = 0;
	lineno  = saveline;
	currfn  = savecurr;
	infunc  = saveinfn;
	fnstart = savestart;
/* end endinclude */}

/*					*/
/*	Close the output file		*/
/*					*/
closeout()
{
	tofile();	/* if diverted, return to file */
	if(output)fclose(output); /* if open, close it */
	output=0;		/* mark as closed */
}
/*					*/
/*	Declare a static variable	*/
/*	  (i.e. define for use)		*/
/*					*/
/* makes an entry in the symbol table so subsequent */
/*  references can call symbol by name	*/
declglb(typ)	/* typ is cchar, cint or DOUBLE jrvz 8/5/82 */
	int typ;
{	int k,j;char sname[namesize];
	while(1)
		{while(1)
			{if(endst())return;	/* do line */
			k=1;		/* assume 1 element */
			if(match("*"))	/* pointer ? */
				j=pointer;	/* yes */
				else j=variable; /* no */
			 if (symname(sname)==0) /* name ok? */
				illname(); /* no... */
			if(findglb(sname)) /* already there? */
				multidef(sname);
			if (match("["))		/* array? */
				{k=needsub();	/* get size */
				if(k)j=array;	/* !0=array */
				else j=pointer; /* 0=ptr */
				}
			if (match("("))	/* function?  */
				{k=0;
				j=function;
				needbrack(")");
				}	/* jrvz 8/11/82 */
			addglb(sname,j,typ,k); /* add symbol */
			break;
			}
		if (match(",")==0) return; /* more? */
		}
	}
/*					*/
/*	Declare local variables		*/
/*	(i.e. define for use)		*/
/*					*/
/* works just like "declglb" but modifies machine stack */
/*	and adds symbol table entry with appropriate */
/*	stack offset to find it again			*/
declloc(typ)	/* typ is cchar, cint or DOUBLE jrvz 8/5/82 */
	int typ;
	{
	int k,j;char sname[namesize];
	while(1)
		{while(1)
			{if(endst())return;
			if(match("*"))
				j=pointer;
				else j=variable;
			if (symname(sname)==0)
				illname();
			if(findloc(sname))
				multidef(sname);
			if (match("["))
				{k=needsub();
				if(k)
				    {j=array;
				    if(typ==cint)k=k+k;
				    else if(typ==DOUBLE)k=k*6;
				    /* jrvz 8/5/82 */
				    }
				else
				    {j=pointer;
				    k=2;
				    }
				}
			else
			    if((typ==cchar)&(j!=pointer))
				k=1;
			    else if((typ==DOUBLE)&(j!=pointer))
				k=6;	/* jrvz 8/7/82 */
			    else k=2;
			/* change machine stack */
			Zsp=modstk(Zsp-k);
			addloc(sname,j,typ,Zsp);
			break;
			}
		if (match(",")==0) return;
		}
	}
/*	>>>>>> start of cc2 <<<<<<<<	*/

/*					*/
/*	Get required array size		*/
/*					*/
/* invoked when declared variable is followed by "[" */
/*	this routine makes subscript the absolute */
/*	size of the array. */
needsub()
	{
	int num[1];
	if(match("]"))return 0;	/* null size */
	if (number(num)==0)
			/* go after a number */
		{error("must be constant");	/* it isn't */
		num[0]=1;		/* so force one */
		}
	if (num[0]<0)
		{error("negative size illegal");
		num[0]=(-num[0]);
		}
	needbrack("]");		/* force single dimension */
	return num[0];		/* and return size */
	}
/*					*/
/*	Begin a function		*/
/*					*/
/* Called from "parse" this routine tries to make a function */
/*	out of what follows.	*/
newfunc()
	{
	char n[namesize], /* ptr => currfn,  gtf 7/16/80 */
	i,		/* ident of an argument  jrvz 8/6/82 */
	*prevarg;	/* pointer to the symbol table entry
		for the most recent argument jrvz 8/6/82 */
	int lgh,	/* size (bytes) of an argument
				jrvz 8/6/82 */
	where,		/* offset to argument in stack
			(zero for last argument) jrvz 8/6/82 */
	*iptr;  /* temporary ptr for stepping along argument
					chain jrvz 8/6/82 */
	if (symname(n)==0)
		{error("illegal function or declaration");
		kill();	/* invalidate line */
		return;
		}
	fnstart=lineno;
		/* remember where fn began	gtf 7/2/80 */
	infunc=1;
		/* note, in function now.	gtf 7/16/80 */
	if(currfn=findglb(n))	/* already in symbol table ? */
		{if(currfn[ident]!=function)multidef(n);
			/* already variable by that name */
		else if(currfn[offset]==function)multidef(n);
			/* already function by that name */
		else currfn[offset]=function;
			/*  we have what was earlier*/
			/*  assumed to be a function */
		}
	/* if not in table, define as a function now */
	else currfn=addglb(n,function,cint,function);

	toconsole();			/* gtf 7/16/80 */
	outstr("====== "); outstr(currfn+name); outstr("()");
	nl(); tofile();

	/* we had better see open paren for args... */
	if(match("(")==0)error("missing open paren");
	if(profile)		/* call count  jrvz 8/21/83 */
		{printlabel(lastfct); col(); defword();
		printlabel(lastfct=getlabel()); nl();
		defbyte(); ol("0,0,0");
		}
	if(trace|profile)
		{printlabel(fname=getlabel());col();
		defbyte();outbyte(39);
		outstr(currfn+name); outasm("\',0"); nl();
		}
	outname(n);col();nl();	/* print function name */
	locptr=STARTLOC;      /* "clear" local symbol table */
	prevarg=0;  /* initialize ptr to prev argument
				jrvz 8/6/82 */
	undeclared=0;		/* init arg count */
	while(match(")")==0)	/* then count args */
		/* any legal name bumps arg count */
		{if(symname(n))
			{if(findloc(n))multidef(n);
			else
			    {prevarg=addloc(n,0,cint,prevarg);
				/* add link to argument chain
						jrvz 8/6/82 */
			    undeclared++; /* jrvz 8/6/82 */
			    }
			}
		else{error("illegal argument name");junk();}
		blanks();
		/* if not closing paren, should be comma */
		if(streq(line+lptr,")")==0)
			{if(match(",")==0)
			error("expected comma");
			}
		if(endst())break;
		}
	Zsp=0;			/* preset stack ptr */
	if(trace)		/* jrvz 8/21/83 */
		{caller=Zsp=Zsp-2;
		immed(); printlabel(fname); nl();
		zpush();
		callrts("ccregis");
		}
	while(undeclared)
		/* now let user declare what types of things */
		/*	those arguments were */
		{if(amatch("char",4)){getarg(cchar);ns();}
		else if(amatch("int",3)){getarg(cint);ns();}
		else if(amatch("double",6))
		    {getarg(DOUBLE);ns();} /* jrvz 8/5/82 */
		else{error("wrong number args");break;}
		}
	/* offset calculation rewritten  jrvz 6/8/82 */
	where=2;
	while(prevarg)
		{lgh=2;  /* all arguments except DOUBLE
			have length 2 bytes (even char) */
		if(prevarg[type]==DOUBLE)lgh=6;
		i=prevarg[ident];
		if(i==pointer)lgh=2;
		iptr=prevarg+offset;
		prevarg=*iptr;  /* follow ptr to prev. arg */
		*iptr=where;	/* insert offset */
		where=where+lgh; /* calculate next offset */
		}
	if(statement()!=streturn) /* do a statement, but if */
				/* it's a return, skip */
				/* cleaning up the stack */
		leave();
	Zsp=0;			/* reset stack ptr again */
	locptr=STARTLOC;	/* deallocate all locals */
	dumplits();		/* dump the literal pool
				for this function */
	litlab=getlabel();
	litptr=0;		/* re-initialize pool */
			/* literal dump added 6/21/82  jrvz */
	infunc=0;		/* not in fn. any more
				gtf 7/2/80 */
	}
/*					*/
/*	Declare argument types		*/
/*					*/
/* called from "newfunc" this routine adds an entry in the */
/*	local symbol table for each named argument */
getarg(t)	/* t = cchar, cint or DOUBLE jrvz 8/5/82 */
	int t;
	{
	char n[namesize],c,*argptr;
	int j,legalname; /* "address" removed  jrvz 8/6/82 */
	while(undeclared)  /* jrvz 8/6/82 */
		{if(match("*"))j=pointer;
			else j=variable;
		if((legalname=symname(n))==0) illname();
		if(match("["))	/* pointer ? */
		/* it is a pointer, so skip all */
		/* stuff between "[]" */
			{while(inbyte()!=']')
				if(endst())break;
			j=pointer;
			/* add entry as pointer */
			}
		if(legalname)
			{if(argptr=findloc(n))
				/* add in details of the type
				of the name */
				{argptr[ident]=j;
				argptr[type]=t;
				/* address calculation removed
					jrvz 8/6/82 */
				}
			else error("expecting argument name");
			}
		undeclared--;	/* cnt down  jrvz 8/6/82 */
		if(endst())return;
		if(match(",")==0)error("expected comma");
		}
	}
/*					*/
/*	Statement parser		*/
/*					*/
/* called whenever syntax requires	*/
/*	a statement. 			 */
/*  this routine performs that statement */
/*  and returns a number telling which one */
statement()
{
	if(cpm(11,0) & 1)	/* check for ctrl-C		gtf 7/17/80 */
		if(getchar()==3)
			abort();

	if ((ch()==0) & (eof)) return;
	else if(amatch("char",4))
		{declloc(cchar);ns();}
	else if(amatch("int",3))
		{declloc(cint);ns();}
	else if(amatch("double",6))
		{declloc(DOUBLE);ns();} /* jrvz 8/5/82 */
	else if(match("{"))compound();
	else if(amatch("if",2))
		{doif();lastst=stif;}
	else if(amatch("while",5))
		{dowhile();lastst=stwhile;}
	else if(amatch("return",6))
		{doreturn();ns();lastst=streturn;}
	else if(amatch("break",5))
		{dobreak();ns();lastst=stbreak;}
	else if(amatch("continue",8))
		{docont();ns();lastst=stcont;}
	else if(match(";"));
	else if(match("#asm"))
		{doasm();lastst=stasm;}
	/* if nothing else, assume it's an expression */
	else{expression();ns();lastst=stexp;}
	return lastst;
}
/*					*/
/*	Semicolon enforcer		*/
/*					*/
/* called whenever syntax requires a semicolon */
ns()	{if(match(";")==0)error("missing semicolon");}
/*					*/
/*	Compound statement		*/
/*					*/
/* allow any number of statements to fall between "{}" */
compound()
	{
	++ncmp;		/* new level open */
	while (match("}")==0) statement(); /* do one */
	--ncmp;		/* close current level */
	}
/*					*/
/*		"if" sta/*					*/
doif()
	{
	int flev,fsp,flab1,flab2;
	flev=locptr;	/* record current local level */
	fsp=Zsp;		/* record current stk ptr */
	flab1=getlabel(); /* get label for false branch */
	test(flab1);	/* get expression, and branch false */
	statement();	/* if true, do a statement */
	Zsp=modstk(fsp);	/* then clean up the stack */
	locptr=flev;	/* and deallocate any locals */
	if (amatch("else",4)==0)	/* if...else ? */
		/* simple "if"...print false label */
		{printlabel(flab1);col();nl();
		return;		/* and exit */
		}
	/* an "if...else" statement. */
	jump(flab2=getlabel());	/* jump around false code */
	printlabel(flab1);col();nl();	/* print false label */
	statement();		/* and do "else" clause */
	Zsp=modstk(fsp);		/* then clean up stk ptr */
	locptr=flev;		/* and deallocate locals */
	printlabel(flab2);col();nl();	/* print true label */
	}
/*					*/
/*	"while" statement		*/
/*					*/
dowhile()
	{
	int wq[4];		/* allocate local queue */
	wq[wqsym]=locptr;	/* record local level */
	wq[wqsp]=Zsp;		/* and stk ptr */
	wq[wqloop]=getlabel();	/* and looping label */
	wq[wqlab]=getlabel();	/* and exit label */
	addwhile(wq);		/* add entry to queue */
				/* (for "break" statement) */
	printlabel(wq[wqloop]);col();nl(); /* loop label */
	test(wq[wqlab]);	/* see if true */
	statement();		/* if so, do a statement */
	jump(wq[wqloop]);	/* loop to label */
	printlabel(wq[wqlab]);col();nl(); /* exit label */
	locptr=wq[wqsym];	/* deallocate locals */
	Zsp=modstk(wq[wqsp]);	/* clean up stk ptr */
	delwhile();		/* delete queue entry */
	}
/*					*/
/*	"return" statement		*/
/*					*/
doreturn()
	{
	/* if not end of statement, get an expression */
	if(endst()==0)force(currfn[type],expression());
		/* added type coersion jrvz 10/10/82 */
	leave();
	}
/*					*/
/*	leave a function		*/
/*					*/
leave()
	{if(trace) callrts("ccleavi");/*jrvz 8/21/83*/
	modstk(0);	/* clean up stk */
	zret();		/* and exit function */
	}
/*					*/
/*	"break" statement		*/
/*					*/
dobreak()
	{
	int *ptr;
	/* see if any "whiles" are open */
	if ((ptr=readwhile())==0) return;	/* no */
	modstk((ptr[wqsp]));	/* else clean up stk ptr */
	jump(ptr[wqlab]);	/* jump to exit label */
	}
/*					*/
/*	"continue" statement		*/
/*					*/
docont()
	{
	int *ptr;
	/* see if any "whiles" are open */
	if ((ptr=readwhile())==0) return;	/* no */
	modstk((ptr[wqsp]));	/* else clean up stk ptr */
	jump(ptr[wqloop]);	/* jump to loop label */
	}
/*					*/
/*	"asm" pseudo-statement		*/
/*					*/
/* enters mode where assembly language statement are */
/*	passed intact through parser	*/
doasm()
	{
	cmode=0;		/* mark mode as "asm" */
	while (1)
		{inline();	/* get and print lines */
		if (match("#endasm")) break;	/* until... */
		if(eof)break;
		outstr(line);
		nl();
		}
	kill();		/* invalidate line */
	cmode=1;		/* then back to parse level */
	}
/*	>>>>> start of cc3 <<<<<<<<<	*/

/*					*/
/*	Perform a function call		*/
/*					*/
/* called from heirb, this routine will either call */
/*	the named function, or if the supplied ptr is */
/*	zero, will call the contents of HL		*/
callfunction(ptr)
	char *ptr;	/* symbol table entry (or 0) */
{	char sym[SYMSIZ];
	int nargs;
	nargs=0;
	blanks();	/* already saw open paren */
	if(ptr==0)zpush();	/* calling HL */
	while(streq(line+lptr,")")==0)
		{if(endst())break;
		if(expression()==DOUBLE)  /* jrvz 8/6/82 */
			{if(ptr==0)dpush2(); /* save addr */
			else dpush();
			nargs=nargs+6;
			}
		else
			{if(ptr==0)swapstk(); /* save addr */
			zpush();	/* push argument */
			nargs=nargs+2;	/* count args*2 */
			}
		if (match(",")==0) break;
		}
	needbrack(")");
	if(ptr)
		{if(nospread(ptr))
			{ot("LD A,");
			outdec(nargs>>1);
			nl();
			}
		zcall(ptr);
		}
	else callstk();
	Zsp=modstk(Zsp+nargs);	/* clean up arguments */
}
nospread(sym) char sym[];
{	if(astreq(sym,"printf",6))return 1;
	if(astreq(sym,"fprint",6))return 1;
	if(astreq(sym,"sprintf",7))return 1;
	if(astreq(sym,"scanf",5))return 1;
	if(astreq(sym,"fscan",5))return 1;
	if(astreq(sym,"sscanf",6))return 1;
	return 0;
}
junk()
{	if(an(inbyte()))
		while(an(ch()))gch();
	else while(an(ch())==0)
		{if(ch()==0)break;
		gch();
		}
	blanks();
}
endst()
{	blanks();
	return ((streq(line+lptr,";")|(ch()==0)));
}
illname()
{	error("illegal symbol name");junk();}
multidef(sname)
	char *sname;
{	error("already defined");
	comment();
	outstr(sname);nl();
}
needbrack(str)
	char *str;
{	if (match(str)==0)
		{error("missing bracket");
		comment();outstr(str);nl();
		}
}
needlval()
{	error("must be lvalue");
}
hash(sname)
	char *sname;
{	int h,c;
	h=*sname;
	while(c=*(++sname)) h=(h<<1)+c;
	return h;
}
findglb(sname)	/* cptr is set to entry if found,
		or appropriate empty slot if not */
	char *sname;
{	int h;
	h=hash(sname)&MASKGLBS;
	cptr=STARTGLB+h*SYMSIZ;
	while(0==astreq(sname,cptr,namemax)){
		if(*cptr==0) return 0;
		cptr=cptr+SYMSIZ;
		if(cptr==ENDGLB)cptr=STARTGLB;
	}
	return cptr;
}
findloc(sname)
	char *sname;
{	char *ptr;
	ptr=STARTLOC;
	while(ptr!=locptr)
		{if(astreq(sname,ptr,namemax))return ptr;
		ptr=ptr+SYMSIZ;
		}
	return 0;
}
addglb(sname,id,typ,value)
	char *sname,id,typ;
	int value;
{	char *ptr;
	if(findglb(sname))return cptr;
			 /* declare exported name */
	if(id!=MACRO){ot("global "); outname(sname); nl();}
	if(glbptr>=ENDGLB)
		{error("global symbol table overflow");
		return 0;
		}
	ptr=cptr;
	while(an(*ptr++ = *sname++));	/* copy name */
	cptr[ident]=id;
	cptr[type]=typ;
	cptr[storage]=statik;
	cptr[offset]=value;
	cptr[offset+1]=value>>8;
	glbptr=glbptr+SYMSIZ;
	return cptr;
}
addloc(sname,id,typ,value)
	char *sname,id,typ;
	int value;
{	char *ptr;
	if(cptr=findloc(sname))return cptr;
	if(locptr>=ENDLOC)
		{error("local symbol table overflow");
		return 0;
		}
	cptr=ptr=locptr;
	while(an(*ptr++ = *sname++));	/* copy name */
	cptr[ident]=id;
	cptr[type]=typ;
	cptr[storage]=stkloc;
	cptr[offset]=value;
	cptr[offset+1]=value>>8;
	locptr=locptr+SYMSIZ;
	return cptr;
}
/* Test if next input string is legal symbol name */
symname(sname)
	char *sname;
{	int k;char c;
	blanks();
	if(alpha(ch())==0)return 0;
	k=0;
	while(an(ch()))sname[k++]=gch();
	sname[k]=0;
	return 1;
	}
/* Return next avail internal label number */
getlabel()
{	return(++nxtlab);
}
/* Print specified number as label */
printlabel(label)
	int label;
{	outasm("cc");
	outdec(label);
}
/* Test if given character is alpha */
alpha(c)  /* rewritten for speed 10/24/82 jrvz */
	char c;
{	c=c&127;
	if(c>='a') return (c<='z');
	if(c<='Z') return (c>='A');
	return (c=='_');
}
/* Test if given character is numeric */
numeric(c)
	char c;
{	c=c&127;
	if(c<='9') return(c>='0');
	return 0;
}
/* Test if given character is alphanumeric */
an(c)		/* rewritten for speed  11/10/82 jrvz */
	char c;
{	if(alpha(c)) return 1;
	return numeric(c);
}
/* Print a carriage return and a string only to console */
pl(str)
	char *str;
{	int k;
	k=0;
	putchar(EOL);
	while(str[k])putchar(str[k++]);
}
addwhile(ptr)
	int ptr[];
 {
	int k;
	if (wqptr==wqmax)
		{error("too many active whiles");return;}
	k=0;
	while (k<wqsiz)
		{*wqptr++ = ptr[k++];}
}
delwhile()
	{if(readwhile()) wqptr=wqptr-wqsiz;
	}
readwhile()
{	if (wqptr==wq){error("no active whiles");return 0;}
	else return (wqptr-wqsiz);
}
ch()
{	return(line[lptr]&127);
}
nch()
{/*	if(ch()==0)return 0;
		else return(line[lptr+1]&127);
*/
	if(ch()) return(line[lptr+1]&127);
	return 0;
}
gch()
{/*	if(ch()==0)return 0;
		else return(line[lptr++]&127);
*/
	if(ch()) return(line[lptr++]&127);
	return 0;
}
kill()
{	lptr=0;
	line[lptr]=0;
}
inbyte()
{
	while(ch()==0)
		{if (eof) return 0;
		inline();
		preprocess();
		}
	return gch();
}
inline()
{
	int k,unit;
	while(1)
		{if (input==0)openin();
		if(eof)return;
		if((unit=inpt2)==0)unit=input;
		kill();
		while((k=getc(unit))>0)
			{if((k==EOL)|(lptr>=linemax))break;
			line[lptr++]=k;
			}
		line[lptr]=0;	/* append null */
		lineno++;	/* read one more line		gtf 7/2/80 */
		if(k<=0)
			{fclose(unit);
			if(inpt2)endinclude();		/* gtf 7/16/80 */
				else input=0;
			}
		if(lptr)
			{if((ctext)&(cmode))
				{comment();
				outstr(line);
				nl();
				}
			lptr=0;
			return;
			}
		}
}
/*	>>>>>> start of cc4 <<<<<<<	*/

keepch(c)
	char c;
{	mline[mptr]=c;
	if(mptr<mpmax)++mptr;
	return c;
}
preprocess()
{	int k;
	char c,sname[namesize];
	if(cmode==0)return;
	mptr=lptr=0;
	while(ch())
		{if((ch()==' ')|(ch()==9))
			{keepch(' ');
			while((ch()==' ')|
				(ch()==9))
				gch();
			}
		else if(ch()=='"')
			{keepch(ch());
			gch();
			while((ch()!='"')|
			((line[lptr-1]==92)&(line[lptr-2]!=92))
			)
				{if(ch()==0)
				   {error("missing quote");
				   break;
				   }
				keepch(gch());
				}
			gch();
			keepch('"');
			}
		else if(ch()==39)
			{keepch(39);
			gch();
			while((ch()!=39)|
			((line[lptr-1]==92)&
			(line[lptr-2]!=92)))
			   {if(ch()==0)
				{error("missing apostrophe");
				break;
				}
			   keepch(gch());
			   }
			gch();
			keepch(39);
			}
		else if((ch()=='/')&(nch()=='*'))
			{lptr=lptr+2;
			while(((ch()=='*')&
				(nch()=='/'))==0)
				{if(ch()==0)inline();
					else lptr++;
				if(eof)break;
				}
			lptr=lptr+2;
			}
		else if(alpha(ch())) /* 10/24/82 jrvz */
			{k=0;
			while(an(ch()))
				{if(k<namemax)sname[k++]=ch();
				gch();
				}
			sname[k]=0;
			if(k=findmac(sname))
				while(c=macq[k++])
					keepch(c);
			else
				{k=0;
				while(c=sname[k++])
					keepch(c);
				}
			}
		else keepch(gch());
		}
	keepch(0);
	if(mptr>=mpmax)error("line too long");
	lptr=mptr=0;
	while(line[lptr++]=mline[mptr++]);
	lptr=0;
	}
addmac()
{	char sname[namesize];
	if(symname(sname)==0)
		{illname();
		kill();
		return;
		}
	addglb(sname,MACRO,0,macptr);
		/* call replaced code which moved the name
		into the macro table	6/19/82  jrvz */
	while(ch()==' ' | ch()==9) gch();
	while(putmac(gch()));
	if(macptr>=macmax)error("macro table full");
	}
putmac(c)
	char c;
{	macq[macptr]=c;
	if(macptr<macmax)macptr++;
	return c;
}
findmac(sname)  /* function rewritten 6/19/82  jrvz */
	char *sname;
{	if((findglb(sname)!=0)&(cptr[ident]==MACRO))
		{return((cptr[offset]&255)+
		(cptr[offset+1]<<8));
		}
	return 0;
}
/* direct output to console		gtf 7/16/80 */
toconsole()
{
	saveout = output;
	output = 0;
/* end toconsole */}

/* direct output back to file		gtf 7/16/80 */
tofile()
{
	if(saveout)
		output = saveout;
	saveout = 0;
/* end tofile */}

outbyte(c)
	char c;
{
	if(c)	/* sense of test reversed  jrvz 9/2/83 */
		{if(output)
			{if((putc(c,output))<=0)
				{closeout();
				error("Output file error");
				abort();	/* gtf 7/17/80 */
				}
			}
		else putchar(c);
		}
	return c;
}
outstr(ptr)
	char ptr[];
 {	while(outbyte(*ptr++));	/* jrvz 8/21/83 */
 }

/* write text destined for the assembler to read */
/* (i.e. stuff not in comments)			*/
/*  gtf  6/26/80 */
outasm(ptr)
char *ptr;
{
/*	while(outbyte(raise(*ptr++)));*/
	while(outbyte(*ptr++));	/* ZMAC changes to upper case */
/* end outasm */}

nl()
	{outbyte(EOL);}
tab()
	{outbyte(9);}
col()
	{outbyte(58);}
bell()				/* gtf 7/16/80 */
	{outbyte(7);}

error(ptr)
char ptr[];
{	int k;
	char junk[81];

	toconsole();
	bell();
	outstr("Line "); outdec(lineno); outstr(", ");
	if(infunc==0)
		outbyte('(');
	if(currfn==NULL)
		outstr("start of file");
	else	outstr(currfn+name);
	if(infunc==0)
		outbyte(')');
	outstr(" + ");
	outdec(lineno-fnstart);
	outstr(": ");  outstr(ptr);  nl();

	outstr(line); nl();

	k=0;	/* skip to error position */
	while(k<lptr){
		if(line[k++]==9)
			tab();
		else	outbyte(' ');
		}
	outbyte('^');  nl();
	++errcnt;

	if(errstop){
		pl("Continue (Y,n,g) ? ");
		gets(junk);		
		k=junk[0];
		if((k=='N') | (k=='n'))
			abort();
		if((k=='G') | (k=='g'))
			errstop=0;
		}
	tofile();
/* end error */}

ol(ptr)
	char ptr[];
{
	ot(ptr);
	nl();
}
ot(ptr)
	char ptr[];
{
	tab();
	outasm(ptr);
}
streq(str1,str2)
	char str1[],str2[];
 {
	int k;
	k=0;
	while (*str2)
		{if ((*str1++)!=(*str2++)) return 0;
		k++;
		}
	return k;
 }
astreq(str1,str2,len)
	char str1[],str2[];int len;
 {
	int k;
	k=0;
	while (k<len)
		{if ((*str1)!=(*str2))break;
		if(*str1==0)break;
		if(*str2==0)break;
		++str1; ++str2; ++k;
		}
	if (an(*str1))return 0;
	if (an(*str2))return 0;
	return k;
 }
match(lit)
	char *lit;
{
	int k;
	blanks();
	if (k=streq(line+lptr,lit))
		{lptr=lptr+k;
		return 1;
		}
 	return 0;
}
amatch(lit,len)
	char *lit;int len;
 {
	int k;
	blanks();
	if (k=astreq(line+lptr,lit,len))
		{lptr=lptr+k;
		while(an(ch())) inbyte();
		return 1;
		}
	return 0;
 }
blanks()
	{while(1)
		{while(ch()==0)
			{inline();
			preprocess();
			if(eof)break;
			}
		if(ch()==' ')gch();
		else if(ch()==9)gch();
		else return;
		}
	}
outdec(number)
	int number;
 {	if (number<0)
		{number=(-number);
		outbyte('-');
		}
	outd2(number);
}
outd2(n) int n;
{	if(n>9) {outd2(n/10); n=n%10;}
	outbyte('0'+n);
 }
/* return the length of a string */
/* gtf 4/8/80 */
strlen(s)
char *s;
{	char *t;

	t = s;
	while(*s) s++;
	return(s-t);
/* end strlen */}

/* convert lower case to upper */
/* gtf 6/26/80 */
raise(c)
char c;
{
	if(c>='a')
		{if(c<='z')
			c = c - 32; /* 'a'-'A'=32 */
		}
	return(c);
/* end raise */}
#include c80v-2.c

.