/************************************************/
/** Module: NCCR1.C  By: s_dubrovich@yahoo.com  */
/** Last: 15-Feb-09 11:22:07 AM                 */
/** Prev: 02-Feb-09 08:06:03 AM                 */
/** Vers: 0.2.7  Release 1.0                    */
/** Note: edits, rename, Release Version.       */
/************************************************/
/** Module: TNR6CC.C  By: s_dubrovich@yahoo.com */
/** Last: 02-Feb-09 08:06:03 AM                 */
/** Vers: 0.2.6                                 */
/************************************************/
/** Module: N2CC.C  By: s_dubrovich@yahoo.com   */
/** Last: 1:52 PM 1/18/2009                     */
/** Vers: 0.2.4                                 */
/** Change: names, add comments                **/
/************************************************/
/** Module: ECC.C  By: s_dubrovich@yahoo.com    */
/** Last: 12:31 PM 9/04/2008                    */
/** Vers: 0.2.2                                 */
/** Change:                                    **/
/** input => fp_in, input2 => fp_in2, output =>**/
/** fp_out, eof => eof_flg, getarg =>          **/
/** decl_autoarg, kill => kill_ln              **/
/************************************************/
/** Module: ECC.C  By: s_dubrovich@yahoo.com    */
/** Last: 8:17 AM 8/31/2008                     */
/** Init: 12:52 PM 8/29/2008 was DCC.C v.c0.1.5 */
/** Vers: c0.2.1 New: re-edit, added comments,  */
/**   changed labels to reflect C terminology.  */
/**  symbols significant to 10 chrs.            */
/**  sho_last();                                */
/** Uses: C5LIB.C                               */
/************************************************/
/** Last: 4:23 PM 8/14/2008 DCC.C               */
/** Vers: c0.1.5 New: inc macro pool 1664->2176 */
/** Stat: compiles itself! Vers for .com by mod */
/**  vstart=0100h, and commenting out section   */
/**  .dseg to form small model CS=DS=SS, the    */
/**  CMD.EXE dpmi server sets SP=FFF0h on load- */
/**  ing a .COM file at segment:0100h and the   */
/**  Program Segment Prefix is initialized with */
/**  the legacy Location 0005h Vector for the   */
/**  CP/M-80 API Emulation under dos fcb struct-*/
/**  ures, also using the CP/M-80 ABI register  */
/**  usage. see: http://www.patersontech.com/   */
/**   dos/Docs/86_Dos_inst_.pdf                 */
/**  also, added user input hints..             */
/************************************************/
/************************************************/
/** SCNXa.C for LVL1 compile w/ POWERC          */
/** SCNX.C for LVL2 compile w/ SCNXa.EXE        */
/** Extern Files Req'd: IOC5.C for LVL2.        */
/** POWERC compiles K&R with pcDos iolib which  */
/** runs under win XP thru CMD.EXE, a DPMIv.9   */
/** server, this is a LVL1 build.  LVL2 build   */
/** binds a Call_5 legacy io-lib, which mimics  */
/** CP/M-80 io functions under pcDos.  LVL2 is a*/
/** 'stand-in' for your hobby io-lib.  It shows */
/** the cross development step needed to boot-  */
/** strap mimimalist small-c for your hobby OS. */
/** Since this demonstrates small-c compiling   */
/** itself, along with grafting a minimal custom*/
/** io-lib, it shows how the migration path to a*/
/** new hobby OS platform can be achieved with  */
/** small-c initially.  The back-end assembler  */
/** syntax chosen is for NASM, 16bit small model*/
/** with an eye for 32bit multi-segmented, or   */
/** 64 bit later on.                            */
/************************************************/
/************************************************/
/** Re-Codified roughly as:                    **/
/**     I.   Static Storage Defn, main()       **/
/**     II.  Recursive Descent Parser          **/
/**     III. Utility Functions                 **/
/**     IV.  U.I. & I/O                        **/
/**     V.   Backend, NASM Object Output       **/
/************************************************/
/************************************************/
/*          small-c compiler                    */
/*              rev. 1.1                        */
/*            by Ron Cain                       */
/*              (1980)                          */
/************************************************/

#define eol 10	/** this is correct **/
#define NULL 0

/** move to the end --> #include C5LIB.C 	*/
/** However, initfcb() still must be called	*/
/**  before main(), so include stub function,	*/
/**  just ahead of file io in main(). 		*/
/************************************************/
/** Appendix A                                 **/
/**  4. C bases interp. of Identifier upon two **/
/**     attributes: Storage Class and its Type.**/
/** Storage Class determines Location, Lifetime**/
/** Type determines the meaning of the values  **/
/**  found in the identifier's storage.        **/
/** Storage Classes[4]={auto,static,extern,reg}**/
/** Type[Object]={char,int[3],float,double}    **/
/**  Type[derived]={array,functions,pointer,   **/
/**                 structures,unions}         **/
/**  5. Objects and lvalues - An Object is a   **/
/** manipulatable region of storage, an lvalue **/
/** is an expression refering to an object.    **/
/************************************************/
/** NOTE: the preprocessor macro does text sub-**/
/** stitution only, so macro expressions are   **/
/** evaluated at runtime.  It is more efficient**/
/** to evaluate macro expressions by hand than **/
/** otherwise having 'runtime' code generated  **/
/** to evaluate the macro expression.          **/
/************************************************/

/**--------------------------------------------**/
/** Appendix A pg 179, Lexical Conventions.    **/
/**  six classes of tokens.                    **/
/** 1. indentifiers                            **/
/** 2. keywords                                **/
/** 3. constants                               **/
/** 4. strings                                 **/
/** 5. operators                               **/
/** 6. other separators {blanks, tabs, newlines,*/
/**    and comments, i.e. whitespace.          **/
/**--------------------------------------------**/

/**--------------------------------------------**/
/** 7.1 -Primary Expressions-                  **/
/** An Identifier is a Primary Expression,     **/
/**  provided it has been suitably declared.   **/
/**--------------------------------------------**/
/** 3.1  -Statements and Blocks-               **/
/** An Expression becomes a Statement when it  **/
/** is followed by a semicolon.  In C the      **/
/** semicolon is a statement terminator.       **/
/**--------------------------------------------**/
/**  Define the symbol table parameters        **/
/**  #define symsiz  38  */       /** 38 bytes **/
/**  symbol table overflows with 38            **/
/**--------------------------------------------**/
#define symsiz 16 /* incr sz by 2 for name */
#define symtbsz   5760 /** 360x16 **/
#define numstatics 300
#define numautos    60 /* new def */
#define startstatic symtab
#define endstatic startstatic+numstatics*symsiz
                  /** which is 4200 **/
#define startauto endstatic+symsiz
                  /** which is 4214 **/
#define endauto   symtab+symtbsz-symsiz
                  /** which is net 812 **/
/**  812 div by symsiz = 58 autos              **/
/**--------------------------------------------**/
/*  Define symbol table entry format,          **/
/** modify if longer symbol name.              **/
#define name    0   /** length 11 {0..10}      **/
#define ob_cl   11  /** len 1 (indirection ndx)**/
#define type    12  /** length 1               **/
#define stor_cl 13  /** length 1               **/
#define offset  14  /** length 2 {14..15}      **/
/** ++ scope?. attributes`lvalue`rvalue.       **/
/*	System wide name size (for symbols)	*/
#define namesize 11 /** namemax plus terminator */
#define namemax  10 /** symbol len max, clipped */

/**--------------------------------------------**/
/**--- TBI => To Be Implemented. --------------**/
/**--------------------------------------------**/
/** Define possible entries for "ob_cl"ass     **/
/** 14. -Types Revisted-                       **/

#define ob_const 0 /** 15. Constant Expression **/
#define ob_var   1
#define ob_array 2 /** 14.3 **/
#define ob_ptr   3 /** 14.3 **/
#define ob_fn    4 /** 14.2 **/
#define ob_struc 5 /** 14.1 TBI **/
#define ob_union 6 /** 14.1 TBI **/

/**  Define possible entries for storage "type" specifiers */
#define cchar      1 /** 8 bits **/
#define cint       2 /** 16 bits **/
#define cdouble    3 /**  new, TBI **/
#define cfloat     4 /**  new, TBI **/
#define ts_struct  5 /**  new, TBI **/
#define ts_union   6 /**  new, TBI **/
#define ts_typedef 7 /**  new, TBI **/

/**  Define possible entries for "type adjective" 8.2 **/
#define ta_unsigned 1 /**  new, TBI **/
#define ta_short    2 /**  new, TBI **/
#define ta_long     3 /**  new, TBI **/

/**  Define possible entries for "storage class" */
/** Storage Class-                              **/
#define sc_fn       0 /** new **/
#define sc_static   1
#define sc_auto     2
#define sc_extern   3 /** new, meant for common block, TBI **/
#define sc_register 4 /** new, TBI **/
/** 8.1 typedef as sc-specifier for syntatic convenience **/
#define sc_typedef  5 /** new, TBI **/

/**--------------------------------------------**/
/*	Define the "while" statement queue	*/
#define wqtabsz 100 /** {0..24} entries    **/
#define wqsiz 4   /** ea. entry size, 4 bytes**/
#define wqmax wq+wqtabsz-wqsiz /**lim offs 96**/

/*	Define entry offsets in while queue	*/
/** Entry of byte elements of indexes:         **/
#define wqsym  0
#define wqsp   1
#define wqloop 2
#define wqlab  3

/**--------------------------------------------**/
/*	Define the literal pool			*/
/*#define	litabsz	2000			*/
/** 2000 limit reached on self compile [1]      */
#define litabsz 4000  
#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 2176 /** was 1664 **/
#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


