From: utzoo!decvax!harpo!npoiv!npois!wbux5!wb2!houxz!ihnp4!ixn5c!inuxc!pur-ee!uiucdcs!schrein
Newsgroups: net.sources
Title: Re: smallC V2 CP/M runtime support - (nf)
Article-I.D.: uiucdcs.1671
Posted: Sun Mar 13 22:45:50 1983
Received: Wed Mar 16 00:46:45 1983

#R:uiucdcs:12600001:uiucdcs:12600003:000:56968
uiucdcs!schrein    Mar 12 09:23:00 1983

(smallC V2 CP/M runtime support continued)
(part 3)

%%%%%%%%%% scc/scc/11.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	= *	not =*
 *	lout has 2 arguments
 *	prompt needs to return 1 for openin... (unused, anyhow)
 *	optimizer by default turned on
 */

#include "smallc.h"	/*** system stuff */

/*
** execution begins here
*/
main(argc, argv) int argc, *argv; {
  argcs=argc;
  argvs=argv;
#ifdef DYNAMIC
  swnext=CCALLOC(SWTABSZ);
  swend=swnext+((SWTABSZ-SWSIZ)>>1);
  stage=CCALLOC(STAGESIZE);
  stagelast=stage+STAGELIMIT;
  wq=CCALLOC(WQTABSZ*BPW);
  litq=CCALLOC(LITABSZ);
#ifdef HASH
  macn=CCALLOC(MACNSIZE);
  cptr=macn-1;
  while(++cptr < MACNEND) *cptr=0;
#endif
  macq=CCALLOC(MACQSIZE);
  pline=CCALLOC(LINESIZE);
  mline=CCALLOC(LINESIZE);
#else
  swend=(swnext=swq)+SWTABSZ-SWSIZ;
  stagelast=stage+STAGELIMIT;
#endif
  swactive=	  /* not in switch */
  stagenext=	  /* direct output mode */
  iflevel=	  /* #if... nesting level = 0 */
  skiplevel=	  /* #if... not encountered */
  macptr=	  /* clear the macro pool */
  csp =		  /* stack ptr (relative) */
  errflag=	  /* not skipping errors till ";" */
  eof=		  /* not eof yet */
  ncmp=		  /* not in compound statement */
  files=
  filearg=
  quote[1]=0;
  ccode=1;	  /* enable preprocessing */
  wqptr=wq;	  /* clear while queue */
  quote[0]='"';	  /* fake a quote literal */
  input=input2=EOF;
  ask();	  /* get user options */
  openin();	  /* and initial input file */
  preprocess();	  /* fetch first line */
#ifdef DYNAMIC
#ifdef HASH
  symtab=CCALLOC(NUMLOCS*SYMAVG + NUMGLBS*SYMMAX);
#else
  symtab=CCALLOC(NUMLOCS*SYMAVG);
  /*  global space is allocated with each new entry  */
#endif
#endif
#ifdef HASH
  cptr=STARTGLB-1;
  while(++cptr < ENDGLB) *cptr=0;
#endif
  glbptr=STARTGLB;
  glbflag=1;
  ctext=0;
  header();	     /* intro code */
  setops();	     /* set values in op arrays */
  parse();	     /* process ALL input */
  outside();	     /* verify outside any function */
  trailer();	     /* follow-up code */
  fclose(output);
  }

/*
** process all input text
**
** At this level, only static declarations,
**	defines, includes and function
**	definitions are legal...
*/
parse() {
  while (eof==0) {
    if(amatch("extern", 6))   dodeclare(EXTERNAL);
    else if(dodeclare(STATIC));
    else if(match("#asm"))    doasm();
    else if(match("#include"))doinclude();
    else if(match("#define")) addmac();
    else		      newfunc();
    blanks();	    /* force eof if pending */
    }
  }

/*
** dump the literal pool
*/
dumplits(size) int size; {
  int j, k;
  k=0;
  while (k<litptr) {
    defstorage(size);
    j=10;
    while(j--) {
      outdec(getint(litq+k, size));
      k=k+size;
      if ((j==0)|(k>=litptr)) {
	nl();
	break;
	}
      outbyte(',');
      }
    }
  }

/*
** dump zeroes for default initial values
*/
dumpzero(size, count) int size, count; {
  int j;
  while (count > 0) {
    defstorage(size);
    j=30;
    while(j--) {
      outdec(0);
      if ((--count <= 0)|(j==0)) {
	nl();
	break;
	}
      outbyte(',');
      }
    }
  }

/*
** verify compile ends outside any function
*/
outside()  {
  if (ncmp) error("no closing bracket");
  }

/*
** get run options
*/
ask() {
  int i;
  i=listfp=nxtlab=0;
  output=stdout;
	optimize=YES;	/* default is to optimize */
  alarm=monitor=pause=NO;
  line=mline;
  while(getarg(++i, line, LINESIZE, argcs, argvs)!=EOF) {
    if(line[0]!='-') continue;
    if((upper(line[1])=='L')&(numeric(line[2]))&(line[3]<=' ')) {
      listfp=line[2]-'0';
      continue;
      }
    if(line[2]<=' ') {
      if(upper(line[1])=='A') {
	alarm=YES;
	continue;
	}
      if(upper(line[1])=='M') {
	monitor=YES;
	continue;
	}
      if(upper(line[1])=='O') {
	optimize=NO;	/* switch turns optimizer off */
	continue;
	}
      if(upper(line[1])=='P') {
	pause=YES;
	continue;
	}
      }
    sout("usage: cc [file]... [-m] [-a] [-p] [-l#] [-o]\n", stderr);
    abort();
    }
  }


/*
** get next input file
*/
openin() {
  input=EOF;
  while(getarg(++filearg, pline, LINESIZE, argcs, argvs)!=EOF) {
    if(pline[0]=='-') continue;
    if((input=fopen(pline,"r"))==NULL) {
      lout("open error", stderr);
      abort();
      }
    files=YES;
    kill();
    return;
    }
  if(files++) eof=YES;
  else input=stdin;
  kill();
  }

setops() {
  op2[00]=     op[00]=	or;  /* heir5 */
  op2[01]=     op[01]= xor;  /* heir6 */
  op2[02]=     op[02]= and;  /* heir7 */
  op2[03]=     op[03]=	eq;  /* heir8 */
  op2[04]=     op[04]=	ne;
  op2[05]=ule; op[05]=	le;  /* heir9 */
  op2[06]=uge; op[06]=	ge;
  op2[07]=ult; op[07]=	lt;
  op2[08]=ugt; op[08]=	gt;
  op2[09]=     op[09]= asr;  /* heir10 */
  op2[10]=     op[10]= asl;
  op2[11]=     op[11]= add;  /* heir11 */
  op2[12]=     op[12]= sub;
  op2[13]=     op[13]=mult;  /* heir12 */
  op2[14]=     op[14]= div;
  op2[15]=     op[15]= mod;
  }
%%%%%%%%%% scc/scc/12.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	eliminate jump to first function
 *	mark code/data sections
 */

#include "smallc.h"

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

/*
** test for global declarations
*/
dodeclare(class) int class; {
  if(amatch("char",4)) {
    declglb(CCHAR, class);
    ns();
    return 1;
    }
  else if((amatch("int",3))|(class==EXTERNAL)) {
    declglb(CINT, class);
    ns();
    return 1;
    }
  return 0;
  }

/*
** delcare a static variable
*/
declglb(type, class)  int type, class; {
  int k, j;
  while(1) {
    if(endst()) return;	    /* do line */
    if(match("*")) {
      j=POINTER;
      k=0;
      }
    else {
      j=VARIABLE;
      k=1;
      }
    if (symname(ssname, YES)==0) illname();
    if(findglb(ssname)) multidef(ssname);
    if(match("()")) j=FUNCTION;
    else if (match("[")) {
      k=needsub();    /* get size */
      j=ARRAY;	 /* !0=array */
      }
    if(class==EXTERNAL) external(ssname);
    else j=initials(type>>2, j, k);
    addsym(ssname, j, type, k, &glbptr, class);
    if (match(",")==0) return; /* more? */
    }
  }

/*
** declare local variables
*/
declloc(typ)  int typ;	{
  int k,j;
#ifdef STGOTO
  if(noloc) error("not allowed with goto");
#endif
  if(declared < 0) error("must declare first in block");
  while(1) {
    while(1) {
      if(endst()) return;
      if(match("*")) j=POINTER;
      else j=VARIABLE;
      if (symname(ssname, YES)==0) illname();
      /* no multidef check, block-locals are together */
      k=BPW;
      if (match("[")) {
	k=needsub();
	if(k) {
	  j=ARRAY;
	  if(typ==CINT)k=k<<LBPW;
	  }
	else j=POINTER;
	}
      else if(match("()")) j=FUNCTION;
      else if((typ==CCHAR)&(j==VARIABLE)) k=SBPC;
      declared = declared + k;
      addsym(ssname, j, typ, csp - declared, &locptr, AUTOMATIC);
      break;
      }
    if (match(",")==0) return;
    }
  }

