/* ### cpcn-1 */
/************************************************/
/*						*/
/*		small-c:PC compiler		*/
/*						*/
/*		  by Ron Cain			*/
/*	modified by CAPROCK SYSTEMS for IBM PC	*/
/*						*/
/************************************************/


#define BANNER  "* * *  Small-C:PC  V1.1  * * *"


#define VERSION "PC-DOS Version N: June, 1982"


#define AUTHOR "By Ron Cain, Modified by CAPROCK SYSTEMS for IBM PC"


/*	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	5040
#define numglbs 300
#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 data for external symbols	*/

#define extblsz 2000
#define startextrn exttab
#define endextrn exttab+extblsz-namesize-1

/* Possible types of exttab entries */
/* Stored in the byte following zero terminating the name */

#define rtsfunc 1
#define userible types of exttab entries */
/* Stored in the byte following zero terminating the name */

#define rtsfunc 1
#define userfunc 2
#define statref 3


/*	Define possible entries for "ident"	*/


#define	variable 1
#define	array	2
#define	pointer	3
#define	function 4


/*	Define possible entries for "type"	*/


#define	cchar	1
#define	cint	2


/*	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	3000
#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 1000
#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	7
#define asmsuff	7


/*	Now reserve some storage words		*/


char	exttab[extblsz];	/* external symbols */
char	*extptr;		/* pointer to next available entry */


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


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


char	litq[litabsz];		/* 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 */
	cextern,	/* collecting external names flag */
	Zsp,		/* compiler relative stk ptr */
	argstk,		/* function arg sp */
	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) */
	input2,		/* iob # for "include" file */
	ctext,		/* non-zero to intermix c-source */
	cmode,		/* non-zero while parsing c-code */
			/* zero when passing assembly code */
	lastst,		/* last executed statement type */
	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 **					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 */


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 */
int	*iptr;		/* work ptr to any int buffer */
/*	>>>>> start cc1 <<<<<<		*/


/*					*/
/*	Compiler begins execution here	*/
/*					*/
main()
{
	hello();	/* greet user */
	see();		/* determine options */
	litlab=1;
	openin();	/* first file to process */
	while (input!=0)	/* process user files till he quits */
		{
		extptr=startextrn;	/* clear external symbols */
		glbptr=startglb;	/* clear global symbols */
		locptr=startloc;	/* clear local symbols */
		wqptr=wq;		/* clear while queue */
		macptr=		/* clear the macro pool */
		litptr=		/* clear literal pool */
	  	Zsp =		/* stack ptr (relative) */
		errcnt=		/* no errors */
		eof=		/* not end-of-file yet */
		input2=		/* no include file */
		saveout=	/* no diverted output */
		ncmp=		/* no open compound states */
		lastst=		/* no last statement yet */
		cextern=	/* no externs yet */
		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 */
		cmode=nxtlab=1;	/* enable preprocessing and reset label numbers */
		openout();
		header();
		parse();
		if (ncmp) error("missing closing bracket");
		extdump();
		dumpublics();
		trailer();
		closeout();
		errorsummary();
		openin();
		}
}
/* ### cpcn-2 */
/*					*/
/*	Abort compilation		*/
/*		gtf 7/17/80		*/
abort()
{
	if(input2)
		endinclude();
	if(input)
		fclose(input);
	closeout();
	toconsole();
	pl("Compilation aborted.");  nl();
	exit();
/* end abort */}


/*					*/
/*	Process all input text		*/);
	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("extern",6)) {
			cextern=1;
			if(amatch("char",4)) {declglb(cchar);ns();}
			else if(amatch("int",3)) {declglb(cint);ns();}
			else {declglb(cint);ns();}
			cextern=0;
			}
		else if(amatch("char",4)){declglb(cchar);ns();}
		else if(amatch("int",3)){declglb(cint);ns();}
		else if(match("#asm"))doasm();
		else if(match("#include"))doinclude();
		else if(match("#define"))addmac();
		else newfunc();
		blanks();	/* force eof if pending */
		}
	}
/* ### cpcn-3 */
dumpublics()
	{
	outstr("DUMMY SEGMENT BYTE STACK 'dummy'");nl();
	outstr("DUMMY ENDS");nl();
	outstr("STACK SEGMENT BYTE PUBLIC 'stack'");nl();
	dumplits();
	dumpglbs();
	outstr("STACK ENDS");nl();
	}

extdump()
	{
	char *ptrext;
	ptrext=startextrn;
	while(ptrext<extptr)
		{
		if((cptr=findglb(ptrext))!=0)
			{if(cptr[ident]==function)
				if(cptr[offset]!=function) outextrn(ptrext);
			}
		else outextrn(ptrext);
		ptrext=ptrext+strlen(ptrext)+2;
		}
	outstr("CSEG ENDS");nl();
	}
/* ### cpcn-4 */
outextrn(ptr)
	char *ptr;
	{
	char *functype;
	functype=ptr+strlen(ptr)+1;
	if(*functype==statref) return;
	ot("EXTRN ");
	if(*functype==rtsfunc) outasm(ptr);
	else outname(ptr);
	col();outstr("NEAR");nl();
	}