/* Now reserve some storage words */
char  symtab[symtbsz];    /* symbol table */
char  *staticptr,*autoptr; /* 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  fnamebuf[16];   * fout name store **/
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 */
      c_sp,       /* compiler relative stk ptr */
      argstk,     /* function arg c_sp */
      ncmp,       /* # open compound statements */
      errcnt,     /* # errors in compilation */
      eof_flg,    /* set non-zero on final input eof */
      fp_in,      /* iob # for input file */
      fp_out,     /* iob # for output file (if any) */
      fp_in2,     /* iob # for "include" file */
      staticflag, /* non-zero if internal globals */
      ctext,      /* non-zero to intermix c-source */
      cmode,      /* non-zero while parsing c-code */
             /** .else. zero when passing assembly code */
      lastst;     /* last executed statement type */

char  quote[2];   /* literal string for '"' */
char  *cptr;      /* work ptr to any char buffer */
int   *iptr;      /* work ptr to any int buffer */

/************************************************/
/** Module: SCCN1.C                            **/
/** Last: 20 JUL 2007  Init: 14 JUL 2007       **/
/** Vers: 0.0.2b  Goal: Self Compile, Nasm out **/
/** Modified for NASM by s_dubrovich@yahoo.com **/
/************************************************/
/** modified dumpstatics, dumplits             **/

/*	>>>>> start cc1 <<<<<<		*/
/*					*/
/*	Compiler begins execution here	*/
/*					*/
main()
{
	staticptr=startstatic; /* clear global symbols */
	autoptr=startauto;     /* clear local symbols */
	wqptr=wq;         /* clear while queue */
	macptr=           /* clear the macro pool */
	litptr=           /* clear literal pool */
  	c_sp =            /* stack ptr (relative) */
	errcnt=           /* no errors */
	eof_flg=          /* not eof yet */
	fp_in=            /* no input file */
	fp_in2=           /* or include file */
	fp_out=           /* no open units */
	ncmp=             /* no open compound states */
	lastst=           /* no last statement yet */
	quote[1]=
	0;                /*  ...all set to zero.... */
	quote[0]='"';     /* fake a quote literal */
	cmode=1;          /* enable preprocessing */
/***--------------------------------------------*/
/*** IO Init code before file use, in C5LIB.C ***/
	initfcb(); 
/***--------------------------------------------*/
/*                      */
/*	compiler body     */
/*                      */
	ask();     /* get user options */
	openout(); /* get an output file */
	openin();  /* and initial input file */
	header();  /* intro code */
	preprocess(); /* process ALL input */
                  /** added back in **/
	dumplits(); /* then dump literal pool */
/** dump global static defs. to output source, req'd **/
	dumpstatics(); /* and all static memory  */
                  /** original place, added back in **/
	errorsummary(); /* summarize errors */
	trailer();  /* follow-up code */
	closeout(); /* close the output (if any) */
	exit(); /*** sjd 25-JUL-2008 ***/
}
/************************************************/
/** Re-Codified roughly as:                    **/
/**     I.   Static Storage Defn, main()       **/
/**     II.  Recursive Descent Parser          **/
/**     III. Utility Functions                 **/
/**     IV.  U.I. & I/O                        **/
/**     V.   Backend, NASM Object Output       **/
/************************************************/
/************************************************/
/*          small-c compiler                    */
/*              rev. 1.1                        */
/*            by Ron Cain                       */
/*              (1980)                          */
/************************************************/
/** Fn's in this file                          **/
/** preprocess(); 	** process ALL input    */
/** declstatic, newfunc, addmac,  doasm        **/
/** declauto(), put in here                    **/
/** doinclude(), is in SCN_IV                  **/
/************************************************/
/************************************************/
/*      Process all input text                  */
/*                                              */
/*   At this level, only static declarations,   */
/*      defines, includes, and function         */
/*      definitions are legal...                */
/************************************************/

preprocess()
{
	while (eof_flg==0)  /* do until no more input */
		{
		if (amatch("char",4))
			{
			declstatic(cchar);
			ns();
			}
		else if (amatch("int",3))
			{
			declstatic(cint);
			ns();
			}
		else if (match("#asm")) doasm();
		else if (match("#include")) doinclude();
		else if (match("#define")) addmac();
		else newfunc();
		blanks();  /* force eof if pending */
		}
}

/************************************************/
/*      Declare a static variable               */
/*        (i.e. define for use)                 */
/*                                              */
/*  makes an entry in the symbol table so       */
/* subsequent references can call symbol by name*/
/************************************************/

declstatic(typ) int typ; /* typ is cchar or cint */

{
	int k,id_typ; char sname[namesize];

	while (1)
		{
		while (1)
			{
			if (endst()) return;  /* do line */
			k = 1;       /* assume 1 element */
			if (match("*"))	/* pointer ? */
				id_typ = ob_ptr; /* yes */
			else id_typ = ob_var;  /* no */
			if (symbform(sname)==0) /* name ok? */
				illname();     /* no... */
			if (findstatic(sname))  /* already there? */
				multidef(sname);
			if (match("["))        /* array? */
				{
				k = needsub();  /* get size */
				if (k) id_typ = ob_array;  /* !0=ob_array */
				else id_typ = ob_ptr;  /* 0=ptr */
				}
			addstatic(sname,id_typ,typ,k);  /* add symbol */
			break;
			}
		if (match(",")==0) return;  /* more? */
		}
}


/************************************************/
/*      Declare local variables                 */
/*      (i.e. define for use)                   */
/*                                              */
/*  works just like "declstatic" but modifies   */
/*   machine stack and adds symbol table entry  */
/*   with appropriate stack offset to find it   */
/*   again.                                     */
/************************************************/
/** modifying machine stack creates Syntatic Action **/

declauto(typ) int typ; /* typ is cchar or cint */
{
	int k,id_typ; char sname[namesize];

	while (1)
		{ /** declare comma'd identifier list **/
		while (1)
			{ /** declare identifier **/
			if (endst()) return;
			if (match("*"))
				id_typ = ob_ptr;
			else id_typ = ob_var;
			if (symbform(sname)==0)
				illname();
			if(findauto(sname))
				multidef(sname);
			if (match("["))
				{
				k = needsub();
				if (k)
					{
					id_typ = ob_array;
					if (typ==cint) k = k + k;
					}
				else	{
					id_typ = ob_ptr;
					k = 2;
					}
				}
			else
				if ((typ==cchar)
					&(id_typ != ob_ptr))
					k = 1;
				else k = 2;

		/* change machine stack */
			c_sp = sa_modstk(c_sp - k);
			addauto(sname,id_typ,typ,c_sp);
			break;
			}
		if (match(",")==0) return;
		/** .else. loop list **/
		}
}

/************************************************/
/**--------------------------------------------**/
/** matches "#define"                          **/
 
addmac()
{
	char sname[namesize]; int k;

	if (symbform(sname)==0)
		{
		illname();
		kill_ln();
		return;
		}
	k = 0;
	while (putmac(sname[k++]));
	while (chr()==' ' | chr()==9) gchr();
	while (putmac(gchr()));
	if (macptr >= macmax) error("macro table full");
}

/**--------------------------------------------**/
putmac(c) char c;
{
	macq[macptr]=c;
	if (macptrnewfunc(); compound();**/
/** doif(); dowhile();                         **/

statement()
{
	if ((chr() == 0) & (eof_flg)) return;
	else if (amatch("char",4))
		{
		declauto(cchar);
		ns();
		}
	else if (amatch("int",3))
		{
		declauto(cint);
		ns();
		}
	else if (match("{")) compound();
	else if (amatch("if",2))
		{
		doif();
		lastst = stif;
		}

/*	else if (amatch("do",2))  added by codeworks */
/*		{dodo();lastst=stwhile;} version */

	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      */
/*  inbetween "{}"                              */
/************************************************/

compound()
{
	++ncmp;  /* new level open */
	while (match("}") == 0)
		if (eof_flg) return;
		else statement();
	--ncmp;		/* close current level */
}

/************************************************/
/*              "if" statement                  */
/************************************************/

doif()
{
	int flev,fsp,flab1,flab2;

	flev = autoptr;	/* record current local level */
	fsp = c_sp;		/* record current stk ptr */
	flab1 = getlabel(); /* get label for false branch */
	m_test(flab1);	/* get expression, and branch false */
	statement();	/* if true, do a statement */
	c_sp = sa_modstk(fsp);	/* then clean up the stack */
	autoptr = flev;	/* and deallocate any autos */
	if (amatch("else",4) == 0)	/* if...else ? */
		/* simple "if"...print false label */
		{
		printlabel(flab1);
		colon();
		nl();
		return;		/* and exit */
		}
	/* an "if...else" statement. */

	sa_jump(flab2 = getlabel());	/* jump around false code */
	printlabel(flab1);colon();nl();	/* print false label */
	statement();		/* and do "else" clause */
	c_sp = sa_modstk(fsp);		/* then clean up stk ptr */
	autoptr = flev;		/* and deallocate autos */
	printlabel(flab2);colon();nl();	/* print true label */
}

/************************************************/
/*      "while" statement                       */
/************************************************/
dowhile()
{
	int wq[4];          /* allocate local queue */
	wq[wqsym] = autoptr;    /* record local level */
	wq[wqsp] = c_sp;        /* 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]);colon();nl(); /* loop label */
	m_test(wq[wqlab]);      /* see if true */
	statement();            /* if so, do a statement */
	sa_jump(wq[wqloop]);    /* loop to label */
	printlabel(wq[wqlab]);colon();nl(); /* exit label */
	autoptr = wq[wqsym];    /* deallocate autos */
	c_sp = sa_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)  expression();
	sa_modstk(0);	/* clean up stk */
	sa_ret();	/* and exit function */
}

/************************************************/
/*      "break" statement                       */
/************************************************/
dobreak()
{
	int *ptr;
	/* see if any "whiles" are open */
	if ((ptr=readwhile()) == 0) return; /* no */
	sa_modstk((ptr[wqsp])); /* else clean up stk ptr */
	sa_jump(ptr[wqlab]);    /* jump to exit label */
}

/************************************************/
/*      "continue" statement                    */
/************************************************/
docont()
{
	int *ptr;
	/* see if any "whiles" are open */
	if ((ptr = readwhile()) == 0) return;  /* no */
	sa_modstk((ptr[wqsp])); /* else clean up stk ptr */
	sa_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_flg)  break;
		outstr(line);
		nl();
		}
	kill_ln();  /* invalidate line */
	cmode = 1;  /* then back to parse level */
}