/*
** initialize global objects
*/
initials(size, ident, dim) int size, ident, dim; {
  int savedim;
  litptr=0;
  if(dim==0) dim = -1;
  savedim=dim;
	dsect();
  entry();
  if(match("=")) {
    if(match("{")) {
      while(dim) {
	init(size, ident, &dim);
	if(match(",")==0) break;
	}
      needtoken("}");
      }
    else init(size, ident, &dim);
    }
  if((dim == -1)&(dim==savedim)) {
     stowlit(0, size=BPW);
    ident=POINTER;
    }
  dumplits(size);
  dumpzero(size, dim);
  return ident;
  }

/*
** evaluate one initializer
*/
init(size, ident, dim) int size, ident, *dim; {
  int value;
  if(qstr(&value)) {
    if((ident==VARIABLE)|(size!=1))
      error("must assign to char pointer or array");
    *dim = *dim - (litptr - value);
    if(ident==POINTER) point();
    }
  else if(constexpr(&value)) {
    if(ident==POINTER) error("cannot assign to pointer");
    stowlit(value, size);
    *dim = *dim - 1;
    }
  }

/*
** get required array size
*/
needsub()  {
  int val;
  if(match("]")) return 0; /* null size */
  if (constexpr(&val)==0) val=1;
  if (val<0) {
    error("negative size illegal");
    val = -val;
    }
  needtoken("]");      /* force single dimension */
  return val;	       /* and return size */
  }

/*
** begin a function
**
** called from "parse" and tries to make a function
** out of the following text
**
** Patched per P.L. Woods (DDJ #52)
*/
newfunc()  {
  char *ptr;
#ifdef STGOTO
  nogo	=	      /* enable goto statements */
  noloc = 0;	      /* enable block-local declarations */
#endif
  lastst=	      /* no statement yet */
  litptr=0;	      /* clear lit pool */
  litlab=getlabel();  /* label next lit pool */
  locptr=STARTLOC;    /* clear local variables */
  if(monitor) lout(line, stderr);
  if (symname(ssname, YES)==0) {
    error("illegal function or declaration");
    kill(); /* invalidate line */
    return;
    }
  if(ptr=findglb(ssname)) {	 /* already in symbol table ? */
    if(ptr[IDENT]!=FUNCTION)	   multidef(ssname);
    else if(ptr[OFFSET]==FUNCTION) multidef(ssname);
    else ptr[OFFSET]=FUNCTION;
      /*  earlier assumed to be a function */
    }
  else
    addsym(ssname, FUNCTION, CINT, FUNCTION, &glbptr, STATIC);
  if(match("(")==0) error("no open paren");
	csect();
  entry();
  locptr=STARTLOC;
  argstk=0;		  /* init arg count */
  while(match(")")==0) {  /* then count args */
    /* any legal name bumps arg count */
    if(symname(ssname, YES)) {
      if(findloc(ssname)) multidef(ssname);
      else {
	addsym(ssname, 0, 0, argstk, &locptr, AUTOMATIC);
	argstk=argstk+BPW;
	}
      }
    else {error("illegal argument name");junk();}
    blanks();
    /* if not closing paren, should be comma */
    if(streq(lptr,")")==0) {
      if(match(",")==0) error("no comma");
      }
    if(endst()) break;
    }
  csp=0;	/* preset stack ptr */
  argtop=argstk;
  while(argstk) {
    /* now let user declare what types of things */
    /*	    those arguments were */
    if(amatch("char",4))     {doargs(CCHAR);ns();}
    else if(amatch("int",3)) {doargs(CINT);ns();}
    else {error("wrong number of arguments");break;}
    }
  if(statement()!=STRETURN) ret();
  if(litptr) {
	dsect();
    printlabel(litlab);
    col();
    dumplits(1); /* dump literals */
    }
  }

/*
** declare argument types
**
** called from "newfunc" this routine adds an entry in the
** local symbol table for each named argument
**
** rewritten per P.L. Woods (DDJ #52)
*/
doargs(t) int t; {
  int j, legalname;
  char c, *argptr;
  while(1) {
    if(argstk==0) return; /* no arguments */
    if(match("*")) j=POINTER; else j=VARIABLE;
    if((legalname=symname(ssname, YES))==0) illname();
    if(match("[")) {   /* is it a pointer? */
      /* yes, so skip stuff between "[...]" */
      while(inbyte()!=']') if(endst()) break;
      j=POINTER; /* add entry as pointer */
      }
    if(legalname) {
      if(argptr=findloc(ssname)) {
	/* add details of type and address */
	argptr[IDENT]=j;
	argptr[TYPE]=t;
	putint(argtop-getint(argptr+OFFSET, OFFSIZE), argptr+OFFSET, OFFSIZE);
	}
      else error("not an argument");
      }
    argstk=argstk-BPW;	      /* cnt down */
    if(endst())return;
    if(match(",")==0) error("no comma");
    }
  }
%%%%%%%%%% scc/scc/13.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	continue in switch (net.micro 1/27/83)
 */

#include "smallc.h"

/*
** statement parser
**
** called whenever syntax requires a statement
**  this routine performs that statement
**  and returns a number telling which one
*/
statement() {
  if ((ch==0) & (eof)) return;
  else if(amatch("char",4))  {declloc(CCHAR);ns();}
  else if(amatch("int",3))   {declloc(CINT);ns();}
  else {
    if(declared >= 0) {
#ifdef STGOTO
      if(ncmp > 1) nogo=declared; /* disable goto if any */
#endif
      csp=modstk(csp - declared, NO);
      declared = -1;
      }
    if(match("{"))		 compound();
    else if(amatch("if",2))	 {doif();lastst=STIF;}
    else if(amatch("while",5))	 {dowhile();lastst=STWHILE;}
#ifdef STDO
    else if(amatch("do",2))	 {dodo();lastst=STDO;}
#endif
#ifdef STFOR
    else if(amatch("for",3))	 {dofor();lastst=STFOR;}
#endif
#ifdef STSWITCH
    else if(amatch("switch",6))	 {doswitch();lastst=STSWITCH;}
    else if(amatch("case",4))	 {docase();lastst=STCASE;}
    else if(amatch("default",7)) {dodefault();lastst=STDEF;}
#endif
#ifdef STGOTO
    else if(amatch("goto", 4))	 {dogoto(); lastst=STGOTO;}
    else if(dolabel())		 ;
#endif
    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(";"))		 errflag=0;
    else if(match("#asm"))	 {doasm();lastst=STASM;}
    else			 {doexpr();ns();lastst=STEXPR;}
    }
  return lastst;
  }

/*
** semicolon enforcer
**
** called whenever syntax requires a semicolon
*/
ns()  {
  if(match(";")==0) error("no semicolon");
  else errflag=0;
  }

compound()  {
  int savcsp;
  char *savloc;
  savcsp=csp;
  savloc=locptr;
  declared=0;	 /* may now declare local variables */
  ++ncmp;	 /* new level open */
  while (match("}")==0)
    if(eof) {
      error("no final }");
      break;
      }
    else statement();	  /* do one */
  --ncmp;		  /* close current level */
  csp=modstk(savcsp, NO); /* delete local variable space */
#ifdef STGOTO
  cptr=savloc;		  /* retain labels */
  while(cptr < locptr) {
    cptr2=nextsym(cptr);
    if(cptr[IDENT] == LABEL) {
      while(cptr < cptr2) *savloc++ = *cptr++;
      }
    else cptr=cptr2;
    }
#endif
  locptr=savloc;	  /* delete local symbols */
  declared = -1;	  /* may not declare variables */
  }

doif()	{
  int flab1,flab2;
  flab1=getlabel(); /* get label for false branch */
  test(flab1, YES); /* get expression, and branch false */
  statement();	    /* if true, do a statement */
  if (amatch("else",4)==0) {	  /* if...else ? */
    /* simple "if"...print false label */
    postlabel(flab1);
    return;	    /* and exit */
    }
  flab2=getlabel();
#ifdef STGOTO
  if((lastst != STRETURN)&(lastst != STGOTO)) jump(flab2);
#else
  if(lastst != STRETURN) jump(flab2);
#endif
  postlabel(flab1); /* print false label */
  statement();	    /* and do "else" clause */
  postlabel(flab2); /* print true label */
  }

doexpr() {
  int const, val;
  char *before, *start;
  while(1) {
    setstage(&before, &start);
    expression(&const, &val);
    clearstage(before, start);
    if(ch != ',') break;
    bump(1);
    }
  }

dowhile()  {
  int wq[4];		  /* allocate local queue */
  addwhile(wq);		  /* add entry to queue for "break" */
  postlabel(wq[WQLOOP]);  /* loop label */
  test(wq[WQEXIT], YES);  /* see if true */
  statement();		  /* if so, do a statement */
  jump(wq[WQLOOP]);	  /* loop to label */
  postlabel(wq[WQEXIT]);  /* exit label */
  delwhile();		  /* delete queue entry */
  }

#ifdef STDO
dodo() {
  int wq[4], top;
  addwhile(wq);
  postlabel(top=getlabel());
  statement();
  needtoken("while");
  postlabel(wq[WQLOOP]);
  test(wq[WQEXIT], YES);
  jump(top);
  postlabel(wq[WQEXIT]);
  delwhile();
  ns();
  }