/*					*/
/*	Dump the literal pool		*/
/*					*/
dumplits()
	{int j,k;
	if (litptr==0) return;	/* if nothing there, exit...*/
	printlabel(litlab); /* 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++]&127));
			if ((j==0) | (k>=litptr))
				{nl();		/* need <cr> */
				break;
				}
			outbyte(',');	/* separate bytes */
			}
		}
	}
/*					*/
/*	Dump all static variables	*/
/*					*/
dumpglbs()
{
	int j;
	cptr=startglb;
	while(cptr<glbptr)
		{if(cptr[ident]!=function)
			/* do if anything but function */
			{
			if(findext(cptr+name))
				{
				ot("EXTRN ");
				outname(cptr);col();
				if((cptr[type]==cint) |
					(cptr[ident]==pointer)) outstr("WORD");
				else outstr("BYTE");
				nl();
				}
			else {
				ot("PUBLIC ");outname(cptr);nl();
				outname(cptr);
				/* output name as label... */
				j=((cptr[offset]&255)+
					((cptr[offset+1]&255)<<8));
					/* calc # bytes */
				if((cptr[type]==cint)|
					(cptr[ident]==pointer)) defword();
				else defbyte();
				outdec(j);
				outstr(" DUP(?)");
				nl();
				}
			}
		cptr=cptr+symsiz;
		}
}
/*					*/
/*	Report errors for user		*/
/*					*/
errorsummary()
	{
	nl();
	outstr("There were ");
	outdec(errcnt);	/* total # errors */
	outstr(" errors in compilation.");
	nl();
	}
/* ### cpcn-5 */
/*	Greet User	*/


hello()
	{
	clrscreen(); 	/* clear screen function */
	nl();nl();		/* print banner */
	pl(BANNER);
	nl();
	pl(AUTHOR);
	nl();nl();
	pl("Distributed by: CAPROCK SYSTEMS, INC.");
	pl("                P.O. Box 13814");
	pl("                Arlington, Texas 76013");
	nl();
	pl(VERSION);
	nl();
	nl();
} /* end of hello */


see()
	{
	kill();
	/* see if user wants to be sure to see all errors */
	pl("Should I pause after an error (y,N)?");
	gets(line);
	errstop=0;
	if((ch()=='Y')|(ch()=='y'))
		errstop=1;

	kill();
	pl("Do you want the small-c:PC-text to appear (y,N)?");
	gets(line);
	ctext=0;
	if((ch()=='Y')|(ch()=='y')) ctext=1;
        }
/*					*/
/*	Get output filename		*/
/*					*/
openout()
	{
	output=0;		/* start with none */
	while(output==0)
		{
		kill();
		pl("Output filename? "); /* ask...*/
		gets(line);	/* get a filename */
		if(ch()==0)break;	/* none given... */
		if((output=fopen(line,"w"))==NULL) /* if given, open */
			{output=0;	/* can't open */
			error("Open failure!");
			}
		}
	kill();			/* erase line */
}
/*					*/
/*	Get (next) input file		*/
/*					*/
openin()
{
	input=0;		/* none to start with */
	while(input==0){	/* any above 1 allowed */
		kill();		/* clear line */
		pl("Input filename? ");
		gets(line);	/* get a name */
		if(ch()==0) break;
		if((input=fopen(line,"r"))!=NULL)
			newfile();			/* gtf 7/16/80 */
		else {	input=0;	/* can't open it */
			pl("Open failure");
			}
		}
	kill();		/* erase line */
	}


/*					*/
/*	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 */}
/* ### cpcn-6 */


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


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


	if(input2)					/* gtf 7/16/80 */
		error("Cannot nest include files");
	else if((input2=fopen(line+lptr,"r"))==NULL)
		{input2=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();


	input2  = 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 */
}
/* ### cpcn-7 */
/*					*/
/*	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 or cint */
	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 */
				}
			addglb(sname,j,typ,k); /* add symbol */
			if(cextern) addext(sname,statref);
			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 or cint */
	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
					{j=pointer;
					k=2;
					}
				}
			else
				if((typ==cchar)
					&(j!=pointer))
					k=1;else k=2;
			/* change machine stack */
			Zsp=modstk(Zsp-k);
			addloc(sname,j,typ,Zsp);
			break;
			}
		if (match(",")==0) return;
		}
	}
/* ### cpcn-8 */
/*	>>>>>> 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 */
	}