/************************************************/
/*      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     */
/*   HL- Primary                                */
/************************************************/
/** Actually the Primary value is placed on the stack **/
/**  and called from off the stack.                   **/

callfunction(ptr) char *ptr;  /* symbol table entry (or 0) */
{
	int nargs;

	nargs = 0;
	blanks();  /* already saw open paren */
/** If Null Ptr, Push the primary register onto the stack **/
	if (ptr == 0)
		{
	/***	ol("  ;+; callfunction push Prim_Tgt.."); ***/
		sa_push();  /** to call Primary **/
		}
	while (streq(line + lptr,")") == 0)
		{
		if (endst()) break;
		expression();  /* get an argument */
		if (ptr == 0)  sa_swapstk(); /* don't push addr */
                      /** swaps each loop to keep on TOS **/

	/***	ol("  ;+; callfunction push arg.."); ***/
		sa_push();  /* push argument */
		nargs = nargs + 2;  /* count args*2 */
		if (match(",") == 0) break;
		}
	needbrack(")");
	if (ptr) sa_call(ptr); /** sematic action, call fn **/
	else  sa_callstk(); /** sematic action, call stack fn **/
	c_sp = sa_modstk(c_sp + nargs);  /* clean up arguments */
}

/************************************************/
junk()
{
	if(an(inbyte()))
		while(an(chr()))  gchr();
	else while(an(chr()) == 0)
		{
		if(chr() == 0)break;
		gchr();
		}
	blanks();
}

/************************************************/
endst()
{
	blanks();
	return ((streq(line + lptr,";") | (chr() == 0)));
}
/************************************************/

/** ch > chr, and > m_and, pop > sa_pop    **/
/** push > sa_push, or > m_or, xor > m_xor **/

/** The hierarchical recursive descent steps have  **/
/** the pattern of, on entry, call the next higher **/
/** precedence level, and then at return, filter   **/
/** for lexeme operators for its level.  If false, **/
/** returns control to the lower precedence level. **/
/** If true, select for matching lexeme for its    **/
/** precedence level and perform the production    **/
/** actions to generate code.                      **/
/** expression() forms a control array: eval[2] to **/
/** which rdvalue(eval) responds after primary(eval)*/
/** has made its determinations on the nature of   **/
/** the identifier parsed in a statement held in a **/
/** line buffer.  Two symbol tables are maintained **/
/** one for Local Symbols (auto storage class) and **/
/** one for Global Symbols (static storage class). **/
/** operations on auto variables take place on the **/
/** Stack, static variable operations involve their**/
/** storage in the Data Segment.  Symbol record    **/
/** structure, and the possible field values are   **/
/** defined at the begining of the source through  **/
/** #define statements.  This C subset language    **/
/** hasn't structures, unions, switch statements,  **/
/** etc., but has enough to bootstrap those elements*/
/** in later editions.  The primary(eval) sets eval**/
/** fields as a control mechanism on identifiers for*/
/** rdvalue and the rest of the expression analyzer */
/** as well, it sets a return value of zero or one **/
/** as an additional control flag.  Consequently,  **/
/** the following control table develops:          **/
/**    ob_cl    eval[0]  [1]  ret_val              **/
/**      .IF. AUTO                                 **/
/**    const      0       0      0                 **/
/**    funct     ptr     typ     1                 **/
/**   ob_array   ptr     typ     0                 **/
/**   ob_ptr     ptr     typ     1                 **/
/**   ob_var     ptr     typ     1                 **/
/**      .IF. STATIC                               **/
/**    const      0       0      0                 **/
/**    funct     ptr      0      0                 **/
/**   ob_array   ptr      0      0                 **/
/**   ob_ptr     ptr      0      1                 **/
/**   ob_var     ptr      0      1                 **/
/** such that.. ptr is identifier location in symbol*/
/**  table and typ for array is one of cchar.1 or  **/
/**  ccint.2, and an identifier of pointer or var  **/
/** return(1), array and function identifiers      **/
/** return(0).                                     **/

/************************************************/
/** Evaluate an expression statement.          **/
/** Callers: statement(); do_return();         **/
/** callfunction(); heir11(); m_test();        **/
/************************************************/

/** eval[2], eval2[2], are two operand attribute arrays **/

expression()
{
	int eval[2];  /** array of 2 integer sized elements **/

	if (heir1(eval)) rdvalue(eval);
}

heir1(eval) int eval[];
{
	int k,eval2[2]; /** second operand attribute array **/

	k = heir2(eval);

	if (match("="))   /** ck next chr as 'assignment' **/
		{
		if (k == 0)
			{
			needlval();   /** err not an lvalue **/
			return 0;
			}
		if (eval[1]) /** sc_auto **/
			{
		/***	ol("  ;+; heir1 push arg.."); ***/
			sa_push(); /** auto val **/
			}
		if (heir1(eval2)) rdvalue(eval2);
	/***	ol("  ;+; heir1 stor_sc`eval.."); ***/

		stor_sc(eval);
		return 0;
		}
	else return k;
}

heir2(eval) int eval[];
{
	int k,eval2[2];

	k = heir3(eval);

	blanks();
	if (chr() != '|') return k;  /** ck next chr as 'or' **/
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("|"))
			{
			sa_push();
			if (heir3(eval2)) rdvalue(eval2);
			sa_pop();
			m_or();
			}
		else return 0;
		}
}

heir3(eval) int eval[];
{
	int k,eval2[2];

	k = heir4(eval);

	blanks();
	if (chr() != '^') return k;  /** ck next chr as 'xor' **/
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("^"))
			{
			sa_push();
			if (heir4(eval2)) rdvalue(eval2);
			sa_pop();
			m_xor();
			}
		else return 0;
		}
}

heir4(eval) int eval[];
{
	int k,eval2[2];

	k = heir5(eval);

	blanks();
	if (chr() != '&') return k;  /** ck next chr as 'and' **/
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("&"))
			{
			sa_push();
			if (heir5(eval2)) rdvalue(eval2);
			sa_pop();
			m_and();
			}
		else return 0;
		}
}

heir5(eval) int eval[];
{
	int k,eval2[2];

	k = heir6(eval);

	blanks();
	  /** ck next chr as 'equivalent' or 'not equal' **/
	if ((streq(line + lptr,"==") == 0) &
		(streq(line + lptr,"!=") == 0)) return k;
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("=="))
			{
			sa_push();
			if (heir6(eval2)) rdvalue(eval2);
			sa_pop();
		/** cmp Secd. to Prim. ret1 in Prim. if TRUE **/
			eq(); 
			}
		else if (match("!="))
			{
			sa_push();
			if (heir6(eval2)) rdvalue(eval2);
			sa_pop();
			ne();
			}
		else return 0;
		}
}

heir6(eval) int eval[]; /** ck next chr pr as 'relational op' **/
{
	int k,eval2[2];

	k = heir7(eval);

	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) rdvalue(eval);
	while(1)
		{
		if (match("<="))
			{
			sa_push();
			if (heir7(eval2)) rdvalue(eval2);
			sa_pop();
			if (cptr = eval[0])
				if (cptr[ob_cl] == ob_ptr)
				{
				ule();
				continue;
				}
			le();
			}
		else if (match(">="))
			{
			sa_push();
			if (heir7(eval2)) rdvalue(eval2);
			sa_pop();
			if (cptr = eval[0])
				if (cptr[ob_cl] == ob_ptr)
				{
				uge();
				continue;
				}
			if(cptr = eval2[0])
				if(cptr[ob_cl] == ob_ptr)
				{
				uge();
				continue;
				}
			ge();
			}
		else if ((streq(line + lptr,"<")) &
			(streq(line + lptr,"<<") == 0))
			{
			inbyte();
			sa_push();
			if (heir7(eval2)) rdvalue(eval2);
			sa_pop();
			if (cptr = eval[0])
				if (cptr[ob_cl] == ob_ptr)
				{
				ult();
				continue;
				}
			if (cptr = eval2[0])
				if (cptr[ob_cl] == ob_ptr)
				{
				ult();
				continue;
				}
			lt();
			}
		else if ((streq(line + lptr,">")) &
			(streq(line + lptr,">>") == 0))
			{
			inbyte();
			sa_push();
			if (heir7(eval2)) rdvalue(eval2);
			sa_pop();
			if (cptr = eval[0])
				if (cptr[ob_cl] == ob_ptr)
				{
				ugt();
				continue;
				}
			if (cptr = eval2[0])
				if(cptr[ob_cl] == ob_ptr)
				{
				ugt();
				continue;
				}
			gt();
			}
		else return 0;
		}
}

/** ch > chr, div > m_div, push > sa_push **/
/** add > m_add, sub > m_sub, mult > m_mult **/
/** inc > m_inc, dec > m_dec, neg > m_neg **/