#endif

#ifdef STFOR
dofor() {
  int wq[4], lab1, lab2;
  addwhile(wq);
  lab1=getlabel();
  lab2=getlabel();
  needtoken("(");
  if(match(";")==0) {
    doexpr();		 /* expr 1 */
    ns();
    }
  postlabel(lab1);
  if(match(";")==0) {
    test(wq[WQEXIT], NO); /* expr 2 */
    ns();
    }
  jump(lab2);
  postlabel(wq[WQLOOP]);
  if(match(")")==0) {
    doexpr();		 /* expr 3 */
    needtoken(")");
    }
  jump(lab1);
  postlabel(lab2);
  statement();
  jump(wq[WQLOOP]);
  postlabel(wq[WQEXIT]);
  delwhile();
  }
#endif

#ifdef STSWITCH
doswitch() {
  int wq[4], endlab, swact, swdef, *swnex, *swptr;
  swact=swactive;
  swdef=swdefault;
  swnex=swptr=swnext;
  addwhile(wq);
	*(wqptr+WQLOOP-WQSIZ) = 0;
  needtoken("(");
  doexpr();	 /* evaluate switch expression */
  needtoken(")");
  swdefault=0;
  swactive=1;
  jump(endlab=getlabel());
  statement();	 /* cases, etc. */
  jump(wq[WQEXIT]);
  postlabel(endlab);
  sw();		 /* match cases */
  while(swptr < swnext) {
    defstorage(CINT>>2);
    printlabel(*swptr++);  /* case label */
    outbyte(',');
    outdec(*swptr++);	   /* case value */
    nl();
    }
  defstorage(CINT>>2);
  outdec(0);
  nl();
  if(swdefault) jump(swdefault);
  postlabel(wq[WQEXIT]);
  delwhile();
  swnext=swnex;
  swdefault=swdef;
  swactive=swact;
  }

docase() {
  if(swactive==0) error("not in switch");
  if(swnext > swend) {
    error("too many cases");
    return;
    }
  postlabel(*swnext++ = getlabel());
  constexpr(swnext++);
  needtoken(":");
  }

dodefault() {
  if(swactive) {
    if(swdefault) error("multiple defaults");
    }
  else error("not in switch");
  needtoken(":");
  postlabel(swdefault=getlabel());
  }
#endif

#ifdef STGOTO
dogoto() {
  if(nogo > 0) error("not allowed with block-locals");
  else noloc = 1;
  if(symname(ssname, YES)) jump(addlabel());
  else error("bad label");
  ns();
  }

dolabel() {
  char *savelptr;
  blanks();
  savelptr=lptr;
  if(symname(ssname, YES)) {
    if(gch()==':') {
      postlabel(addlabel());
      return 1;
      }
    else bump(savelptr-lptr);
    }
  return 0;
  }

addlabel()  {
  if(cptr=findloc(ssname)) {
    if(cptr[IDENT]!=LABEL) error("not a label");
    }
  else cptr=addsym(ssname, LABEL, LABEL, getlabel(), &locptr, LABEL);
  return (getint(cptr+OFFSET, OFFSIZE));
  }
#endif

doreturn()  {
  if(endst()==0) {
    doexpr();
    modstk(0, YES);
    }
  else modstk(0, NO);
  ret();
  }

dobreak()  {
  int *ptr;
  if ((ptr=readwhile(wqptr))==0) return; /* no loops open */
  modstk((ptr[WQSP]), NO);	    /* clean up stk ptr */
  jump(ptr[WQEXIT]);		    /* jump to exit label */
  }

docont()  {
  int *ptr;
	ptr = wqptr;
	while (1)
	{	if ((ptr = readwhile(ptr)) == 0)
			return;
		if (ptr[WQLOOP])
			break;
	}
  modstk((ptr[WQSP]), NO);	    /* clean up stk ptr */
  jump(ptr[WQLOOP]);		    /* jump to loop label */
  }

doasm()	 {
  ccode=0;		  /* mark mode as "asm" */
  while (1) {
    inline();
    if (match("#endasm")) break;
    if(eof)break;
    lout(line, output);
    }
  kill();
  ccode=1;
  }
%%%%%%%%%% scc/scc/21.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	= *	not =*
 *	internal labels start with "."
 *	it is needed in ask()
 */

#include "smallc.h"

junk() {
  if(an(inbyte())) while(an(ch)) gch();
  else while(an(ch)==0) {
    if(ch==0) break;
    gch();
    }
  blanks();
  }

endst() {
  blanks();
  return ((streq(lptr,";")|(ch==0)));
  }

illname() {
  error("illegal symbol");
  junk();
  }


multidef(sname)	 char *sname; {
  error("already defined");
  }

needtoken(str)	char *str; {
  if (match(str)==0) error("missing token");
  }

needlval() {
  error("must be lvalue");
  }

findglb(sname)	char *sname; {
#ifdef HASH
  if(search(sname, STARTGLB, SYMMAX, ENDGLB, NUMGLBS, NAME))
    return cptr;
#else
  cptr=STARTGLB;
  while(cptr < glbptr) {
    if(astreq(sname, cptr+NAME, NAMEMAX)) return cptr;
    cptr=nextsym(cptr);
    }
#endif
  return 0;
  }

findloc(sname)	char *sname;  {
  cptr = locptr - 1;  /* search backward for block locals */
  while(cptr > STARTLOC) {
    cptr = cptr - *cptr;
    if(astreq(sname, cptr, NAMEMAX)) return (cptr - NAME);
    cptr = cptr - NAME - 1;
    }
  return 0;
  }

addsym(sname, id, typ, value, lgptrptr, class)
  char *sname, id, typ;	 int value, *lgptrptr, class; {
  if(lgptrptr == &glbptr) {
    if(cptr2=findglb(sname)) return cptr2;
#ifdef HASH
    if(cptr==0) {
      error("global symbol table overflow");
      return 0;
      }
#else
#ifndef DYNAMIC
    if(glbptr >= ENDGLB) {
      error("global symbol table overflow");
      return 0;
      }
#endif
    cptr= *lgptrptr;	/*** */
#endif
    }
  else {
    if(locptr > (ENDLOC-SYMMAX)) {
      error("local symbol table overflow");
      abort();
      }
    cptr= *lgptrptr;	/*** */
    }
  cptr[IDENT]=id;
  cptr[TYPE]=typ;
  cptr[CLASS]=class;
  putint(value, cptr+OFFSET, OFFSIZE);
  cptr3 = cptr2 = cptr + NAME;
  while(an(*sname)) *cptr2++ = *sname++;
#ifdef HASH
  if(lgptrptr == &locptr) {
    *cptr2 = cptr2 - cptr3;	    /* set length */
    *lgptrptr = ++cptr2;
    }
#else
  *cptr2 = cptr2 - cptr3;	  /* set length */
  *lgptrptr = ++cptr2;
#ifdef DYNAMIC
  if(lgptrptr == &glbptr) CCALLOC(cptr2 - cptr);
  /*  gets allocation error if no more memory  */
#endif
#endif
  return cptr;
  }

#ifndef HASH
nextsym(entry) char *entry; {
  entry = entry + NAME;
  while(*entry++ >= ' '); /* find length byte */
  return entry;
  }
#endif

/*
** get integer of length len from address addr
** (byte sequence set by "putint")
*/
getint(addr, len) char *addr; int len; {
  int i;
  i = *(addr + --len);	/* high order byte sign extended */
  while(len--) i = (i << 8) | *(addr+len)&255;
  return i;
  }

/*
** put integer i of length len into address addr
** (low byte first)
*/
putint(i, addr, len) char *addr; int i, len; {
  while(len--) {
    *addr++ = i;
    i = i>>8;
    }
  }

/*
** test if next input string is legal symbol name
*/
symname(sname, ucase) char *sname; int ucase; {
  int k;char c;
  blanks();
  if(alpha(ch)==0) return 0;
  k=0;
  while(an(ch)) {
      sname[k]=gch();
    if(k<NAMEMAX) ++k;
    }
  sname[k]=0;
  return 1;
  }

/*
** force upper case alphabetics
*/
upper(c)  char c; {	/*** */
  if((c >= 'a') & (c <= 'z')) return (c - 32);
  else return c;
  }

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

/*
** post a label in the program
*/
postlabel(label) int label; {
  printlabel(label);
  col();
  nl();
  }

/*
** print specified number as a label
*/
printlabel(label)  int label; {
  outstr(".");
  outdec(label);
  }

/*
** test if given character is alphabetic
*/
alpha(c)  char c; {
  return (((c>='a')&(c<='z'))|((c>='A')&(c<='Z'))|(c=='_'));
  }

/*
** test if given character is numeric
*/
numeric(c)  char c; {
  return((c>='0')&(c<='9'));
  }

/*
** test if given character is alphanumeric
*/
an(c)  char c; {
  return ((alpha(c))|(numeric(c)));
  }