/*					*/
/* ### cpcn-9 */
/*	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 */
	if (symname(n)==0)
		{
		if(eof==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;
			/* otherwise 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");
	ot("PUBLIC ");outname(n);nl();
	outname(n);col();nl();	/* print function name */
	argstk=0;		/* init arg count */
	while(match(")")==0)	/* then count args */
		/* any legal name bumps arg count */
		{if(symname(n))argstk=argstk+2;
		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;
		}
	locptr=startloc;	/* "clear" local symbol table*/
	Zsp=0;			/* preset stack ptr */
	while(argstk)
		/* 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{error("wrong number args");break;}
		}
	if(statement()!=streturn) /* do a statement, but if */
				/* it's a return, skip */
				/* cleaning up the stack */
		{modstk(0);
		zret();
		}
	Zsp=0;			/* reset stack ptr again */
	locptr=seturn, skip */
				/* cleaning up the stack */
		{modstk(0);
		zret();
		}
	Zsp=0;			/* reset stack ptr again */
	locptr=startloc;	/* deallocate all locals */
	infunc=0;		/* not in fn. any more		gtf 7/2/80 */
	}
/* ### cpcn-10 */
/*					*/
/*	Declare argument types		*/
/*					*/
/* called from "newfunc" this routine adds an entry in the */
/*	local symbol table for each named argument */
getarg(t)		/* t = cchar or cint */
	int t;
	{
	char n[namesize],c;int j;
	while(1)
		{if(argstk==0)return;	/* no more args */
		if(match("*"))j=pointer;
			else j=variable;
		if(symname(n)==0) illname();
		if(findloc(n))multidef(n);
		if(match("["))	/* pointer ? */
		/* it is a pointer, so skip all */
		/* stuff between "[]" */
			{while(inbyte()!=']')
				if(endst())break;
			j=pointer;
			/* add entry as pointer */
			}
		addloc(n,j,t,argstk);
		argstk=argstk-2;	/* cnt down */
		if(endst())return;
		if(match(",")==0)error("expected comma");
		}
	}
/* ### cpcn-11 */
/*	Statement parser		*/
/*					*/
/* called whenever syntax requires	*/
/*	a statement. 			 */
/*  this routine performs that statement */
/*  and returns a number telling which one */
statement()
{
/* comment out ctrl-C check since ctrl-break will work on PC */
/*	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(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;
}
/*					*/
/* ### cpcn-12 */
/*	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" statement		*/
/*					*/
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 */
	Zsp = modstk(wq[wqsp]);	/* zap local vars: 9/25/80 gtf */
	jump(wq[wqloop]);	/* loop to label */
	printlabel(wq[wqlab]);col();nl(); /* exit label */
	locptr=wq[wqsym];	/* deallocate locals */
	delwhile();		/* delete queue entry */
	}
/*					*/
/* ### cpcn-13 */
/*					*/
/*	"return" statement		*/
/*					*/
doreturn()
	{
	/* if not end of statement, get an expression */
	if(endst()==0)expression();
	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 */
	}
/* ### cpcn-14 */
/*	>>>>> start of cc3 <<<<<<<<<	*/


/*					*/
/*	Perform a function call		*/
/*					*/
/* called from heir11, this routine will either call */
/*	the named function, or if the supplied ptr is */
/*	zero, will call the contents of BX		*/
callfunction(ptr)
	char *ptr;	/* symbol table entry (or 0) */
{	int nargs;
	nargs=0;
	blanks();	/* already saw open paren */
	if(ptr==0)zpush();	/* calling BX */
	while(streq(line+lptr,")")==0)
		{if(endst())break;
		expression();	/* get an argument */
		if(ptr==0)swapstk(); /* don't push addr */
		zpush();	/* push argument */
		nargs=nargs+2;	/* count args*2 */
		if (match(",")==0) break;
		}
	needbrack(")");
	if(ptr)zcall(ptr);
	else callstk();
	Zsp=modstk(Zsp+nargs);	/* clean up arguments */
}
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");
}
/* ### cpcn-15 */
findglb(sname)
	char *sname;
{	char *ptr;
	ptr=startglb;
	while(ptr!=glbptr)
		{if(astreq(sname,ptr,namemax))return ptr;
		ptr=ptr+symsiz;
		}
	return 0;
}
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(cptr=findglb(sname))return cptr;
	if(glbptr>=endglb)
		{error("global symbol table overflow");
		return 0;
		}
	cptr=ptr=glbptr;
	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;
}
/* ### cpcn-16 */
addext(sname,id)
	char *sname,id;
	{
	char *ptr;
	if(cptr=findext(sname)) return cptr;
	if(extptr>=endextrn)
		{error("external symbol table overflow"); return 0;}
	cptr=ptr=extptr;
	while(an(*ptr++=*sname++)); /* copy name */
	/* type stored in byte following zero terminating name */
	*ptr++=id;
	extptr=ptr;
	return cptr;
	}
findext(sname)
	char *sname;
	{char *ptr;
	ptr=startextrn;
	while(ptr<extptr)
		{if(astreq(sname,ptr,namemax)) return ptr;
		 ptr=ptr+strlen(ptr)+2;
		}
	return 0;
	}