heir7(eval) int eval[];  /** ck next chr as 'shift ops' **/
{
	int k,eval2[2];

	k = heir8(eval); /** recursive descent **/

	blanks();
	if ((streq(line + lptr,">>") == 0) &
		(streq(line + lptr,"<<") == 0)) return k;
		/** trap for >> << **/
	if (k) rdvalue(eval);
	while(1)
		{
		if (match(">>"))
			{
			sa_push();
			if (heir8(eval2)) rdvalue(eval2);
			sa_pop();
			asr();
			}
		else if (match("<<"))
			{
			sa_push();
			if(heir8(eval2)) rdvalue(eval2);
			sa_pop();
			asl();
			}
		else return 0;
		}
}

heir8(eval) int eval[];  /** ck next chr as 'plus or minus op' **/
{
	int k,eval2[2];

	k = heir9(eval);

	blanks();
	if ((chr() != '+') & (chr() != '-')) return k;
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("+"))
			{
			sa_push();
			if (heir9(eval2)) rdvalue(eval2);
			if (cptr = eval[0])
				if ((cptr[ob_cl] == ob_ptr) &
					(cptr[type] == cint))
					doublereg();
			sa_pop();
			m_add();
			}
		else if (match("-"))
			{
			sa_push();
			if (heir9(eval2)) rdvalue(eval2);
			if (cptr = eval[0])
				if ((cptr[ob_cl] == ob_ptr) &
					(cptr[type] == cint))
					doublereg();
			sa_pop();
			m_sub();
			}
		else return 0;
		}
}

heir9(eval) int eval[];  /** ck next chr as 'mult, div or mod op' **/
{
	int k,eval2[2];

	k = heir10(eval);

	blanks();
	if((chr() != '*') & (chr() != '/') &
		(chr() != '%')) return k;
	if (k) rdvalue(eval);
	while(1)
		{
		if (match("*"))
			{
			sa_push();
			if (heir9(eval2)) rdvalue(eval2);
			sa_pop();
			m_mult();
			}
		else if (match("/"))
			{
			sa_push();
			if (heir10(eval2)) rdvalue(eval2);
			sa_pop();
			m_div();
			}
		else if (match("%"))
			{
			sa_push();
			if (heir10(eval2)) rdvalue(eval2);
			sa_pop();
			mod();
			}
		else return 0;
		}
}

heir10(eval) int eval[];
{       /** ck next chr as 'prefix unary op' **/
	int k; char *ptr;

	if (match("++"))
		{
		if ((k = heir10(eval)) == 0)  /** recurse **/
			{
			needlval();   /** err not an lvalue **/
			return 0;
			}
		if (eval[1]) sa_push(); /** auto **/
		rdvalue(eval);
		m_inc();          /** incr by ob_sz char **/
		ptr = eval[0];
					/** incr by ob_sz int **/
		if ((ptr[ob_cl] == ob_ptr) & (ptr[type] == cint))  m_inc();
	/***	ol("  ;+; heir10 ++a stor_sc`eval.."); ***/
		stor_sc(eval);
		return 0;
		}
	else if (match("--"))
		{
		if((k=heir10(eval)) == 0)  /** recurse **/
			{
			needlval();   /** err not an lvalue **/
			return 0;
			}
		if (eval[1]) sa_push(); /** auto **/
		rdvalue(eval);
		m_dec();		/** decr by ob_sz char **/
		ptr = eval[0];
					/** decr by ob_sz int **/
		if ((ptr[ob_cl]==ob_ptr) & (ptr[type]==cint))  m_dec();
		stor_sc(eval);
		return 0;
		}
	else if (match("-"))
		{
		k = heir10(eval);  /** recurse **/

		if (k) rdvalue(eval);
		m_neg();
		return 0;
		}
	else if (match("*"))
		{
		k = heir10(eval);  /** recurse **/

		if (k) rdvalue(eval);
		if (ptr = eval[0])
			eval[1] = ptr[type]; /** auto int or char **/
		
		eval[0] = 0;
		return 1;    /** flag to cont. ck of str '***' **/
		}
	else if (match("&"))
		{
		k = heir10(eval);  /** recurse **/

		if (k == 0)
			{
			error("illegal address");
			return 0;
			}
		else if (eval[1]) return 0;
		else	{
			mn_ldi_prim();  /** mnem LD Imm Primary **/
			outstr(ptr = eval[0]);
			nl();
			eval[1] = ptr[type];
			return 0;
			}
		}

  /** .else. ck next chr as 'postfix unary op' **/
	else	{
		k = heir11(eval);

		if (match("++"))
			{
			if (k == 0)
				{
				needlval();  /** err not an lvalue **/
				return 0;
				}
			if (eval[1]) sa_push(); /** auto **/
			rdvalue(eval);
			m_inc();
			ptr = eval[0];
			if ((ptr[ob_cl] == ob_ptr) & (ptr[type] == cint))
					m_inc();
		/***	ol("  ;+; heir10 a++ stor_sc`eval.."); ***/
			stor_sc(eval);
			m_dec();
			if ((ptr[ob_cl] == ob_ptr) & (ptr[type] == cint))
				m_dec();
			return 0;
			}
		else if (match("--"))
			{
			if (k == 0)
				{
				needlval(); /** err not an lvalue **/
				return 0;
				}
			if (eval[1]) sa_push(); /** auto **/
			rdvalue(eval);
			m_dec();
			if ((ptr[ob_cl] == ob_ptr) & (ptr[type] == cint))
				m_dec();

			stor_sc(eval);
			m_inc();
			if ((ptr[ob_cl] == ob_ptr) & (ptr[type] == cint))
				m_inc();
			return 0;
			}
		else return k;
		}
}

/************************************************/
/** ch > chr, gch > gchr, add > m_add.         **/
/** push > sa_push, pop > sa_pop,          **/
/** test > m_test                              **/

/** ck next token as 'left bracket or left parenthesis terminal' **/
/** L-Brkt indicates array, L-Paren indicates a function call.   **/

heir11(eval) int *eval;
{
	int k; char *ptr;

	k = primary(eval); /** Ck Lexeme as static, auto or number **/
				/** or New Fn, const or error.           **/

	ptr = eval[0];  /** ck nonterminal kind **/
	blanks();
	if ((chr() == '[')|(chr() == '('))
		while (1)
		{
		if (match("["))  /*** Array Form ***/
			{
			if (ptr == 0)
				{
				error("can't subscript");
				junk();
				needbrack("]");
				return 0;
				}
			else if (ptr[ob_cl] == ob_ptr) rdvalue(eval);
			else if (ptr[ob_cl] != ob_array)
				{
				error("can't subscript");
				k = 0;   /** err not an lvalue **/
				}
			sa_push();
			expression();  /** recursive call to itself **/
			needbrack("]");
			if (ptr[type] == cint) doublereg();
			sa_pop();
			m_add();
			eval[0] = 0;
			eval[1] = ptr[type];
			k = 1;
			}
		else if (match("("))  /*** Function Form ***/
			{  /** Parse Fn indicator -Ident followed by '(' **/
			if (ptr == 0)
				{
				callfunction(0); /** lvalue on stack **/
				}
			else if (ptr[ob_cl] != ob_fn)
				{
				rdvalue(eval);
				callfunction(0); /** lvalue on stack **/
				}
			  /** otherwise lvalue of ob_fn is in the **/
			  /** symbol table as 'offset' value.     **/
			else callfunction(ptr);
			k = eval[0] = 0;   /** err not an lvalue **/
			}
		else return k;
		}
	if (ptr == 0) return k;
	if (ptr[ob_cl] == ob_fn)
		{
		mn_ldi_prim();	/** mnem LD Imm Primary **/
		outstr(ptr);
		nl();
		return 0;
		}
	return k;
}

/** Primary Checks for Lexeme as static, auto or number... **/
/**  also perform Syntatic Action for Code Generation.     **/
/** The return value is part of the signal of expression() **/
/** Map these signals...**/

primary(eval) int *eval;  /** token typing **/
{
	char *ptr,sname[namesize]; int num[1]; int k;

	if (match("(")) /** is it a parenthesis expression? **/
		{
		k = heir1(eval); /** suspend eval, recurse next depth **/

		needbrack(")");
		return k; /** Note: if k == 0, err not an lvalue **/
		}
	if (symbform(sname)) /** check valid symbol name **/
		{
		if (ptr = findauto(sname)) /** search auto symtbl **/
			{  /** already auto, fill eval[] array **/
			get_auto(ptr);  /** Syntatic Action -> codegen **/

			eval[0] = ptr;  /** SymTbl`sym_index`0 is lexeme **/
			eval[1] = ptr[type]; /** assign SymTbl .type **/
			if (ptr[ob_cl] == ob_ptr) eval[1] = cint;
			if (ptr[ob_cl] == ob_array) return 0;
			else return 1;
			}
/** so if identifier is sc_auto, ret`1, except if ob_array ret`0 **/

		if (ptr = findstatic(sname)) /** search static symtbl **/
			if (ptr[ob_cl] != ob_fn) /** Except Function..**/
				{
				eval[0] = ptr;
				eval[1] = 0;
				if (ptr[ob_cl] != ob_array) return 1;

			/** .else. ob_ is static array **/
				/** Syntatic Action -> codegen **/
				mn_ldi_prim();  /** mnem LD Imm Primary **/
				outstr(ptr); nl(); /*outname*/
				  /** finish parsing state for static array **/
				eval[1] = ptr[type];
				return 0;
				}
/** so if identifier is sc_static but not a ob_function, **/
/** then also ret`1 except if ob_array ret`0 **/

	/** .if. here, then not previously in any symbol table **/
	/** add to static symbol table as Fn, set parse array. **/
		ptr = addstatic(sname,ob_fn,cint,0);
		eval[0] = ptr;
		eval[1] = 0;
		return 0;
		}  /** end symbol name check **/

/** .if. here, not a parenthesis, nor name, is it a number ? **/

	if (constant(num)) return (eval[0] = eval[1] = 0);

	else	{
		error("invalid expression");
		mn_ldi_prim();  /** mnem LD Imm Primary **/
		outdec(0);
		nl();
		junk();
		return 0;
		}
}  /** end Primary expression ck **/


