smallC V2 CP/M runtime support - (nf)
utzoo!decvax!harpo!npoiv!npois!wbux5!wb2!houxz!ihnp4!ixn5c!inuxc!pur-ee!uiucdcs!schrein
utzoo!decvax!harpo!npoiv!npois!wbux5!wb2!houxz!ihnp4!ixn5c!inuxc!pur-ee!uiucdcs!schrein
Sun Mar 13 22:45:50 AEST 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 %%%%%%%%%%
More information about the Comp.sources.unix
mailing list