/* 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;
	}
/* ### cpcn-17 */
/* 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)
	char c;
{	c=c&127;
	return(((c>='a')&(c<='z'))|
		((c>='A')&(c<='Z'))|
		(c=='_'));
}
/* Test if given character is numeric */
numeric(c)
	char c;
{	c=c&127;
	return((c>='0')&(c<='9'));
}
/* Test if given character is alphanumeric */
an(c)
	char c;
{	return((alpha(c))|(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);
}
gch()
{	if(ch()==0)return 0;
		else return(line[lptr++]&127);
}
kill()
{	lptr=0;
	line[lptr]=0;
}
/* ### cpcn-18 */
inbyte()
{
	while(ch()==0)
		{if (eof) return 0;
		inline();
		preprocess();
		}
	return gch();
}
inchar()
{
	if(ch()==0)inline();
	if(eof)return 0;
	return(gch());
}
inline()
{
	int k,unit;
	while(1)
		{if (input==0)  {eof=1;return;}
		if((unit=input2)==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(input2)endinclude();		/* gtf 7/16/80 */
				else input=0;
			}
		if(lptr)
			{if((ctext)&(cmode))
				{comment();
				outstr(line);
				nl();
				}
			lptr=0;
			relse input=0;
			}
		if(lptr)
			{if((ctext)&(cmode))
				{comment();
				outstr(line);
				nl();
				}
			lptr=0;
			return;
			}
		}
}
/* ### cpcn-19 */
/*	>>>>>> start of cc4 <<<<<<<	*/


preprocess()
{	int k;
	char c,sname[namesize];
	if(cmode==0)return;
	mptr=lptr=0;
	while(ch())
		{if((ch()==' ')|(ch()==9))
			predel();
		else if(ch()=='"')
			prequote();
		else if(ch()==39)
			preapos();
		else if((ch()=='/')&(nch()=='*'))
			precomm();
		else if(alpha(ch()))	/* from an(): 9/22/80 gtf */
			{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;
	}
/* ### cpcn-20 */
keepch(c)
	char c;
{	mline[mptr]=c;
	if(mptr<mpmax)mptr++;
	return c;
}
predel()
			{keepch(' ');
			while((ch()==' ')|
				(ch()==9))
				gch();
			}
prequote()
			{keepch(ch());
			gch();
			while(ch()!='"')
				{if(ch()==0)
				  {error("missing quote");
				  break;
				  }
				keepch(gch());
				}
			gch();
			keepch('"');
			}
preapos()
			{keepch(39);
			gch();
			while(ch()!=39)
				{if(ch()==0)
				  {error("missing apostrophe");
				  break;
				  }
				keepch(gch());
				}
			gch();
			keepch(39);
			}
precomm()
			{inchar();inchar();
			while(((ch()=='*')&
				(nch()=='/'))==0)
				{if(ch()==0)inline();
					else inchar();
				if(eof)break;
				}
			inchar();inchar();
			}
/* ### cpcn-21 */
addmac()
{	char sname[namesize];
	int k;
	if(symname(sname)==0)
		{illname();
		kill();
		return;
		}
	k=0;
	while(putmac(sname[k++]));
	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)
	char *sname;
{	int k;
	k=0;
	while(k<macptr)
		{if(astreq(sname,macq+k,namemax))
			{while(macq[k++]);
			return k;
			}
		while(macq[k++]);
		while(macq[k++]);
		}
	return 0;
}
/* ### cpcn-22 */
/* 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==0)return 0;
	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[];
 {
	int k;
	k=0;
	while(outbyte(ptr[k++]));
 }


/* 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++)));
/* end outasm */}


nl()
	{outbyte(eol);}
tab()
	{outbyte(9);}
col()
	{outbyte(58);}
/* ### cpcn-23 */
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);
}
/* ### cpcn-24 */
streq(str1,str2)
	char str1[],str2[];
 {
	int k;
	k=0;
	while (str2[k])
		{if ((str1[k])!=(str2[k])) return 0;
		k++;
		}
	return k;
 }
astreq(str1,str2,len)
	char str1[],str2[];int len;
 {
	int k;
	k=0;
	while (k<len)
		{if ((str1[k])!=(str2[k]))break;
		if(str1[k]==0)break;
		if(str2[k]==0)break;
		k++;
		}
	if (an(str1[k]))return 0;
	if (an(str2[k]))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;
 }
/* ### cpcn-25 */
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;
 {
	int k,zs;
	char c;
	zs = 0;
	k=10000;
	if (number<0)
		{number=(-number);
		outbyte('-');
		}
	while (k>=1)
		{
		c=number/k + '0';
		if ((c!='0')|(k==1)|(zs))
			{zs=1;outbyte(c);}
		number=number%k;
		k=k/10;
		}
 }
/* 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') & (c<='z'))
		c = c - 'a' + 'A';
	return(c);
/* end raise */}
/* ### cpcn-26 */
/*	>>>>>>> start of cc5 <<<<<<<	*/


/* modified 9/25/80: putstk() */