/**--------------------------------------------**/

stor_sc(eval) int *eval;
{
	if (eval[1]==0) put_static(eval[0]);
		/***	else putstk(eval[1]);  ***/
	else putssstk(eval[1]);
}

rdvalue(eval) int *eval;
{
	if ((eval[0] != 0) & (eval[1] == 0))
		get_static(eval[0]); /** static; fn, ptr, or var **/
/**	else indirect(eval[1]); ** auto; array or const **/
	else stk_indi(eval[1]); /** auto; array or const **/
}

m_test(label) int label;
{
	needbrack("(");
	expression();
	needbrack(")");
	testjump(label);
}

constant(val) int val[];
{		/** is it a number constant? **/
	if (number(val))  mn_ldi_prim();  /** mnem LD Imm Primary **/

		/** is it a char constant? **/
	else if (pstr(val))  mn_ldi_prim();

		/** is it a string constant? **/
	else if (qstr(val))  /** static quoted str of char **/
		{
		mn_ldi_prim();  /** mnem LD Imm Primary **/
		printlabel(litlab);
		outbyte('+');
		}
	else return 0;	
	outdec(val[0]);
	nl();
	return 1;
}

number(val) int val[];
{
	int k,minus; char c;

	k = minus = 1;
	while (k)  /** handle signs **/
		{
		k = 0;
		if (match("+")) k = 1;
		if (match("-"))
			{
			minus = (-minus);
			k = 1;
			}
		}
	if (numeric(chr()) == 0) return 0; 
		/** failed, next char from ln buff isn't a digit **/

	while (numeric(chr())) /** conv ascii digit str to value **/
		{
		c = inbyte();
		k = k*10+(c-'0');
		}
	if (minus<0) k = (-k);
	val[0] = k;
	return 1;
}

pstr(val) int val[];
{		/** check for character constant **/
	int k; char c;

	k = 0;
	if (match("'") == 0) return 0; /** not a char const **/
	while ((c = gchr()) != 39)    /** single quote **/
		k = (k&255) * 256 + (c&127);
	val[0] = k;
	return 1;
}

/** 2.5 Strings, are a sequence of characters surrounded by **/
/** double quotes, has type 'array of char', and storage    **/
/** class _static_                                          **/

qstr(val) int val[];
{
	char c;

	if (match(quote) == 0) return 0;
	val[0] = litptr;
	while (chr() != '"')
		{
		if (chr() == 0) break;
		if (litptr >= litmax)
			{
			error("string space exhausted");
			while (match(quote) == 0)
				if( gchr() == 0) break;
			return 1;
			}
		litq[litptr++] = gchr();
		}
	gchr();
	litq[litptr++] = 0;
	return 1;
}

/****************************************/
/**  SCN_II.C 			       **/
/** Next is SCN_III.C 		       **/
/************************************************/
/** Re-Codified roughly as:                    **/
/**     I.   Static Storage Defn, main()       **/
/**     II.  Recursive Descent Parser          **/
/**     III. Utility Functions                 **/
/**     IV.  U.I. & I/O                        **/
/**     V.   Backend, NASM Object Output       **/
/************************************************/
/************************************************/
/*          small-c compiler                    */
/*              rev. 1.1                        */
/*            by Ron Cain                       */
/*              (1980)                          */
/************************************************/

/** Symbol Lookup in Static Table, ret`0 if not found, **/
/** .else. address of symbol matched in static table   **/

findstatic(sname) char *sname;
{
	char *ptr;

	ptr = startstatic;
	while (ptr != staticptr)
		{
		if (astreq(sname,ptr,namemax)) return ptr;
		ptr = ptr + symsiz;
		}
	return 0;
}

/** Symbol Lookup in Auto Table, ret`0 if not found, **/
/** .else. address of symbol matched in auto table   **/

findauto(sname) char *sname;
{
	char *ptr;

	ptr = startauto;
	while (ptr != autoptr)
		{
		if (astreq(sname,ptr,namemax)) return ptr;
		ptr = ptr + symsiz;
		}
	return 0;
}

addstatic(sname,id,typ,value) char *sname,id,typ; int value;
{
	char *ptr;

		/** return cptr of sym if already defined **/
	if (cptr = findstatic(sname)) return cptr;
	if (staticptr >= endstatic)
		{
		error("global symbol table overflow");
		return 0;
		}
	cptr = ptr = staticptr;
	while (an(*ptr++ = *sname++));	/* copy name */
	cptr[ob_cl] = id;
	cptr[type] = typ;
	cptr[stor_cl] = sc_static;
	cptr[offset] = value;
	cptr[offset+1] = value >> 8;
	staticptr = staticptr + symsiz; /** structure increment **/
	return cptr;
}

addauto(sname,id,typ,value) char *sname,id,typ; int value;
{
	char *ptr;

		/** return cptr of sym if already defined **/
	if (cptr = findauto(sname)) return cptr;
	if (autoptr >= endauto)
		{
		error("auto, symbol table overflow");
		return 0;
		}
	cptr = ptr = autoptr;
	while (an(*ptr++ = *sname++));	/* copy name */
	cptr[ob_cl] = id;
	cptr[type] = typ;
	cptr[stor_cl] = sc_auto;
	cptr[offset] = value;
	cptr[offset+1] = value >> 8;
	autoptr = autoptr + symsiz;
	return cptr;
}

/* Test if next input string is legal symbol name */
/** symname -> symbform **/
symbform(sname) char *sname;
{
	int k; char c;

	blanks();
	if (alpha(chr()) == 0) return 0;
	k = 0;
	while (an(chr())) sname[k++] = gchr();
	sname[k] = 0;
	return 1;
}

/* Return next avail internal label number */
getlabel()
{
	return (++nxtlab);
}

/* Print specified number as label */
printlabel(label) int label;
{
	outstr("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)));
}

/*** 'While' Method Primitives ***/

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);
}

/**--------------------------------------------**/
/** input line buffer functions.               **/
/**--------------------------------------------**/

chr() /** fetch 7-bit char from line buffer **/
{
	return (line[lptr] & 127);
}

nchr() /** look_ahead to next char in line buffer **/
{
	if (chr() == 0) return 0;
	else return (line[lptr+1] & 127);
}

gchr() /** fetch 7-bit char from line buffer, inc ptr **/
{
	if (chr() == 0) return 0;
	else return (line[lptr++] & 127);
}

/** reset (to erase) linebuffer, callers: ask();**/
/** openout(); openin(); doinclude();addmac();  **/
/** newfunc(); doasm(); inline();               **/
/** set ln ptr to zero offset and poke location w/null **/

kill_ln()
{
	lptr = 0;
	line[lptr] = 0;
}

inbyte()
{
	while (chr() == 0)
		{
		if (eof_flg) return 0;
		inline();
		prepline();
		}
	/** fetch 7-bit char from line buffer, inc ptr **/
	return gchr(); 
}

inchar() /** see kill_ln, fill inline buffer, ret char **/
{
	if (chr() == 0) inline();
	if (eof_flg) return 0;
		/** fetch 7-bit char from line buffer, inc ptr **/
	return (gchr());
}

inline() /** Read infile, char by char, to fill line buffer **/
{
	int k,unit;

	while (1)
		{
		if (fp_in == 0) openin();
		if (eof_flg) return;
		if ((unit = fp_in2) == 0) unit = fp_in;
		kill_ln();
		while ((k = getc(unit)) > 0)
			{
			if ((k == eol) | (lptr >= linemax)) break;
			line[lptr++] = k;
			}
		line[lptr] = 0;	/* append null */
		if (k <= 0)
			{
			fclose(unit);
			if (fp_in2) fp_in2 = 0;
				else fp_in = 0;
			}
		if (lptr)
			{  /* cmode==0 means mode is "asm" */
			if ((ctext) & (cmode))
				{
				comment();
				outstr(line);
				nl();
				}
			lptr = 0;
			return;
			}
		}
}

/** ch > chr, gch > gchr, nch > nchr           **/
/** method uses the macro line buffer as a temp store **/

keepch(c) char c;
{
	mline[mptr] = c;
	if (mptr < mpmax) mptr++;
	return c;
}

/* Preprocess input lines by removing
 * comments and excess white space,
 * checking strings and char constants,
 * & applying #define macros to the rest
 */