addwhile(ptr)  int ptr[]; {
  int k;
  ptr[WQSP]=csp;	   /* and stk ptr */
  ptr[WQLOOP]=getlabel();  /* and looping label */
  ptr[WQEXIT]=getlabel();   /* and exit label */
  if (wqptr==WQMAX) {
    error("too many active loops");
    abort();
    }
  k=0;
  while (k<WQSIZ) *wqptr++ = ptr[k++];
  }

delwhile() {
  if(wqptr > wq) wqptr=wqptr-WQSIZ;
  }

readwhile(ptr)
	int *ptr;
{
	if (ptr <= wq)
	{	error("out of context");
		return 0;
	}
	return (ptr-WQSIZ);
}

white() {
  /* test for stack/program overlap */
  /* primary -> symname -> blanks -> white */
#ifdef DYNAMIC
  CCAVAIL();  /* abort on stack/symbol table overflow */
#endif
  if(*lptr==' ') return 1;
  if(*lptr==9)	 return 1;
  return 0;
  }

gch() {
  int c;
  if(c=ch) bump(1);
  return c;
  }

bump(n) int n; {
  if(n) lptr=lptr+n;
  else	lptr=line;
  if(ch=nch= *lptr) nch= *(lptr+1);	/*** */
  }

kill() {
  *line=0;
  bump(0);
  }

inbyte()  {
  while(ch==0) {
    if (eof) return 0;
    preprocess();
    }
  return gch();
  }

inline() {
  int k,unit;
  while(1) {
    if (input==EOF) openin();
    if(eof) return;
    if((unit=input2)==EOF) unit=input;
    if(fgets(line, LINEMAX, unit)==NULL) {
      fclose(unit);
      if(input2!=EOF) input2=EOF;
      else input=EOF;
      }
    else {
      bump(0);
      return;
      }
    }
  }
%%%%%%%%%% scc/scc/22.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	= *	not =*
 */

#include "smallc.h"

ifline() {
  while(1) {
    inline();
    if(eof) return;
    if(match("#ifdef")) {
      ++iflevel;
      if(skiplevel) continue;
      blanks();
#ifdef HASH
      if(search(lptr, macn, NAMESIZE+2, MACNEND, MACNBR, 0)==0)
#else
      if(findmac(lptr)==0)
#endif
	skiplevel=iflevel;
      continue;
      }
    if(match("#ifndef")) {
      ++iflevel;
      if(skiplevel) continue;
      blanks();
#ifdef HASH
      if(search(lptr, macn, NAMESIZE+2, MACNEND, MACNBR, 0))
#else
      if(findmac(lptr))
#endif
	skiplevel=iflevel;
      continue;
      }
    if(match("#else")) {
      if(iflevel) {
	if(skiplevel==iflevel) skiplevel=0;
	else if(skiplevel==0)  skiplevel=iflevel;
	}
      else noiferr();
      continue;
      }
    if(match("#endif")) {
      if(iflevel) {
	if(skiplevel==iflevel) skiplevel=0;
	--iflevel;
	}
      else noiferr();
      continue;
      }
    if(skiplevel) continue;
    if(listfp) {
      if(listfp==output) cout(';', output);
      lout(line, listfp);
      }
    if(ch==0) continue;
    break;
    }
  }

keepch(c)  char c; {
  if(pptr<LINEMAX) pline[++pptr]=c;
  }

preprocess() {
  int k;
  char c;
  if(ccode) {
    line=mline;
    ifline();
    if(eof) return;
    }
  else {
    line=pline;
    inline();
    return;
    }
  pptr = -1;
  while(ch) {
    if(white()) {
      keepch(' ');
      while(white()) gch();
      }
    else if(ch=='"') {
      keepch(ch);
      gch();
      while((ch!='"')|((*(lptr-1)==92)&(*(lptr-2)!=92))) {
	if(ch==0) {
	  error("no quote");
	  break;
	  }
	keepch(gch());
	}
      gch();
      keepch('"');
      }
    else if(ch==39) {
      keepch(39);
      gch();
      while((ch!=39)|((*(lptr-1)==92)&(*(lptr-2)!=92))) {
	if(ch==0) {
	  error("no apostrophe");
	  break;
	  }
	keepch(gch());
	}
      gch();
      keepch(39);
      }
    else if((ch=='/')&(nch=='*')) {
      bump(2);
      while(((ch=='*')&(nch=='/'))==0) {
	if(ch) bump(1);
	else {
	  ifline();
	  if(eof) break;
	  }
	}
      bump(2);
      }
    else if(an(ch)) {
      k=0;
      while(an(ch)) {
	if(k<NAMEMAX) msname[k++]=ch;
	gch();
	}
      msname[k]=0;
#ifdef HASH
      if(search(msname, macn, NAMESIZE+2, MACNEND, MACNBR, 0)) {
	k=getint(cptr+NAMESIZE, 2);
	while(c=macq[k++]) keepch(c);
	}
#else
      if(k=findmac(msname)) while(c=macq[k++]) keepch(c);
#endif
      else {
	k=0;
	while(c=msname[k++]) keepch(c);
	}
      }
    else keepch(gch());
    }
  if(pptr>=LINEMAX) error("line too long");
  keepch(0);
  line=pline;
  bump(0);
  }

noiferr() {
  error("no matching #if...");
  errflag=0;
  }

addmac() {
  int k;
  if(symname(msname, NO)==0) {
    illname();
    kill();
    return;
    }
  k=0;
#ifdef HASH
  if(search(msname, macn, NAMESIZE+2, MACNEND, MACNBR, 0)==0) {
    if(cptr2=cptr) while(*cptr2++ = msname[k++]);
    else {
      error("macro name table full");
      return;
      }
    }
  putint(macptr, cptr+NAMESIZE, 2);
#else
  while(putmac(msname[k++]));
#endif
  while(white()) gch();
  while(putmac(gch()));
  if(macptr>=MACMAX) {
    error("macro string queue full"); abort();
    }
  }

putmac(c)  char c; {
  macq[macptr]=c;
  if(macptr<MACMAX) ++macptr;
  return c;
  }

#ifdef HASH
/*
** search for symbol match
** on return cptr points to slot found or empty slot
*/
search(sname, buf, len, end, max, off)
  char *sname, *buf, *end;  int len, max, off; {
  cptr=cptr2=buf+((hash(sname)%(max-1))*len);
  while(*cptr != 0) {
    if(astreq(sname, cptr+off, NAMEMAX)) return 1;
    if((cptr=cptr+len) >= end) cptr=buf;
    if(cptr == cptr2) return (cptr=0);
    }
  return 0;
  }

hash(sname) char *sname; {
  int i, c;
  i=0;
  while(c= *sname++) i=(i<<1)+c;	/*** */
  return i;
  }

#else

findmac(sname)	char *sname; {
  mack=0;
  while(mack<macptr) {
    if(astreq(sname,macq+mack,NAMEMAX)) {
      while(macq[mack++]);
      return mack;
      }
    while(macq[mack++]);
    while(macq[mack++]);
    }
  return 0;
  }
#endif

setstage(before, start) int *before, *start; {
  if((*before=stagenext)==0) stagenext=stage;
  *start=stagenext;
  }

clearstage(before, start) char *before, *start; {
  *stagenext=0;
  if(stagenext=before) return;
  if(start) {
    peephole(start);
    }
  }

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

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

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

outstr(ptr) char ptr[]; {
  /* must work with symbol table names terminated by length */
  while(*ptr >= ' ') outbyte(*ptr++);
  }

outbyte(c) char c; {
  if(stagenext) {
    if(stagenext==stagelast) {
      error("staging buffer overflow");
      return 0;
      }
    else *stagenext++ = c;
    }
  else cout(c,output);
  return c;
  }

cout(c, fd) char c; int fd; {
  if(fputc(c, fd)==EOF) xout();
  }

sout(string, fd) char *string; int fd; {
  if(fputs(string, fd)==EOF) xout();
  }

lout(line, fd) char *line; int fd; {
  sout(line, fd);
  cout('\n', fd);
  }

xout() {
  fputs("output error\n", stderr);
  abort();
  }

nl() {
  outbyte('\n');
  }

tab() {
  outbyte('\t');
  }

col() {
  outbyte(':');
  }

error(msg) char msg[]; {
  if(errflag) return; else errflag=1;
  lout(line, stderr);
  errout(msg, stderr);
  if(alarm) fputc(7, stderr);
  if(pause) while(fgetc(stderr)!='\n');
  if(listfp>0) errout(msg, listfp);
  }

errout(msg, fp) char msg[]; int fp; {
  int k; k=line+2;
  while(k++ <= lptr) cout(' ', fp);
  lout("/\\", fp);
  sout("**** ", fp); lout(msg, fp);
  }

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;
    /*
    ** must detect end of symbol table names terminated by
    ** symbol length in binary
    */
    if(str1[k] < ' ') break;
    if(str2[k] < ' ') 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(lptr,lit)) {
    bump(k);
    return 1;
    }
  return 0;
  }

amatch(lit,len)	 char *lit;int len; {
  int k;
  blanks();
  if (k=astreq(lptr,lit,len)) {
    bump(k);
    while(an(ch)) inbyte();
    return 1;
    }
  return 0;
 }