expression()
{
	int lval[2];
	if(heir1(lval))rvalue(lval);
}
heir1(lval)
	int lval[];
{
	int k,lval2[2];
	k=heir2(lval);
	if (match("="))
		{if(k==0){needlval();return 0;}
		if (lval[1])zpush();
		if(heir1(lval2))rvalue(lval2);
		store(lval);
		return 0;
		}
	else return k;
}
heir2(lval)
	int lval[];
{	int k,lval2[2];
	k=heir3(lval);
	blanks();
	if(ch()!='|')return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("|"))
			{zpush();
			if(heir3(lval2)) rvalue(lval2);
			zpop();
			zor();
			}
		else return 0;
		}
}
/* ### cpcn-27 */
heir3(lval)
	int lval[];
{	int k,lval2[2];
	k=heir4(lval);
	blanks();
	if(ch()!='^')return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("^"))
			{zpush();
			if(heir4(lval2))rvalue(lval2);
			zpop();
			zxor();
			}
		else return 0;
		}
}
heir4(lval)
	int lval[];
{	int k,lval2[2];
	k=heir5(lval);
	blanks();
	if(ch()!='&')return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("&"))
			{zpush();
			if(heir5(lval2))rvalue(lval2);
			zpop();
			zand();
			}
		else return 0;
		}
}
heir5(lval)
	int lval[];
{
	int k,lval2[2];
	k=heir6(lval);
	blanks();
	if((streq(line+lptr,"==")==0)&
		(streq(line+lptr,"!=")==0))return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("=="))
			{zpush();
			if(heir6(lval2))rvalue(lval2);
			zpop();
			zeq();
			}
		else if (match("!="))
			{zpush();
			if(heir6(lval2))rvalue(lval2);
			zpop();
			zne();
			}
		else return 0;
		}
}
/* ### cpcn-28 */
heir6(lval)
	int lval[];
{
	int k;
	k=heir7(lval);
	blanks();
	if((streq(line+lptr,"<")==0)&
		(streq(line+lptr,">")==0)&
		(streq(line+lptr,"<=")==0)&
		(streq(line+lptr,">=")==0))return k;
		if(streq(line+lptr,">>"))return k;
		if(streq(line+lptr,"<<"))return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("<="))
			{if(heir6wrk(1,lval)) continue;
			zle();
			}
		else if (match(">="))
			{if(heir6wrk(2,lval)) continue;
			zge();
			}
		else if((streq(line+lptr,"<"))&
			(streq(line+lptr,"<<")==0))
			{inbyte();
			if(heir6wrk(3,lval)) continue;
			zlt();
			}
		else if((streq(line+lptr,">"))&
			(streq(line+lptr,">>")==0))
			{inbyte();
			if(heir6wrk(4,lval)) continue;
			zgt();
			}
		else return 0;
		}
}
/* ### cpcn-29 */
heir6wrk(k,lval)
	int k,lval[];
{
	int lval2[2];
	zpush();
	if(heir7(lval2))rvalue(lval2);
	zpop();
	if(cptr=lval[0])
		if(cptr[ident]==pointer)
			{heir6op(k);
			return 1;
			}
	if(cptr=lval2[0])
		if(cptr[ident]==pointer)
			{heir6op(k);
			return 1;
			}
	return 0;
}
heir6op(k)
	int k;
{
	if(k==1) ule();
	else if(k==2) uge();
	     else if(k==3) ult();
		  else ugt();
}
/* ### cpcn-30 */
/*	>>>>>> start of cc6 <<<<<<	*/


heir7(lval)
	int lval[];
{
	int k,lval2[2];
	k=heir8(lval);
	blanks();
	if((streq(line+lptr,">>")==0)&
		(streq(line+lptr,"<<")==0))return k;
	if(k)rvalue(lval);
	while(1)
		{if (match(">>"))
			{zpush();
			if(heir8(lval2))rvalue(lval2);
			zpop();
			asr();
			}
		else if (match("<<"))
			{zpush();
			if(heir8(lval2))rvalue(lval2);
			zpop();
			asl();
			}
		else return 0;
		}
}
/* ### cpcn-31 */
heir8(lval)
	int lval[];
{
	int k,lval2[2];
	k=heir9(lval);
	blanks();
	if((ch()!='+')&(ch()!='-'))return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("+"))
			{zpush();
			if(heir9(lval2))rvalue(lval2);
			if(cptr=lval[0])
				if((cptr[ident]==pointer)&
				(cptr[type]==cint))
				doublereg();
			zpop();
			zadd();
			}
		else if (match("-"))
			{zpush();
			if(heir9(lval2))rvalue(lval2);
			if(cptr=lval[0])
				if((cptr[ident]==pointer)&
				(cptr[type]==cint))
				doublereg();
			zpop();
			zsub();
			}
		else return 0;
		}
}
/* ### cpcn-32 */
heir9(lval)
	int lval[];
{
	int k,lval2[2];
	k=heir10(lval);
	blanks();
	if((ch()!='*')&(ch()!='/')&
		(ch()!='%'))return k;
	if(k)rvalue(lval);
	while(1)
		{if (match("*"))
			{zpush();
			if(heir9(lval2))rvalue(lval2);
			zpop();
			mult();
			}
		else if (match("/"))
			{zpush();
			if(heir10(lval2))rvalue(lval2);
			zpop();
			div();
			}
		else if (match("%"))
			{zpush();
			if(heir10(lval2))rvalue(lval2);
			zpop();
			zmod();
			}
		else return 0;
		}
}
/* ### cpcn-33 */
heir10(lval)
	int lval[];
{
	int k;
	if(match("++"))
		{if((k=heir10(lval))==0)
			{needlval();
			return 0;
			}
		heir10inc(lval);
		return 0;
		}
	else if(match("--"))
		{if((k=heir10(lval))==0)
			{needlval();
			return 0;
			}
		heir10dec(lval);
		return 0;
		}
	else if (match("-"))
		{k=heir10(lval);
		if (k) rvalue(lval);
		neg();
		return 0;
		}
	else if(match("*"))
		{heir10as(lval);
		return 1;
		}
	else if(match("&"))
		{k=heir10(lval);
		if(k==0)
			{error("illegal address");
			return 0;
			}
		else if(lval[1])return 0;
		else
			{heir10at(lval);
			return 0;
			}
		}
	else 
		{k=heir11(lval);
		if(match("++"))
	lse if(lval[1])return 0;
		else
			{heir10at(lval);
			return 0;
			}
		}
	else 
		{k=heir11(lval);
		if(match("++"))
			{if(k==0)
				{needlval();
				return 0;
				}
			heir10id(lval);
			return 0;
			}
		else if(match("--"))
			{if(k==0)
				{needlval();
				return 0;
				}
			heir10di(lval);
			return 0;
			}
		else return k;
		}
	}