prepline() /* Process Line in LineBuffer line[k] */
{
	int k; char c, sname[namesize]; /** identifier **/

		/* cmode==0 means mark mode as "asm" */
	if (cmode == 0) return;
	mptr = lptr = 0;
	while (chr())
		{
		if ((chr()==' ')|(chr() == 9)) /* filter sp, tab */
			{
			keepch(' ');
			while ((chr() == ' ') | (chr() == 9)) gchr();
			}
		else if (chr() == '"')         /* filter double quote */
			{
			keepch(chr());
			gchr();
			while (chr() != '"')
				{
				if(chr() == 0)
					{
					error("missing quote");
				  	break;
					}
				keepch(gchr());
				}
			gchr();
			keepch('"');
			}
		else if (chr() == 39)          /* filter single quote */
			{
			keepch(39);
			gchr();
			while (chr() != 39)
				{
				if(chr() == 0)
					{
					error("missing apostrophe");
					break;
					}
				keepch(gchr());
				}
			gchr();
			keepch(39);
			}
		else if ((chr() == '/') & (nchr() == '*'))
			{	/* filter bi-glyph, comment start */
			inchar();
			inchar();
			while (((chr() == '*') & (nchr() == '/')) == 0)
				{
				if(chr() == 0) inline();
				else inchar();
				if (eof_flg) break;
				}
			inchar();
			inchar();
			}
		else if (an(chr()))  /* CK alpha..numeric + '_' */
			{
			k = 0;
			while (an(chr()))
				{
				if (k < namemax) sname[k++] = chr();
				gchr();
				}
			sname[k] = 0;
			if (k = findmac(sname))
				while (c = macq[k++]) keepch(c);
			else	{
				k = 0;
				while (c = sname[k++]) keepch(c);
				}
			}
		else keepch(gchr());
		}
	keepch(0);
	if (mptr >= mpmax) error("line too long");
	lptr = mptr = 0;
	while (line[lptr++] = mline[mptr++]);
	lptr = 0;
}

/************************************************/
streq(str1,str2) char str1[], str2[];
{
	int k;

	k = 0;
	while (str2[k]) /** callers str **/
		{
		if ((str1[k]) != (str2[k])) return 0;
		k++;
		}
	return k;  /** number of char matched **/
}

/** ascii strings equate **/

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;
}

/** Bool= Ret`1 if matched, .else.`0 **/

match(lit) char *lit;
{
	int k;

	blanks();
		/** streq rets`0 if not matched **/
	if (k = streq(line+lptr,lit))
		{
		lptr = lptr + k;  /** advance ln ptr **/
		return 1;
		}
 	return 0;
}

/** Bool= Ret`1 if matched str by length, .else.`0 **/

amatch(lit,len) char *lit; int len;
{
	int k;

	blanks();
	if (k = astreq(line+lptr,lit,len))
		{
		lptr = lptr + k;
		while (an(chr())) inbyte();
		return 1;
		}
	return 0;
}

blanks()
{
	while(1)
		{
		while (chr() == 0)
			{
			inline();
			prepline();
			if (eof_flg) break;
			}
		if (chr() == ' ') gchr();
		else if (chr() == 9) gchr();
		else return;
		}
}

/**  SCN_III.C **/
/** Next is SCN_IV.C **/
/************************************************/
/** Re-Codified roughly as:                    **/
/**     I.   Static Storage Defn, main()       **/
/**     II.  Recursive Descent Parser          **/
/**     III. Utility Functions                 **/
/**     IV.  U.I. & I/O                        **/
/**     V.   Backend, NASM Object Output       **/
/************************************************/
/************************************************/
/*          small-c compiler                    */
/*              rev. 1.1                        */
/*            by Ron Cain                       */
/*              (1980)                          */
/************************************************/

/** Fn's in this file **/
/**	ask();		* get user options */
/**	openout();	* get an output file */
/**	openin();	* and initial input file */
/**	header();	* intro code */
/** Logically Parse is here **/
/**	dumplits();	* then dump literal pool */
/** dump global static defs. to output source,  **/
/**  required **/
/**	dumpstatics();	* and all static memory  */
/** original place, added back in **/
/**	errorsummary();	* summarize errors */
/**	trailer();	* follow-up code */
/**	closeout();	* close the output (if any) */
/**	return;		* then exit to system */
/************************************************/
/** doinclude() **/
/************************************************/

/************************************************/
/*      Get options from user                   */
/************************************************/
ask()
{
	int k,num[1];

	kill_ln();			/* clear input line */
	nl();nl();nl();		/* print banner */
	pl("     * * *  small-c compiler  * * *");
	nl();
	pl("              by Ron Cain");
	nl();
	pl("* NASM Vers c0.2.7, Feb. 2009, s_dubrovich@yahoo.com *");
	nl();
	/* see if user wants to interleave the c-text */
	/*	in form of comments (for clarity) */
	pl("Do you want the c-text to appear? (hint: y) ");
	gets(line);  /* get answer */
	ctext = 0;  /* assume no */
	if((chr()=='Y')|(chr()=='y'))
		ctext = 1;  /* user said yes */
 	/* see if user wants us to allocate static */
 	/*  variables by name in this module	*/
 	/*	(pseudo external capability)	*/
 	pl("Do you wish the globals to be defined? (hint: y) ");
 	gets(line);
 	staticflag = 0;
 	if ((chr()=='Y')|(chr()=='y'))
 		staticflag = 1;  /* user said yes */
	/* get first allowable number for compiler-generated */
 	/*	labels (in case user will append modules) */
 	while(1)
		{
 		pl("Starting number for labels? (hint: 0) ");
 		gets(line);
 		if (chr() == 0)  /** empty ln buf **/
			{
			num[0] = 0; /** defaults to label_0 **/
			break;
			}
		if (k = number(num)) break;
		}
	nxtlab = num[0];
	litlab = getlabel();	/* first label=literal pool */ 
	kill_ln();			/* erase line */
}

/************************************************/
/*      Get output filename                     */
/************************************************/
openout()
{
/**	char *tmpp, *fnp, chr; ** fname buf ptr **/

/**	fnp = &fnamebuf[0]; **/
	kill_ln();		/* erase line */
	fp_out = 0;		/* start with none */
	pl("Output filename? "); /* ask...*/
	gets(line);              /* get a filename */
	if (chr() == 0) return; /* none given... */

/***	tmpp = line;
	while (*fnp != 0)  ** fname zr termination **
		{  ** copy file name to stor **
			chr = *tmpp++;
			*fnp++ = chr;
		} ***/

	if ((fp_out=fopen(line,"w")) == NULL) /* if given, open */
		{
		fp_out = 0;     /* can't open */
		error("Open failure!");
		}
	kill_ln();			/* erase line */
}

/************************************************/
/*      Get (next) input file                   */
/************************************************/
openin()
{
	fp_in = 0;       /* none to start with */
	while (fp_in == 0) /* any above 1 allowed */
		{
		kill_ln();  /* clear line */
		if (eof_flg) break; /* if user said none */
		pl("Input filename? ");
		gets(line);  /* get a name */
		if (chr() == 0)
			{ /* none given... */
			eof_flg = 1;
			break;
			}
		if ((fp_in = fopen(line,"r")) == NULL)
			{  /* can't open it */
			fp_in = 0;
			pl("Open failure");
			}
		}
	kill_ln();		/* erase line */
	}

/************************************************/
/*      Report errors for user                  */
/************************************************/
errorsummary()
{  	/* see if anything left hanging... */
	if (ncmp) error("missing closing bracket");
		/* open compound statement ... */
	nl();
	comment();
	outdec(errcnt);	/* total # errors */
	outstr(" errors in compilation.");
	nl();
}

/************************************************/
/*      Close the output file                   */
/************************************************/
closeout()
{
	if (fp_out) fclose(fp_out); /* if open, close it */
	fp_out = 0;  /* mark as closed */
}

/************************************************/
/*      Dump the literal pool                   */
/************************************************/
dumplits()
{
	int j,k;

	if (litptr == 0) return; /* if nothing there, exit...*/

	do_dseg(); /** in SCN_V.C for section .dseg **/

	nl();

	printlabel(litlab); colon(); /* 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  */
				break;
				}
			outbyte(','); /* separate bytes */
			}
		}
}

/************************************************/
/*      Dump all static variables               */
/*                                              */
/** these are put to outfile, required for nasm */
/** DSegment data ref. defs.,                   */
/** Form; {Name,TIMES,numb,DB 0}               **/
/************************************************/

dumpstatics()
{
	int j;

	if (staticflag == 0) return;  /* don't if user said no */
/** do SECTION here as well, there may not be lits, above **/
	do_dseg();  /** in SCN_V.C for section .dseg **/
	nl();       /** do in dumplits, it is first **/
	cptr = startstatic;
	while (cptr < staticptr)
		{
		if (cptr[ob_cl] != ob_fn)
			{  /* do if anything but function */
			   /* output name as label... */
			outstr(cptr); colon();
			defstorage();  /* define storage, Times */
				/* calc # bytes lo,hi */
			j = ((cptr[offset]&255) + ((cptr[offset+1]&255) << 8));

			outdec(j);	/* need that many */
			if ((cptr[type] == cint) | (cptr[ob_cl] == ob_ptr))
				defword();
				else defbyte();
			ot("0"); /** filler value **/
			nl();
			}
		cptr = cptr + symsiz;  /** inc thru table **/
		}
}

/************************************************/
/*      Open an include file                    */
/************************************************/
doinclude()
{
	blanks();	/* skip over to name */
	if ((fp_in2 = fopen(line+lptr,"r")) == NULL)
		{
		fp_in2 = 0;
		error("Open failure on include file");
		}
	kill_ln();		/* clear rest of line */
			/* so next read will come from */
			/* new file (if open */
}

/************************************************/

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();
		}
}

/** error - not an lvalue **/
needlval() 
{
	error("must be lvalue");
}

/************************************************/
/* Console Output a carriage return and a string*/
/************************************************/
pl(str) char *str;
{
	int k;

	k = 0;
	putchar(eol);
	while (str[k]) putchar(str[k++]);
}


/************************************************/
/** putc <- outbyte <- nl, outstr <- ol        **/
/** Note: null, eof_flg, cause closeout.       **/
/************************************************/