nextop(list) char *list; {
  char op[4];
  opindex=0;
  blanks();
  while(1) {
    opsize=0;
    while(*list > ' ') op[opsize++]= *list++;	/*** */
    op[opsize]=0;
    if(opsize=streq(lptr, op))
      if((*(lptr+opsize) != '=')&
	 (*(lptr+opsize) != *(lptr+opsize-1)))
	 return 1;
    if(*list) {
      ++list;
      ++opindex;
      }
    else return 0;
    }
  }

blanks() {
  while(1) {
    while(ch) {
      if(white()) gch();
      else return;
      }
    if(line==mline) return;
    preprocess();
    if(eof)break;
    }
  }
%%%%%%%%%% scc/scc/31.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	testfunc	int (*) ()	not int
 *	oper		int (*) ()	not int
 *	oper2		int (*) ()	not int
 *	heir		int (*) ()	not int
 *	needs external references to heir*()
 *	plung1	not plunge1	(M80 is stupid!!)
 *	plung2	not plunge2
 */

#include "smallc.h"

/*
** lval[0] - symbol table address, else 0 for constant
** lval[1] - type of indirect obj to fetch, else 0 for static
** lval[2] - type of pointer or array, else 0 for all other
** lval[3] - true if constant expression
** lval[4] - value of constant expression
** lval[5] - true if secondary register altered
** lval[6] - function address of highest/last binary operator
** lval[7] - stage address of "oper 0" code, else 0
*/

/*
** skim over terms adjoining || and && operators
*/
skim(opstr, testfunc, dropval, endval, heir, lval)
  char *opstr;
  int (*testfunc)(), dropval, endval, (*heir)(), lval[]; {	/*** */
  int k, hits, droplab, endlab;
  hits=0;
  while(1) {
    k=plung1(heir, lval);
    if(nextop(opstr)) {
      bump(opsize);
      if(hits==0) {
	hits=1;
	droplab=getlabel();
	}
      dropout(k, testfunc, droplab, lval);
      }
    else if(hits) {
      dropout(k, testfunc, droplab, lval);
      const(endval);
      jump(endlab=getlabel());
      postlabel(droplab);
      const(dropval);
      postlabel(endlab);
      lval[1]=lval[2]=lval[3]=lval[7]=0;
      return 0;
      }
    else return k;
    }
  }

/*
** test for early dropout from || or && evaluations
*/
dropout(k, testfunc, exit1, lval)
	int k, (*testfunc)(), exit1, lval[]; {	/*** */
  if(k) rvalue(lval);
  else if(lval[3]) const(lval[4]);
  (*testfunc)(exit1); /* jumps on false */	/*** */
  }

/*
** plunge to a lower level
*/
plunge(opstr, opoff, heir, lval)
  char *opstr;
  int opoff, (*heir)(), lval[]; {	/*** */
  int k, lval2[8];
  k=plung1(heir, lval);
  if(nextop(opstr)==0) return k;
  if(k) rvalue(lval);
  while(1) {
    if(nextop(opstr)) {
      bump(opsize);
      opindex=opindex+opoff;
      plung2(op[opindex], op2[opindex], heir, lval, lval2);
      }
    else return 0;
    }
  }

/*
** unary plunge to lower level
*/
plung1(heir, lval)
	int (*heir)(), lval[]; {	/*** */
  char *before, *start;
  int k;
  setstage(&before, &start);
  k=(*heir)(lval);
  if(lval[3]) clearstage(before,0); /* load constant later */
  return k;
  }

/*
** binary plunge to lower level
*/
plung2(oper, oper2, heir, lval, lval2)
  int (*oper)(), (*oper2)(), (*heir)(), lval[], lval2[]; {	/*** */
  char *before, *start;
  setstage(&before, &start);
  lval[5]=1;	      /* flag secondary register used */
  lval[7]=0;	      /* flag as not "... oper 0" syntax */
  if(lval[3]) {	      /* constant on left side not yet loaded */
    if(plung1(heir, lval2)) rvalue(lval2);
    if(lval[4]==0) lval[7]=stagenext;
    const2(lval[4]<<dbltest(lval2, lval));
    }
  else {	      /* non-constant on left side */
    push();
    if(plung1(heir, lval2)) rvalue(lval2);
    if(lval2[3]) {    /* constant on right side */
      if(lval2[4]==0) lval[7]=start;
      if(oper==add) { /* may test other commutative operators */
	csp=csp+2;
	clearstage(before, 0);
	const2(lval2[4]<<dbltest(lval, lval2));	  /* load secondary */
	}
      else {
	const(lval2[4]<<dbltest(lval, lval2));	  /* load primary */
	smartpop(lval2, start);
	}
      }
    else {	      /* non-constants on both sides */
      smartpop(lval2, start);
      if((oper==add)|(oper==sub)) {
	if(dbltest(lval,lval2)) doublereg();
	if(dbltest(lval2,lval)) {
	  swap();
	  doublereg();
	  if(oper==sub) swap();
	  }
	}
      }
    }
  if(oper) {
    if(lval[3]=lval[3]&lval2[3]) {
      lval[4]=calc(lval[4], oper, lval2[4]);
      clearstage(before, 0);
      lval[5]=0;
      }
    else {
      if((lval[2]==0)&(lval2[2]==0)) {
	(*oper)();	/*** */
	lval[6]=oper;	/* identify the operator */
	}
      else {
	(*oper2)();	/*** */
	lval[6]=oper2;	/* identify the operator */
	}
      }
    if(oper==sub) {
      if((lval[2]==CINT)&(lval2[2]==CINT)) {
	swap();
	const(1);
	asr();	/** div by 2 **/
	}
      }
    if((oper==sub)|(oper==add)) result(lval, lval2);
    }
  }

calc(left, oper, right)
	int left, (*oper)(), right; {	/*** */
       if(oper ==  or) return (left  |	right);
  else if(oper == xor) return (left  ^	right);
  else if(oper == and) return (left  &	right);
  else if(oper ==  eq) return (left  == right);
  else if(oper ==  ne) return (left  != right);
  else if(oper ==  le) return (left  <= right);
  else if(oper ==  ge) return (left  >= right);
  else if(oper ==  lt) return (left  <	right);
  else if(oper ==  gt) return (left  >	right);
  else if(oper == asr) return (left  >> right);
  else if(oper == asl) return (left  << right);
  else if(oper == add) return (left  +	right);
  else if(oper == sub) return (left  -	right);
  else if(oper ==mult) return (left  *	right);
  else if(oper == div) return (left  /	right);
  else if(oper == mod) return (left  %	right);
  else return 0;
  }

expression(const, val) int *const, *val;  {
  int lval[8];
  if(heir1(lval)) rvalue(lval);
  if(lval[3]) {
    *const=1;
    *val=lval[4];
    }
  else *const=0;
  }

heir1(lval)  int lval[];  {
  int k,lval2[8], (*oper)();	/*** */
  k=plung1(heir3, lval);
  if(lval[3]) const(lval[4]);
       if(match("|="))	oper=or;
  else if(match("^="))	oper=xor;
  else if(match("&="))	oper=and;
  else if(match("+="))	oper=add;
  else if(match("-="))	oper=sub;
  else if(match("*="))	oper=mult;
  else if(match("/="))	oper=div;
  else if(match("%="))	oper=mod;
  else if(match(">>=")) oper=asr;
  else if(match("<<=")) oper=asl;
  else if(match("="))	oper=0;
  else return k;
  if(k==0) {
    needlval();
    return 0;
    }
  if(lval[1]) {
    if(oper) {
      push();
      rvalue(lval);
      }
    plung2(oper, oper, heir1, lval, lval2);
    if(oper) pop();
    }
  else {
    if(oper) {
      rvalue(lval);
      plung2(oper, oper, heir1, lval, lval2);
      }
    else {
      if(heir1(lval2)) rvalue(lval2);
      lval[5]=lval2[5];
      }
    }
  store(lval);
  return 0;
  }

heir3(lval)  int lval[]; {
  return skim("||", eq0, 1, 0, heir4, lval);
  }

heir4(lval)  int lval[]; {
  return skim("&&", ne0, 0, 1, heir5, lval);
  }

heir5(lval)  int lval[]; {
  return plunge("|", 0, heir6, lval);
  }

heir6(lval)  int lval[]; {
  return plunge("^", 1, heir7, lval);
  }

heir7(lval)  int lval[]; {
  return plunge("&", 2, heir8, lval);
  }

heir8(lval)  int lval[];  {
  return plunge("== !=", 3, heir9, lval);
  }

heir9(lval)  int lval[];  {
  return plunge("<= >= < >", 5, heir10, lval);
  }

heir10(lval)  int lval[];  {
  return plunge(">> <<", 9, heir11, lval);
  }

heir11(lval)  int lval[];  {
  return plunge("+ -", 11, heir12, lval);
  }

heir12(lval)  int lval[];  {
  return plunge("* / %", 13, heir13, lval);
  }
%%%%%%%%%% scc/scc/32.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	plung2	not plunge2
 *	adapt callfunction(_narg) to MACRO-80 CP/M RTL
 */

#include "smallc.h"

