Category : C Source Code
Archive   : SMALLC.ZIP
Filename : CPCN.C

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


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


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


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


/* Define system dependent parameters */


/* Stand-alone definitions */


#define NULL 0
#define eol 13


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


/* #include */
/* #define eol 10 */


/* Define the symbol table parameters */


#define symsiz 14
#define symtbsz 5040
#define numglbs 300
#define startglb symtab
#define endglb startglb+numglbs*symsiz
#define startloc endglb+symsiz
#define endloc symtab+symtbsz-symsiz


/* Define symbol table entry format */


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


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


#define namesize 9
#define namemax 8


/* Define data for external symbols */

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

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

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


/* Define possible entries for "ident" */


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


/* Define possible entries for "type" */


#define cchar 1
#define cint 2


/* Define possible entries for "storage" */


#define statik 1
#define stkloc 2


/* Define the "while" statement queue */


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


/* Define entry offsets in while queue */


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


/* Define the literal pool */


#define litabsz 3000
#define litmax litabsz-1


/* Define the input line */


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


/* Define the macro (define) pool */


#define macqsize 1000
#define macmax macqsize-1


/* Define statement types (tokens) */


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


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


#define asmpref 7
#define asmsuff 7


/* Now reserve some storage words */


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


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


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


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


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


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


/* Misc storage */


int nxtlab, /* next avail label # */
litlab, /* label # assigned to literal pool */
cextern, /* collecting external names flag */
Zsp, /* compiler relative stk ptr */
argstk, /* function arg sp */
ncmp, /* # open compound statements */
errcnt, /* # errors in compilation */
errstop, /* stop on error gtf 7/17/80 */
eof, /* set non-zero on final input eof */
input, /* iob # for input file */
output, /* iob # for output file (if any) */
input2, /* iob # for "include" file */
ctext, /* non-zero to intermix c-source */
cmode, /* non-zero while parsing c-code */
/* zero when passing assembly code */
lastst, /* last executed statement type */
saveout, /* holds output ptr when diverted to console */
/* gtf 7/16/80 */
fnstart, /* line# of start of current fn. gtf 7/2/80 */
lineno, /* line# in current file gtf 7/2/80 */
infunc, /* "inside function" flag gtf 7/2/80 */
savestart, /* copy of fnstart " " gtf 7/16/80 */
saveline, /* copy of lineno " " gtf 7/16/80 */
saveinfn; /* copy of infunc " " gtf 7/16/80 */


char *currfn, /* ptr to symtab entry for current fn. gtf 7/17/80 */
*savecurr; /* copy of currfn for #include gtf 7/17/80 */
char quote[2]; /* literal string for '"' */
char *cptr; /* work ptr to any char buffer */
int *iptr; /* work ptr to any int buffer */
/* >>>>> start cc1 <<<<<< */


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


/* */
/* Process all input text */
/* */
/* At this level, only static declarations, */
/* defines, includes, and function */
/* definitions are legal... */
parse()
{
while (eof==0) /* do until no more input */
{
if(amatch("extern",6)) {
cextern=1;
if(amatch("char",4)) {declglb(cchar);ns();}
else if(amatch("int",3)) {declglb(cint);ns();}
else {declglb(cint);ns();}
cextern=0;
}
else if(amatch("char",4)){declglb(cchar);ns();}
else if(amatch("int",3)){declglb(cint);ns();}
else if(match("#asm"))doasm();
else if(match("#include"))doinclude();
else if(match("#define"))addmac();
else newfunc();
blanks(); /* force eof if pending */
}
}
/* ### cpcn-3 */
dumpublics()
{
outstr("DUMMY SEGMENT BYTE STACK 'dummy'");nl();
outstr("DUMMY ENDS");nl();
outstr("STACK SEGMENT BYTE PUBLIC 'stack'");nl();
dumplits();
dumpglbs();
outstr("STACK ENDS");nl();
}

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


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


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


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

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


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


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


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


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


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


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


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


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


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