/** Note usage: outbyte must return null or chr **/
outbyte(c) char c;
{	/** don't pass null terminator in **/
	if (c == 0) return 0;
	if (fp_out)  /** output is file fp_out **/
		{
		if ((putc(c,fp_out)) <= 0)
			{
			closeout();
			error("Output file error");
			}
		}
	else putchar(c);
	return c;
}

outstr(ptr) char ptr[];
{
	int k;

	k = 0;
  /** Note usage: outbyte must return null or chr **/
	while (outbyte(ptr[k++]));
}

/************************************************/
/** outfname put file name to text out to file **/
/************************************************/
outfname(ptr) char ptr[];
{
	int k;

	k = 0;
	while (ptr[k])
		{  /** not null **/
		if (ptr[k] == '.') break;
		outbyte(ptr[k++]);
		}
}

/** was nl() {outbyte(eol);} **/
nl()	{ outbyte(13); outbyte(10); }

tab()	{ outbyte(9); }

colon() { outbyte(58); }

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

	comment();
	outstr(line);
	nl();
	comment();
	k = 0;
	while (k < lptr)
		{
		if (line[k] == 9) tab();
		else outbyte(' ');
		++k;
		}
	outbyte('^');
	nl();
	comment();
	outstr("******  ");
	outstr(ptr);
	outstr("  ******");
	nl();
	++errcnt;
}

ol(ptr) char ptr[];
{
	ot(ptr);
	nl();
}

ot(ptr) char ptr[];
{
	tab();
	outstr(ptr);	/*outasm*/
}

/************************************************/

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;
		}
 }


/**  SCN_IV.C **/
/** Next is SCN_V.C **/
/************************************************/
/** Re-Codified roughly as:                    **/
/**     I.   Static Storage Defn, main()       **/
/**     II.  Recursive Descent Parser          **/
/**     III. Utility Functions                 **/
/**     IV.  U.I. & I/O                        **/
/**     V.   Backend, NASM Object Output       **/
/************************************************/
/************************************************/
/*          small-c compiler                    */
/*              rev. 1.1                        */
/*            by Ron Cain                       */
/*              (1980)                          */
/************************************************/
/************************************************/
/** Functions in this file: comment, header,   **/
/** outhexb, trailer, get_static, get_auto     **/
/** put_static, putstk, indirect, swap,        **/
/** mn_ldi_prim, m_push, sa_push_zr, m_pop,    **/
/** sa_swapstk, m_call, m_ret, callstk, jump,  **/
/** testjump, do_seg, defbyte, defstorage,     **/
/** defword, modstk, doublereg, m_add, m_sub,  **/
/** m_mult, m_div, mod, m_or, m_xor, m_and,    **/
/** asr, asl, m_neg, com, m_inc, m_dec, eq, ne,**/
/** lt, le, gt, ult, ule, ugt, uge             **/
/**  SCN_V.C                                   **/
/*   >>>>>> start of cc8 <<<<<<<                */
/************************************************/
/** Nasm Text Output Begins in This Module     **/
/** Primary: 8080.HL 8086.BX,                  **/
/** Static Cell is DSEG                        **/
/** Secondary: 8080.DE 8086.DX                 **/
/**  -made 2 versions, SCCN8.C & SCCNT8.C test **/
/** - appx A 6.1 char are conv to ints, which  **/
/**   are signed values. K&R C.                **/
/** 8:47 PM 7/27/2007 -Changes Primary = AX,   **/
/** Secondary = BX, chg due to sign extend AL  **/
/** 10:34 PM 12/23/2007 --                     **/
/** -Fixed 'indirect' mov prim,[prim]          **/

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

/************************************************/
/* Print all assembler info before any code     */
/*  is generated.                               */
/************************************************/
header()
{
	comment();
	outstr("Small-c Compiler rev 1.1 re:NASM c0.2.7 Feb. 2009");
	nl();
	ol("[MAP ALL NCCR1.MAP]");
/**	ol("SECTION .cseg vstart=0");	**/
	ol("SECTION .text vstart=0100h"); /*** .com vers. ***/
	nl();
}

/***------------------------------------------***/
/***------------------------------------------***/

outhexw(number) int number;
 {
	leaderx();
	hex(number);
 }

hex(x) int x;
{
	hexb(x >> 8);
	hexb(x);
}

hexb(x) int x;
{
	hexn(x >> 4);
	hexn(x);
}

hexn(x) int x;
{
	x = x & 15;
	if (x < 10) putchar(x + '0');
	else putchar(x - 10 + 'A');
} /** EO outhexw **/

/***------------------------------------------***/

outhexb(number) int number;
{
	leaderx();
	hexb(number & 255);
} /** EO outhexb **/

/***------------------------------------------***/

leaderx()
{
/**	ot("0x"); **/
	putchar('0');
	putchar('x');
}  /** EO leaderx() **/

/***------------------------------------------***/
/**--------------------------------------------**/

/***------------------------------------------***/
/* Print any assembler stuff needed after all code */
trailer()
{
	comment();
	ol("-= END =-");
}

/***--------------------------------------------------***/
/* Fetch a static memory cell into the primary register */
/** Primary 8080.HL 8086.AX, Static Cell is DSEG       **/
/** If byte, then affirm it is sign extended to wordsz **/

get_static(sym) char *sym;
{
/***	ol("  ;+; get_static DS tag..");  ***/
	if ((sym[ob_cl] != ob_ptr) & (sym[type] == cchar))
		{
		ot("MOV  AL,[");
		outstr(sym + name); /** symbol tbl + offset **/
		outstr("]");
		nl();
		  /** sign extension **/
		ol("CBW");
		}
	else	{
		ot("MOV  AX,[");
		outstr(sym + name); /** symbol tbl + offset **/
		outstr("]");
		nl();
		}
}

/* Fetch the address of the specified symbol */
/** the Stack Address of the passed Parameter, **/
/** place that reference into the Primary Cell **/

get_auto(sym) char *sym;
{
/***	ol("  ;+; get_auto SP.."); ***/
	mn_ldi_prim();  /** mnem LD Imm Primary **/
	outdec(((sym[offset] & 255) +
		((sym[offset+1] & 255) << 8)) - c_sp);
	nl();
	ol("ADD  AX,SP");
}

/* Store the primary register into the specified */
/*  static memory cell                           */

put_static(sym) char *sym;
{
/***	ol("  ;+; put_static DS.."); ***/
	if ((sym[ob_cl] != ob_ptr) & (sym[type] == cchar))
		{
		ot("MOV  [");
		outstr(sym + name); /** symbol tbl + offset **/
		outstr("],AL");
		nl();
		}
	else	{
		ot("MOV  [");
		outstr(sym + name); /** symbol tbl + offset **/
		outstr("],AX");
		nl();
		}
}

/* Store the specified object type in the primary register */
/*  at the address on the top of the stack                 */

putstk(typeobj) char typeobj;
/**{pop();if(typeobj==cchar)call("ccpchar");else call("ccpint");}**/
{
/***	ol("  ;+; putstk DS:[tos].."); ***/
	sa_pop();	/** BX <- Addr.TOS **/
			/** Effective Address must be in BX **/
	if (typeobj == cchar) ol("MOV  [BX],AL");
	else ol("MOV  [BX],AX");
}

/*** Store the specified object type in the primary register ***/
/***  at the SS:address found currently on the top of the stack ***/

putssstk(typeobj) char typeobj;
/**{pop();if(typeobj==cchar)call("ccpchar");else call("ccpint");}**/
{
/***	ol("  ;+; putstk SS:[tos].."); ***/
/**--	sa_pop();	-** BX <- Addr.TOS **/
			/** Effective Address must be in BP **/
	ol("POP  BP");
	c_sp = c_sp + 2;

/**--	ol("MOV  BP,BX"); -**/
	if (typeobj == cchar) ol("MOV  [BP],AL");
	else ol("MOV  [BP],AX");
}

/* Fetch the specified object type indirect through the */
/*  primary register into the primary register          */
/** one caller, rvalue, ie. rdvalue, replaced with stk_indi **/

/**--indirect(typeobj) char typeobj; --**/
/**{if (typeobj==cchar)call("ccgchar");else call("ccgint");}**/
/**-- {ol("  ;+; get DS:[primary]->primary, tag msg."); --**/
/**-- if (typeobj==cchar){ol("MOV  BX,AX");ol("MOV  AL,[Byte BX]"); --**/
/**-- ol("CBW");}else{ol("MOV  BX,AX");ol("MOV  AX,[BX]");}} --**/

/*** Primary indirect dereferencing Stack ***/
stk_indi(typeobj) char typeobj;
	/**{if (typeobj==cchar)call("ccgchar");else call("ccgint");}**/
{
/***	ol("  ;+; get SS:[primary]->primary,.."); ***/
	if (typeobj==cchar) 
		{
		ol("MOV  BP,AX");
		ol("MOV  AL,[Byte BP]");
		ol("CBW");
		}
	else	{
		ol("MOV  BP,AX");
		ol("MOV  AX,[BP]");
		}
}

/* Swap the primary and secondary registers */
swap() { ol("XCHG AX,BX"); }

/* Print partial instruction to get an immediate value */
/*	into the primary register */
mn_ldi_prim() { ot("MOV  AX,"); }

/* Push the primary register onto the stack */
/** 24 callers  sa_ means sematic action   **/
sa_push()
{
	ol("PUSH AX");
	c_sp=c_sp-2;
}

/** Push Zero onto the stack		**/
/** 10:30 AM 8/5/2007			**/
/** unlinked from callfunction() 11:54 AM 8/5/2007 **/
/** sa_push_zr() { ol("PUSH 0"); c_sp = c_sp - 2; } **/