heir13(lval)  int lval[];  {
  int k;
  char *ptr;
  if(match("++")) {		      /* ++lval */
    if(heir13(lval)==0) {
      needlval();
      return 0;
      }
    step(inc, lval);
    return 0;
    }
  else if(match("--")) {	      /* --lval */
    if(heir13(lval)==0) {
      needlval();
      return 0;
      }
    step(dec, lval);
    return 0;
    }
  else if (match("~")) {	      /* ~ */
    if(heir13(lval)) rvalue(lval);
    com();
    lval[4] = ~lval[4];
    return 0;
    }
  else if (match("!")) {	      /* ! */
    if(heir13(lval)) rvalue(lval);
    lneg();
    lval[4] = !lval[4];
    return 0;
    }
  else if (match("-")) {	      /* unary - */
    if(heir13(lval)) rvalue(lval);
    neg();
    lval[4] = -lval[4];
    return 0;
    }
  else if(match("*")) {		      /* unary * */
    if(heir13(lval)) rvalue(lval);
    if(ptr=lval[0])lval[1]=ptr[TYPE];
    else lval[1]=CINT;
    lval[2]=0;	/* flag as not pointer or array */
    lval[3]=0;	/* flag as not constant */
    return 1;
    }
  else if(match("&")) {		      /* unary & */
    if(heir13(lval)==0) {
      error("illegal address");
      return 0;
      }
    ptr=lval[0];
    lval[2]=ptr[TYPE];
    if(lval[1]) return 0;
    /* global & non-array */
    address(ptr);
    lval[1]=ptr[TYPE];
    return 0;
    }
  else {
    k=heir14(lval);
    if(match("++")) {		      /* lval++ */
      if(k==0) {
	needlval();
	return 0;
	}
      step(inc, lval);
      dec(lval[2]>>2);
      return 0;
      }
    else if(match("--")) {	      /* lval-- */
      if(k==0) {
	needlval();
	return 0;
	}
      step(dec, lval);
      inc(lval[2]>>2);
      return 0;
      }
    else return k;
    }
  }

heir14(lval)  int *lval; {
  int k, const, val, lval2[8];
  char *ptr, *before, *start;
  k=primary(lval);
  ptr=lval[0];
  blanks();
  if((ch=='[')|(ch=='(')) {
    lval[5]=1;	  /* secondary register will be used */
    while(1) {
      if(match("[")) {		      /* [subscript] */
	if(ptr==0) {
	  error("can't subscript");
	  junk();
	  needtoken("]");
	  return 0;
	  }
	else if(ptr[IDENT]==POINTER)rvalue(lval);
	else if(ptr[IDENT]!=ARRAY) {
	  error("can't subscript");
	  k=0;
	  }
	setstage(&before, &start);
	lval2[3]=0;
	plung2(0, 0, heir1, lval2, lval2); /* lval2 deadend */
	needtoken("]");
	if(lval2[3]) {
	  clearstage(before, 0);
	  if(lval2[4]) {
	    if(ptr[TYPE]==CINT) const2(lval2[4]<<LBPW);
	    else		const2(lval2[4]);
	    add();
	    }
	  }
	else {
	  if(ptr[TYPE]==CINT) doublereg();
	  add();
	  }
	lval[0]=lval[2]=0;
	lval[1]=ptr[TYPE];
	k=1;
	}
      else if(match("(")) {	      /* function(...) */
	if (ptr==0) callfunction(0);
	else if (ptr[IDENT]!=FUNCTION) {
	  rvalue(lval);
	  callfunction(0);
	  }
	else callfunction(ptr);
	k=lval[0]=lval[3]=0;
	}
      else return k;
      }
    }
  if(ptr==0) return k;
  if(ptr[IDENT]==FUNCTION) {
    address(ptr);
    return 0;
    }
  return k;
  }

primary(lval)  int *lval; {
  char *ptr;
  int k;
  if(match("(")) {		      /* (expression) */
    k=heir1(lval);
    needtoken(")");
    return k;
    }
  putint(0, lval, 8<<LBPW); /* clear lval array */
  if(symname(ssname, YES)) {
    if(ptr=findloc(ssname)) {
#ifdef STGOTO
      if(ptr[IDENT]==LABEL) {
	experr();
	return 0;
	}
#endif
      getloc(ptr);
      lval[0]=ptr;
      lval[1]=ptr[TYPE];
      if(ptr[IDENT]==POINTER) {
	lval[1]=CINT;
	lval[2]=ptr[TYPE];
	}
      if(ptr[IDENT]==ARRAY) {
	lval[2]=ptr[TYPE];
	return 0;
	}
      else return 1;
      }
    if(ptr=findglb(ssname))
      if(ptr[IDENT]!=FUNCTION) {
	lval[0]=ptr;
	lval[1]=0;
	if(ptr[IDENT]!=ARRAY) {
	  if(ptr[IDENT]==POINTER) lval[2]=ptr[TYPE];
	  return 1;
	  }
	address(ptr);
	lval[1]=lval[2]=ptr[TYPE];
	return 0;
	}
    ptr=addsym(ssname, FUNCTION, CINT, 0, &glbptr, STATIC);
    lval[0]=ptr;
    lval[1]=0;
    return 0;
    }
  if(constant(lval)==0) experr();
  return 0;
  }

experr() {
  error("invalid expression");
  const(0);
  junk();
  }

callfunction(ptr)  char *ptr; { /* symbol table entry or 0 */
  int nargs, const, val;
  nargs=0;
  blanks();		  /* already saw open paren */
  if(ptr==0) push();	  /* calling HL */
  while(streq(lptr,")")==0) {
    if(endst()) break;
    expression(&const, &val);
    if(ptr==0) swapstk(); /* don't push addr */
    push();		  /* push argument */
    nargs=nargs+BPW;	  /* count args*BPW */
    if (match(",")==0) break;
    }
  needtoken(")");
	if (! streq(ptr+NAME, "_narg"))
		loadargc(nargs >> LBPW);
	if (ptr)
		call(ptr+NAME);
  else callstk();
  csp=modstk(csp+nargs, YES);
  }
%%%%%%%%%% scc/scc/33.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	oper	int (*) ()	not int
 *	correct escape sequences in strings
 */

#include "smallc.h"

/*
** true if val1 -> int pointer or int array and val2 not ptr or array
*/
dbltest(val1,val2) int val1[], val2[]; {
  if(val1[2]!=CINT) return 0;
  if(val2[2]) return 0;
  return 1;
  }

/*
** determine type of binary operation
*/
result(lval, lval2) int lval[], lval2[]; {
  if((lval[2]!=0)&(lval2[2]!=0)) {
    lval[2]=0;
    }
  else if(lval2[2]) {
    lval[0]=lval2[0];
    lval[1]=lval2[1];
    lval[2]=lval2[2];
    }
  }

step(oper, lval)
	int (*oper)(), lval[]; {	/*** */
  if(lval[1]) {
    if(lval[5]) {
      push();
      rvalue(lval);
      (*oper)(lval[2]>>2);	/*** */
      pop();
      store(lval);
      return;
      }
    else {
      move();
      lval[5]=1;
      }
    }
  rvalue(lval);
  (*oper)(lval[2]>>2);		/*** */
  store(lval);
  }

store(lval)  int lval[]; {
  if(lval[1]) putstk(lval);
  else	      putmem(lval);
  }

rvalue(lval) int lval[]; {
  if ((lval[0]!=0)&(lval[1]==0)) getmem(lval);
  else			       indirect(lval);
  }

test(label, parens)  int label, parens;	 {
  int lval[8];
  char *before, *start;
  if(parens) needtoken("(");
  while(1) {
    setstage(&before, &start);
    if(heir1(lval)) rvalue(lval);
    if(match(",")) clearstage(before, start);
    else break;
    }
  if(parens) needtoken(")");
  if(lval[3]) {	 /* constant expression */
    clearstage(before, 0);
    if(lval[4]) return;
    jump(label);
    return;
    }
  if(lval[7]) {	 /* stage address of "oper 0" code */
    oper=lval[6];/* operator function address */
	 if((oper==eq)|
	    (oper==ule)) zerojump(eq0, label, lval);
    else if((oper==ne)|
	    (oper==ugt)) zerojump(ne0, label, lval);
    else if (oper==gt)	 zerojump(gt0, label, lval);
    else if (oper==ge)	 zerojump(ge0, label, lval);
    else if (oper==uge)	 clearstage(lval[7],0);
    else if (oper==lt)	 zerojump(lt0, label, lval);
    else if (oper==ult)	 zerojump(ult0, label, lval);
    else if (oper==le)	 zerojump(le0, label, lval);
    else		 testjump(label);
    }
  else testjump(label);
  clearstage(before, start);
  }

constexpr(val) int *val; {
  int const;
  char *before, *start;
  setstage(&before, &start);
  expression(&const, val);
  clearstage(before, 0);  /* scratch generated code */
  if(const==0) error("must be constant expression");
  return const;
  }

const(val) int val; {
  immed();
  outdec(val);
  nl();
  }

const2(val) int val; {
  immed2();
  outdec(val);
  nl();
  }