/* ### cpcn-34 */
heir10inc(lval)
	int lval[];
{
	char *ptr;
	if(lval[1])zpush();
	rvalue(lval);
	inc();
	ptr=lval[0];
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
			inc();
	store(lval);
}
heir10dec(lval)
	int lval[];
{
	char *ptr;


	if(lval[1])zpush();
	rvalue(lval);
	dec();
	ptr=lval[0];
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
			dec();
	store(lval);
}
heir10as(lval)
	int lval[];
{
	int k;
	char *ptr;


	k=heir10(lval);
	if(k)rvalue(lval);
	lval[1]=cint;
	if(ptr=lval[0])lval[1]=ptr[type];
	lval[0]=0;
}
/* ### cpcn-35 */
heir10at(lval)
	int lval[];
{
	char *ptr;


	immed();
	outstr("OFFSET ");
	outname(ptr=lval[0]);
	nl();
	lval[1]=ptr[type];
}
heir10id(lval)
	int lval[];
{
	char *ptr;


	if(lval[1])zpush();
	rvalue(lval);
	inc();
	ptr=lval[0];
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
			inc();
	store(lval);
	dec();
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
		dec();
}
heir10di(lval)
	int lval[];
{
	char *ptr;


	if(lval[1])zpush();
	rvalue(lval);
	dec();
	ptr=lval[0];
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
			dec();
	store(lval);
	inc();
	if((ptr[ident]==pointer)&
		(ptr[type]==cint))
		inc();
}
/* ### cpcn-36 */
/*	>>>>>> start of cc7 <<<<<<	*/


heir11(lval)
	int *lval;
{	int k;char *ptr;
	k=primary(lval);
	ptr=lval[0];
	blanks();
	if((ch()=='[')|(ch()=='('))
	while(1)
		{if(match("["))
			{if(ptr==0)
				{error("can't subscript");
				junk();
				needbrack("]");
				return 0;
				}
			else if(ptr[ident]==pointer)rvalue(lval);
			else if(ptr[ident]!=array)
				{error("can't subscript");
				k=0;
				}
			zpush();
			expression();
			needbrack("]");
			if(ptr[type]==cint)doublereg();
			zpop();
			zadd();
			lval[1]=ptr[type];
			k=1;
			}
		else if(match("("))
			{if(ptr==0)
				{callfunction(0);
				}
			else if(ptr[ident]!=function)
				{rvalue(lval);
				callfunction(0);
				}
			else callfunction(ptr);
			k=lval[0]=0;
			}
		else return k;
		}
	if(ptr==0)return k;
	if(ptr[ident]==function)
		{immed();
		outstr("OFFSET ");
		outname(ptr);
		nl();
		return 0;
		}
	return k;
}
/* ### cpcn-37 */
primary(lval)
	int *lval;
{	char *ptr,sname[namesize];int num[1];
	int k;
	if(match("("))
		{k=heir1(lval);
		needbrack(")");
		return k;
		}
	if(symname(sname))
		{if(ptr=findloc(sname))
			{getloc(ptr);
			lval[0]=ptr;
			lval[1]=ptr[type];
			if(ptr[ident]==pointer)lval[1]=cint;
			if(ptr[ident]==array)return 0;
				else return 1;
			}
		if(ptr=findglb(sname))
			if(ptr[ident]!=function)
			{lval[0]=ptr;
			lval[1]=0;
			if(ptr[ident]!=array)return 1;
			immed();
			outstr("OFFSET ");
			outname(ptr);nl();
			lval[1]=ptr[type];
			return 0;
			}
		ptr=addglb(sname,function,cint,0);
		lval[0]=ptr;
		lval[1]=0;
		return 0;
		}
	if(constant(num))
		return(lval[0]=lval[1]=0);
	else
		{error("invalid expression");
		immed();outdec(0);nl();
		junk();
		return 0;
		}
	}