/* Pop the top of the stack into the secondary register */
/** 17 callers **/
sa_pop()
{
	ol("POP  BX");
	c_sp = c_sp + 2;
}

/* Swap the primary register and the top of the stack */
sa_swapstk()
{
	ol("XCHG [SP],AX");
}

/* Call the specified subroutine name */
/** 1 caller **/
sa_call(sname) char *sname;
{
	ot("CALL ");
	outstr(sname);
	nl();
}

/* Return from subroutine */
/** 2 callers **/
sa_ret()
{
	ol("RET");
}

/* Perform subroutine call to value on top of stack */
/** one caller **/
sa_callstk()
{
	mn_ldi_prim();  /** mnem LD Imm Primary **/
	outstr("$+5");
	nl();
	sa_swapstk();
	ol("CALL [AX]");
	c_sp = c_sp + 2;
}

/* Jump to specified internal label number */
/** 4 Callers **/
sa_jump(label) int label;
{
	ot("JMP  ");
	printlabel(label);
	nl();
}

/* Test the primary register and jump if false to label */
/** Primary holds Bool on entry 1=TRUE, 0=FALSE the jump **/
/** often is not short, so change this... **/
/** testjump(label)int label;{ol("MOV  CX,AX"); **/
/** ot("JCXZ ");printlabel(label);nl();} **/

testjump(label) int label;
{
	ol("CMP  AX,0"); /** ZF if equal **/
	ol("JNE  $+5"); /** next is past, jmp label **/
	ot("JMP  ");
	printlabel(label);
	nl();
}

/** .dseg section **/

do_dseg()
{
  ot(";-; SECTION .dseg align=16 ;; commented out for .com version");
}


/* Print pseduo-op to define a byte */

defbyte()
{
	ot("DB ");
}

/* Print psedo-op to define storage */
/** Called by CC1 dumpstatics(), both will need modifications **/
/**   form: times nn d_sz val **/

defstorage()
{
	ot("TIMES "); /**ot("DS ");**/
}

/* Print pseudo-op to define a word */

defword()
{
	ot("DW ");
}

/* Modify the stack pointer to the new value indicated */
/** 9 callers, pertains to storage class auto, stack index **/

sa_modstk(newsp) int newsp;
{
	int k;

	k = newsp - c_sp;
	if (k == 0) return newsp;
	if (k > +0)
		{
		ot("ADD  SP,");
		outdec(k);
		nl();
		return newsp;
		}
	if (k < 0)
		{
		if (k > -7)
			{
			if ( k & 1)
				{
				ol("DEC  SP");
				k++;
				}
			while(k)
				{
			/**	ol("  ;+; sa_modstk.."); **/
			/**	ol("PUSH AX");          **/
				ol("PUSH 0");
				k = k + 2;
				}
			return newsp;
			}
		}

/* Modify the stack pointer to the new value indicated */
/** 9 callers, pertains to local stack index **/
/* sa_modstk(newsp)int newsp;{int k;k=newsp-c_sp; **/
/* if(k==0)return newsp;if(k>+0){if(k<7){if(k&1)**/
/** handle odd alignment **/
/* {ol("INC  SP");k--;}while(k)**/
/** throw away **/
/** without overwriting primary */
/* {ol("POP  DX");k=k-2;}return newsp;}} **/
/* if(k<0){if(k>-7){if(k&1){ol("DEC  SP");k++;}while(k){ol("PUSH AX"); **/
/* k=k+2;}return newsp;}} **/

/* Modify the stack pointer to the new value indicated */
/* modstk(newsp)int newsp;{int k;k=newsp-Zsp; **/
/* if(k==0)return newsp;ot("ADD SP,");outdec(k); **/
/* nl();return newsp;} **/

/** Have a closer look at the following for improvement **/
 /**	ol("  ;+; sa_modstk-b.."); **/
 /**	swap();         * Swap the primary and secondary registers */
 /**	mn_ldi_prim();  ** mnem LD Imm Primary **/
 /**	outdec(k); nl();
	ol("ADD  AX,SP");
	ol("MOV  SP,AX");
	swap();         * Swap the primary and secondary registers *
	return newsp;  **/
/***
	ot("MOV  BP,");
	outdec(k); nl();
	ol("ADD  BP,SP");
	ol("MOV  SP,BP");  ***/

	ot("ADD  SP,");
	outdec(k); nl();
	return newsp;
}

/* Double the primary register */

doublereg()
{
	ol("ADD  AX,AX");
}

/* Add the primary and secondary registers */
/*	(results in primary) */

m_add()
{
	ol("ADD  AX,BX");
}

/* Substract the primary register from the secondary */
/*	(results in the primary) */
/** sub() {call("ccsub");} **/

m_sub()
{
	ol("SUB  BX,AX"); /** BX-AX -> BX **/
	ol("MOV  AX,BX");
}

/* Multiply the primary and secondary registers */
/*	(results in primary) */
/** mult() {call("ccmult");} **/
/** Unsigned Mult re:AX*BX -> DX:AX **/

m_mult() { ol("MUL  BX"); }

/* Divide the secondary by the primary */
/* (quotient in primary, remainder in secondary) */
/*** 21-Jul-08 07:41:16 PM add signed integer divide ***/
/**** 24-Jul-08 02:51:10 PM force DX := 0, prevent exception ****/
/** div() {call("ccdiv");} **/
/** swap Primary&Secondary **/
/** Unsigned Div re:DX.0:AX/BX -> AX.quot DX.rem **/
/** mov remainder into Secondary		**/

m_div()
{
	ol("XCHG AX,BX");
	ol("MOV  DX,0"); /** clear extended reg DX **/
	ol("DIV  BX");   /** DX has remainder **/
	ol("MOV  BX,DX");
}

m_sdiv()
{
	ol("XCHG AX,BX");
	ol("CWD");      /** sign extend into DX **/
	ol("IDIV BX");  /** DX has remainder **/
	ol("MOV  BX,DX");
}

/* Compute remainder (mod) of secondary register dividend */
/*	by the primary */
/*	(remainder in primary, quotient in secondary) */

mod() { m_div(); swap(); }

/* Inclusive 'or' the primary and secondary registers */
/*	(results in the primary) */
/** or() {call("ccor");} **/

m_or() { ol("OR   AX,BX"); }

/* Exclusive 'or' the primary and secondary registers */
/*	(results in the primary) */
/** xor() {call("ccxor");} **/

m_xor() { ol("XOR  AX,BX"); }

/* 'And' the primary and secondary registers */
/*	(results in primary) */
/** and() {call("ccand");} **/

m_and() { ol("AND  AX,BX"); }

/* Arithmetic shift right the secondary register number of */
/*	times in the primary (results in primary) */
/** asr() {call("ccasr");} **/

asr()
{
	ol("MOV  CL,AL"); /** BH is disregarded **/
	ol("MOV  AX,BX");
	ol("SAR  AX,CL");
}

/* Arithmetic left shift the secondary register number of */
/*	times in the primary (results in primary) */
/** asl() {call("ccasl");} **/

asl()
{
	ol("MOV  CL,AL"); /** BH is disregarded **/
	ol("MOV  AX,BX");
	ol("SAL  AX,CL");
}

/* Form two's complement of primary register */
/** neg() {call("ccneg");} **/

m_neg() { ol("NEG  AX"); }

/* Form one's complement of primary register */
/** com() {call("cccom");} **/

com() { ol("NOT  AX"); }

/* Increment the primary register by one */
/** inc() {ol("INX H");} **/

m_inc() { ol("INC  AX"); }

/* Decrement the primary register by one */
/** dec() {ol("DCX H");} **/

m_dec() { ol("DEC  AX"); }

/* 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 */
/** Here for NASM, I've inlined these fns instead of	**/
/**  leaving them for an include *.* 			**/

/* Test for equal */

eq()	/** {call("cceq");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JZ   $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for not equal */

ne()	/** {call("ccne");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JNZ  $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for less than (signed) */

lt()	/** {call("cclt");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JL   $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for less than or equal to (signed) */

le()	/** {call("ccle");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JLE  $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for greater than (signed) */

gt()	/** {call("ccgt");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JG   $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for greater than or equal to (signed) */

ge()	/** {call("ccge");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JGE  $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for less than (unsigned) */

ult()	/** {call("ccult");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JB   $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for less than or equal to (unsigned) */

ule()	/** {call("ccule");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JBE  $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for greater than (unsigned) */

ugt()	/** {call("ccugt");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JA   $+5");
	ol("MOV  AX,0");   /** is false **/
}

/* Test for greater than or equal to (unsigned) */

uge()	/** {call("ccuge");} **/
{
	ol("CMP  BX,AX");  /** sets flags **/
	ol("MOV  AX,1");   /** assume true **/
	ol("JAE  $+5");
	ol("MOV  AX,0");   /** is false **/
}
/***------------------------------------------***/
/**-------------------------------------**/
/** extern functions needed by small-c: **/
/** fopen()				**/
/** fclose()				**/
/** putchar()				**/
/** getc()				**/
/** putc()				**/
/** gets()				**/
/**	Example..			**/
/** CALL gets | gets(line);		**/
/** CALL fopen | fopen(line,"w")	**/
/** CALL fclose | fclose(fp_out);	**/
/*	<<<<< End of Compiler >>>>>	 */
/* #include IOC5.C * when self compiling */
/* Otherwise, the PowerC pcdos io lib is */
/* used: stdio.h			**/
/** SCNXa.C is PowerC Level 1 Compile	**/
/** SCNX.C is IOC5.C Level 2 Self-Compile*/
/** #include IOC5.C ** for self-compile **/
/** Name changed to...			**/
#include C5LIB.C /** for self-compile	**/
/** -======== End of Compiler ========- **/