/* we had better see open paren for args... */
if(match("(")==0)error("missing open paren");
ot("PUBLIC ");outname(n);nl();
outname(n);col();nl(); /* print function name */
argstk=0; /* init arg count */
while(match(")")==0) /* then count args */
/* any legal name bumps arg count */
{if(symname(n))argstk=argstk+2;
else{error("illegal argument name");junk();}
blanks();
/* if not closing paren, should be comma */
if(streq(line+lptr,")")==0)
{if(match(",")==0)
error("expected comma");
}
if(endst())break;
}
locptr=startloc; /* "clear" local symbol table*/
Zsp=0; /* preset stack ptr */
while(argstk)
/* now let user declare what types of things */
/* those arguments were */
{if(amatch("char",4)){getarg(cchar);ns();}
else if(amatch("int",3)){getarg(cint);ns();}
else{error("wrong number args");break;}
}
if(statement()!=streturn) /* do a statement, but if */
/* it's a return, skip */
/* cleaning up the stack */
{modstk(0);
zret();
}
Zsp=0; /* reset stack ptr again */
locptr=startloc; /* deallocate all locals */
infunc=0; /* not in fn. any more gtf 7/2/80 */
}
/* ### cpcn-10 */
/* */
/* Declare argument types */
/* */
/* called from "newfunc" this routine adds an entry in the */
/* local symbol table for each named argument */
getarg(t) /* t = cchar or cint */
int t;
{
char n[namesize],c;int j;
while(1)
{if(argstk==0)return; /* no more args */
if(match("*"))j=pointer;
else j=variable;
if(symname(n)==0) illname();
if(findloc(n))multidef(n);
if(match("[")) /* pointer ? */
/* it is a pointer, so skip all */
/* stuff between "[]" */
{while(inbyte()!=']')
if(endst())break;
j=pointer;
/* add entry as pointer */
}
addloc(n,j,t,argstk);
argstk=argstk-2; /* cnt down */
if(endst())return;
if(match(",")==0)error("expected comma");
}
}
/* ### cpcn-11 */
/* Statement parser */
/* */
/* called whenever syntax requires */
/* a statement. */
/* this routine performs that statement */
/* and returns a number telling which one */
statement()
{
/* comment out ctrl-C check since ctrl-break will work on PC */
/* if(cpm(11,0) & 1) */ /* check for ctrl-C gtf 7/17/80 */
/* if(getchar()==3) */
/* abort(); */


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


/* */
/* Perform a function call */
/* */
/* called from heir11, this routine will either call */
/* the named function, or if the supplied ptr is */
/* zero, will call the contents of BX */
callfunction(ptr)
char *ptr; /* symbol table entry (or 0) */
{ int nargs;
nargs=0;
blanks(); /* already saw open paren */
if(ptr==0)zpush(); /* calling BX */
while(streq(line+lptr,")")==0)
{if(endst())break;
expression(); /* get an argument */
if(ptr==0)swapstk(); /* don't push addr */
zpush(); /* push argument */
nargs=nargs+2; /* count args*2 */
if (match(",")==0) break;
}
needbrack(")");
if(ptr)zcall(ptr);
else callstk();
Zsp=modstk(Zsp+nargs); /* clean up arguments */
}
junk()
{ if(an(inbyte()))
while(an(ch()))gch();
else while(an(ch())==0)
{if(ch()==0)break;
gch();
}
blanks();
}
endst()
{ blanks();
return ((streq(line+lptr,";")|(ch()==0)));
}
illname()
{ error("illegal symbol name");junk();}
multidef(sname)
char *sname;
{ error("already defined");
comment();
outstr(sname);nl();
}
needbrack(str)
char *str;
{ if (match(str)==0)
{error("missing bracket");
comment();outstr(str);nl();
}
}
needlval()
{ error("must be lvalue");
}
/* ### cpcn-15 */
findglb(sname)
char *sname;
{ char *ptr;
ptr=startglb;
while(ptr!=glbptr)
{if(astreq(sname,ptr,namemax))return ptr;
ptr=ptr+symsiz;
}
return 0;
}
findloc(sname)
char *sname;
{ char *ptr;
ptr=startloc;
while(ptr!=locptr)
{if(astreq(sname,ptr,namemax))return ptr;
ptr=ptr+symsiz;
}
return 0;
}
addglb(sname,id,typ,value)
char *sname,id,typ;
int value;
{ char *ptr;
if(cptr=findglb(sname))return cptr;
if(glbptr>=endglb)
{error("global symbol table overflow");
return 0;
}
cptr=ptr=glbptr;
while(an(*ptr++ = *sname++)); /* copy name */
cptr[ident]=id;
cptr[type]=typ;
cptr[storage]=statik;
cptr[offset]=value;
cptr[offset+1]=value>>8;
glbptr=glbptr+symsiz;
return cptr;
}
addloc(sname,id,typ,value)
char *sname,id,typ;
int value;
{ char *ptr;
if(cptr=findloc(sname))return cptr;
if(locptr>=endloc)
{error("local symbol table overflow");
return 0;
}
cptr=ptr=locptr;
while(an(*ptr++ = *sname++)); /* copy name */
cptr[ident]=id;
cptr[type]=typ;
cptr[storage]=stkloc;
cptr[offset]=value;
cptr[offset+1]=value>>8;
locptr=locptr+symsiz;
return cptr;
}
/* ### cpcn-16 */
addext(sname,id)
char *sname,id;
{
char *ptr;
if(cptr=findext(sname)) return cptr;
if(extptr>=endextrn)
{error("external symbol table overflow"); return 0;}
cptr=ptr=extptr;
while(an(*ptr++=*sname++)); /* copy name */
/* type stored in byte following zero terminating name */
*ptr++=id;
extptr=ptr;
return cptr;
}
findext(sname)
char *sname;
{char *ptr;
ptr=startextrn;
while(ptr {if(astreq(sname,ptr,namemax)) return ptr;
ptr=ptr+strlen(ptr)+2;
}
return 0;
}


/* Test if next input string is legal symbol name */
symname(sname)
char *sname;
{ int k;char c;
blanks();
if(alpha(ch())==0)return 0;
k=0;
while(an(ch()))sname[k++]=gch();
sname[k]=0;
return 1;
}
/* ### cpcn-17 */
/* Return next avail internal label number */
getlabel()
{ return(++nxtlab);
}
/* Print specified number as label */
printlabel(label)
int label;
{ outasm("cc");
outdec(label);
}
/* Test if given character is alpha */
alpha(c)
char c;
{ c=c&127;
return(((c>='a')&(c<='z'))|
((c>='A')&(c<='Z'))|
(c=='_'));
}
/* Test if given character is numeric */
numeric(c)
char c;
{ c=c&127;
return((c>='0')&(c<='9'));
}
/* Test if given character is alphanumeric */
an(c)
char c;
{ return((alpha(c))|(numeric(c)));
}
/* Print a carriage return and a string only to console */
pl(str)
char *str;
{ int k;
k=0;
putchar(eol);
while(str[k])putchar(str[k++]);
}
addwhile(ptr)
int ptr[];
{
int k;
if (wqptr==wqmax)
{error("too many active whiles");return;}
k=0;
while (k {*wqptr++ = ptr[k++];}
}
delwhile()
{if(readwhile()) wqptr=wqptr-wqsiz;
}
readwhile()
{
if (wqptr==wq){error("no active whiles");return 0;}
else return (wqptr-wqsiz);
}
ch()
{ return(line[lptr]&127);
}
nch()
{ if(ch()==0)return 0;
else return(line[lptr+1]&127);
}
gch()
{ if(ch()==0)return 0;
else return(line[lptr++]&127);
}
kill()
{ lptr=0;
line[lptr]=0;
}
/* ### cpcn-18 */
inbyte()
{
while(ch()==0)
{if (eof) return 0;
inline();
preprocess();
}
return gch();
}
inchar()
{
if(ch()==0)inline();
if(eof)return 0;
return(gch());
}
inline()
{
int k,unit;
while(1)
{if (input==0) {eof=1;return;}
if((unit=input2)==0)unit=input;
kill();
while((k=getc(unit))>0)
{if((k==eol)|(lptr>=linemax))break;
line[lptr++]=k;
}
line[lptr]=0; /* append null */
lineno++; /* read one more line gtf 7/2/80 */
if(k<=0)
{fclose(unit);
if(input2)endinclude(); /* gtf 7/16/80 */
else input=0;
}
if(lptr)
{if((ctext)&(cmode))
{comment();
outstr(line);
nl();
}
lptr=0;
return;
}
}
}
/* ### cpcn-19 */
/* >>>>>> start of cc4 <<<<<<< */


preprocess()
{ int k;
char c,sname[namesize];
if(cmode==0)return;
mptr=lptr=0;
while(ch())
{if((ch()==' ')|(ch()==9))
predel();
else if(ch()=='"')
prequote();
else if(ch()==39)
preapos();
else if((ch()=='/')&(nch()=='*'))
precomm();
else if(alpha(ch())) /* from an(): 9/22/80 gtf */
{k=0;
while(an(ch()))
{if(k gch();
}
sname[k]=0;
if(k=findmac(sname))
while(c=macq[k++])
keepch(c);
else
{k=0;
while(c=sname[k++])
keepch(c);
}
}
else keepch(gch());
}
keepch(0);
if(mptr>=mpmax)error("line too long");
lptr=mptr=0;
while(line[lptr++]=mline[mptr++]);
lptr=0;
}
/* ### cpcn-20 */
keepch(c)
char c;
{ mline[mptr]=c;
if(mptr return c;
}
predel()
{keepch(' ');
while((ch()==' ')|
(ch()==9))
gch();
}
prequote()
{keepch(ch());
gch();
while(ch()!='"')
{if(ch()==0)
{error("missing quote");
break;
}
keepch(gch());
}
gch();
keepch('"');
}
preapos()
{keepch(39);
gch();
while(ch()!=39)
{if(ch()==0)
{error("missing apostrophe");
break;
}
keepch(gch());
}
gch();
keepch(39);
}
precomm()
{inchar();inchar();
while(((ch()=='*')&
(nch()=='/'))==0)
{if(ch()==0)inline();
else inchar();
if(eof)break;
}
inchar();inchar();
}
/* ### cpcn-21 */
addmac()
{ char sname[namesize];
int k;
if(symname(sname)==0)
{illname();
kill();
return;
}
k=0;
while(putmac(sname[k++]));
while(ch()==' ' | ch()==9) gch();
while(putmac(gch()));
if(macptr>=macmax)error("macro table full");
}
putmac(c)
char c;
{ macq[macptr]=c;
if(macptr return c;
}
findmac(sname)
char *sname;
{ int k;
k=0;
while(k {if(astreq(sname,macq+k,namemax))
{while(macq[k++]);
return k;
}
while(macq[k++]);
while(macq[k++]);
}
return 0;
}
/* ### cpcn-22 */
/* direct output to console gtf 7/16/80 */
toconsole()
{
saveout = output;
output = 0;
/* end toconsole */}


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


outbyte(c)
char c;
{
if(c==0)return 0;
if(output)
{if((putc(c,output))<=0)
{closeout();
error("Output file error");
abort(); /* gtf 7/17/80 */
}
}
else putchar(c);
return c;
}
outstr(ptr)
char ptr[];
{
int k;
k=0;
while(outbyte(ptr[k++]));
}


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


nl()
{outbyte(eol);}
tab()
{outbyte(9);}
col()
{outbyte(58);}
/* ### cpcn-23 */
error(ptr)
char ptr[];
{ int k;
char junk[81];


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


outstr(line); nl();


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


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


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


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


/* convert lower case to upper */
/* gtf 6/26/80 */
raise(c)
char c;
{
if((c>='a') & (c<='z'))
c = c - 'a' + 'A';
return(c);
/* end raise */}
/* ### cpcn-26 */
/* >>>>>>> start of cc5 <<<<<<< */


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


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


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


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


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


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


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


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



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


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


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


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


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


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


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


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