constant(lval)	int lval[]; {
  lval=lval+3;
  *lval=1;	 /* assume it will be a constant */
  if (number(++lval)) immed();
  else if (pstr(lval)) immed();
  else if (qstr(lval)) {
    *(lval-1)=0; /* nope, it's a string address */
    immed();
    printlabel(litlab);
    outbyte('+');
    }
  else return 0;
  outdec(*lval);
  nl();
  return 1;
  }

number(val)  int val[]; {
  int k, minus;
  k=minus=0;
  while(1) {
    if(match("+")) ;
    else if(match("-")) minus=1;
    else break;
    }
  if(numeric(ch)==0)return 0;
  while (numeric(ch)) k=k*10+(inbyte()-'0');
  if (minus) k=(-k);
  val[0]=k;
  return 1;
  }

address(ptr) char *ptr; {
  immed();
  outstr(ptr+NAME);
  nl();
  }

pstr(val)  int val[]; {
  int k;
  k=0;
  if (match("'")==0) return 0;
  while(ch!=39)	   k=(k&255)*256 + (litchar()&255);
  ++lptr;
  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;
    stowlit(litchar(), 1);
    }
  gch();
  litq[litptr++]=0;
  return 1;
  }

stowlit(value, size) int value, size; {
  if((litptr+size) >= LITMAX) {
    error("literal queue overflow"); abort();
    }
  putint(value, litq+litptr, size);
  litptr=litptr+size;
  }

/*
** return current literal char & bump lptr
*/

litchar()
{	int i, oct;

	if (ch != '\\' || nch == 0)
		return gch();
	gch();
	switch(ch) {
	case 'b':
		gch();
		return 8;	/* BS */
	case 'f':
		gch();
		return 12;	/* FF */
	case 'n':
		gch();
		return 10;	/* LF */
	case 'r':
		gch();
		return 13;	/* CR */
	case 't':
		gch();
		return 9;	/* HT */
	}
	i = 3;
	oct = 0;
	while (i-- > 0 && ch >= '0' && ch <= '7')
		oct = (oct << 3) + gch() - '0';
	if (i == 2)
		return gch();	/* \x is just x */
	return oct;
}
%%%%%%%%%% scc/scc/41.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	= *	not =*
 *	oper	int (*) ()	not int
 *	overhauled for MACRO-80 and CP/M
 */

#include "smallc.h"

header()	/* incantations at begin of module */
{
	ol("EXTRN ?smallC ; smallC for MACRO-80 CP/M");
	ol("EXTRN ?30217 ; ats 02/17/83");

	/*
	 *	linkage boot strap:
	 *
	 *	?smallC is EXTRN in all modules compiled by this compiler
	 *		is ENTRY in the outermost runtime routine
	 *		which is entered from CP/M
	 *
	 *	?ymmdd	is EXTRN in all modules compiled by this compiler
	 *		is ENTRY in ?smallC module and controls version dates
	 *
	 *	_shell	is EXTRN in ?smallC module
	 *		is the outermost runtime routine written in smallC
	 *
	 *	main	is extern in _shell()
	 *		and must be supplied by the user,
	 *		to be called UN*X-style
	 *
	 *	_end	is EXTRN in ?smallC module
	 *		marks the first byte available to a heap
	 *		by being linked absolutely last
	 */
}

csect()		/* incantations at begin of code */
{
	ol("CSEG");
}

dsect()		/* incantations at begin of data */
{
	ol("DSEG");
}

trailer()	/* incantations at end of module */
{
	ol("END");
}

loadargc(val)	/* the great #arguments trick */
	int val;
{
#ifdef HASH
	if (search("NOCCARGC", macn, NAMESIZE+2, MACNEND, MACNBR, 0) == 0)
#else
	if (findmac("NOCCARGC") == 0)
#endif
	{	ot("MVI A,");
		outdec(val);
		nl();
	}
}

entry()		/* define entry point */
{
	outstr(ssname);
	outstr("::");
	nl();
}

external(name)	/* declare external reference */
	char *name;
{
	ot("EXTRN");
	ol(name);
}

indirect(lval)	/* PR = *(PR) */
	int lval[];
{
	if(lval[1] == CCHAR)
		call("?GCHAR##");
	else
		call("?GINT##");
}

getmem(lval)	/* PR = memory */
	int lval[];
{	char *sym;

	sym = lval[0];
	if (sym[IDENT] != POINTER && sym[TYPE] == CCHAR)
	{	ot("LDA ");
		outstr(sym+NAME);
		nl();
		call("?SXT##");
	}
	else
	{	ot("LHLD ");
		outstr(sym+NAME);
		nl();
	}
}

getloc(sym)	/* PR = &symbol */
	char *sym;
{
	const(getint(sym+OFFSET, OFFSIZE) - csp);
	ol("DAD SP");
}

putmem(lval)	/* memory = PR */
	int lval[];
{	char *sym;

	sym = lval[0];
	if (sym[IDENT] != POINTER && sym[TYPE] == CCHAR)
	{	ol("MOV A,L");
		ot("STA ");
	}
	else
		ot("SHLD ");
	outstr(sym+NAME);
	nl();
}

putstk(lval)	/* push = PR */
	int lval[];
{
	if (lval[1] == CCHAR)
	{	ol("MOV A,L");
		ol("STAX D");
	}
	else
		call("?PINT##");
}

move()		/* SE = PR */
{
	ol("MOV D,H");
	ol("MOV E,L");
}

swap()		/* SE = PR and PR = SE */
{
	ol("XCHG;;");	 /* peephole() uses trailing ";;" */
}

immed()		/* PR = value (partial!) */
{
	ot("LXI H,");
}

immed2()	/* SE = value (partial!) */
{
	ot("LXI D,");
}

push()		/* push = PR */
{
	ol("PUSH H");
	csp -= BPW;
}

smartpop(lval, start)	/* unpush or pop as required */
	int lval[];
	char *start;
{
	if (lval[5])
		pop();		/* secondary was used */
	else
		unpush(start);
}

unpush(dest)	/* replace push by swap */
	char *dest;
{	int i;
	char *sour;

	sour = "\tXCHG;;";	/* peephole() uses trailing ";;" */
	while (*sour)
		*dest++ = *sour++;
	sour = stagenext;
	while (--sour > dest)	/* adjust stack references */
		if (streq(sour,"\tDAD SP"))
		{	--sour;
			i = BPW;
			while (numeric(*--sour))
				if ((*sour -= i) < '0')
				{	*sour += 10;
					i = 1;
				}
				else
					i = 0;
		}
	csp += BPW;
}

pop()		/* SE = pop */
{
	ol("POP D");
	csp += BPW;
}

swapstk()	/* stack = PR and PR = stack */
{
	ol("XTHL");
}

sw()		/* switch statement */
{
	call("?SWITCH##");
}

call(sname)	/* subroutine call */
	char *sname;
{
	ot("CALL ");
	outstr(sname);
	nl();
}

ret()		/* subroutine return */
{
	ol("RET");
}

callstk()	/* call subroutine address on stack */
{
	immed();
	outstr("$+5");
	nl();
	swapstk();
	ol("PCHL");
	csp += BPW;
}

jump(label)	/* jump to internal label */
	int label;
{
	outjmp("JMP",label);
}

testjump(label) /* test PR, jump if false */
	int label;
{
	ol("MOV A,H");
	ol("ORA L");
	outjmp("JZ",label);
}

zerojump(oper, label, lval)	/* test PR 0, jump of false */
	int (*oper)(), label, lval[];
{
	clearstage(lval[7], 0);	 /* purge conventional code */
	(*oper)(label);
}

defstorage(size)	/* define storage */
	int size;
{
	if (size == 1)
		ot("DB ");
	else
		ot("DW ");
}

point()		/* point to following objects */
{
	ol("DW $+2");
}

modstk(newsp, save)	/* mod stack pointer to value */
	int newsp, save;
{	int k;

	if ((k = newsp-csp) == 0)
		return newsp;
	if (k >= 0)
	{	if (k < 7)
		{	if (k & 1)
			{	ol("INX SP");
				k--;
			}
			while (k)
			{	ol("POP B");
				k -= BPW;
			}
			return newsp;
		}
	}
	if (k < 0)
	{	if (k > -7)
		{	if (k & 1)
			{	ol("DCX SP");
				k++;
			}
			while (k)
			{	ol("PUSH B");
				k += BPW;
			}
			return newsp;
		}
	}
	if (save)
		swap();
	const(k);
	ol("DAD SP");
	ol("SPHL");
	if (save)
		swap();
	return newsp;
}

doublereg()	/* PR += PR */
{
	ol("DAD H");
}
%%%%%%%%%% scc/scc/42.c %%%%%%%%%%
/***
 *	fixes:
 *
 *	pp	int (*)()	not int
 *	overhauled for MACRO-80 CP/M
 *	optimizer corrected (was very wrong)
 */

#include "smallc.h"

add()		/* PR += SE */
{
	ol("DAD D");
}

sub()		/* PR = SE-PR */
{
	call("?SUB##");
}

mult()		/* PR *= SE */
{
	call("?MULT##");
}