/* ### cpcn-38 */
store(lval)
	int *lval;
{	if (lval[1]==0)putmem(lval[0]);
	else putstk(lval[1]);
}
rvalue(lval)
	int *lval;
{	if((lval[0] != 0) & (lval[1] == 0))
		getmem(lval[0]);
		else indirect(lval[1]);
}
test(label)
	int label;
{
	needbrack("(");
	expression();
	needbrack(")");
	testjump(label);
}
constant(val)
	int val[];
{	if (number(val))
		immed();
	else if (pstr(val))
		immed();
	else if (qstr(val))
		{immed();outstr("OFFSET ");printlabel(litlab);outbyte('+');}
	else return 0;	
	outdec(val[0]);
	nl();
	return 1;
}
/* ### cpcn-39 */
number(val)
	int val[];
{	int k,minus;char c;
	k=minus=1;
	while(k)
		{k=0;
		if (match("+")) k=1;
		if (match("-")) {minus=(-minus);k=1;}
		}
	if(numeric(ch())==0)return 0;
	while (numeric(ch()))
		{c=inbyte();
		k=k*10+(c-'0');
		}
	if (minus<0) k=(-k);
	val[0]=k;
	return 1;
}
pstr(val)
	int val[];
{	int k;char c;
	k=0;
	if (match("'")==0) return 0;
	while((c=gch())!=39)
		k=(k&255)*256 + (c&127);
	val[0]=k;
	return 1;
}
qstr(val)
	int val[];
{	char c;
	if (match(quote)==0) return 0;
	val[0]=litptr;
	while (ch()!='"')
		{if(ch()==0)break;
		if(litptr>=litmax)
			{error("string space exhausted");
			while(match(quote)==0)
				if(gch()==0)break;
			return 1;
			}
		litq[litptr++]=gch();
		}
	gch();
	litq[litptr++]=0;
	return 1;
}
/* ### cpcn-40 */
/*	>>>>>> start of cc8 <<<<<<<	*/


/* Begin a comment line for the assembler */
comment()
{	outbyte(';');
}


/* Put out assembler info before any code is generated */
header()
{	comment();
	outstr(BANNER);
	nl();
	comment();
	outstr(VERSION);
	nl();
	comment();
	outstr(AUTHOR);
	nl();
	comment();
	nl();
	outstr("CSEG SEGMENT BYTE PUBLIC 'code'");nl();
	ol("ASSUME CS:CSEG,SS:STACK");
}
/* Print any assembler stuff needed af);
	outstr("CSEG SEGMENT BYTE PUBLIC 'code'");nl();
	ol("ASSUME CS:CSEG,SS:STACK");
}
/* Print any assembler stuff needed after all code */
trailer()
{
	nl();			/* 6 May 80 rj errorsummary() now goes to console */
	comment();
	outstr(" --- End of Compilation ---");
	nl();
	ol("END");
}
/* ### cpcn-41 */
/* Print out a name such that it won't annoy the assembler */
/*	(by matching anything reserved, like opcodes.) */
/*	gtf 4/7/80 */
outname(sname)
char *sname;
{	int len, i,j;


	outasm("qz");
	len = strlen(sname);
	if(len>(asmpref+asmsuff)){
		i = asmpref;
		len = len-asmpref-asmsuff;
		while(i-- > 0)
			outbyte(raise(*sname++));
		while(len-- > 0)
			sname++;
		while(*sname)
			outbyte(raise(*sname++));
		}
	else	outasm(sname);
/* end outname */}
/* Fetch a static memory cell into the primary register */
getmem(sym)
	char *sym;
{	if((sym[ident]!=pointer)&(sym[type]==cchar))
		{ ot("MOV AL,SS:");
		outname(sym+name);
		nl();
		ol("CBW");
		ol("MOV BX,AX");
		}
	else
		{ot("MOV BX,SS:");
		outname(sym+name);
		nl();
		}
	}
/* Fetch the address of the specified symbol */
/*	into the primary register */
getloc(sym)
	char *sym;
{	immed();
	outdec(((sym[offset]&255)+
		((sym[offset+1]&255)<<8))-
		Zsp);
	nl();
	ol("ADD BX,SP");
	}
/* Store the primary register into the specified */
/*	static memory cell */
putmem(sym)
	char *sym;
{
	ot("MOV SS:");outname(sym+name);
	outstr(",");
	if((sym[ident]!=pointer)&(sym[type]==cchar)) outstr("BL");
	else outstr("BX");
	nl();
	}
/* Store the specified object type in the primary register */
/*	at the address on the top of the stack */
putstk(typeobj)
	char typeobj;
{	zpop();
	if(typeobj==cint)
		callrts("ccpint");
	else {
		ol("MOV BP,DX");
		ol("MOV [BP],BL");
		}
	}
/* ### cpcn-42 */
/* Fetch the specified object type indirect through the */
/*	primary register into the primary register */
indirect(typeobj)
	char typeobj;
{	if(typeobj==cchar)callrts("ccgchar");
		else callrts("ccgint");
}
/* Swap the primary and secondary registers */
swap()
{
	ol("XCHG DX,BX");
}
/* Print partial instruction to get an immediate value */
/*	into the primary register */
immed()
{
	ot("MOV BX,");
}
/* Push the primary register onto the stack */
zpush()
{
	ol("PUSH BX");
	Zsp=Zsp-2;
}
/* Pop the top of the stack into the secondary register */
zpop()
{
	ol("POP DX");
	Zsp=Zsp+2;
}
/* Swap the primary register and the top of the stack */
swapstk()
{
	ol("MOV BP,SP");
	ol("XCHG BX,[BP]");
}
/* Call the specified subroutine name */
zcall(sname)
	char *sname;
{	ot("CALL ");
	outname(sname);
	nl();
	addext(sname,userfunc);
}
/* Call a run-time library routine */
callrts(sname)
char *sname;
{
	ot("CALL ");
	outasm(sname);
	nl();
	addext(sname,rtsfunc);
/*end callrts*/}


