smallC V2 CP/M runtime support - (nf)
uiucdcs!schrein
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 %%%%%%%%%%
uiucdcs!schrein
uiucdcs!schrein Mar 12 09:22:00 1983
(smallC V2 CP/M runtime support continued)
(part 2)
%%%%%%%%%% scc/rtl/crtl.mac %%%%%%%%%%
; crtl.mac -- smallC runtime environment module
; for CP/M
; for MACRO/80
; ats 2/83
; in part adapted from Jim Hendrix' code
; global name conventions:
; ========================
;
; ? starts an internal routine name
; _ starts an internal C-callable name
; other starts a published C-callable name
;
; This file is organized so that all references
; to global symbols are forward.
; smallC CP/M environment:
; ========================
;
; Set up stack to run from top of memory downward,
; and call smallC environment routine _shell().
;
; Upon return, connect to BIOS warm start.
;
; _exit entry point to BIOS warm start,
; i.e., no file management wrapup.
;
; If the END module is linked last (and it must be):
;
; _edata follows the last static data area,
; is preceded by the 6 character production date mmddyy
;
; _eprog follows the last code area
; is preceded by the 6 character compiler logo
;
; _end follows the end of code and data
;
; The smallC compiler is expected to supply a reference
; to the ?smallC routine to arrange for proper library search.
ENTRY ?smallC
ENTRY _exit
EXTRN _shell ; outermost C runtime routine
EXTRN ?30217 ; version reference
V.BIOS EQU 0 ; entry vector for BIOS warm start
V.BDOS EQU 5 ; entry vector for BDOS
CSEG
?smallC:
LHLD V.BDOS+1 ; stack starts at top of memory
SPHL
CALL _shell ; call C environment routine
_exit:
JMP V.BIOS ; return to system
; BDOS calls:
; ===========
;
; BDOS C call return entry description
; code value value
; -------------------------------------------------------------
; 0 abort() system reset
; 1 i = _getchar() char console read
; 2 _putchar(c) char console write
; 3 i = _rgetchar() char reader read
; 4 _pputchar(c) char punch write
; 5 _lputchar(c) char list write
; 6 i = _dirio(c) char 0xFF direct input
; 0=busy char direct output
; 7 i = _giob() byte get i/o byte
; 8 _siob(c) byte set i/o byte
; 9 _puts(&c) address print string to next $
; 10 _gets(&buf) address read console buffer
; 11 i = _cstat() 0=busy get console status
; 12 i = _vers() word get version number (in hex)
; 13 _reset() reset disk
; 14 i = _mount(c) 0=ok drive# select disk
; 15 i = _open(&f) dir [1] address open file
; 16 i = _close(&f) dir address close file
; 17 i = _glob(&f) dir [2] address search for first file name
; 18 i = _nglob() dir [2] search for next file name
; 19 i = _delete(&f) dir address delete file
; 20 i = _read(&f) err [3] address read next record
; 21 i = _write(&f) err [3] address write next record
; 22 i = _create(&f) dir [1] address create file
; 23 i = _renam(&fn) dir address rename file
; 24 i = _login() vector get login vector
; 25 i = _drive() drive# get disk number
; 26 _setbuf(&c) address set DMA address (of 128 bytes)
; 27 i = _bitmap() bitmap get allocate vector
; 28 _protect() write protect
; 29 i = romap() vector get R/O vector
; 30 i = _chmod(&f) dir address set file attributes
; 31 i = _diskmap() diskmap get disk header address
; 32 i = _uid(c) user# 0xFF get user number
; 0=ok user# set user number
; 33 i = _rread(&f) err [4] address read random
; 34 i = _rwrite(&f) err [4] address write random
; 35 _stat(&f) [5] address compute file size
; 36 _record(&f) [5] address set random record
; 37 i = _umount(i) 0=ok vector reset selected drives
; 40 i = _rzwrite(&f) err[4] address write random zero fill
; -------------------------------------------------------------
;
; bitmap from left to right, set bits indicate allocated
; reservation blocks
;
; buf console buffer has the following format:
;
; byte (in) maximum length available for text
; byte (out) length actually filled
; byte... (out) text read, without trailing newline
;
; c character (byte) parameter
;
; dir position in directory sector, 0..3
; not found: 0xFF
;
; diskmap CP/M disk description
;
; drive# disk drive number, 0==A, 1==B, ...
;
; err error code:
;
; 0 ok
; 1 reading unwritten data (end of file)
;
; f file control block
; can usually contain wildcard file name
;
; fn file control block,
; new name begins at offset 17
;
; i integer (word) result, possibly byte sign-extended
;
; vector bit vector indicating disk drives,
; least significant bit is drive 0
;
; [1] modifies argument file control block
;
; [2] requires _setbuf(),
; result indicates directory entry in this buffer
;
; [3] requires _setbuf(),
; i/o happens from the DMA area set up by _setbuf()
;
; [4] [3], additionally, the random record position
; must have been set in the argument file control block
;
; [5] result is returned to the random record position
; in the file control block
; macro to dispatch BDOS calls:
; -----------------------------
;
; t action
; -------------------------------------------------------------
; 0 jump to BDOS
; 1 call BDOS, return HL = (int) A
; 2 DE = parm, call BDOS
; 3 DE = parm, call BDOS, return HL = (int) A
BDOS MACRO func,t,code
&func:: ;; entry point from C
MVI C,&code ;; set BDOS function code
JMP ?BD&t ;; goto executor
ENDM
BDOS abort,0,0
BDOS _getch,1,1
BDOS _putch,2,2
BDOS _rgetc,1,3
BDOS _pputc,2,4
BDOS _lputc,2,5
BDOS _dirio,3,6
BDOS _giob,1,7
BDOS _siob,2,8
BDOS _puts,2,9
BDOS _gets,2,10
BDOS _cstat,1,11
BDOS _vers,0,12
BDOS _reset,0,13
BDOS _mount,3,14
BDOS _open,3,15
BDOS _close,3,16
BDOS _glob,3,17
BDOS _nglob,1,18
BDOS _delete,3,19
BDOS _read,3,20
BDOS _write,3,21
BDOS _create,3,22
BDOS _rename,3,23
BDOS _login,0,24
BDOS _drive,1,25
BDOS _setbuf,2,26
BDOS _bitmap,0,27
BDOS _protect,0,28
BDOS _romap,0,29
BDOS _chmod,3,30
BDOS _diskmap,0,31
BDOS _uid,3,32
BDOS _rread,3,33
BDOS _rwrite,3,34
BDOS _stat,2,35
BDOS _record,2,36
BDOS _umount,3,37
BDOS _rzwrite,3,40
; BDOS interface:
; ---------------
; type 0:
;
; jump to BDOS
; i.e., either no return, or return HL
?BD0 EQU V.BDOS
; type 2:
;
; C in BDOS function
; DE local int parameter
; HL local
?BD2: POP H ; return
POP D ; int parameter
PUSH D
PUSH H
JMP V.BDOS ; return through BDOS
; type 3:
;
; A local from BDOS
; C in BDOS function
; DE local int parameter
; HL out = (int) A
?BD3: POP H ; return
POP D ; int parameter
PUSH D
PUSH H
; JMP ?BD1 ; BDOS, return HL = (int) A
; type 1:
;
; A local from BDOS
; C in BDOS function
; HL out = (int) A
?BD1: CALL V.BDOS
JMP ?SXT ; HL = (int) A
; BIOS calls:
; ===========
;
; BIOS C call return entry description
; offset value value
; -------------------------------------------------------------
; 0 complete cold start
; 3 _wboot() warm start
; 6 i = _const() ff=ready console status
; 9 c = _conin() char console input (no echo)
; 12 _conout(c) char console output
; 15 _lstout(c) char printer output
; 18 _punout(c) char punch output
; 21 c = _rdrin() char reader input
; 24 _home() set track zero
; 27 i = _seldsk(c,b) 0=no drive#, select disk
; diskmap first
; 30 _settrk(i) track select track
; 33 _setsec(i) sector set sector
; 36 _setdma(&c) address set DMA address
; 39 i = _sread() 0=ok read CP/M sector
; 42 i = _swrite(c) 0=ok all write CP/M sector
; 45 i = _lstst() ff=ready printer status
; 48 i = _sectran(i,&c) phys log, translate sector
; ttable
; -------------------------------------------------------------
;
; all 0: write to previously allocated block
; 1: write to directory (always to disk)
; 2: write to first sector of unallocated data block
;
; b bit parameter
;
; c character (byte) parameter
;
; diskmap CP/M disk description (0==no such drive)
;
; drive# disk drive number, 0==A, 1==B, ...
;
; first bit 0: 0==first call for this disk
;
; i integer (word) result, possibly byte sign-extended
;
; ttable translation table address (0==none)
; macro to dispatch BIOS calls:
; -----------------------------
;
; t action
; -------------------------------------------------------------
; 0 jump to BIOS
; 1 call BIOS, return HL = (int) A
; 2 BC = parm, call BIOS
; 3 BC = parm, DE = parm, call BIOS
; 4 BC = parm, call BIOS, return HL = (int) A
BIOS MACRO func,t,offset
&func:: ;; entry point from C
MVI A,&offset ;; set BIOS offset
JMP ?BI&t ;; goto executor
ENDM
BIOS _wboot,0,3
BIOS _const,1,6
BIOS _conin,1,9
BIOS _conou,2,12
BIOS _lstou,2,15
BIOS _punou,2,18
BIOS _rdrin,1,21
BIOS _home,0,24
BIOS _selds,3,27
BIOS _settr,2,30
BIOS _setse,2,33
BIOS _setdm,2,36
BIOS _sread,1,39
BIOS _swrit,4,42
BIOS _lstst,1,45
BIOS _sectr,3,48
; BIOS interface:
; ---------------
; type 1:
;
; A in offset in BIOS page
; local BIOS return
; HL out = (int) A
?BI1: LHLD V.BIOS+1 ; H = BIOS page number
MOV L,A ; L = BIOS offset
PUSH H
LXI H,$+5 ; return address
XTHL ; to stack
PCHL
JMP ?SXT ; HL = (int) A
; type 2:
;
; A in offset in BIOS page
; BC local int parameter
; HL local
?BI2: POP H ; return
POP B ; parameter
PUSH B
PUSH H
JMP ?BI0 ; go and return through BIOS
; type 3:
;
; A in offset in BIOS page
; BC local int parameter (first)
; DE local int parameter (second)
; HL local
?BI3: POP H ; return
POP D ; second parameter
POP B ; first parameter
PUSH B
PUSH D
PUSH H
; JMP ?BI0 ; go and return through BIOS
; type 0:
;
; A in offset in BIOS page
; HL local
?BI0: LHLD V.BIOS+1 ; H = BIOS page number
MOV L,A ; L = BIOS offset
PCHL
; type 4:
;
; A in offset in BIOS page
; local BIOS return
; BC local int parameter
; HL out = (int) A
?BI4: POP H ; return
POP B ; parameter
PUSH B
PUSH H
LHLD V.BIOS+1 ; H = BIOS page number
MOV L,A ; L = BIOS offset
PUSH H
LXI H,$+5 ; return address
XTHL ; to stack
PCHL
JMP ?SXT ; HL = (int) A
; Jim Hendrix' arithmetic and logic library:
; ==========================================
; routine headers:
; ----------------
ENTRY ?OR ; hl |= de
ENTRY ?XOR ; hl ^= de
ENTRY ?AND ; hl &= de
ENTRY ?EQ ; hl = hl == de
ENTRY ?NE ; hl = hl != de
ENTRY ?GT ; hl = (int) de > hl
ENTRY ?LE ; hl = (int) de <= hl
ENTRY ?GE ; hl = (int) de >= hl
ENTRY ?LT ; hl = (int) de < hl
ENTRY ?UGE ; hl = (unsigned) de >= hl
ENTRY ?ULT ; hl = (unsigned) de < hl
ENTRY ?UGT ; hl = (unsigned) de > hl
ENTRY ?ULE ; hl = (unsigned) de <= hl
ENTRY ?ASR ; hl = de >> hl
ENTRY ?ASL ; hl = de << hl
ENTRY ?SUB ; hl = de - hl
ENTRY ?NEG ; hl = - hl
ENTRY ?COM ; hl = ~ hl
ENTRY ?MULT ; hl *= de
ENTRY ?DIV ; hl = de / hl, de %= hl
ENTRY ?LNEG ; hl = ! hl
ENTRY ?DECC ; (byte) *(hl+top()) --
ENTRY ?INCC ; (byte) *(hl+top()) ++
ENTRY ?DECI ; (word) *(hl+top()) --
ENTRY ?INCI ; (word) *(hl+top()) ++
ENTRY ?DDGC ; hl = (int) (byte) *(hl+de)
ENTRY ?DSGC ; hl = (int) (byte) *(hl+top())
ENTRY ?GCHAR ; hl = (int) (byte) *hl
ENTRY ?SXT ; hl = (int) a
ENTRY _narg ; hl = (int) a /* number of arguments */
ENTRY ?DDGI ; hl = (word) *(hl+de)
ENTRY ?DSGI ; hl = (word) *(hl+top())
ENTRY ?GINT ; hl = (word) *hl
ENTRY ?DDPPC ; (byte) *(pop()) = de+hl
ENTRY ?PDPC ; (byte) *(pop()) = hl
ENTRY ?DDPPI ; (word) *(pop()) = de+hl
ENTRY ?PDPI ; (word) *(pop()) = hl
ENTRY ?PINT ; (word) *de = hl
ENTRY ?SWITCH ; switch selector execution
; code region:
; ------------
;
; Blank lines separate potential modules.
?OR:
MOV A,L
ORA E
MOV L,A
MOV A,H
ORA D
MOV H,A
RET
?XOR:
MOV A,L
XRA E
MOV L,A
MOV A,H
XRA D
MOV H,A
RET
?AND:
MOV A,L
ANA E
MOV L,A
MOV A,H
ANA D
MOV H,A
RET
?EQ:
CALL CMP0
RZ
DCX H
RET
?NE:
CALL CMP0
RNZ
DCX H
RET
?GT:
XCHG
CALL CMP0
RC
DCX H
RET
?LE:
CALL CMP0
RZ
RC
DCX H
RET
?GE:
CALL CMP0
RNC
DCX H
RET
?LT:
CALL CMP0
RC
DCX H
RET
CMP0:
MOV A,H ; INVERT SIGN OF HL
XRI 80H
MOV H,A
MOV A,D ; INVERT SIGN OF DE
XRI 80H
CMP H ; COMPARE MSBS
JNZ CMP1 ; DONE IF NEQ
MOV A,E ; COMPARE LSBS
CMP L
CMP1:
LXI H,1 ; PRESET TRUE COND
RET
?UGE:
CALL UCMP0
RNC
DCX H
RET
?ULT:
CALL UCMP0
RC
DCX H
RET
?UGT:
XCHG
CALL UCMP0
RC
DCX H
RET
?ULE:
CALL UCMP0
RZ
RC
DCX H
RET
UCMP0:
MOV A,D
CMP H
JNZ UCMP1
MOV A,E
CMP L
UCMP1:
LXI H,1
RET
?ASR:
XCHG
DCR E
RM
MOV A,H
RAL
MOV A,H
RAR
MOV H,A
MOV A,L
RAR
MOV L,A
JMP ?ASR+1
?ASL:
XCHG
DCR E
RM
DAD H
JMP ?ASL+1
?SUB:
MOV A,E
SUB L
MOV L,A
MOV A,D
SBB H
MOV H,A
RET
?NEG:
CALL ?COM
INX H
RET
?COM:
MOV A,H
CMA
MOV H,A
MOV A,L
CMA
MOV L,A
RET
?MULT:
MOV B,H
MOV C,L
LXI H,0
MULT1:
MOV A,C
RRC
JNC MULT2
DAD D
MULT2:
XRA A
MOV A,B
RAR
MOV B,A
MOV A,C
RAR
MOV C,A
ORA B
RZ
XRA A
MOV A,E
RAL
MOV E,A
MOV A,D
RAL
MOV D,A
ORA E
RZ
JMP MULT1
?DIV:
MOV B,H
MOV C,L
MOV A,D
XRA B
PUSH PSW
MOV A,D
ORA A
CM DENEG
MOV A,B
ORA A
CM BCNEG
MVI A,16
PUSH PSW
XCHG
LXI D,0
DIV1:
DAD H
CALL RDEL
JZ DIV2
CALL CMPBCDE
JM DIV2
MOV A,L
ORI 1
MOV L,A
MOV A,E
SUB C
MOV E,A
MOV A,D
SBB B
MOV D,A
DIV2:
POP PSW
DCR A
JZ DIV3
PUSH PSW
JMP DIV1
DIV3:
POP PSW
RP
CALL DENEG
XCHG
CALL DENEG
XCHG
RET
DENEG: ;NEGATE THE INTEGER IN DE
MOV A,D
CMA
MOV D,A
MOV A,E
CMA
MOV E,A
INX D
RET
BCNEG: ;NEGATE THE INTEGER IN BC
MOV A,B
CMA
MOV B,A
MOV A,C
CMA
MOV C,A
INX B
RET
RDEL: ;ROTATE DE LEFT ONE BIT
MOV A,E
RAL
MOV E,A
MOV A,D
RAL
MOV D,A
ORA E
RET
CMPBCDE: ;COMPARE BC TO DE
MOV A,E
SUB C
MOV A,D
SBB B
RET
?LNEG:
MOV A,H
ORA L
JNZ $+6
MVI L,1
RET
LXI H,0
RET
?DECC:
INX H
INX H
DAD SP
MOV D,H
MOV E,L
CALL ?GCHAR
DCX H
MOV A,L
STAX D
RET
?INCC:
INX H
INX H
DAD SP
MOV D,H
MOV E,L
CALL ?GCHAR
INX H
MOV A,L
STAX D
RET
?DECI:
INX H
INX H
DAD SP
MOV D,H
MOV E,L
CALL ?GINT
DCX H
JMP ?PINT
?INCI:
INX H
INX H
DAD SP
MOV D,H
MOV E,L
CALL ?GINT
INX H
JMP ?PINT
?DDGC:
DAD D
JMP ?GCHAR
?DSGC:
INX H
INX H
DAD SP
?GCHAR:
MOV A,M
_narg:
?SXT:
MOV L,A
RLC
SBB A
MOV H,A
RET
?DDGI:
DAD D
JMP ?GINT
?DSGI:
INX H
INX H
DAD SP
?GINT:
MOV A,M
INX H
MOV H,M
MOV L,A
RET
?DDPPC:
DAD D
?PDPC:
POP B ; RET ADDR
POP D
PUSH B
;PCHAR:
MOV A,L
STAX D
RET
?DDPPI:
DAD D
?PDPI:
POP B ; RET ADDR
POP D
PUSH B
?PINT:
MOV A,L
STAX D
INX D
MOV A,H
STAX D
RET
; EXECUTE "SWITCH" STATEMENT
;
; HL = SWITCH VALUE
; (SP) -> SWITCH TABLE
; DW ADDR1, VALUE1
; DW ADDR2, VALUE2
; ...
; DW 0
; [JMP default]
; continuation
;
?SWITCH:
XCHG ; DE = SWITCH VALUE
POP H ; HL -> SWITCH TABLE
SWLOOP:
MOV C,M
INX H
MOV B,M ; BC -> CASE ADDR, ELSE 0
INX H
MOV A,B
ORA C
JZ SWEND ; DEFAULT OR CONTINUATION CODE
MOV A,M
INX H
CMP E
MOV A,M
INX H
JNZ SWLOOP
CMP D
JNZ SWLOOP
MOV H,B ; CASE MATCHED
MOV L,C
SWEND:
PCHL
END ?smallC
%%%%%%%%%% scc/rtl/csh.c %%%%%%%%%%
/*
* csh.c -- smallC runtime environment for CP/M and MACRO-80
* ats 2/83, in part adapted from Jim Hendrix' code
*/
#define NOCCARGC
#include def.h /* TO BE FIXED */
/*
* external references
*/
extern _exit(); /* termination point in ?smallC */
extern main(); /* user's main program */
extern char _end[]; /* begin of heap */
extern _dnm[], _dop[], /* CP/M driver table */
_drd[], _dwr[],
_dbr[], _dbw[],
_dsk[], _dcl[];
extern _drive(); /* BDOS /* current drive number */
/****
**** global data regions
****/
/*
* character classification table
*/
/* 128 64 32 16 8 4 2 1 */
/* special upper lower num hex space punct cntrl */
#define C_PRINT (128+64+32+16 +4 ) /* printing character */
#define C_CNTRL ( 1) /* control character */
#define C_ALPHA ( 64+32 ) /* alphabetic */
#define C_UPPER ( 64 ) /* upper case */
#define C_LOWER ( 32 ) /* lower case */
#define C_DIGIT ( 16 ) /* digit */
#define C_XDIGI ( 16+8 ) /* base 16 digit */
#define C_ALNUM ( 64+32+16 ) /* alpha or numeric */
#define C_SPACE ( 4 ) /* white space */
#define C_PUNCT ( 2 ) /* punctuation */
char _ctype[128] = {
1, 1, 1, 1, 1, 1, 1, 1, /* nul soh stx etx eot enq ack bel */
1, 5, 5, 1, 1, 5, 1, 1, /* es ht lf vt ff cr so si */
1, 1, 1, 1, 1, 1, 1, 1, /* dle ^q ^r ^s ^t nak syn etb */
1, 1, 1, 1, 1, 1, 1, 1, /* can em sub esc fs gs rs us */
4,130,130,128,128,128,128,130, /* sp ! " # $ % & ' */
130,130,128,128,130,130,130,128, /* ( ) * + , - . / */
16, 16, 16, 16, 16, 16, 16, 16, /* 0 1 2 3 4 5 6 7 */
16, 16,130,130,128,128,128,130, /* 8 9 : ; < = > ? */
128, 72, 72, 72, 72, 72, 72, 64, /* \@ A B C D E F G */
64, 64, 64, 64, 64, 64, 64, 64, /* H I J K L M N O */
64, 64, 64, 64, 64, 64, 64, 64, /* P Q R S T U V W */
64, 64, 64,128,128,128,128,128, /* X Y Z [ \ ] ^ _ */
130, 40, 40, 40, 40, 40, 40, 32, /* ` a b c d e f g */
32, 32, 32, 32, 32, 32, 32, 32, /* h i j k l m n o */
32, 32, 32, 32, 32, 32, 32, 32, /* p q r s t u v w */
32, 32, 32,128,128,128,128, 1}; /* x y z { | } ~ del */
/*
* file blocks:
*
* These are the center of file activity.
* 'stdin', 'stdout', and 'stderr' are dedicated.
*/
char _fbin[FB_]; /* standard input (first!!) */
char _fbout[FB_]; /* standard output */
char _fberr[FB_]; /* diagnostic output */
STATIC FILE *_fblocks; /* -> chain of open file blocks */
STATIC FILE *_cfp; /* i/o transfer: -> current file block */
/****
**** smallC MACRO-80 CP/M runtime environment
****/
/*
* _shell called from the ?smallC code
* sets up environment and calls main()
*
* exit close all files and terminate program execution.
*
* BUG: more than 19 arguments cause great trouble...
* fewer waste space.
*/
_shell()
{ char *cp, *fnp, ch;
int argc, argv[20];
int *wp; /* for casting */
wp = _end+1 & ~1; /* even */
*wp = wp+1; /* blind heap element */
*++wp = NULL; /* terminal heap element */
_fblocks = NULL; /* no open file block */
_fbin[FB_FLG] = 0; /* stdio closed */
_fbout[FB_FLG] = 0;
_fberr[FB_FLG] = 0;
freopen("con:", "r", stdin);
freopen("con:", "w", stdout);
freopen("con:", "w", stderr);
argv[0] = "*"; /* argument vector passed at 0x81 */
for (cp = 129, argc=1; ch = *cp++; )
switch(ch) {
case '\'':
cp = mkarg(argv[argc++] = cp, '\'');
continue;
case '\"':
cp = mkarg(argv[argc++] = cp, '\"');
continue;
case '>':
if (*cp == '>')
{ ch = '+'; /* append */
cp++;
}
case '<':
while (isspace(*cp))
cp++;
if (! *cp)
{ fputs("bad redirect", stderr);
_exit();
}
cp = mkarg(fnp = cp, 0);
switch (ch) {
case '<':
if (freopen(fnp, "r", stdin) == stdin)
continue;
break;
case '>':
if (freopen(fnp, "w", stdout) == stdout)
continue;
break;
case '+':
if (freopen(fnp, "a", stdout) == stdout)
continue;
}
fputs("cannot access ", stderr);
fputs(fnp, stderr);
_exit();
default:
if (! isspace(ch))
cp = mkarg(argv[argc++] = cp-1, 0);
continue;
}
argv[argc] = NULL;
main(argc,argv);
exit();
}
exit()
{
while (_fblocks)
fclose(_fblocks);
fclose(stdin);
fclose(stdout);
fclose(stderr);
_exit();
}
/****
**** UN*X compatible dynamic memory allocation
****/
/*
* calloc return pointer to vector of 0, or NULL
* cfree free previously allocated area
*
* The heap starts at _end and runs upward toward the stack.
* Each area in the heap is preceded by a word at an even address;
* a pointer chain runs from _end through these words to NULL;
* The low bit in each word is 1 if the following area is free.
* There is a blind, allocated element at the front of the chain.
*
* BUG: very unreasonable demands (e.g., wraparound)
* will corrupt memory.
*/
#define SLACK 1024 /* at least 1KB stack to be free */
CHAR_P calloc(n,len)
int n; /* number of elements */
int len; /* length of element */
{ int cell; /* current allocation chain cell */
char *p; /* -> cell */
char *np; /* pointer in cell */
int *ip, *wp; /* for casting */
len = (len*n + 1) & ~1; /* even */
if (len == 0)
return NULL;
for (ip = p = word(_end+1 & ~1) & ~1;
np = (cell = *ip) & ~1;
ip = p = np)
if (cell & 1) /* lowbit == 1 means free */
{ if ((n = np-p - 2) > len+2)
{ wp = p + len+2;
*wp = cell;
*ip = wp;
}
else if (n >= len)
*ip = np;
else
continue;
for (wp = p+2; len; len -= 2)
*wp++ = 0;
return p+2;
}
if ((wp = p + len+2) > &n - SLACK)
return NULL;
*ip = wp;
*wp = NULL;
for (wp = p+2; len; len -= 2)
*wp++ = 0;
return p+2;
}
cfree(fp)
int *fp; /* to be freed */
{ int *p, *np;
--fp; /* to cell */
for (p = _end+1 & ~1;
np = word(p) & ~1;
p = np) /* p-> previous cell */
if (np == fp) /* fp-> cell to free */
{ np = *fp; /* np-> following cell */
if ((*fp & 1) || np == NULL)
break; /* he does not own it */
if (*p & 1)
if (*np & 1)
*p = *np;
else if (*np == NULL)
*p = NULL;
else
{ *p = np;
*p |= 1;
}
else if (*np & 1)
*fp = *np;
else if (*np == NULL)
*fp = NULL;
else
*fp |= 1;
return;
}
fputs("cfree botch", stderr);
_exit();
}
/****
**** UN*X compatible character functions
****/
/*
* character type functions:
*
* isascii(i) i is ASCII character
* isupper(c) c is upper case
* islower(c) c is lower case
* isalnum(c) c is alphabetic or digit
* isspace(c) c is white space
*/
INT isascii(i) int i; { return i >= 0 && i < 128; }
INT isupper(c) char c; { return _ctype[c] & C_UPPER; }
INT islower(c) char c; { return _ctype[c] & C_LOWER; }
INT isalnum(c) char c; { return _ctype[c] & C_ALNUM; }
INT isspace(c) char c; { return _ctype[c] & C_SPACE; }
/*
* character conversion functions:
*
* tolower(u) return lower case version of u
* toupper(l) return upper case version of l
*/
CHAR tolower(u) char u; { return u + 'a'-'A'; }
CHAR toupper(l) char l; { return l + 'A'-'a'; }
/****
**** UN*X compatible string functions
****/
/*
* strcmp 0 if `a' == `b'
* <0 if `a' < `b'
* >0 if `a' > `b'
*/
INT strcmp(a,b)
char *a, *b;
{
while (*a == *b && *a)
a++, b++;
return *a - *b;
}
/****
**** routines to approximate C features
****/
/*
* word(&i) return word
*/
INT word(wp)
int *wp;
{
return *wp;
}
/****
**** CP/M utility routines
****/
/*
* mkarg massage argument text, return -> unused char
*
* convert upper case to lower, unless preceded by \
* terminate on stop character or white space,
* append NUL to resulting text.
*
* mkdrive(&c) return 0.. for A..
* mkfield(&c,i,&c) upper-case, copy, pad, return -> next
* mkfilename(&c,&c) fix-format filename, return success
* mkfcb(&c,&c) init fcb with file name, return success
*/
CHAR_P mkarg(str, stop)
char *str; /* -> (first) result character */
char stop; /* 0: space, other: terminator */
{ char *cp, ch;
for(cp = str; ; )
{ switch (ch = *cp++) {
case NUL:
if (stop == 0)
{ *str = NUL;
return cp-1;
}
fputs("missing ", stderr);
fputc(stop, stderr);
_exit();
case '\\':
if (*cp)
{ *str++ = *cp++;
continue;
}
fputs("trailing \\", stderr);
_exit();
}
if (ch == stop || isspace(ch) && stop == 0)
{ *str = NUL;
return cp;
}
if (isupper(ch))
*str++ = tolower(ch);
else
*str++ = ch;
}
}
INT mkdrive(cp)
char *cp;
{
if (isascii(*cp))
if (isupper(*cp))
return *cp - 'A';
else if (islower(*cp))
return *cp - 'a';
return ERR;
}
CHAR_P mkfield(f,l,s) /* copy isalnum() */
char *f; /* upper-cased to this buffer */
int l; /* blank padded to this length */
char *s; /* from this string */
{
do
if (isascii(*s) && isalnum(*s))
if (islower(*s))
*f++ = toupper(*s++);
else
*f++ = *s++;
else
break;
while (--l);
while (l--)
*f++ = ' ';
return s;
}
INT mkfilename(fnb, fnm)
char fnb[16]; /* to be filled */
char *fnm; /* with this file name */
{ int i;
if (fnm[1] == ':')
{ if ((i = mkdrive(fnm)) == ERR)
return ERR;
fnb[FCB_ET] = i+1;
fnm += 2;
}
else /* make sure to set current drive */
fnb[FCB_ET] = _drive()+1;
fnm = mkfield(fnb+FCB_FN,8,fnm);
if (*fnm == '.')
fnm = mkfield(fnb+FCB_FT,3,fnm+1);
else
for (i=0; i<3; i++)
fnb[FCB_FT+i] = ' ';
if (*fnm != NUL)
return ERR;
return NULL;
}
INT mkfcb(fcb,fnm)
char fcb[FCB_]; /* to be initialized */
char *fnm; /* with this file name */
{ int i;
for (i=0; i<FCB_; i++)
fcb[i] = NUL;
return mkfilename(fcb,fnm);
}
/****
**** UN*X compatible file management for CP/M
****/
/*
* file management routines:
*
* fopen connect to file or device, return fp, or NULL
* freopen change connection, return given fp, or NULL
* fclose disconnect, return NULL, or EOF
*
* BUG: < 1<<16 sectors(records) per file
*/
FILE_P fopen(fnm,mode)
char *fnm; /* CP/M logical device or file name */
char *mode; /* "r", "w", or "a" */
{ FILE *fp;
int *wp; /* for casting */
if ((fp = calloc(1, FB_)) == NULL)
return NULL;
wp = fp+FB_NXT; /* link new block in */
*wp = _fblocks;
_fblocks = fp;
return freopen(fnm, mode, fp);
}
FILE_P freopen(fnm,mode,fp)
char *fnm; /* CP/M logical device or file name */
char *mode; /* "r", "w", or "a" */
FILE *fp; /* -> FB, need not be open */
{ int i; /* # in driver table */
int f; /* for function call */
int *wp; /* for casting */
if (fp[FB_FLG] & FB_OPF && fclose(fp) == EOF)
return NULL; /* cannot close */
if (fnm[0] && fnm[1] && fnm[2] && fnm[3] == ':' && fnm[4] == NUL)
{ mkfield(fp+FCB_FN,3,fnm); /* upper-case */
fp[FCB_FN+3] = NUL; /* terminate */
for(i=1; ;i++)
if (_dnm[i] == 0)
return NULL; /* unknown device */
else if (strcmp(fp+FCB_FN, _dnm[i]) == 0)
break;
}
else if (mkfcb(fp, fnm) == ERR)
return NULL; /* bad file name */
else
i = 0;
fp[FB_DRV] = i; /* point to driver */
fp[FCB_OV] = 0; /* set record 0 */
wp = fp + FCB_RR;
*wp = 0;
wp = fp + FB_NCP; /* set buffer empty */
*wp = fp + FB_BUF;
switch (*mode) {
case 'r':
if (_drd[i] == NULL)
return NULL; /* illegal to read */
fp[FB_FLG] = FB_OPF;
break;
case 'a':
case 'w':
if (_dwr[i] == NULL)
return NULL; /* illegal to write */
fp[FB_FLG] = FB_OPF|FB_OUF;
break;
default:
return NULL; /* illegal mode */
}
if (f = _dop[i])
return (f)(fp,mode);
return fp; /* no special open */
}
INT fclose(fp)
FILE *fp;
{ int f; /* for function call */
FILE *p;
int *wp; /* for casting */
if ((fp[FB_FLG] & FB_OPF) == 0)
return EOF; /* not open */
fp[FB_FLG] &= ~FB_OPF; /* reset open flag */
if (f = _dcl[fp[FB_DRV]])
f = (f)(fp); /* f is NULL or return */
if (fp == _fblocks)
_fblocks = word(fp+FB_NXT);
else
{ p = _fblocks;
while (p)
{ wp = p+FB_NXT;
if (fp == *wp)
{ *wp = word(fp+FB_NXT);
break;
}
p = *wp;
}
if (p == NULL)
return f; /* stdio ?? */
}
cfree(fp);
return f;
}
/****
**** UN*X compatible i/o transfer routines for CP/M
****/
/*
* character i/o:
*
* fputc(ch,fp) to fp
* map '\n' to RETURN LINEFEED,
* return EOF on hard error.
*/
INT fputc(ch,fp)
char ch;
FILE *fp;
{ int f; /* to cast a function call */
if ((fp[FB_FLG] & FB_OUF) == 0 || (fp[FB_FLG] & FB_OPF) == 0)
{ fputs("writing bad file", stderr);
_exit();
}
if (fp[FB_FLG] & FB_EOF)
return EOF; /* hard end of file */
_cfp = fp; /* pass to _fputchar */
f = _dwr[fp[FB_DRV]];
if (ch == '\n') /* map '\n' to RETURN LINEFEED */
{ (f)(CR);
(f)(LF);
}
else
(f)(ch);
if (fp[FB_FLG] & (FB_EOF | FB_ERM))
return EOF;
return ch;
}
/*
* other i/o:
*
* fputs string to fp
*
* return NULL on error, else string.
*/
CHAR_P fputs(s, fp)
char *s;
FILE *fp;
{ char ch;
char *str;
str = s;
while (ch = *s++)
if (fputc(ch, fp) == EOF)
return NULL;
return str;
}
/****
**** CP/M drivers to execute i/o operations
****/
/*
* general routines:
*
* _binit clear buffer
* _bgetchar return one character from buffer
* _bputchar enter one character to buffer
* _ngetchar return EOF
* _nop do nothing (accept anything)
*
* BUG: assumes at most 16-bit record address
* i.e., FCB_OV is not used.
*/
_binit(cp) /* initialize buffer */
char *cp;
{ int len;
for (len = SLEN; len--; )
*cp++ = SUB; /* to end of file character */
}
INT _bgetchar() /* use _cfp */
{ int *wp; /* for casting */
char *cp; /* for casting */
int f; /* for function call */
wp = _cfp+FB_NCP;
if (*wp >= _cfp + FB_BUF+SLEN)
{ wp = _cfp+FCB_RR;
++*wp; /* next record */
f = _dbr[_cfp[FB_DRV]];
if ((f)(_cfp))
return EOF;
wp = _cfp+FB_NCP;
*wp = _cfp+FB_BUF; /* at begin */
}
cp = (*wp)++;
return *cp & 255;
}
_bputchar(ch) /* use _cfp */
char ch;
{ int *wp; /* for casting */
char *cp; /* for casting */
int f; /* for function call */
wp = _cfp+FB_NCP;
if (*wp >= _cfp + FB_BUF+SLEN)
{ f = _dbw[_cfp[FB_DRV]];
if ((f)(_cfp))
return EOF;
wp = _cfp+FCB_RR;
++*wp;
wp = _cfp+FB_NCP;
_binit(*wp = _cfp+FB_BUF);
}
cp = (*wp)++;
*cp = ch;
}
INT _ngetchar()
{
_cfp[FB_FLG] |= FB_EOF;
return EOF;
}
_nop()
{
}
%%%%%%%%%% scc/rtl/def.h %%%%%%%%%%
/*
* def.h -- definitions for smallC runtime support
* ats 3/83, in part adapted from Jim Hendrix' code
*/
/*
* return types for functions
*/
#define STATIC /* object is internal */
#define INT /* int */
#define CHAR /* char */
#define CHAR_P /* char * */
#define FILE_P /* FILE * */
/*
* constants
*/
#define NULL 0 /* null pointer */
#define NUL 0 /* nul character */
#define EOF (-1) /* end of file */
#define ERR (-2) /* error return a la Hendrix */
/*
* file management
*/
#define FILE char /* file pointer is char * */
#define stdin (_fbin) /* elsewhere, must be addresses */
#define stdout (_fbout)
#define stderr (_fberr)
/*
* CP/M related definitions
*/
#define EOT 4 /* ^D marks end of file at console */
#define LF 10 /* line feed */
#define CR 13 /* carriage return */
#define SUB 26 /* ^Z marks end of text */
#define SLEN 128 /* sector length */
#define LSLEN 7 /* log2 of SLEN */
/* /* offset to... */
#define DHD_ 16 /* next disk header block */
#define DHD_XLT 0 /* -> translate table */
#define DHD_DBF 8 /* -> directory buffer */
#define DHD_DPB 10 /* -> disk parameter block */
#define DHD_CST 12 /* -> directory checksum table */
#define DHD_RBR 14 /* -> allocation table */
#define DPB_ 15 /* next disk parameter block */
#define DPB_SPT 0 /* sectors per track */
#define DPB_BSH 2 /* block shift */
#define DPB_BLM 3 /* block shift mask */
#define DPB_EXM 4 /* extent mask */
#define DPB_DSM 5 /* disk size - 1 in blocks */
#define DPB_DRM 7 /* directory size - 1 in entries */
#define DPB_ALB 9 /* directory allocation */
#define DPB_CKS 11 /* check area size */
#define DPB_OFF 13 /* offset to first track */
#define FCB_ 36 /* next file control block */
#define FCB_ET 0 /* entry type/drive code/user number */
#define FCB_FN 1 /* file name */
#define FCB_FT 9 /* file type (extension) */
#define FCB_RO 9 /* high bit is read only flag */
#define FCB_SY 10 /* high bit is system file flag */
#define FCB_EX 12 /* file extent */
#define FCB_S1 13 /* 00 */
#define FCB_S2 14 /* system use */
#define FCB_RC 15 /* record count in extent */
#define FCB_DM 16 /* 16 record allocation bytes */
#define FCB_NR 32 /* next record number in this extent */
#define FCB_RR 33 /* random record number */
#define FCB_OV 35 /* RR overflow */
/*define FB_FCB 0 /* FCB is first */
#define FB_FLG (FCB_) /* (char) flags */
#define FB_OPF (1<<7) /* 0: closed, 1: open */
#define FB_OUF (1<<6) /* 0: input, 1: output */
#define FB_EOF (1<<5) /* hard end of file */
#define FB_UNF (1<<4) /* ungetc buffer full */
#define FB_ERM (FB_UNF-1) /* mask to get error code */
#define FB_UNC (FCB_+1) /* (char) ungetc buffer */
#define FB_NXT (FCB_+2) /* (FILE *) -> next file block */
#define FB_DRV (FCB_+4) /* (char) index into driver table */
#define FB_NCP (FCB_+5) /* (char *) -> next character */
#define FB_BUF (FB_NCP+2) /* (char[SLEN]) buffer */
#define FB_ (FB_BUF+SLEN) /* next file block */
%%%%%%%%%% scc/rtl/dtab.c %%%%%%%%%%
/*
* dtab.c -- driver table with raw disk interface
* ats 3/83
*/
#include def.h /* TO BE FIXED */
%%%%%%%%%% scc/rtl/end.mac %%%%%%%%%%
; end.mac -- smallC runtime library - last module
; for CP/M
; for MACRO/80
ENTRY _edata ; end of all DSEG
ENTRY _eprog ; end of all CSEG
ENTRY _end ; end of code and data
ENTRY ?30217 ; version reference
DSEG
?30217:
DB "021783" ; production date
_edata:
CSEG
DB 115,109,97,108,108,67 ; smallC
_eprog:
_end:
END
%%%%%%%%%% scc/rtl/fio.c %%%%%%%%%%
/*
* fio.c -- file driver for CP/M
* ats 3/83
*/
#define NOCCARGC
#include def.h /* TO BE FIXED */
/*
* external references
*/
extern word(), /* CSH /* return word at pointer */
_binit(), /* initialize buffer to EOF character */
_open(), /* BDOS /* connect to existing file */
_romap(), /* return r/o vector */
_setbuf(), /* set DMA address */
_glob(), /* search for first name */
_close(), /* disconnect from file */
_delete(), /* remove file */
_create(), /* make file, connect */
_rread(), /* read random record */
_rzwrite(), /* write random record, zero new block */
_stat(); /* determine file size */
/****
**** CP/M file driver
****/
/*
* _fopen connect, get buffer, return given fp or NULL
* _fblin input one CP/M sector
* _fblout output one CP/M sector
* _fseek position to offset, return NULL or -1
* _fclose write last buffer, disconnect, return NULL or EOF
*
* There is a problem in positioning to end of file,
* since CP/M marks this using SUB -- see _fseek.
*/
FILE_P _fopen(fp,mode)
FILE *fp; /* available file block */
char *mode;
{ int i;
switch(*mode) {
case 'r':
if (_open(fp) >> 2)
break;
_fblin(fp); /* read first buffer */
return fp;
case 'a':
case 'w':
if (_romap() & 1 << fp[FCB_ET]-1)
break; /* disk read only */
_setbuf(fp+FB_BUF);
if ((i = _glob(fp)) >> 2 == 0)
if (fp[FB_BUF + 32*i + FCB_RO] & 128)
break; /* file read only */
else if (*mode == 'a')
{ if (_open(fp) >> 2)
break;
/*
* issue a trick call to position to
* char-EOF without reading first
*/
if (_fseek(fp, 2, -1,-1, 0,0) == -1)
{ _close(fp);
break;
}
return fp;
}
else if (_delete(fp) >> 2)
break; /* unable to delete */
if (_create(fp) >> 2)
break; /* unable to create */
_binit(fp+FB_BUF);
return fp;
}
fp[FB_FLG] = 0; /* nothing */
return NULL;
}
INT _fblin(fp)
FILE *fp;
{ int code;
_setbuf(fp+FB_BUF);
switch(code = _rread(fp)) {
case 0: /* read ok */
return NULL;
case 1: /* reading unwritten data */
fp[FB_FLG] |= FB_EOF;
break;
default: /* other error */
fp[FB_FLG] &= ~FB_ERM;
fp[FB_FLG] |= code;
}
return EOF;
}
INT _fblout(fp)
FILE *fp;
{ int code;
_setbuf(fp+FB_BUF);
switch(code = _rzwrite(fp)) {
case 0:
return NULL;
case 5: /* directory overflow */
fp[FB_FLG] |= FB_EOF;
break;
default: /* other error */
fp[FB_FLG] &= ~FB_ERM;
fp[FB_FLG] |= code;
}
return EOF;
}
INT _fseek(fp,mode,csec,cpos,ssec,spos)
FILE *fp; /* to position */
int mode; /* checked to be 0,1,2,8,9,10 */
int csec,cpos; /* current position */
int ssec,spos; /* to be attained,
relative for modes 2,10 */
{ int *wp; /* for casting */
/*
* csec/cpos is current position,
* current position was flushed,
* now position to end of file
*
* note that mode==2, csec==-1 will
* position to char-EOF without worrying
* about buffer contents first.
*/
_setbuf(fp+FB_BUF);
_stat(fp); /* file size to RR */
wp = fp+FCB_RR;
switch(mode) {
case 0:
case 1:
case 2:
if (*wp == 0)
{ csec = cpos = 0;
wp = fp+FB_NCP;
_binit(*wp = fp+FB_BUF);
break;
}
if (--(*wp) != csec)
if (_rread(fp))
return -1; /* ouch!!! */
csec = *wp; /* last sector is buffered */
for (cpos = 0; cpos < SLEN; cpos++)
if (fp[FB_BUF+cpos] == SUB)
break;
if (cpos >= SLEN) /* last byte found */
{ cpos = 0;
*wp = ++csec;
wp = fp+FB_NCP;
_binit(*wp = fp+FB_BUF);
}
else
{ wp = fp+FB_NCP;
*wp = fp+FB_BUF + cpos;
}
if (mode != 2)
break;
ssec += csec; /* make absolute */
if ((spos += cpos) < 0)
{ spos += SLEN;
--ssec;
}
else if (spos >= SLEN)
{ spos -= SLEN;
++ssec;
}
break;
case 10:
ssec += *wp; /* make absolute */
spos = 0; /* sector-relative! */
case 8:
case 9:
csec = *wp; /* buffer end of file */
cpos = 0;
wp = fp+FB_NCP;
_binit(*wp = fp+FB_BUF);
}
/*
* csec/cpos is end of file
* buffer contents reflect this
* now position to ssec/spos (absolute)
*/
if (ssec < 0 || ssec > csec || ssec == csec && spos > cpos)
return -1; /* not inside file */
if (ssec != csec) /* i.e., before EOF */
{ wp = fp+FCB_RR;
*wp = ssec;
if (_rread(fp))
return -1; /* ouch!!! */
}
wp = fp+FB_NCP;
*wp = fp+FB_BUF + spos;
return 0;
}
INT _fclose(fp)
FILE *fp;
{ int result;
if (fp[FB_FLG] & FB_OUF && word(fp+FB_NCP) != fp+FB_BUF)
result = _fblout(fp);
else
result = 0;
if (_close(fp) >> 2 || result)
return EOF;
return NULL;
}
%%%%%%%%%% scc/rtl/ftab.c %%%%%%%%%%
/*
* ftab.c -- driver table without raw disk interface
* ats 3/83
*/
#include def.h /* TO BE FIXED */
#define FTAB /**/ /* signal to io.h */
%%%%%%%%%% scc/rtl/io.h %%%%%%%%%%
/*
* io.h -- disk and file driver tables for CP/M
* ats 3/83
*/
/*
* define...
*
* FTAB to create a driver table without the raw disk interface.
*/
/*
* C.REL: CRTL DTAB CSH FTAB FIO ... END
*
* The first external reference to the driver table
* is (officially) in CSH, thus FTAB is the default table.
* If the user's program contains a reference like
* `extern _dopen();' DTAB will instead be included.
*/
#define NOCCARGC
/*
* external references
*/
extern mkdrive(), /* CSH /* convert letter to drive # */
word(), /* return word from pointer */
_binit(), /* set buffer to EOF character */
_bgetchar(), /* read byte from buffer */
_bputchar(), /* write byte to buffer */
_ngetchar(), /* set+return end of file */
_nop(), /* do nothing */
_fopen(), /* FIO /* complete open */
_fblin(), /* read buffer */
_fblout(), /* write buffer */
_fseek(), /* seek */
_fclose(), /* complete close */
_getchar(), /* BDOS /* console read (+echo) */
_rgetchar(), /* reader read */
_putchar(), /* console write (+tab) */
_pputchar(), /* punch write */
_lputchar(), /* printer write */
_romap(); /* return r/o vector */
#ifndef FTAB
extern _seldsk(), /* BIOS /* select disk drive */
_sectran(), /* translate sector address */
_settrk(), /* set track */
_setsec(), /* set sector */
_setdma(), /* set DMA address */
_sread(), /* read sector */
_swrite(); /* write sector */
/* special argument to... */
#define SELDSK2 0 /* _seldsk: ignored by Osborne CBIOS */
#define SWRITE 0 /* _swrite: regular write */
#endif
/****
**** driver table
****/
/*
* _dnm permissible device names, 0-terminated
* _dop open &func, NULL if none needed
* _drd read byte &func, NULL if not allowed
* _dwr write byte &func, NULL if not allowed
* _dbr block read &func, NULL if read byte unbuffered
* _dbw block write &func, NULL if write byte unbuffered
* _dsk seek &func, NULL if not permitted
* _dcl close &func, NULL if none needed
*
* File manager is entry 0, other entries are devices.
* Device names are known (in freopen) to be 3 letters.
* Disk names are known (in _dopen) to have a legal and
* existing drive name as third character.
*
* con: read/write console, as set by i/o byte
* rdr: read reader, as set by i/o byte
* pun: write punch, as set by i/o byte
* lst: write list device, as set by i/o byte
* nul: EOF on read, no operation on write
* dka: disk A: under BIOS
* dkb: disk B: under BIOS
*/
/*
* Due to bugs in smallC, this is done in assembler.
char *_dnm[] ={"", "CON", "RDR", "PUN", "LST", "NUL", "DKA", "DKB", 0};
int (*_dop[])() ={_fopen,NULL, NULL, NULL, NULL, NULL, _dopen,_dopen };
int (*_drd[])() ={_bgetc,_getch,_rgetc,NULL, NULL, _ngetc,_bgetc,_bgetc };
int (*_dwr[])() ={_bputc,_putch,NULL, _pputc,_lputc,_nop, _bputc,_bputc };
int (*_dbr[])() ={_fblin,NULL, NULL, NULL, NULL, NULL, _dblin,_dblin };
int (*_dbw[])() ={_fblou,NULL, NULL, NULL, NULL, NULL, _dblou,_dblou };
int (*_dsk[])() ={_fseek,NULL, NULL, NULL, NULL, NULL, _dseek,_dseek };
int (*_dcl[])() ={_fclos,NULL, NULL, NULL, NULL, NULL, NULL, NULL };
*
*/
STATIC int _dnm[1];
#asm
DSEG
ORG _dnm
DW ..1
DW ..2
DW ..3
DW ..4
DW ..5
DW ..6
#endasm
#ifndef FTAB
#asm
DW ..7
DW ..8
#endasm
#endif
#asm
DW 0
..2: DB 'CON'
..1: DB 0
..3: DB 'RDR',0
..4: DB 'PUN',0
..5: DB 'LST',0
..6: DB 'NUL',0
#endasm
#ifndef FTAB
#asm
..7: DB 'DKA',0
..8: DB 'DKB',0
#endasm
#endif
STATIC int _dop[1];
#asm
DSEG
ORG _dop
DW _fopen
DW 0
DW 0
DW 0
DW 0
DW 0
#endasm
#ifndef FTAB
#asm
DW _dopen
DW _dopen
#endasm
#endif
int _drd[1];
#asm
DSEG
ORG _drd
DW _bgetcha
DW _getchar
DW _rgetcha
DW 0
DW 0
DW _ngetcha
#endasm
#ifndef FTAB
#asm
DW _bgetcha
DW _bgetcha
#endasm
#endif
int _dwr[1];
#asm
DSEG
ORG _dwr
DW _bputcha
DW _putchar
DW 0
DW _pputcha
DW _lputcha
DW _nop
#endasm
#ifndef FTAB
#asm
DW _bputcha
DW _bputcha
#endasm
#endif
STATIC int _dbr[1];
#asm
DSEG
ORG _dbr
DW _fblin
DW 0
DW 0
DW 0
DW 0
DW 0
#endasm
#ifndef FTAB
#asm
DW _dblin
DW _dblin
#endasm
#endif
STATIC int _dbw[1];
#asm
DSEG
ORG _dbw
DW _fblout
DW 0
DW 0
DW 0
DW 0
DW 0
#endasm
#ifndef FTAB
#asm
DW _dblout
DW _dblout
#endasm
#endif
int _dsk[1];
#asm
DSEG
ORG _dsk
DW _fseek
DW 0
DW 0
DW 0
DW 0
DW 0
#endasm
#ifndef FTAB
#asm
DW _dseek
DW _dseek
#endasm
#endif
STATIC int _dcl[1];
#asm
DSEG
ORG _dcl
DW _fclose
DW 0
DW 0
DW 0
DW 0
DW 0
#endasm
#ifndef FTAB
#asm
DW _dclose
DW _dclose
#endasm
#endif
#ifndef FTAB
/****
**** CP/M raw disk driver
****/
/*
* _dopen connect, get buffer, return given fp or NULL
* _dblin input one CP/M sector
* _dblout output one CP/M sector
* _dseek position to offset, return NULL or -1
* _dclose write last buffer, disconnect, return NULL or EOF
*
* BUGS: <= 127 sectors/track, <=127 first track,
* sectors before first directory track are not translated,
* <= 32767 sectors/disk,
* _dseek only knows sector-EOF
*/
#define DSK_DR FCB_ET /* drive #, 0==A, ... */
#define DSK_NM (FCB_FN+2) /* (existing) drive name */
#define DSK_ST FCB_S1 /* sectors/track */
#define DSK_FT FCB_S2 /* first directory track */
#define DSK_XL FCB_DM /* (word) -> translate table */
FILE_P _dopen(fp,mode)
FILE *fp; /* available file block */
char *mode;
{ int *wp; /* for casting */
char *cp; /* for casting */
int i;
if ((cp = _seldsk(fp[DSK_DR] = mkdrive(fp+DSK_NM), SELDSK2)) != NULL)
{ wp = fp+DSK_XL;
*wp = word(cp+DHD_XLT);
cp = word(cp+DHD_DPB);
fp[DSK_ST] = word(cp+DPB_SPT);
fp[DSK_FT] = word(cp+DPB_OFF);
switch(*mode) {
case 'r':
if (_dblin(fp))
break;
return fp;
case 'w':
if (_romap() & 1 << fp[DSK_DR])
break;
_binit(fp+FB_BUF);
return fp;
}
}
fp[FB_FLG] = 0; /* nothing */
return NULL;
}
STATIC INT _dblio(fp) /* setup for disk i/o */
FILE *fp;
{ int track, sector;
if (_seldsk(fp[DSK_DR], SELDSK2) == NULL)
{ fp[FB_FLG] &= ~FB_ERM;
fp[FB_FLG] |= 1; /* BUG, really */
return EOF;
}
sector = word(fp+FCB_RR);
if ((track = sector/fp[DSK_ST]) >= fp[DSK_FT])
sector = _sectran(sector % fp[DSK_ST], word(fp+DSK_XL));
else
sector %= fp[DSK_ST];
_settrk(track);
_setsec(sector);
_setdma(fp+FB_BUF);
return NULL;
}
INT _dblin(fp)
FILE *fp;
{
if (_dblio(fp))
return EOF;
if (_sread())
{ fp[FB_FLG] |= FB_EOF;
return EOF;
}
return NULL;
}
INT _dblout(fp)
FILE *fp;
{
if (_dblio(fp))
return EOF;
if (_swrite(SWRITE))
{ fp[FB_FLG] |= FB_EOF;
return EOF;
}
return NULL;
}
INT _dseek(fp,mode,csec,cpos,ssec,spos)
FILE *fp; /* to position */
int mode; /* checked to be 0,1,2,8,9,10 */
int csec,cpos; /* current position */
int ssec,spos; /* to be attained,
relative for modes 2,10 */
{ int *wp; /* for casting */
char *cp; /* for casting */
/*
* csec/cpos is current position,
* current position was flushed,
* now position to end of drive
*/
if ((cp = _seldsk(fp[DSK_DR], SELDSK2)) == NULL)
return -1; /* unknown drive */
wp = fp+FCB_RR; /* set RR */
cp = word(cp+DHD_DPB); /* point to DPB */
*wp = csec = (cp[DPB_BLM]+1) /* sectors/block */
* (word(cp+DPB_DSM)+1) /* blocks/disk */
+ word(cp+DPB_OFF) /* system tracks */
* word(cp+DPB_SPT); /* sectors/track
cpos = 0;
wp = fp+FB_NCP; /* empty buffer */
_binit(*wp = fp+FB_BUF);
switch(mode) {
case 10:
spos = 0; /* sector-relative */
case 2:
ssec += csec; /* make absolute */
break;
}
/*
* csec/cpos is end of file
* buffer contents reflect this
* now position to ssec/spos (absolute)
*/
if (ssec < 0 || ssec > csec || ssec == csec && spos > cpos)
return -1; /* not inside file */
if (ssec != csec) /* i.e., before EOF */
{ wp = fp+FCB_RR;
*wp = ssec;
if (_dblin(fp))
return -1; /* ouch!!! */
}
wp = fp+FB_NCP;
*wp = fp+FB_BUF + spos;
return 0;
}
INT _dclose(fp)
FILE *fp;
{
if (fp[FB_FLG] & FB_OUF && word(fp+FB_NCP) != fp+FB_BUF)
return _dblout(fp);
return NULL;
}
#endif /* ndef FTAB */
%%%%%%%%%% scc/rtl/make.sub %%%%%%%%%%
; smallC runtime library
;
; c?: source($1) object($2)
; get($3) smallC($4)
; macro-80($5) lib-80($6)
;
; ats 2/83
;
; mkwfield needs is*
;
$3 #$$a <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp1=$1:tmp
;
; mkwfilename needs mkwfield
;
$3 #$$b <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp2=$1:tmp
;
; mkwfcb needs mkwfilename
;
$3 #$$c <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp3=$1:tmp
;
; dumpbit needs putbit printf
;
$3 #d <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp4=$1:tmp
;
; dumpdpb needs putchar printf byte
;
$3 #e <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp5=$1:tmp
$6 $2:clib=$2:tmp1,$2:tmp2,$2:tmp3,$2:tmp4,$2:tmp5/e
;
; dumpfcb needs putchar printf byte
;
$3 #f <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp1=$1:tmp
;
; feof
;
$3 #$$g <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp2=$1:tmp
;
; ferror
;
$3 #$$h <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp3=$1:tmp
;
; clearerr
;
$3 #$$i <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp4=$1:tmp
;
; fseek
;
$3 #$$j <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp5=$1:tmp
$6 $2:tmp=$2:clib,$2:tmp1,$2:tmp2,$2:tmp3,$2:tmp4,$2:tmp5/e
era $2:clib.rel
ren $2:clib.rel=$2:tmp.rel
;
; rewind needs fseek
;
$3 #$$k <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp1=$1:tmp
;
; getchar needs fgetc
;
$3 #$$m <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp3=$1:tmp
;
; fgetc needs ungetc
;
$3 #$$n <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp4=$1:tmp
;
; ungetc
;
$3 #$$o <$1:c0.get >$1:tmp.c
$4 $1:tmp.c >$1:tmp.mac
$5 $2:tmp5=$1:tmp
$6 $2:tmp=$2:clib,$2:tmp1,$2:tmp3,$2:tmp4,$2:tmp5/e
era $2:clib.rel
ren $2:clib.rel=$2:tmp.rel
submit 2 $1 $2 $3 $4 $5 $6
%%%%%%%%%% scc/rtl/printf.c %%%%%%%%%%
/*
* printf.c -- smallC runtime library for CP/M and MACRO-80
* UN*X compatible printf routines
* ats 2/83, adapted from Jim Hendrix' code
* rev (treat %??c like %??s) ats 3/83
*/
#define NOCCARGC
#include def.h /* TO BE FIXED */
/*
* globally external things (in csh)
*/
extern char _fbin[]; /* stdin */
extern char _fbout[]; /* stdout */
extern char _fberr[]; /* stderr */
extern _narg(); /* returns # arguments */
extern abort(); /* terminate on output error */
extern fputc(), fputs(); /* output to file */
extern isdigit(); /* character class */
/*
* local definitions
*/
#define SZ 7 /* output item size */
/*
* _pfemit emit one character
*/
STATIC char *_pfstr; /* sprintf: -> string */
STATIC _pfemit(c, fp)
char c;
FILE *fp;
{
if (fp == &_pfstr)
*_pfstr++ = c; /* sprintf */
else if (fputc(c, fp) == EOF)
{ fputs("output error", stderr);
abort();
}
}
/*
* _itod nbr to signed decimal string
* _itou nbr to unsigned decimal string
* _itox nbr to hex string
*
* width SZ, right adjusted, blank filled, terminated with null byte
*/
STATIC _itod(nbr, str)
int nbr;
char str[];
{ char sgn;
int sz;
sz = SZ;
if (nbr < 0)
{ nbr = -nbr;
sgn = '-';
}
else
sgn = ' ';
str[--sz] = NUL;
while(sz)
{ str[--sz] = nbr % 10 + '0';
if ((nbr /= 10) == 0)
break;
}
if (sz)
str[--sz] = sgn;
while (sz > 0)
str[--sz] = ' ';
}
STATIC _itou(nbr, str)
int nbr;
char str[];
{ int lowbit;
int sz;
sz = SZ;
str[--sz] = NUL;
while (sz)
{ lowbit = nbr & 1;
nbr = (nbr >> 1) & 32767; /* divide by 2 */
str[--sz] = ((nbr % 5) << 1) + lowbit + '0';
if ((nbr /= 5) == 0)
break;
}
while (sz)
str[--sz] = ' ';
}
STATIC _itox(nbr, str)
int nbr;
char str[];
{ int digit, offset;
int sz;
sz = SZ;
str[--sz] = NUL;
while (sz)
{ digit = nbr & 15;
nbr = (nbr >> 4) & 4095;
if (digit < 10)
offset = '0';
else
offset = 'A'-10;
str[--sz] = digit + offset;
if (nbr == 0)
break;
}
while (sz)
str[--sz] = ' ';
}
/*
* _utoi convert unsigned decimal string to integer nbr
* returns field size, else ERR on error
*/
STATIC INT _utoi(decstr, nbr)
char *decstr;
int *nbr;
{ int d,t;
d = 0;
*nbr = 0;
while (isdigit(*decstr))
{ t = *nbr;
t = (10*t) + (*decstr++ - '0');
if (t >= 0 && *nbr < 0)
return ERR;
d++;
*nbr = t;
}
return d;
}
/*
* _printf do the actual formatting
*/
STATIC _printf(fp, nxtarg)
FILE *fp; /* may be &_pfstr */
int *nxtarg; /* -> format */
{ int i, width, prec, preclen, len;
char *ctl, *cx, c, right, str[SZ], *sptr, pad;
ctl = *nxtarg;
while (c = *ctl++)
{ if (c != '%')
{ _pfemit(c, fp);
continue;
}
if (*ctl == '%')
{ _pfemit(*ctl++, fp);
continue;
}
cx = ctl;
if (*cx == '-')
{ right = 0;
++cx;
}
else
right = 1;
if (*cx == '0')
{ pad = '0';
++cx;
}
else
pad = ' ';
if ((i = _utoi(cx, &width)) >= 0)
cx += i;
else
continue;
if (*cx == '.')
{ if ((preclen = _utoi(++cx, &prec)) >= 0)
cx += preclen;
else
continue;
}
else
preclen = 0;
sptr = str;
i = *--nxtarg;
switch (c = *cx++) {
case 'c':
str[0] = i;
str[1] = NUL;
break;
case 'd':
_itod(i, str);
break;
case 's':
sptr = i;
break;
case 'u':
_itou(i, str);
break;
case 'x':
_itox(i, str);
break;
default:
continue;
}
ctl=cx; /* accept conversion spec */
if (c != 's' && c != 'c')
while (*sptr == ' ')
++sptr;
len = -1;
while (sptr[++len])
; /* get length */
if ((c == 's' || c == 'c') && len > prec && preclen > 0)
len = prec;
if (right)
while (width-- - len > 0)
_pfemit(pad, fp);
while (len)
{ _pfemit(*sptr++, fp);
--len;
--width;
}
while (width-- - len > 0)
_pfemit(pad, fp);
}
}
/*
* printf(format [, arg, ...] )
* fprintf(fp, format [, arg, ...] )
* sprintf(string, format [, arg, ...] )
*
* as described by Kernighan and Ritchie
* support % [-] [0] [width] [. precision] (c|d|s|u|x)
* uses _narg() feature
*/
printf(argc)
int argc;
{ int i;
i = _narg();
_printf(stdout, &argc + i-1);
}
fprintf(argc)
int argc;
{ int i, *wp;
i = _narg();
wp = &argc + i-1;
_printf(*wp, wp-1);
}
sprintf(argc)
int argc;
{ int i, *wp;
i = _narg();
wp = &argc + i-1;
_pfstr = *wp;
_printf(&_pfstr, wp-1);
}
%%%%%%%%%% end of part 2 %%%%%%%%%%
uiucdcs!schrein
uiucdcs!schrein Mar 12 09:23:00 1983
(smallC V2 CP/M runtime support continued)
(part 4)
%%%%%%%%%% scc/scc/READ_ME %%%%%%%%%%
This directory contains a slightly modified version of the original
smallC V2 compiler obtained from 'net.sources'.
Changes are generally noted; the header file 'smallc.h' is arranged
so as to allow separate compilation of each source file.
[1234][123].c the smallc V2 compiler
misc.c a small amount of fudging the runtime routines
smallc.c static (!!) allocation of global variables
smallc.h header file, to allow separate compilation
c.h header file, to be used with C/80
Now for the bad news: this has not compiled itself -- but that has not
even been tried. Nor has it compiled on a UN*X system. It has been compiled
using Software Toolwork's C/80 system and Microsoft's MACRO-80.
The result was used to compile utilities and runtime support.
Major bugs (as far as they have been noted) are listed elsewhere.
A major fix is contained in 42.c -- the optimizer has been cleaned up.
Since 'calloc' is now part of the runtime support, work could start
on making it compile itself, while allocating tables dynamically.
The 'wc' utility noted the following:
0xD9E1 4735 572 222 11.c
0x7E6A 6309 780 272 12.c
0x500B 6855 765 314 13.c
0x5A14 5159 729 293 21.c
0x0B7A 7051 782 413 22.c
0x1D8C 6730 882 280 31.c
0x7B5F 4613 505 230 32.c
0x6363 4249 540 224 33.c
0xC33F 4710 806 322 41.c
0x81F7 6150 1037 430 42.c
0x2E43 1073 192 53 c.h
0x169C 1041 191 68 misc.c
0x982B 1429 249 72 smallc.c
0x84D0 10594 1702 530 smallc.h
%%%%%%%%%% scc/scc/c.h %%%%%%%%%%
/*
* c.h -- CP/M C/80 M80 header file
* ats 1/83
*/
#ifndef cpm
#define cpm /* signal CP/M system */
/*
* coding standards
*/
#define HALT exit() /* bad end */
#define EXIT exit() /* good end */
/*
* important constants
*/
#define TRUE 1 /* active truth values */
#define FALSE 0
#define EOF (-1) /* end of file getchar() */
#define NIL (-1) /* null pointer from alloc() */
#define NULL 0 /* no file from fopen() */
/*
* bug fixes and kludges
*/
#define AUTO auto /* locals under recursion */
#define FILE int /* fopen et alia */
#define getc getch /* re-route getc to work right */
#define getchar _getch /* re-route getchar to work right */
#define putc putch /* re-route putc to work right */
/*
* standard i/o support
*/
extern FILE * fin, * fout;
#define stdin fin /* standard input */
#define stdout fout /* standard output */
extern FILE * stderr; /* diagnostic output */
/*
* printf support
*/
#define printf prnt_1(),prnt_2
#define fprintf prnt_1(),prnt_3
#define sprintf prnt_1(),prnt_4
#endif /* will be included once */
%%%%%%%%%% scc/scc/misc.c %%%%%%%%%%
/*
* smallC C/80 runtime routines
* ats 1/83
*/
/*
* getarg
* as described by Hendrix
*
* fgetc
* alias for getch -- getchar() or getc()
*
* fgets
* fetch a string using getch()
*
* fputc
* alias for putch -- putchar() or putc()
*/
#include <c.h> /* C/80 system stuff */
getarg(n, str, maxsz, argc, argv)
int n; /* argument index */
char *str; /* argument text */
int maxsz; /* max length */
int argc,*argv; /* from main() */
{ register char *dptr, *sptr;
register int cnt;
if ((n > argc-1) | (n<0))
{ str[0] = NULL;
return EOF;
}
cnt=0;
dptr=str;
sptr=argv[n];
while (*dptr++ = *sptr++)
if (++cnt >= maxsz-1)
{ *dptr = NULL;
break;
}
return cnt;
}
fgetc(fd)
FILE *fd;
{
#asm
JMP getch##
fputc:: JMP putch##
#endasm
}
fgets(string, size, fd)
char *string;
int size;
int fd;
{ register int ch;
register char * cp;
cp = string;
while(--size && (ch = fgetc(fd)) != '\n' && ch != EOF)
*cp++ = ch;
*cp = '\0';
if (size && ch == EOF && cp == string)
return NULL;
return string;
}
%%%%%%%%%% scc/scc/smallc.c %%%%%%%%%%
/*
* Small-C Compiler Version 2.0
*
* Copyright 1982 J. E. Hendrix
* rev (adaption to cp/m, macro-80) ats 1/83
*/
/*
* major changes:
*
* SEPARATE
* eliminated; all parts compile separately
* all functions are declared in header file
*
* LINK
* PDS
* CMD_LINE
* TAB
* PHASE2
* OPTIMIZE
* COL
* UPPER
* SMALL_VM
* POLL
* eliminated; environment is MACRO-80, CP/M
*
* EXTERN
* define it once to allocate global variables
*
* C80 to enable C/80 specific code:
* abort alias for exit
* added relevant part of stdio.h here
*
* CCDDPDP[CI] are too long for preprocessor
* rename plunge[12] to plung[12] for MACRO-80
*/
/*
* major bugs:
*
* HASH can't define -- eliminates nextsym needed by STGOTO
*
* must `extern' external functions for MACRO-80
*
* very permissive about syntax like `int f*;'
*
* generates char [10] for char *[10] w/out warning
*
* doesn't notice lots of duplicate definitions
*
* very ungraceful about overrunning tables
* like switch table or literal pool
*
* complains about multiple externs to same name
*
* should not allow MACRO-80 reserved names as global
*/
/*
* major fixes:
*
* CCDDPDP[CI] are too long for preprocessor
* rename plunge[12] to plung[12] for MACRO-80
*
* maps \-escapes correctly now
*
* no longer creates undefined first label
* on pure data file
*/
#define EXTERN /* define globale variables */
#include "smallc.h"
%%%%%%%%%% scc/scc/smallc.h %%%%%%%%%%
/*
* smallc.h -- header file Small-C Compiler Version 2.0
*/
#define C80 /* Software Toolworks C/80 V2.0 */
#ifdef C80
#include <c.h> /* C/80 system stuff */
#define abort exit
#define ERR (-2) /* extra smallC stdio.h stuff */
#define YES 1
#define NO 0
#endif C80
#ifndef EXTERN
#define EXTERN extern /* globals allocated elsewhere */
#else
#undef EXTERN
#define EXTERN /* globals allocated here */
#endif EXTERN
/*
* remaining compile options
*/
#define NOCCARGC /* no calls to CCARGC */
/* #define HASH /* use hash search for macros */
/* #define DYNAMIC /* allocate memory dynamically */
/*
* machine dependent parameters
*/
#define BPW 2 /* bytes per word */
#define LBPW 1 /* log2(BPW) */
#define SBPC 1 /* stack bytes per character */
/*
* symbol table format
*/
#define IDENT 0
#define TYPE 1
#define CLASS 2
#define OFFSET 3
#define NAME 5
#define OFFSIZE (NAME - OFFSET)
#define SYMAVG 10
#define SYMMAX 14
/*
* symbol table parameters
*/
#define NUMLOCS 25
#define STARTLOC symtab
#define ENDLOC (symtab + NUMLOCS*SYMAVG)
#define NUMGLBS 180
#define STARTGLB ENDLOC
#define ENDGLB (ENDLOC + (NUMGLBS-1)*SYMMAX)
#define SYMTBSZ (NUMLOCS*SYMAVG + NUMGLBS*SYMMAX)
/*
* System wide name size (for symbols)
*/
#define NAMESIZE 9
#define NAMEMAX 8
/*
* possible entries for "IDENT"
*/
#define LABEL 0
#define VARIABLE 1
#define ARRAY 2
#define POINTER 3
#define FUNCTION 4
/*
* possible entries for "TYPE"
* low order 2 bits make type unique within length
* high order bits give length of object
*/
/* LABEL 0 */
#define CCHAR (1 << 2)
#define CINT (BPW << 2)
/*
* possible entries for "CLASS"
*/
/* LABEL 0 */
#define STATIC 1
#define AUTOMATIC 2
#define EXTERNAL 3
/*
* "switch" table
*/
#define SWSIZ (2*BPW)
#define SWTABSZ (25*SWSIZ)
/*
* "while" statement queue
*/
#define WQTABSZ 30
#define WQSIZ 3
#define WQMAX (wq + WQTABSZ-WQSIZ)
/*
* entry offsets in while queue
*/
#define WQSP 0
#define WQLOOP 1
#define WQEXIT 2
/*
* literal pool
*/
#define LITABSZ 700
#define LITMAX (LITABSZ-1)
/*
* input line
*/
#define LINEMAX 100
#define LINESIZE (LINEMAX+1)
/*
* output staging buffer size
*/
#define STAGESIZE 800
#define STAGELIMIT (STAGESIZE-1)
/*
* macro (define) pool
*/
#ifdef HASH
#define MACNBR 90
#define MACNSIZE (90 * (NAMESIZE+2))
#define MACNEND (macn + MACNSIZE)
#define MACQSIZE (90 * 5)
#else
#define MACQSIZE 950
#endif
#define MACMAX (MACQSIZE-1)
/*
* statement types
*/
#define STIF 1
#define STWHILE 2
#define STRETURN 3
#define STBREAK 4
#define STCONT 5
#define STASM 6
#define STEXPR 7
#define STDO 8 /* compile "do" logic */
#define STFOR 9 /* compile "for" logic */
#define STSWITCH 10 /* compile "switch/case/default" logic */
#define STCASE 11
#define STDEF 12
#define STGOTO 13 /* compile "goto" logic */
/*
* miscellaneous storage
* to be allocate once by defining EXTERN
*/
EXTERN char
optimize, /* optimize output of staging buffer */
alarm, /* audible alarm on errors? */
monitor, /* monitor function headers? */
pause, /* pause for operator on errors? */
#ifdef DYNAMIC
*stage, /* output staging buffer */
*symtab, /* symbol table */
*litq, /* literal pool */
#ifdef HASH
*macn, /* macro name buffer */
#endif
*macq, /* macro string buffer */
*pline, /* parsing buffer */
*mline, /* macro buffer */
#else
stage[STAGESIZE],
symtab[SYMTBSZ],
litq[LITABSZ],
#ifdef HASH
macn[MACNSIZE],
#endif
macq[MACQSIZE],
pline[LINESIZE],
mline[LINESIZE],
swq[SWTABSZ],
#endif
*line, /* points to pline or mline */
*lptr, /* ptr to either */
*glbptr, /* ptrs to next entries */
*locptr, /* ptr to next local symbol */
*stagenext, /* next addr in stage */
*stagelast, /* last addr in stage */
quote[2], /* literal string for '"' */
*cptr, /* work ptrs to any char buffer */
*cptr2,
*cptr3,
msname[NAMESIZE], /* macro symbol name array */
ssname[NAMESIZE]; /* static symbol name array */
EXTERN int
#ifdef STGOTO
nogo, /* > 0 disables goto statements */
noloc, /* > 0 disables block locals */
#endif
op[16], /* function addresses of binary operators */
op2[16], /* same for unsigned operators */
opindex, /* index to matched operator */
opsize, /* size of operator in bytes */
swactive, /* true inside a switch */
swdefault, /* default label #, else 0 */
*swnext, /* address of next entry */
*swend, /* address of last table entry */
#ifdef DYNAMIC
*wq, /* while queue */
#else
wq[WQTABSZ],
#endif
argcs, /* static argc */
*argvs, /* static argv */
*wqptr, /* ptr to next entry */
litptr, /* ptr to next entry */
macptr, /* macro buffer index */
#ifndef HASH
mack, /* variable k for findmac routine */
#endif
pptr, /* ptr to parsing buffer */
oper, /* address of binary operator function */
ch, /* current character of line being scanned */
nch, /* next character of line being scanned */
declared, /* # of local bytes declared, else -1 when done */
iflevel, /* #if... nest level */
skiplevel, /* level at which #if... skipping started */
nxtlab, /* next avail label # */
litlab, /* label # assigned to literal pool */
csp, /* compiler relative stk ptr */
argstk, /* function arg sp */
argtop,
ncmp, /* # open compound statements */
errflag, /* non-zero after 1st error in statement */
eof, /* set non-zero on final input eof */
input, /* fd # for input file */
input2, /* fd # for "include" file */
output, /* fd # for output file */
files, /* non-zero if file list specified on cmd line */
filearg, /* cur file arg index */
glbflag, /* non-zero if internal globals */
ctext, /* non-zero to intermix c-source */
ccode, /* non-zero while parsing c-code */
/* zero when passing assembly code */
listfp, /* file pointer to list device */
lastst, /* last executed statement type */
*iptr; /* work ptr to any int buffer */
/*
* global declarations for all functions
*/
/*
* 11.c
*/
int main(),
parse(), /* process all input text */
dumplits(), /* dump literal pool *l
dumpzero(), /* dump zeros for default initial values */
outside(), /* verify compile ends outside any function */
ask(), /* get runtime options */
openin(), /* open next input file */
setops(), /* initialize op arrays */
/*
* 12.c
*/
doinclude(), /* open include file */
dodeclare(), /* test for global declarations */
declglb(), /* declare a static variable */
declloc(), /* declare local variables */
initials(), /* initialize global objects */
init(), /* evaluate one initializer */
needsub(), /* get required array size */
newfunc(), /* begin a function */
doargs(), /* declare argument types */
/*
* 13.c
*/
statement(), /* statement parser */
ns(), /* semicolon enforcer */
compound(),
doif(),
doexpr(),
dowhile(),
#ifdef STDO
dodo(),
#endif
#ifdef STFOR
dofor(),
#endif
#ifdef STSWITCH
doswitch(),
docase(),
dodefault(),
#endif
#ifdef STGOTO
dogoto(),
dolabel(),
addlabel(),
#endif
doreturn(),
dobreak(),
docont(),
doasm(),
/*
* 21.c
*/
junk(),
endst(),
illname(),
multidef(),
needtoken(),
needlval(),
findglb(),
findloc(),
addsym(),
#ifndef HASH
nextsym(),
#endif
getint(), /* get int from addr */
putint(), /* put int to addr */
symname(), /* test if next input legal symbol name */
upper(), /* force alpha upper case */
getlabel(), /* next avail internal label */
postlabel(), /* post a label in the program */
printlabel(), /* print number as a label */
alpha(), /* test if char is alpha */
numeric(), /* test if char is numeric */
an(), /* test if character is alphanumeric */
addwhile(),
delwhile(),
readwhile(),
white(), /* test for stack/program overlap */
gch(),
bump(),
kill(),
inbyte(),
inline(),
/*
* 22.c
*/
ifline(),
keepch(),
preprocess(),
noiferr(),
addmac(),
putmac(),
#ifdef HASH
search(),
hash(),
#else
findmac(),
#endif
setstage(),
clearstage(),
outdec(),
ol(),
ot(),
outstr(),
outbyte(),
cout(),
sout(),
lout(),
xout(),
nl(),
tab(),
col(),
error(),
errout(),
streq(),
astreq(),
match(),
amatch(),
nextop(),
blanks(),
/*
* 31.c
*/
skim(), /* skim over terms adjoining || and && */
dropout(), /* early dropout from || && */
plunge(), /* plunge to a lower level */
plung1(), /* unary plunge to lower level */
plung2(), /* binary plunge to lower level */
calc(),
expression(),
heir1(),
heir3(),
heir4(),
heir5(),
heir6(),
heir7(),
heir8(),
heir9(),
heir10(),
heir11(),
heir12(),
/*
* 32.c
*/
heir13(),
heir14(),
primary(),
experr(),
callfunction(),
/*
* 33.c
*/
dbltest(), /* true if val1->int ptr or int[], val2 not ptr [] */
result(), /* determine type of binary op */
step(),
store(),
rvalue(),
test(),
constexpr(),
const(),
const2(),
constant(),
number(),
address(),
pstr(),
qstr(),
stowlit(),
litchar(), /* return current literal, bump lit ptr */
/*
* 41.c
*/
header(), /* print all assembler info first */
csect(), /* code segment */
dsect(), /* data segment */
trailer(), /* assembler stuff at end */
loadargc(), /* load # args before fct call */
entry(), /* decl entry */
external(), /* decl external reference */
indirect(), /* fetch obj indirect to primary reg */
getmem(), /* static mem to primary */
getloc(), /* symbol addr to primary */
putmem(), /* primary to static */
putstk(), /* put on stack type obj in primary */
move(), /* primary to secondary */
swap(), /* swap primary and secondary */
immed(), /* partial instr. to get immediate val to primary */
immed2(), /* partial instr to get immediate to secondary */
push(), /* primary to stack */
smartpop(), /* unpush or pop as required */
unpush(), /* replace push by swap */
pop(), /* pop stack to secondary */
swapstk(), /* swap primary and stack */
sw(), /* process switch */
call(), /* call subroutine */
ret(), /* return from subroutine */
callstk(), /* subroutine call to val on stack */
jump(), /* jump to internal label */
testjump(), /* test primary, jump if false */
zerojump(), /* test primary against zero, jump if false */
defstorage(), /* define storage */
point(), /* point to following object */
modstk(), /* modify staack pointer to value */
doublereg(), /* double primary reg */
/*
* 42.c
*/
/* operators */
add(), sub(), mult(), div(), mod(),
or(), xor(), and(), lneg(), asr(),
asl(), neg(), com(), inc(), dec(),
eq(), eq0(), ne(), ne0(), lt(),
lt0(), le(), le0(), gt(), gt0(),
ge(), ge0(), ult(), ult0(), ule(),
ugt(), uge(),
outjmp(), /* emit jump to internal label */
peephole(),
pp1(),
pp2(),
pp3();
%%%%%%%%%% scc/status %%%%%%%%%%
3-04-83 Bugs in code generation for pointers.
1) int *p; p = p | 1;
This should actually be illegal (you cannot use OR on a pointer),
but it is accepted, and the OR is with 2 (two) not 1 (one)!!
Due, of course, to the fact that arithmetic with pointers is
meant to be scaled...
2) int *p, *q; p-q
The value 'p-q', assuming that p points to a higher address than q,
cannot be negative. But since it is computed by first subtracting
and then arithmetically shifting, it is, sometimes...
This is a problem, if you try to compute free space between
the top of the program and the stack.
2-25-83 Bug in function calls.
int i, v[5];
f() { (i)(); LHLD H,i
call address in HL
(v[5])(); LXI H,v
LXI D,10
DAD D
call address in HL
(v+5)(); LXI H,v
LXI D,10
CALL CCDDGI
call address in HL
}
Code in the first case is expected (abuse of "int" as "int (*)()"),
code in the second and third case is reversed. In effect, function
pointers can only be used from int variables, not from array elements.
2-21-83 Status of smallC under CP/M.
I now have a runtime support to run smallC programs under CP/M.
This includes interfaces to all BDOS calls, and a very UNIX-compatible
I/O library (FILE * is with us...). Missing at this point is dynamic memory
allocation and seeking in files, both yet to be done.
I have not yet let the compiler compile itself, but I did note the bugs
(and some fixes) as indicated in the following list. I do, therefore,
not share Cain's enthusiasm in the February issue of DDJ.
--- BUG list ---
BUG: Compiler complains about multiple 'extern' definitions of the
same name.
IMPACT: Cosmetic only.
BUG: Compiler calls external() routine when 'extern' is seen.
IMPACT: Depends on the assembler used. If it does not like global symbols
to be defined in a file where they are also made external,
there will be problems.
BUG: Compiler transmits global names from source to assembler file.
IMPACT: Depends on assembler. If it has names (e.g., for registers)
predefined, or if it silently uses shorter names, there are problems.
BUG: Switch table and literal pool overruns cause compiler to crash
very ungracefully.
IMPACT: Error message (missing token) is quite misleading.
BUG: Maps escape sequences '\r' silently to 'r', and '\n' to 13,
i.e., does not know RETURN and maps NEWLINE as RETURN.
IMPACT: Incompatible with C definition, surprising in the case of '\n'.
FIX: Obvious in litchar().
BUG: If source file does not contain a function, a jump to an
undefined label is generated. This jump is in any case not
necessary.
IMPACT: Largely cosmetic, wastes space, however.
FIX: Eliminate global variables beglab and func1, eliminate
jump generation in header(), and label generation in newfunc().
BUG: An array of pointers to character is silently turned into an
array of character, initialization is 'adjusted' accordingly.
I.e.,
char *arr[] ={ "abc", "def", "ghi" };
will become an array of 12 characters.
IMPACT: Major, since completely wrong code is generated.
BUG: Function name cannot be initializer.
I.e.,
extern f(); int arr[] ={ f };
is flagged as not containing a constant.
IMPACT: Minor - was probably a desing choice.
BUG: Cannot take address of array name.
I.e.,
int arr[10]; ... &arr
is flagged.
IMPACT: Minor - the address operator in this case is wrong, but cc and
pcc were kind enough to forgive.
BUG: Cannot define HASH feature - eliminates nextsym() routine.
BUG: Very permissive (without reports) about syntax errors in
declarations, e.g.,
int f*;
IMPACT: Not minor - code stability becomes a problem!
BUG: Very permissive about duplicate and undefined names.
IMPACT: Major - possibly compounded by the assembler. E.g., MACRO-80
has an (unadvertised) feature to turn NUL and NULL into -1.
Multiply defined names are usually caught by the assembler.
BUG: The peephole() optimizer demolishes fetches from the stack,
as indicated by the code sequences below. It only works
correctly, if a fetch is not followed by a swap (XCHG;;)
but there are trivial examples, where this is not the case.
IMPACT: Major - invalidates code generation if OPTIMIZE is included.
(Note: not specifying the -o switch to smallC will not make
the problem go away, since this optimization is always performed.)
FIX: Involved. Basically, all 8 possible patterns from
[XCHG] LOAD [XCHG]
can be replaced by PUSH/POP and XCHG sequences individually.
I revised the optimizer for the case TAB (can only be 9, anyhow),
using a tree-structured pattern selection path and a simple
routine to compare pattern and staging buffer.
BAD PATTERNS: HL DE
--------------------------------
original x y
--------------------------------
after
LXI H,#
DAD SP
CALL CCGINT (sp+#) y
XCHG y (sp+#)
--------------------------------
after
POP D
PUSH D x (sp+0)
--------------------------------
after
POP B
POP D
PUSH D
PUSH B x (sp+2)
--------------------------------
after
POP H
PUSH H (sp+0) y
--------------------------------
after
POP B
POP H
PUSH H
PUSH B (sp+2) y
--------------------------------
%%%%%%%%%% scc/uty/READ_ME %%%%%%%%%%
This directory holds some utilities and exercising programs to be
compiled by smallC V2 and run under CP/M with the 'csh' environment.
bdos exercise BDOS calls from command line
bios exercise BIOS calls from command line
cat like UN*X cat, '-h' inserts file names prior to each file
cmp like UN*X cmp; conditionalized to also produce 'cp'
entab insert \t for multiple spaces
get unarchive the runtime library
hex dump anything -- including naked disk
wc like UN*X wc, '-v' computes sum of non-white-space
See and understand the sources for more information.
Verify numbers produced by 'wc' are as follows:
0xE460 7124 806 378 bdos.c
0x932E 2639 294 148 bios.c
0x45F0 1221 185 73 cat.c
0xF233 2853 435 172 cmp.c
0x7F2B 2493 403 139 entab.c
0x5ED5 1297 224 72 get.c
0x2D37 3016 516 167 hex.c
0x8A51 1534 255 95 wc.c
%%%%%%%%%% scc/uty/bdos.c %%%%%%%%%%
/*
* bdos.c -- exercise smallC CP/M BDOS calls
* ats 2/83
*/
extern printf(), atoi(), isascii(), isupper(), islower(),
isdigit(), isspace(), toupper(),
mkdrive(), mkfilename(), mkfcb(), mkwfcb(),
dumpbit(), dumpdpb(), dumpfcb(),
byte(), puthex(),
_exit(), _end,
abort(), _getchar(), _putchar(), _rgetchar(), _pputchar(),
_lputchar(), _dirio(), _giob(), _siob(), _puts(),
_gets(), _cstat(), _vers(), _reset(), _mount(),
_open(), _close(), _glob(), _nglob(), _delete(),
_read(), _write(), _create(), _rename(), _login(),
_drive(), _setbuf(), _bitmap(), _protect(), _romap(),
_chmod(), _diskmap(), _uid(), _rread(), _rwrite(),
_stat(), _record(), _umount(), _rzwrite();
extern char _fbout[];
#define stdout (_fbout) /* standard output */
#define LEN 128 /* buffer size */
#define NUL 0 /* null character */
#define ERR (-2) /* error return */
char *f1 = "\n",
*f2 = " = %x\n",
*f3 = "\7syntax: %s\n",
*f4 = " = %x\t";
main(argc,argv)
int argc;
int *argv; /* char ** */
{ char *cp;
int *ip;
int i;
char buf[LEN];
char fcb[36];
while (--argc)
{ i = atoi(*++argv);
if (0 <= i && i < 20) switch (i) { /* split switch */
case 0:
abort();
case 1:
printf("_getchar() ");
printf("%c\n", _getchar());
break;
case 2:
if (!--argc)
_exit();
cp = *++argv;
printf("_putchar(%c)\n", *cp);
_putchar(*cp);
printf(f1);
break;
case 3:
printf("_rgetchar() ");
printf("%c\n", _rgetchar());
break;
case 4:
if (!--argc)
_exit();
cp = *++argv;
printf("_pputchar(%c)\n", *cp);
_pputchar(*cp);
printf(f1);
break;
case 5:
if (!--argc)
_exit();
cp = *++argv;
printf("_lputchar(%c)\n", *cp);
_lputchar(*cp);
printf(f1);
break;
case 6:
if (!--argc)
_exit();
i = atoi(*++argv);
printf("_dirio(%d) ", i);
printf(f2, _dirio(i));
break;
case 7:
printf("_giob()");
printf(f2, _giob());
break;
case 8:
if (!--argc)
_exit();
i = atoi(*++argv);
printf("_siob(%x)", i);
_siob(i);
printf(f1);
break;
case 9:
if (!--argc)
_exit();
cp = *++argv;
printf("_puts(%s)\n", cp);
_puts(cp);
printf(f1);
break;
case 10:
printf("_gets() ");
buf[0] = LEN-3;
_gets(buf);
buf[2+buf[1]] = NUL;
printf("\n%d %d %s\n", buf[0], buf[1], buf+2);
break;
case 11:
printf("_cstat()");
printf(f2, _cstat());
break;
case 12:
printf("_vers()");
printf(f2, _vers());
break;
case 13:
printf("_reset()");
_reset();
printf(f1);
break;
case 14:
if (!--argc)
_exit();
i = mkdrive(*++argv);
if (i < 0 || i > 1)
printf(f3,*argv);
else
{ printf("_mount(%d)", i);
printf(f2, _mount(i));
}
break;
case 15:
if (!--argc)
_exit();
if (mkfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_open(FCB)");
printf(f2, i = _open(fcb));
dumpfcb(fcb);
}
break;
case 16:
printf("_close(FCB)");
printf(f2, i = _close(fcb));
break;
case 17:
newbuf(buf,0);
if (!--argc)
_exit();
if (mkwfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_glob(FCB)");
printf(f2, i = _glob(fcb));
dircode(i,buf);
}
break;
case 18:
_setbuf(buf);
printf("_nglob()");
printf(f2, i = _nglob());
dircode(i,buf);
break;
case 19:
if (!--argc)
_exit();
if (mkwfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_delete(FCB)");
printf(f2, i = _delete(fcb));
}
break;
}
else if (20 <= i && i < 38 || i == 40) switch(i) {
case 20:
if (!--argc)
_exit();
for (i = atoi(*++argv); i>0; i--)
{ newbuf(buf,0);
printf("_read(FCB)");
printf(f4, _read(fcb));
puthex(buf,buf,LEN,stdout);
}
dumpfcb(fcb);
break;
case 21:
if (!--argc)
_exit();
for (i = atoi(*++argv); i>0; i--)
{ newbuf(buf, fcb[32]);
printf("_write(FCB)");
printf(f4, _write(fcb));
puthex(buf,buf,LEN,stdout);
}
dumpfcb(fcb);
break;
case 22:
if (!--argc)
_exit();
if (mkfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_create(FCB)");
printf(f2, i = _create(fcb));
}
break;
case 23:
if (!--argc)
_exit();
if (mkfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else if (!--argc)
_exit();
else if (mkfilename(fcb+16,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_rename(FCB)");
printf(f2, i = _rename(fcb));
}
break;
case 24:
printf("_login()");
printf(f2, _login());
break;
case 25:
printf("_drive()");
printf(f2, _drive());
break;
case 26:
if (!--argc)
_exit();
if ((cp = atoi(*++argv)) < &_end)
printf("\7overlaps program\n");
else
{ printf("_setbuf(%x)", cp);
_setbuf(cp);
printf(f1);
}
break;
case 27:
printf("_bitmap()");
printf(f2, cp = _bitmap());
dumpbit(cp);
break;
case 28:
printf("_protect()");
_protect();
printf(f1);
break;
case 29:
printf("_romap()");
printf(f2, _romap());
break;
case 30:
if (!--argc)
_exit();
if (mkfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else if (!--argc)
_exit();
else
{ i = atoi(*++argv);
printf("_chmod(%d)",i);
if (i&1)
fcb[9] |= 128;
else
fcb[9] &= ~128;
if (i&2)
fcb[10] |= 128;
else
fcb[10] &= ~128;
printf(f2, i = _chmod(fcb));
dumpfcb(fcb);
}
break;
case 31:
printf("_diskmap()");
printf(f2, cp = _diskmap());
dumpdpb(cp);
break;
case 32:
if (!--argc)
_exit();
i = atoi(*++argv);
printf("_uid(%x)", i);
printf(f2, _uid(i));
break;
case 33:
if (!--argc)
_exit();
ip = fcb+33; /* FCB_RR */
*ip = atoi(*++argv);
fcb[35] = 0; /* FCB_OV */
newbuf(buf,0);
printf("_rread(FCB)");
printf(f4, _rread(fcb));
puthex(buf,buf,LEN,stdout);
dumpfcb(fcb);
break;
case 34:
if (!--argc)
_exit();
ip = fcb+33;
*ip = atoi(*++argv);
fcb[35] = 0;
newbuf(buf, *ip);
printf("_rwrite(FCB)");
printf(f4, _rwrite(fcb));
puthex(buf,buf,LEN,stdout);
dumpfcb(fcb);
break;
case 35:
if (!--argc)
_exit();
if (mkfcb(fcb,*++argv) == ERR)
printf(f3, *argv);
else
{ printf("_stat(FCB)");
_stat(fcb);
printf(f1);
dumpfcb(fcb);
}
break;
case 36:
printf("_record(FCB)");
_record(fcb);
printf(f1);
dumpfcb(fcb);
break;
case 37:
if (!--argc)
_exit();
i = atoi(*++argv);
printf("_umount(%x)", i);
printf(f2, _umount(i));
break;
case 40:
if (!--argc)
_exit();
ip = fcb+33;
*ip = atoi(*++argv);
fcb[35] = 0;
newbuf(buf, *ip);
printf("_rzwrite(FCB)");
printf(f4, _rzwrite(fcb));
puthex(buf,buf,LEN,stdout);
dumpfcb(fcb);
break;
}
else
printf("\7%d??\n",i);
}
}
newbuf(buf,v) /* clear and set buffer for DMA */
char buf[LEN]; /* buffer */
int v; /* value to initial */
{ int i;
for (i=0; i<LEN; i++)
buf[i] = v;
_setbuf(buf);
}
dircode(i,buf) /* display directory code fcb */
int i;
char *buf;
{
if (0 <= i && i < 4)
dumpfcb(buf+32*i);
}
%%%%%%%%%% scc/uty/bios.c %%%%%%%%%%
/*
* bios.c -- exercise smallC CP/M BIOS calls
* ats 2/83
*/
extern atoi(), printf(), _exit(), _end,
dumpbit(), dumpdpb(), dumpdhd(), puthex(),
_wboot(), _const(), _conin(), _conout(), _lstout(),
_punout(), _rdrin(), _home(), _seldsk(), _settrk(),
_setsec(), _setdma(), _sread(),
_swrite(),
_lstst(), _sectran();
extern char _fbout[];
#define stdout (_fbout) /* standard output */
#define LEN 128 /* buffer size */
char *f1 = "[done]\n",
*f2 = " = %x\n";
main(argc,argv)
int argc;
int *argv; /* char ** */
{ char *cp;
int i,j;
char buf[LEN];
while (--argc)
{ switch(i = atoi(*++argv)) {
default:
printf("%d??\n", i);
break;
case 3:
printf("_wboot()");
_wboot();
printf(f1);
break;
case 6:
printf("_const()");
printf(f2, _const());
break;
case 9:
printf("_conin() ");
printf("%c\n", _conin());
break;
case 12:
if (! --argc)
_exit();
cp = *++argv;
printf("_conout(%c)\n", *cp);
_conout(*cp);
printf(f1);
break;
case 15:
if (! --argc)
_exit();
cp = *++argv;
printf("_lstout(%c)\n", *cp);
_lstout(*cp);
printf(f1);
break;
case 18:
if (! --argc)
_exit();
cp = *++argv;
printf("_punout(%c)\n", *cp);
_punout(*cp);
printf(f1);
break;
case 21:
printf("_rdrin() ");
printf("%c\n", _rdrin());
break;
case 24:
printf("_home()");
_home();
printf(f1);
break;
case 27:
if (! --argc)
_exit();
i = atoi(*++argv);
if (! --argc)
_exit();
j = atoi(*++argv);
printf("_seldsk(%d,%d)",i,j);
printf(f2, cp = _seldsk(i,j));
if (cp)
dumpdhd(cp);
break;
case 30:
if (! --argc)
_exit();
i = atoi(*++argv);
printf("_settrk(%d)", i);
_settrk(i);
printf(f1);
break;
case 33:
if (! --argc)
_exit();
i = atoi(*++argv);
printf("_setsec(%d)", i);
_setsec(i);
printf(f1);
break;
case 36:
if (!--argc)
_exit();
if ((cp = atoi(*++argv)) < &_end)
printf("%04x overlaps program\n", cp);
else
{ printf("_setdma(%x)", cp);
_setdma(cp);
printf(f1);
}
break;
case 39:
_setdma(buf);
printf("_sread()");
printf(f2, _sread());
puthex(buf,buf,LEN,stdout);
break;
case 42:
if (! --argc)
_exit();
i = atoi(*++argv);
_setdma(buf);
printf("_swrite(%d)",i);
printf(f2, _swrite(i));
break;
case 45:
printf("_lstst()");
printf(f2,_lstst());
break;
case 48:
if (! --argc)
_exit();
i = atoi(*++argv);
if (! --argc)
_exit();
j = atoi(*++argv);
printf("_sectran(%d,%04x)", i,j);
printf(" = %d\n", _sectran(i,j));
break;
}
}
}
%%%%%%%%%% scc/uty/cat.c %%%%%%%%%%
/*
* cat.c - file concatenation
* ats 3/83
*/
#define FILE char
#define NULL 0
#define NUL 0
#define EOF (-1)
#define stdin (_fbin)
#define stdout (_fbout)
#define stderr (_fberr)
extern char _fbin[], _fbout[], _fberr[];
#define HALT exit()
#define EXIT exit()
extern exit();
extern fputs(), fopen(), fclose(), strcmp(), fgetc(), putchar();
char usage[] = "cat [-h] [from]...";
char hflag = 0;
main(argc,argv)
int argc;
int *argv; /* really char ** */
{ char *cp; /* for casting */
FILE *in;
while (--argc)
{ cp = *++argv;
if (*cp != '-' || *++cp == NUL)
break;
switch(*cp) {
case 'h':
++hflag;
break;
default:
fputs(usage, stderr);
HALT;
}
}
if (argc == 0)
docat(stdin, stdout, "stdin");
else
do
{ if (strcmp(*argv, "-") == 0)
docat(stdin, stdout, *argv);
else if ((in = fopen(*argv, "r")) == NULL)
{ fputs("cannot read ", stderr);
fputs(*argv, stderr);
}
else
{ docat(in, stdout, *argv);
fclose(in);
}
++argv;
} while (--argc);
}
docat(in, out, inn)
FILE *in, *out;
char * inn;
{ int ch;
if (hflag)
{ fputs("%%%%% ", stdout);
fputs(inn, stdout);
fputs(" %%%%%\n", stdout);
}
while ((ch = fgetc(in)) != EOF)
putchar(ch);
}
%%%%%%%%%% scc/uty/cmp.c %%%%%%%%%%
/*
* cmp.c - file copy and comparison
* rev (smallC) ats 3/83
*/
/*
* define...
*
* CP to make cp [-v] from to
*/
#define FILE char
#define NULL 0
#define stdin (_fbin)
#define stdout (_fbout)
#define stderr (_fberr)
extern char _fbin[], _fbout[], _fberr[];
#define HALT exit()
extern exit();
extern fputs(), freopen(), getw(), feof(), ferror(), fprintf();
#ifdef CP
char usage[] = "cp [-v] from to";
extern putw();
#else
char usage[] = "cmp file1 file2";
#endif
main(argc,argv)
int argc;
int *argv; /* really char ** */
{ char *cp; /* for casting */
#ifdef CP
int vflag;
vflag = 0;
#endif
while (--argc)
{ cp = *++argv;
if (*cp != '-')
break;
switch(*++cp) {
#ifdef CP
case 'v':
++vflag;
break;
#endif
default:
fputs(usage, stderr);
HALT;
}
}
if (argc != 2)
{ fputs(usage, stderr);
HALT;
}
#ifdef CP
if (freopen(argv[0], "r", stdin) == NULL)
{ fputs("cannot read ", stderr);
fputs(argv[0], stderr);
HALT;
}
else if (freopen(argv[1], "w", stdout) == NULL)
{ fputs("cannot write ", stderr);
fputs(argv[1], stderr);
HALT;
}
else
docopy(stdin, stdout, argv[0], argv[1]);
if (vflag)
#endif
if (freopen(argv[0], "r", stdin) == NULL)
{ fputs("cannot read ", stderr);
fputs(argv[0], stderr);
HALT;
}
else if (freopen(argv[1], "r", stdout) == NULL)
{ fputs("cannot read ", stderr);
fputs(argv[1], stderr);
HALT;
}
else
docmp(stdin, stdout, argv[0], argv[1]);
}
#ifdef CP
docopy(in, out, inn, outn)
FILE *in, *out;
char * inn, *outn;
{ int word;
int kb, b;
for (kb = b = 0; ; )
{ word = getw(in);
if (feof(in))
{ fprintf(stderr, "%d KB", kb);
if (b)
fprintf(stderr, " %d bytes", b);
fputs(" copied\n", stderr);
return;
}
if (ferror(in))
{ fputs("error reading ", stderr);
fputs(inn, stderr);
HALT;
}
putw(word, out);
if (feof(out) || ferror(out))
{ fputs("error writing ", stderr);
fputs(outn, stderr);
HALT;
}
if ((b += 2) >= 1024)
{ ++kb;
b = 0;
}
}
}
#endif
docmp(fa,fb,fna,fnb)
FILE *fa, *fb;
char *fna, *fnb;
{ int wa, wb;
int kb, b;
for(kb = b = 0; ; )
{ wa = getw(fa);
wb = getw(fb);
if (feof(fa))
if (feof(fb))
{ fprintf(stderr, "%d KB", kb);
if (b)
fprintf(stderr, " %d bytes", b);
fputs(" verified\n", stderr);
return;
}
else
{ fputs(fna, stderr);
fputs(" is short", stderr);
HALT;
}
else if (feof(fb))
{ fputs(fnb, stderr);
fputs(" is short", stderr);
HALT;
}
if (ferror(fa))
{ fputs("error reading ", stderr);
fputs(fna, stderr);
HALT;
}
if (ferror(fb))
{ fputs("error reading ", stderr);
fputs(fnb, stderr);
HALT;
}
if (wa != wb)
{ fprintf(stderr, "verify error at %d KB", kb);
if (b)
fprintf(stderr, " %d bytes", b);
HALT;
}
if ((b += 2) >= 1024)
{ ++kb;
b = 0;
}
}
}
%%%%%%%%%% scc/uty/entab.c %%%%%%%%%%
/*
* entab - turn blank series into tabs
* eliminate trailing white space
*
* will handle blank/tab mixtures
* will not turn single blank into tabs (intentionally)
* will not handle backspaces
* ats 9/82
* cpm ats 1/83
* cpm smallC ats 3/83
*/
#define FILE char
#define stdin (_fbin)
#define stdout (_fbout)
#define stderr (_fberr)
#define NULL 0
#define EOF (-1)
extern char _fbin[], _fbout[], _fberr[];
#define HALT exit()
#define EXIT exit()
extern exit();
extern fputs(), freopen(), getchar(), putchar();
#define TAB 8 /* columns per tab */
char usage[] = "entab [-b] [from [to]]";
main(argc, argv)
int argc;
int *argv; /* really char ** */
{ int tab; /* stored tabs */
int blank; /* additionally stored blanks */
int delay; /* ==1 if one blank caused tab stop */
int col; /* column modulo 8 */
int ch;
int bflag; /* if set: ^\t only */
int begin; /* if set: not yet non-white */
char *cp; /* for casting */
tab = blank = delay = col = bflag = 0;
while (--argc)
{ cp = *++argv;
if (*cp != '-')
break;
switch(*++cp) {
case 'b':
bflag++;
break;
default:
fputs(usage, stderr);
HALT;
}
}
switch (argc) {
case 0:
break; /* standard i/o */
case 1:
if (freopen(argv[0], "r", stdin) == NULL)
{ fputs("cannot read ", stderr);
fputs(argv[0], stderr);
HALT;
}
break;
case 2:
if (freopen(argv[0], "r", stdin) == NULL)
{ fputs("cannot read ", stderr);
fputs(argv[0], stderr);
HALT;
}
if (freopen(argv[1], "w", stdout) == NULL)
{ fputs("cannot write ", stderr);
fputs(argv[1], stderr);
HALT;
}
break;
default:
fputs(usage, stderr);
HALT;
}
for (begin = 1;;)
switch(ch = getchar()) {
case EOF:
EXIT;
case '\n':
putchar('\n');
col = blank = delay = tab = 0;
begin = 1;
continue;
case '\t':
if (! begin)
goto nope;
tab++;
if (delay)
tab++;
col = blank = delay = 0;
continue;
case ' ':
if (! begin)
goto nope;
if (delay)
{ delay = 0;
tab++;
blank++;
col++;
}
else if (blank == 0 && col+1 >= TAB)
{ delay++;
col = 0;
}
else
{ blank++;
if (++col >= TAB)
{ tab++;
col = blank = 0;
}
}
continue;
default:
if (begin && bflag)
begin = 0;
nope: if (delay)
putchar(' ');
else
{ while (tab--)
putchar('\t');
while (blank--)
putchar(' ');
}
tab = delay = blank = 0;
putchar(ch);
if (++col >= TAB)
col = 0;
continue;
}
}
%%%%%%%%%% scc/uty/get.c %%%%%%%%%%
/*
* get.c -- extract archived text
* ats 2/83
*
* used to extract from the libraries:
*
* 'flags' are one or more characters.
* Lines are copied from stdin to stdout,
* provided they start with a 'flags' character.
* The 'flags' character is not copied.
*/
#define FILE char
#define stdout _fbout
#define stderr _fberr
#define NULL 0
#define EOF (-1)
extern char _fbout[], _fberr[];
extern fputs(), abort(), getchar(), fputc(), exit();
char *usage = "usage: get flags";
#define OOPS fputs(usage, stderr), abort()
char flags['~'-' '+1];
isflag(ch) /* return TRUE if... */
int ch; /* ...this is a flag */
{
return ch >= ' ' && ch <= '~';
}
toflag(ch) /* return position if... */
char ch; /* ...this is a flag */
{
return ch - ' ';
}
main(argc,argv)
int argc;
int *argv; /* really char ** */
{ char *cp;
int ch;
while (--argc)
for (cp = *++argv; ch = *cp; cp++)
if (isflag(ch))
flags[toflag(ch)]++;
else
OOPS;
for (;;)
if ((ch = getchar()) == EOF)
return;
else if (isflag(ch) && flags[toflag(ch)])
doline(stdout);
else if (ch != '\n')
doline(NULL);
}
doline(out)
FILE *out;
{ int ch, eof;
do
{ if ((eof = ch = getchar()) == EOF)
ch = '\n';
if (out != NULL)
fputc(ch, out);
} while (ch != '\n');
if (eof == EOF)
exit();
}
%%%%%%%%%% scc/uty/hex.c %%%%%%%%%%
/*
* hex.c -- CP/M file dump program
* ats 3/83
*/
/*
* BUGS: offsets and addresses are handled in 16 bits,
* the displayed address thus will wrap around.
* Things are pretty much locked into
* CP/M sectors, tracks, and blocks as on the Osborne...
*/
extern _dopen(); /* enable raw disk i/o */
char usage[] = "hex [-b[+][w|s|k|b|t]#] [-l[+][w|s|k|b|t]#]";
#define stdin (_fbin)
#define stdout (_fbout)
#define stderr (_fberr)
extern char _fbin[], _fbout[], _fberr[];
#define HALT exit()
extern exit();
extern atoi(), fputs(), feof(), printf(), puthex(), getw(), fseek();
/*
* if the following defines are changed,
* 'getarg' should be reviewed for scale and meaning
*/
#define SMODE 8 /* fseek measured in sectors */
#define SLEN 128 /* sector length */
#define LSLEN 7 /* log2 of SLEN */
#define CPW 2 /* sizeof(int), really */
#define SPT 20 /* sectors/track (Osborne) */
main(argc,argv)
int argc;
int *argv;
{ char *cp; /* for casting */
int mode, first, offset;
int lflag, sectors, bytes;
mode =
first =
offset =
lflag =
sectors =
bytes = 0;
while (--argc)
{ cp = *++argv;
if (*cp != '-')
{ fputs(usage, stderr);
HALT;
}
switch (*++cp) {
default:
fputs(usage, stderr);
HALT;
case 'b':
getarg(cp, &mode, &first, &offset);
continue;
case 'l':
getarg(cp, &lflag, §ors, &bytes);
lflag = 1;
continue;
}
}
doseek(mode, first, &offset);
dohex(first, offset, lflag, sectors, bytes);
}
doseek(mode,first,offset)
int mode, first, *offset;
{
if (mode == 0)
first = first << LSLEN | *offset;
else
*offset = 0;
if (first && fseek(stdin, first, mode) == -1)
{ fputs("unable to position", stderr);
HALT;
}
}
dohex(first, offset, lflag, sectors, bytes)
int first; /* # first sector */
int offset; /* offset in sector */
int lflag; /* 0: to EOF */
int sectors; /* sectors to show */
int bytes; /* plus bytes to show */
{ char buf[SLEN];
int *wp;
int len;
for ( ; !lflag || sectors; --sectors)
{ wp = buf;
for (len = 0; len<SLEN; len += CPW)
{ *wp++ = getw(stdin);
if (feof(stdin))
break;
}
if (len)
puthex(first<<LSLEN | offset, buf, len, stdout);
if (feof(stdin))
return;
++first;
}
if (bytes)
{ wp = buf;
for (len = 0; len < bytes; len += CPW)
{ *wp++ = getw(stdin);
if (feof(stdin))
break;
}
if (len)
puthex(first<<7 | offset, buf, len, stdout);
}
}
getarg(cp, mode, sec, off)
char *cp;
int *mode, *sec, *off;
{ int m,s,o,plus;
if (*++cp == '+')
{ plus = 1;
++cp;
}
else
plus = 0;
m = s = o = 0;
switch (*cp) {
default:
o = atoi(cp);
break;
case 'w':
o = atoi(++cp) << 1;
break;
case 's':
m = SMODE;
s = atoi(++cp);
break;
case 'k':
m = SMODE;
s = atoi(++cp) << 3;
break;
case 'b':
m = SMODE;
s = atoi(++cp) << 4;
break;
case 't':
m = SMODE;
s = atoi(++cp) * SPT;
}
if (plus)
{ *off += o;
*sec += s + (*off >> LSLEN);
*off &= SLEN-1;
}
else
{ *mode = m;
*sec = s + (o >> LSLEN);
*off = o & SLEN-1;
}
}
%%%%%%%%%% scc/uty/wc.c %%%%%%%%%%
/*
* wc.c -- words, characters, lines in files
* ats 3/83
*/
#define FILE char
#define NULL 0
#define NUL 0
#define EOF (-1)
#define stdin (_fbin)
#define stdout (_fbout)
#define stderr (_fberr)
extern char _fbin[], _fbout[], _fberr[];
#define HALT exit()
#define EXIT exit()
extern exit();
extern fputs(), fopen(), fclose(), strcmp(), fgetc(), printf();
char usage[] = "wc [-v] [from]...";
char vflag = 0;
int cc = 0, wc = 0, lc = 0; /* grand total */
main(argc,argv)
int argc;
int *argv; /* really char ** */
{ char *cp; /* for casting */
FILE *in;
while (--argc)
{ cp = *++argv;
if (*cp != '-' || *++cp == NUL)
break;
switch(*cp) {
case 'v':
++vflag;
break;
default:
fputs(usage, stderr);
HALT;
}
}
if (argc == 0)
dowc(stdin, "stdin");
else
{ do
{ if (strcmp(*argv, "-") == 0)
dowc(stdin, "stdin");
else if ((in = fopen(*argv, "r")) == NULL)
{ fputs("cannot read ", stderr);
fputs(*argv, stderr);
}
else
{ dowc(in, *argv);
fclose(in);
}
++argv;
} while (--argc);
printf("\t%6d\t%6d\t%6d\ttotal", cc, wc, lc);
}
}
dowc(in, inn)
FILE *in;
char * inn;
{ int ch;
int c, w, l, sum, inword;
c = w = l = sum = inword = 0;
while ((ch = fgetc(in)) != EOF)
{ ++c;
switch(ch) {
case '\n':
++l;
case ' ':
case '\t':
if (inword)
inword = 0;
continue;
}
if (! inword)
{ ++inword;
++w;
}
sum += ch;
}
if (vflag)
printf("0x%4x", sum);
printf("\t%6d\t%6d\t%6d\t%s\n", c, w, l, inn);
cc += c;
wc += w;
lc += l;
}
%%%%%%%%%% end of part 4 and of smallC V2 CP/M runtime support %%%%%%%%%%