div()		/* SE %= PR and PR = SE/PR */
{
	call("?DIV##");
}

mod()		/* SE /= PR and PR = SE%PR */
{
	div();
	swap();
}

or()		/* PR |= SE */
{
	call("?OR##");
}

xor()		/* PR ^= SE */
{
	call("?XOR##");
}

and()		/* PR &= SE */
{
	call("?AND##");
}

lneg()		/* PR = !PR */
{
	call("?LNEG##");
}

asr()		/* PR = SE >> PR */
{
	call("?ASR##");
}

asl()		/* PR = SE << PR */
{
	call("?ASL##");
}

neg()		/* PR = -PR */
{
	call("?NEG##");
}

com()		/* PR ~PR */
{
	call("?COM##");
}

inc(n)		/* PR += n */
	int n;
{
	while(1)
	{	ol("INX H");
		if (--n < 1)
			break;
	}
}

dec(n)		/* PR -= n */
	int n;
{
	while(1)
	{	ol("DCX H");
		if (--n < 1)
			break;
	}
}

eq()		/* == */
{
	call("?EQ##");
}

eq0(label)	/* == 0 */
	int label;
{
	ol("MOV A,H");
	ol("ORA L");
	outjmp("JNZ", label);
}

ne()		/* != */
{
	call("?NE##");
}

ne0(label)	/* != 0 */
	int label;
{
	ol("MOV A,H");
	ol("ORA L");
	outjmp("JZ", label);
}

lt()		/* (int) < */
{
	call("?LT##");
}

lt0(label)	/* (int) < 0 */
	int label;
{
	ol("XRA A");
	ol("ORA H");
	outjmp("JP", label);
}

le()		/* (int) <= */
{
	call("?LE##");
}

le0(label)	/* (int) <= 0 */
	int label;
{
	ol("MOV A,H");
	ol("ORA L");
	ol("JZ $+8");
	ol("XRA A");
	ol("ORA H");
	outjmp("JP", label);
}

gt()		/* (int) > */
{
	call("?GT##");
}

gt0(label)	/* (int) > 0 */
	int label;
{
	ol("XRA A");
	ol("ORA H");
	outjmp("JM", label);
	ol("ORA L");
	outjmp("JZ", label);
}

ge()		/* (int) >= */
{
	call("?GE##");
}

ge0(label)	/* (int) >= 0 */
	int label;
{
	ol("XRA A");
	ol("ORA H");
	outjmp("JM", label);
}

ult()		/* (unsigned) < */
{
	call("?ULT##");
}

ult0(label)	/* (unsigned) < 0 */
	int label;
{
	outjmp("JMP", label);
}

ule()		/* (unsigned) <= */
{
	call("?ULE##");
}

ugt()		/* (unsigned) > */
{
	call("?UGT##");
}

uge()		/* (unsigned) >= */
{
	call("?UGE##");
}

outjmp(j, l)	/* \t j sp l \n */
	char *j;
	int l;
{
	ot(j);
	outbyte(' ');
	printlabel(l);
	nl();
}

/*
 *	pattern compare:
 *
 *	'*' is a match-all,
 *	first such character matched is returned in 'drop'.
 *
 *	return value is non-matched pattern position
 *	or end of pattern.
 *
 *	non-matched string position is also dropped.
 */

p_eq(str,nstr,pat,drop)
	char *str;	/* to search */
	int *nstr;	/* really char **, return */
	char *pat;	/* pattern to search */
	char *drop;	/* return */
{
	for (*drop = '\0'; *pat; str++,pat++)
		if (*str == *pat)
			continue;
		else if (*pat == '*')
		{	if (*drop == '\0')
				*drop = *str;
			continue;
		}
		else
			break;
	*nstr = str;
	return pat;
}

char p_1[] =
 "XCHG;;\n\tLXI H,*\n\tDAD SP\n\tCALL ?GINT##\n\tXCHG;;\n";
/*	    1				       2	 3 */

char p_2[] =
 "DAD SP\n\tMOV D,H\n\tMOV E,L\n\t";
/*	    1			  2 */

char p_3[] =
 "CALL ?GINT##\n\t**X H\n\tCALL ?PINT##\n";
/*		1	   2		 3 */

char p_4[] =
 "CALL ?GCHAR##\n\t**X H\n\tMOV A,L\n\tSTAX D\n";
/*		 1	    2		       3 */

char p_5[] =
 "DAD D\n\tPOP D\n\t";
/*	   1	    2 */

#define p_1_1	(p_1+8)
#define p_1_2	(p_1+38)
#define p_1_3	(p_1+46)

#define p_2_1	(p_2+8)
#define p_2_2	(p_2+26)

#define _p_3_1	13
#define p_3_1	(p_3+_p_3_1)
#define p_3_2	(p_3+21)
#define p_3_3	(p_3+34)

#define _p_4_1	14
#define p_4_1	(p_4+_p_4_1)
#define p_4_2	(p_4+22)
#define p_4_3	(p_4+38)

#define p_5_1	(p_5+7)
#define p_5_2	(p_5+14)

peephole(ptr)		/* emit stage buffer, replacing some text */
	char *ptr;
{	char ch, *pp, *nptr, *nnptr;

	while (ch = *ptr++)
	{	if (! optimize	/* can turn it totally off */
		|| ch != '\t')	/* \t before ANY mnemonic */
		{	cout(ch, output);
			continue;
		}
		pp = p_eq(ptr, &nptr, p_1, &ch);
		if (ch == '0' || ch == '2')
		{	if (pp == p_1_3)
			{	if (ch == '0')
					pp2();
				else
					pp3(pp2);
				ptr = nptr;
				continue;
			}
			if (pp >= p_1_2)
			{	ol("XCHG");
				if (ch == '0')
					pp1();
				else
					pp3(pp1);
				ptr += p_1_2-p_1;
				continue;
			}
		}
		pp = p_eq(ptr, &nptr, p_1_1, &ch);
		if (ch == '0' || ch == '2')
		{	if (pp == p_1_3)
			{	ol("XCHG");
				if (ch == '0')
					pp2();
				else
					pp3(pp2);
				ptr = nptr;
				continue;
			}
			if (pp >= p_1_2)
			{	if (ch == '0')
					pp1();
				else
					pp3(pp1);
				ptr += p_1_2-p_1_1;
				continue;
			}
		}
		if ((pp = p_eq(ptr, &nptr, p_2, &ch)) == p_2_2)
		{	pp = p_eq(nptr, &nnptr, p_3, &ch);
			if (ch == 'I' || ch == 'D')
				if (pp == p_3_3)
				{	if (ch == 'D')
						call("?DECI##");
					else
						call("?INCI##");
					ptr = nnptr;
					continue;
				}
			pp = p_eq(nptr, &nnptr, p_4, &ch);
			if (ch == 'I' || ch == 'D')
				if (pp == p_4_3)
				{	if (ch == 'D')
						call("?DECC##");
					else
						call("?INCC##");
					ptr = nnptr;
					continue;
				}
		}
		else if (pp == p_2_1)
		{	if (p_eq(nptr, &nnptr, p_3, &ch) >= p_3_1)
			{	call("?DSGI##");
				ptr = nptr + _p_3_1;
				continue;
			}
			if (p_eq(nptr, &nnptr, p_4, &ch) >= p_4_1)
			{	call("?DSGC##");
				ptr = nptr + _p_4_1;
				continue;
			}
		}
		if ((pp = p_eq(ptr, &nptr, p_5, &ch)) == p_5_2)
		{	if (p_eq(nptr, &nnptr, p_3_2, &ch) == p_3_3)
			{	call("?DDPPI##");
				ptr = nnptr;
				continue;
			}
			if (p_eq(nptr, &nnptr, p_4_2, &ch) == p_4_3)
			{	call("?DDPPC##");
				ptr = nnptr;
				continue;
			}
		}
		else if (pp == p_5_1)
		{	if (p_eq(nptr, &nnptr, p_3, &ch) >= p_3_1)
			{	call("?DDGI##");
				ptr = nptr + _p_3_1;
				continue;
			}
			if (p_eq(nptr, &nnptr, p_4, &ch) >= p_4_1)
			{	call("?DDGC##");
				ptr = nptr + _p_4_1;
				continue;
			}
		}
		if ((pp == p_eq(ptr, &nptr, p_5_1, &ch)) == p_5_2)
		{	if (p_eq(nptr, &nnptr, p_3_2, &ch) == p_3_3)
			{	call("?PDPI##");
				ptr = nnptr;
				continue;
			}
			if (p_eq(nptr, &nnptr, p_4_2, &ch) == p_4_3)
			{	call("?PDPC##");
				ptr = nnptr;
				continue;
			}
		}
		cout('\t', output);
	}
}

pp1()		/* PR = top() */
{
	ol("POP H");
	ol("PUSH H");
}

pp2()		/* SE = top() */
{
	ol("POP D");
	ol("PUSH D");
}

pp3(pp)		/* PR or SE = belowtop() */
	int (*pp)();
{
	ol("POP B");
	(*pp)();
	ol("PUSH B");
}
%%%%%%%%%% end of part 3 %%%%%%%%%%