/* Return from subroutine */
zret()
{	ol("RET");
}
/* ### cpcn-43 */
/* Perform subroutine call to value on top of stack */
callstk()
{	immed();
	outasm("$+11");
	nl();
	swapstk();
	ol("JMP BX");
	Zsp=Zsp-2;
	}
/* Jump to specified internal label number */
jump(label)
	int label;
{	ot("JMP ");
	printlabel(label);
	nl();
	}
/* Test the primary register and jump if false to label */
testjump(label)
	int label;
{	
	ol("OR BX,BX");
	ol("JNZ $+5");
	jump(label);
}
/* Print pseudo-op to define a byte */
defbyte()
{	ot("DB ");
}
/*Print pseudo-op to define storage */
defstorage()
{	ot("DS ");
}
/* Print pseudo-op to define a word */
defword()
{	ot("DW ");
}
/* Modify the stack pointer to the new value indicated */
modstk(newsp)
	int newsp;
 {	int k;
	k=newsp-Zsp;
	if(k==0)return newsp;
	if(k>=0)
		{if(k<7)
			{if(k&1)
				{
				ol("INC SP");
				k--;
				}
			while(k)
				{ol("POP CX");
				k=k-2;
				}
			return newsp;
			}
		}
	if(k<0)
		{if(k>-7)
			{if(k&1)
				{ ol("DEC SP");
				k++;
				}
			while(k)
				{ol("PUSH CX");
				k=k+2;
				}
			return newsp;
			}
		}
	swap();
	immed();outdec(k);nl();
	ol("ADD SP,BX");
	swap();
	return newsp;
}
/* ### cpcn-44 */
/* Double the primary register */
doublereg()
{	ol("ADD BX,BX");
}
/* Add the primary and secondary registers */
/*	(results in primary) */
zadd()
{	ol("ADD BX,DX");
}
/* Subtract the primary register from the secondary */
/*	(results in primary) */
zsub()
{
	ol("SUB BX,DX");
	ol("NEG BX");
}
/* Multiply the primary and secondary registers */
/*	(results in primary */
mult()
{	callrts("ccmult");
}
/* Divide the secondary register by the primary */
/*	(quotient in primary, remainder in secondary) */
div()
{	callrts("ccdiv");
}
/* Compute remainder (mod) of secondary register divided */
/*	by the primary */
/*	(remainder in primary, quotient in secondary) */
zmod()
{	div();
	swap();
	}
/* Inclusive 'or' the primary and the secondary registers */
/*	(results in primary) */
zor()
	{ol("OR BX,DX");}
/* Exclusive 'or' the primary and seconday registers */
/*	(results in primary) */
zxor()
	{ol("XOR BX,DX");}
/* 'And' the primary and secondary rerimary and seconday registers */
/*	(results in primary) */
zxor()
	{ol("XOR BX,DX");}
/* 'And' the primary and secondary registers */
/*	(results in primary) */
zand()
	{ol("AND BX,DX");}
/* Arithmetic shift right the secondary register number of */
/* 	times in primary (results in primary) */
asr()
	{ol("MOV CL,BL");ol("MOV BX,DX");ol("SAR BX,CL");}
/* Arithmetic left shift the secondary register number of */
/*	times in primary (results in primary) */
asl()
	{ol("MOV CL,BL");ol("MOV BX,DX");ol("SAL BX,CL");}
/* Form two's complement of primary register */
neg()
	{ol("NEG BX");}
/* Form one's complement of primary register */
com()
	{ol("NOT BX");}
/* Increment the primary register by one */
inc()
	{ol("INC BX");}
/* Decrement the primary register by one */
dec()
	{ol("DEC BX");}


/* Following are the conditional operators */
/* They compare the secondary register against the primary */
/* and put a literal 1 in the primary if the condition is */
/* true, otherwise they clear the primary register */


/* Test for equal */
zeq()
	{callrts("cceq");}
/* Test for not equal */
zne()
	{callrts("ccne");}
/* Test for less than (signed) */
zlt()
	{callrts("cclt");}
/* Test for less than or equal to (signed) */
zle()
	{callrts("ccle");}
/* Test for greater than (signed) */
zgt()
	{callrts("ccgt");}
/* Test for greater than or equal to (signed) */
zge()
	{callrts("ccge");}
/* Test for less than (unsigned) */
ult()
	{callrts("ccult");}
/* Test for less than or equal to (unsigned) */
ule()
	{callrts("ccule");}
/* Test for greater than (unsigned) */
ugt()
	{callrts("ccugt");}
/* Test for greater than or equal to (unsigned) */
uge()
	{callrts("ccuge");}


/*	<<<<<  End of small-c:PC compiler  >>>>>	*/
r greater than or equal to (unsigned) */
uge()
	{callrts("ccuge");}


/*	<<<<<  End of small-c:PC compiler  >>>>>	*/