9base

revived minimalist port of Plan 9 userland to Unix
git clone git://git.suckless.org/9base
Log | Files | Refs | README | LICENSE

commit fbd05cbd195a12683bcc05dfb6d54955c18fef19
parent 877adeba5fbe1704ba41961099e452eb8e88ebd7
Author: Anselm R. Garbe <garbeam@wmii.de>
Date:   Tue, 24 Jan 2006 16:23:07 +0200

added dc to 9base as requested

Diffstat:
Makefile | 2+-
dc/Makefile | 6++++++
dc/dc.1 | 257+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
dc/dc.c | 2302+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 2566 insertions(+), 1 deletion(-)

diff --git a/Makefile b/Makefile @@ -3,7 +3,7 @@ include config.mk -SUBDIRS = lib9 yacc awk basename bc cat cleanname date echo grep mk \ +SUBDIRS = lib9 yacc awk basename bc dc cat cleanname date echo grep mk \ rc sed seq sleep sort tee test touch tr uniq all: diff --git a/dc/Makefile b/dc/Makefile @@ -0,0 +1,6 @@ +# dc - dc unix port from plan9 +# Depends on ../lib9 + +TARG = dc + +include ../std.mk diff --git a/dc/dc.1 b/dc/dc.1 @@ -0,0 +1,257 @@ +.TH DC 1 +.SH NAME +dc \- desk calculator +.SH SYNOPSIS +.B dc +[ +.I file +] +.SH DESCRIPTION +.I Dc +is an arbitrary precision desk calculator. +Ordinarily it operates on decimal integers, +but one may specify an input base, output base, +and a number of fractional digits to be maintained. +The overall structure of +.I dc +is +a stacking (reverse Polish) calculator. +If an argument is given, +input is taken from that file until its end, +then from the standard input. +The following constructions are recognized: +.TP +number +The value of the number is pushed on the stack. +A number is an unbroken string of the digits +.B 0-9A-F +or +.BR 0-9a-f . +A hexadecimal number beginning with a lower case +letter must be preceded by a zero to distinguish it +from the command associated with the letter. +It may be preceded by an underscore +.B _ +to input a +negative number. +Numbers may contain decimal points. +.TP +.L ++ - / * % ^ +Add +.LR + , +subtract +.LR - , +multiply +.LR * , +divide +.LR / , +remainder +.LR % , +or exponentiate +.L ^ +the top two values on the stack. +The two entries are popped off the stack; +the result is pushed on the stack in their place. +Any fractional part of an exponent is ignored. +.TP +.BI s x +.br +.ns +.TP +.BI S x +Pop the top of the stack and store into +a register named +.IR x , +where +.I x +may be any character. +Under operation +.B S +register +.I x +is treated as a stack and the value is pushed on it. +.TP +.BI l x +.br +.ns +.TP +.BI L x +Push the value in register +.I x +onto the stack. +The register +.I x +is not altered. +All registers start with zero value. +Under operation +.B L +register +.I x +is treated as a stack and its top value is popped onto the main stack. +.TP +.B d +Duplicate the +top value on the stack. +.TP +.B p +Print the top value on the stack. +The top value remains unchanged. +.B P +interprets the top of the stack as an +text +string, +removes it, and prints it. +.TP +.B f +Print the values on the stack. +.TP +.B q +.br +.ns +.TP +.B Q +Exit the program. +If executing a string, the recursion level is +popped by two. +Under operation +.B Q +the top value on the stack is popped and the string execution level is popped +by that value. +.TP +.B x +Treat the top element of the stack as a character string +and execute it as a string of +.I dc +commands. +.TP +.B X +Replace the number on the top of the stack with its scale factor. +.TP +.B "[ ... ]" +Put the bracketed +text +string on the top of the stack. +.TP +.PD0 +.BI < x +.TP +.BI > x +.TP +.BI = x +.PD +Pop and compare the +top two elements of the stack. +Register +.I x +is executed if they obey the stated +relation. +.TP +.B v +Replace the top element on the stack by its square root. +Any existing fractional part of the argument is taken +into account, but otherwise the scale factor is ignored. +.TP +.B ! +Interpret the rest of the line as a shell command. +.TP +.B c +Clear the stack. +.TP +.B i +The top value on the stack is popped and used as the +number base for further input. +.TP +.B I +Push the input base on the top of the stack. +.TP +.B o +The top value on the stack is popped and used as the +number base for further output. +In bases larger than 10, each `digit' prints as a group of decimal digits. +.TP +.B O +Push the output base on the top of the stack. +.TP +.B k +Pop the top of the stack, and use that value as +a non-negative scale factor: +the appropriate number of places +are printed on output, +and maintained during multiplication, division, and exponentiation. +The interaction of scale factor, +input base, and output base will be reasonable if all are changed +together. +.TP +.B z +Push the stack level onto the stack. +.TP +.B Z +Replace the number on the top of the stack with its length. +.TP +.B ? +A line of input is taken from the input source (usually the terminal) +and executed. +.TP +.B "; :" +Used by +.I bc +for array operations. +.PP +The scale factor set by +.B k +determines how many digits are kept to the right of +the decimal point. +If +.I s +is the current scale factor, +.I sa +is the scale of the first operand, +.I sb +is the scale of the second, +and +.I b +is the (integer) second operand, +results are truncated to the following scales. +.IP +.nf +\fL+\fR,\fL-\fR max(\fIsa,sb\fR) +\fL*\fR min(\fIsa\fR+\fIsb \fR, max\fR(\fIs,sa,sb\fR)) +\fL/\fI s +\fL%\fR so that dividend = divisor*quotient + remainder; remainder has sign of dividend +\fL^\fR min(\fIsa\fR\(mu|\fIb\fR|, max(\fIs,sa\fR)) +\fLv\fR max(\fIs,sa\fR) +.fi +.SH EXAMPLES +.LP +Print the first ten values of +.IR n ! +.IP +.EX +[la1+dsa*pla10>y]sy +0sa1 +lyx +.EE +.SH SOURCE +.B \*9/src/cmd/dc.c +.SH "SEE ALSO" +.IR bc (1), +.IR hoc (1) +.SH DIAGNOSTICS +.I x +.LR "is unimplemented" , +where +.I x +is an octal number: an internal error. +.br +`Out of headers' +for too many numbers being kept around. +.br +`Nesting depth' +for too many levels of nested execution. +.SH BUGS +When the input base exceeds 16, +there is no notation for digits greater than +.BR F . +.PP +Past its time. diff --git a/dc/dc.c b/dc/dc.c @@ -0,0 +1,2302 @@ +#include <u.h> +#include <libc.h> +#include <bio.h> + +typedef void* pointer; + +#define div dcdiv + +#define FATAL 0 +#define NFATAL 1 +#define BLK sizeof(Blk) +#define PTRSZ sizeof(int*) +#define HEADSZ 1024 +#define STKSZ 100 +#define RDSKSZ 100 +#define TBLSZ 256 +#define ARRAYST 221 +#define MAXIND 2048 +#define NL 1 +#define NG 2 +#define NE 3 +#define length(p) ((p)->wt-(p)->beg) +#define rewind(p) (p)->rd=(p)->beg +#undef create +#define create(p) (p)->rd = (p)->wt = (p)->beg +#define fsfile(p) (p)->rd = (p)->wt +#define truncate(p) (p)->wt = (p)->rd +#define sfeof(p) (((p)->rd==(p)->wt)?1:0) +#define sfbeg(p) (((p)->rd==(p)->beg)?1:0) +#define sungetc(p,c) *(--(p)->rd)=c +#define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++) +#define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;} +#define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd) +#define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd)) +#define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;} +#define sputc(p,c) {if((p)->wt==(p)->last)more(p);\ + *(p)->wt++ = c; } +#define salterc(p,c) {if((p)->rd==(p)->last)more(p);\ + *(p)->rd++ = c;\ + if((p)->rd>(p)->wt)(p)->wt=(p)->rd;} +#define sunputc(p) (*((p)->rd = --(p)->wt)) +#define sclobber(p) ((p)->rd = --(p)->wt) +#define zero(p) for(pp=(p)->beg;pp<(p)->last;)\ + *pp++='\0' +#define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} } +#define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}} +#define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; } +#define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;} +#define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);} +#define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);} +#define error(p) {Bprint(&bout,p); continue; } +#define errorrt(p) {Bprint(&bout,p); return(1); } +#define LASTFUN 026 + +typedef struct Blk Blk; +struct Blk +{ + char *rd; + char *wt; + char *beg; + char *last; +}; +typedef struct Sym Sym; +struct Sym +{ + Sym *next; + Blk *val; +}; +typedef struct Wblk Wblk; +struct Wblk +{ + Blk **rdw; + Blk **wtw; + Blk **begw; + Blk **lastw; +}; + +Biobuf *curfile, *fsave; +Blk *arg1, *arg2; +uchar savk; +int dbg; +int ifile; +Blk *scalptr, *basptr, *tenptr, *inbas; +Blk *sqtemp, *chptr, *strptr, *divxyz; +Blk *stack[STKSZ]; +Blk **stkptr,**stkbeg; +Blk **stkend; +Blk *hfree; +int stkerr; +int lastchar; +Blk *readstk[RDSKSZ]; +Blk **readptr; +Blk *rem; +int k; +Blk *irem; +int skd,skr; +int neg; +Sym symlst[TBLSZ]; +Sym *stable[TBLSZ]; +Sym *sptr, *sfree; +long rel; +long nbytes; +long all; +long headmor; +long obase; +int fw,fw1,ll; +void (*outdit)(Blk *p, int flg); +int logo; +int logten; +int count; +char *pp; +char *dummy; +long longest, maxsize, active; +int lall, lrel, lcopy, lmore, lbytes; +int inside; +Biobuf bin; +Biobuf bout; + +void main(int argc, char *argv[]); +void commnds(void); +Blk* readin(void); +Blk* div(Blk *ddivd, Blk *ddivr); +int dscale(void); +Blk* removr(Blk *p, int n); +Blk* dcsqrt(Blk *p); +void init(int argc, char *argv[]); +void onintr(void); +void pushp(Blk *p); +Blk* pop(void); +Blk* readin(void); +Blk* add0(Blk *p, int ct); +Blk* mult(Blk *p, Blk *q); +void chsign(Blk *p); +int readc(void); +void unreadc(char c); +void binop(char c); +void dcprint(Blk *hptr); +Blk* dcexp(Blk *base, Blk *ex); +Blk* getdec(Blk *p, int sc); +void tenot(Blk *p, int sc); +void oneot(Blk *p, int sc, char ch); +void hexot(Blk *p, int flg); +void bigot(Blk *p, int flg); +Blk* add(Blk *a1, Blk *a2); +int eqk(void); +Blk* removc(Blk *p, int n); +Blk* scalint(Blk *p); +Blk* scale(Blk *p, int n); +int subt(void); +int command(void); +int cond(char c); +void load(void); +#define log2 dclog2 +int log2(long n); +Blk* salloc(int size); +Blk* morehd(void); +Blk* copy(Blk *hptr, int size); +void sdump(char *s1, Blk *hptr); +void seekc(Blk *hptr, int n); +void salterwd(Blk *hptr, Blk *n); +void more(Blk *hptr); +void ospace(char *s); +void garbage(char *s); +void release(Blk *p); +Blk* dcgetwd(Blk *p); +void putwd(Blk *p, Blk *c); +Blk* lookwd(Blk *p); +char* nalloc(char *p, unsigned nbytes); +int getstk(void); + +/********debug only**/ +void +tpr(char *cp, Blk *bp) +{ + print("%s-> ", cp); + print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd, + bp->wt, bp->last); + for (cp = bp->beg; cp != bp->wt; cp++) { + print("%d", *cp); + if (cp != bp->wt-1) + print("/"); + } + print("\n"); +} +/************/ + +void +main(int argc, char *argv[]) +{ + Binit(&bin, 0, OREAD); + Binit(&bout, 1, OWRITE); + init(argc,argv); + commnds(); + exits(0); +} + +void +commnds(void) +{ + Blk *p, *q, **ptr, *s, *t; + long l; + Sym *sp; + int sk, sk1, sk2, c, sign, n, d; + + while(1) { + Bflush(&bout); + if(((c = readc())>='0' && c <= '9') || + (c>='A' && c <='F') || c == '.') { + unreadc(c); + p = readin(); + pushp(p); + continue; + } + switch(c) { + case ' ': + case '\n': + case -1: + continue; + case 'Y': + sdump("stk",*stkptr); + Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor); + Bprint(&bout, "nbytes %ld\n",nbytes); + Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest, + active, maxsize); + Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n", + lall, lrel, lcopy, lmore, lbytes); + lall = lrel = lcopy = lmore = lbytes = 0; + continue; + case '_': + p = readin(); + savk = sunputc(p); + chsign(p); + sputc(p,savk); + pushp(p); + continue; + case '-': + subt(); + continue; + case '+': + if(eqk() != 0) + continue; + binop('+'); + continue; + case '*': + arg1 = pop(); + EMPTY; + arg2 = pop(); + EMPTYR(arg1); + sk1 = sunputc(arg1); + sk2 = sunputc(arg2); + savk = sk1+sk2; + binop('*'); + p = pop(); + if(savk>k && savk>sk1 && savk>sk2) { + sclobber(p); + sk = sk1; + if(sk<sk2) + sk = sk2; + if(sk<k) + sk = k; + p = removc(p,savk-sk); + savk = sk; + sputc(p,savk); + } + pushp(p); + continue; + case '/': + casediv: + if(dscale() != 0) + continue; + binop('/'); + if(irem != 0) + release(irem); + release(rem); + continue; + case '%': + if(dscale() != 0) + continue; + binop('/'); + p = pop(); + release(p); + if(irem == 0) { + sputc(rem,skr+k); + pushp(rem); + continue; + } + p = add0(rem,skd-(skr+k)); + q = add(p,irem); + release(p); + release(irem); + sputc(q,skd); + pushp(q); + continue; + case 'v': + p = pop(); + EMPTY; + savk = sunputc(p); + if(length(p) == 0) { + sputc(p,savk); + pushp(p); + continue; + } + if(sbackc(p)<0) { + error("sqrt of neg number\n"); + } + if(k<savk) + n = savk; + else { + n = k*2-savk; + savk = k; + } + arg1 = add0(p,n); + arg2 = dcsqrt(arg1); + sputc(arg2,savk); + pushp(arg2); + continue; + + case '^': + neg = 0; + arg1 = pop(); + EMPTY; + if(sunputc(arg1) != 0) + error("exp not an integer\n"); + arg2 = pop(); + EMPTYR(arg1); + if(sfbeg(arg1) == 0 && sbackc(arg1)<0) { + neg++; + chsign(arg1); + } + if(length(arg1)>=3) { + error("exp too big\n"); + } + savk = sunputc(arg2); + p = dcexp(arg2,arg1); + release(arg2); + rewind(arg1); + c = sgetc(arg1); + if(c == -1) + c = 0; + else + if(sfeof(arg1) == 0) + c = sgetc(arg1)*100 + c; + d = c*savk; + release(arg1); + /* if(neg == 0) { removed to fix -exp bug*/ + if(k>=savk) + n = k; + else + n = savk; + if(n<d) { + q = removc(p,d-n); + sputc(q,n); + pushp(q); + } else { + sputc(p,d); + pushp(p); + } + /* } else { this is disaster for exp <-127 */ + /* sputc(p,d); */ + /* pushp(p); */ + /* } */ + if(neg == 0) + continue; + p = pop(); + q = salloc(2); + sputc(q,1); + sputc(q,0); + pushp(q); + pushp(p); + goto casediv; + case 'z': + p = salloc(2); + n = stkptr - stkbeg; + if(n >= 100) { + sputc(p,n/100); + n %= 100; + } + sputc(p,n); + sputc(p,0); + pushp(p); + continue; + case 'Z': + p = pop(); + EMPTY; + n = (length(p)-1)<<1; + fsfile(p); + backc(p); + if(sfbeg(p) == 0) { + if((c = sbackc(p))<0) { + n -= 2; + if(sfbeg(p) == 1) + n++; + else { + if((c = sbackc(p)) == 0) + n++; + else + if(c > 90) + n--; + } + } else + if(c < 10) + n--; + } + release(p); + q = salloc(1); + if(n >= 100) { + sputc(q,n%100); + n /= 100; + } + sputc(q,n); + sputc(q,0); + pushp(q); + continue; + case 'i': + p = pop(); + EMPTY; + p = scalint(p); + release(inbas); + inbas = p; + continue; + case 'I': + p = copy(inbas,length(inbas)+1); + sputc(p,0); + pushp(p); + continue; + case 'o': + p = pop(); + EMPTY; + p = scalint(p); + sign = 0; + n = length(p); + q = copy(p,n); + fsfile(q); + l = c = sbackc(q); + if(n != 1) { + if(c<0) { + sign = 1; + chsign(q); + n = length(q); + fsfile(q); + l = c = sbackc(q); + } + if(n != 1) { + while(sfbeg(q) == 0) + l = l*100+sbackc(q); + } + } + logo = log2(l); + obase = l; + release(basptr); + if(sign == 1) + obase = -l; + basptr = p; + outdit = bigot; + if(n == 1 && sign == 0) { + if(c <= 16) { + outdit = hexot; + fw = 1; + fw1 = 0; + ll = 70; + release(q); + continue; + } + } + n = 0; + if(sign == 1) + n++; + p = salloc(1); + sputc(p,-1); + t = add(p,q); + n += length(t)*2; + fsfile(t); + if(sbackc(t)>9) + n++; + release(t); + release(q); + release(p); + fw = n; + fw1 = n-1; + ll = 70; + if(fw>=ll) + continue; + ll = (70/fw)*fw; + continue; + case 'O': + p = copy(basptr,length(basptr)+1); + sputc(p,0); + pushp(p); + continue; + case '[': + n = 0; + p = salloc(0); + for(;;) { + if((c = readc()) == ']') { + if(n == 0) + break; + n--; + } + sputc(p,c); + if(c == '[') + n++; + } + pushp(p); + continue; + case 'k': + p = pop(); + EMPTY; + p = scalint(p); + if(length(p)>1) { + error("scale too big\n"); + } + rewind(p); + k = 0; + if(!sfeof(p)) + k = sgetc(p); + release(scalptr); + scalptr = p; + continue; + case 'K': + p = copy(scalptr,length(scalptr)+1); + sputc(p,0); + pushp(p); + continue; + case 'X': + p = pop(); + EMPTY; + fsfile(p); + n = sbackc(p); + release(p); + p = salloc(2); + sputc(p,n); + sputc(p,0); + pushp(p); + continue; + case 'Q': + p = pop(); + EMPTY; + if(length(p)>2) { + error("Q?\n"); + } + rewind(p); + if((c = sgetc(p))<0) { + error("neg Q\n"); + } + release(p); + while(c-- > 0) { + if(readptr == &readstk[0]) { + error("readstk?\n"); + } + if(*readptr != 0) + release(*readptr); + readptr--; + } + continue; + case 'q': + if(readptr <= &readstk[1]) + exits(0); + if(*readptr != 0) + release(*readptr); + readptr--; + if(*readptr != 0) + release(*readptr); + readptr--; + continue; + case 'f': + if(stkptr == &stack[0]) + Bprint(&bout,"empty stack\n"); + else { + for(ptr = stkptr; ptr > &stack[0];) { + dcprint(*ptr--); + } + } + continue; + case 'p': + if(stkptr == &stack[0]) + Bprint(&bout,"empty stack\n"); + else { + dcprint(*stkptr); + } + continue; + case 'P': + p = pop(); + EMPTY; + sputc(p,0); + Bprint(&bout,"%s",p->beg); + release(p); + continue; + case 'd': + if(stkptr == &stack[0]) { + Bprint(&bout,"empty stack\n"); + continue; + } + q = *stkptr; + n = length(q); + p = copy(*stkptr,n); + pushp(p); + continue; + case 'c': + while(stkerr == 0) { + p = pop(); + if(stkerr == 0) + release(p); + } + continue; + case 'S': + if(stkptr == &stack[0]) { + error("save: args\n"); + } + c = getstk() & 0377; + sptr = stable[c]; + sp = stable[c] = sfree; + sfree = sfree->next; + if(sfree == 0) + goto sempty; + sp->next = sptr; + p = pop(); + EMPTY; + if(c >= ARRAYST) { + q = copy(p,length(p)+PTRSZ); + for(n = 0;n < PTRSZ;n++) { + sputc(q,0); + } + release(p); + p = q; + } + sp->val = p; + continue; + sempty: + error("symbol table overflow\n"); + case 's': + if(stkptr == &stack[0]) { + error("save:args\n"); + } + c = getstk() & 0377; + sptr = stable[c]; + if(sptr != 0) { + p = sptr->val; + if(c >= ARRAYST) { + rewind(p); + while(sfeof(p) == 0) + release(dcgetwd(p)); + } + release(p); + } else { + sptr = stable[c] = sfree; + sfree = sfree->next; + if(sfree == 0) + goto sempty; + sptr->next = 0; + } + p = pop(); + sptr->val = p; + continue; + case 'l': + load(); + continue; + case 'L': + c = getstk() & 0377; + sptr = stable[c]; + if(sptr == 0) { + error("L?\n"); + } + stable[c] = sptr->next; + sptr->next = sfree; + sfree = sptr; + p = sptr->val; + if(c >= ARRAYST) { + rewind(p); + while(sfeof(p) == 0) { + q = dcgetwd(p); + if(q != 0) + release(q); + } + } + pushp(p); + continue; + case ':': + p = pop(); + EMPTY; + q = scalint(p); + fsfile(q); + c = 0; + if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) { + error("neg index\n"); + } + if(length(q)>2) { + error("index too big\n"); + } + if(sfbeg(q) == 0) + c = c*100+sbackc(q); + if(c >= MAXIND) { + error("index too big\n"); + } + release(q); + n = getstk() & 0377; + sptr = stable[n]; + if(sptr == 0) { + sptr = stable[n] = sfree; + sfree = sfree->next; + if(sfree == 0) + goto sempty; + sptr->next = 0; + p = salloc((c+PTRSZ)*PTRSZ); + zero(p); + } else { + p = sptr->val; + if(length(p)-PTRSZ < c*PTRSZ) { + q = copy(p,(c+PTRSZ)*PTRSZ); + release(p); + p = q; + } + } + seekc(p,c*PTRSZ); + q = lookwd(p); + if(q!=0) + release(q); + s = pop(); + EMPTY; + salterwd(p, s); + sptr->val = p; + continue; + case ';': + p = pop(); + EMPTY; + q = scalint(p); + fsfile(q); + c = 0; + if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) { + error("neg index\n"); + } + if(length(q)>2) { + error("index too big\n"); + } + if(sfbeg(q) == 0) + c = c*100+sbackc(q); + if(c >= MAXIND) { + error("index too big\n"); + } + release(q); + n = getstk() & 0377; + sptr = stable[n]; + if(sptr != 0){ + p = sptr->val; + if(length(p)-PTRSZ >= c*PTRSZ) { + seekc(p,c*PTRSZ); + s = dcgetwd(p); + if(s != 0) { + q = copy(s,length(s)); + pushp(q); + continue; + } + } + } + q = salloc(1); /*so uninitialized array elt prints as 0*/ + sputc(q, 0); + pushp(q); + continue; + case 'x': + execute: + p = pop(); + EMPTY; + if((readptr != &readstk[0]) && (*readptr != 0)) { + if((*readptr)->rd == (*readptr)->wt) + release(*readptr); + else { + if(readptr++ == &readstk[RDSKSZ]) { + error("nesting depth\n"); + } + } + } else + readptr++; + *readptr = p; + if(p != 0) + rewind(p); + else { + if((c = readc()) != '\n') + unreadc(c); + } + continue; + case '?': + if(++readptr == &readstk[RDSKSZ]) { + error("nesting depth\n"); + } + *readptr = 0; + fsave = curfile; + curfile = &bin; + while((c = readc()) == '!') + command(); + p = salloc(0); + sputc(p,c); + while((c = readc()) != '\n') { + sputc(p,c); + if(c == '\\') + sputc(p,readc()); + } + curfile = fsave; + *readptr = p; + continue; + case '!': + if(command() == 1) + goto execute; + continue; + case '<': + case '>': + case '=': + if(cond(c) == 1) + goto execute; + continue; + default: + Bprint(&bout,"%o is unimplemented\n",c); + } + } +} + +Blk* +div(Blk *ddivd, Blk *ddivr) +{ + int divsign, remsign, offset, divcarry, + carry, dig, magic, d, dd, under, first; + long c, td, cc; + Blk *ps, *px, *p, *divd, *divr; + + dig = 0; + under = 0; + divcarry = 0; + rem = 0; + p = salloc(0); + if(length(ddivr) == 0) { + pushp(ddivr); + Bprint(&bout,"divide by 0\n"); + return(p); + } + divsign = remsign = first = 0; + divr = ddivr; + fsfile(divr); + if(sbackc(divr) == -1) { + divr = copy(ddivr,length(ddivr)); + chsign(divr); + divsign = ~divsign; + } + divd = copy(ddivd,length(ddivd)); + fsfile(divd); + if(sfbeg(divd) == 0 && sbackc(divd) == -1) { + chsign(divd); + divsign = ~divsign; + remsign = ~remsign; + } + offset = length(divd) - length(divr); + if(offset < 0) + goto ddone; + seekc(p,offset+1); + sputc(divd,0); + magic = 0; + fsfile(divr); + c = sbackc(divr); + if(c < 10) + magic++; + c = c * 100 + (sfbeg(divr)?0:sbackc(divr)); + if(magic>0){ + c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2; + c /= 25; + } + while(offset >= 0) { + first++; + fsfile(divd); + td = sbackc(divd) * 100; + dd = sfbeg(divd)?0:sbackc(divd); + td = (td + dd) * 100; + dd = sfbeg(divd)?0:sbackc(divd); + td = td + dd; + cc = c; + if(offset == 0) + td++; + else + cc++; + if(magic != 0) + td = td<<3; + dig = td/cc; + under=0; + if(td%cc < 8 && dig > 0 && magic) { + dig--; + under=1; + } + rewind(divr); + rewind(divxyz); + carry = 0; + while(sfeof(divr) == 0) { + d = sgetc(divr)*dig+carry; + carry = d / 100; + salterc(divxyz,d%100); + } + salterc(divxyz,carry); + rewind(divxyz); + seekc(divd,offset); + carry = 0; + while(sfeof(divd) == 0) { + d = slookc(divd); + d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry; + carry = 0; + if(d < 0) { + d += 100; + carry = 1; + } + salterc(divd,d); + } + divcarry = carry; + backc(p); + salterc(p,dig); + backc(p); + fsfile(divd); + d=sbackc(divd); + if((d != 0) && /*!divcarry*/ (offset != 0)) { + d = sbackc(divd) + 100; + salterc(divd,d); + } + if(--offset >= 0) + divd->wt--; + } + if(under) { /* undershot last - adjust*/ + px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/ + chsign(px); + ps = add(px,divd); + fsfile(ps); + if(length(ps) > 0 && sbackc(ps) < 0) { + release(ps); /*only adjust in really undershot*/ + } else { + release(divd); + salterc(p, dig+1); + divd=ps; + } + } + if(divcarry != 0) { + salterc(p,dig-1); + salterc(divd,-1); + ps = add(divr,divd); + release(divd); + divd = ps; + } + + rewind(p); + divcarry = 0; + while(sfeof(p) == 0){ + d = slookc(p)+divcarry; + divcarry = 0; + if(d >= 100){ + d -= 100; + divcarry = 1; + } + salterc(p,d); + } + if(divcarry != 0)salterc(p,divcarry); + fsfile(p); + while(sfbeg(p) == 0) { + if(sbackc(p) != 0) + break; + truncate(p); + } + if(divsign < 0) + chsign(p); + fsfile(divd); + while(sfbeg(divd) == 0) { + if(sbackc(divd) != 0) + break; + truncate(divd); + } +ddone: + if(remsign<0) + chsign(divd); + if(divr != ddivr) + release(divr); + rem = divd; + return(p); +} + +int +dscale(void) +{ + Blk *dd, *dr, *r; + int c; + + dr = pop(); + EMPTYS; + dd = pop(); + EMPTYSR(dr); + fsfile(dd); + skd = sunputc(dd); + fsfile(dr); + skr = sunputc(dr); + if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) { + sputc(dr,skr); + pushp(dr); + Bprint(&bout,"divide by 0\n"); + return(1); + } + if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) { + sputc(dd,skd); + pushp(dd); + return(1); + } + c = k-skd+skr; + if(c < 0) + r = removr(dd,-c); + else { + r = add0(dd,c); + irem = 0; + } + arg1 = r; + arg2 = dr; + savk = k; + return(0); +} + +Blk* +removr(Blk *p, int n) +{ + int nn, neg; + Blk *q, *s, *r; + + fsfile(p); + neg = sbackc(p); + if(neg < 0) + chsign(p); + rewind(p); + nn = (n+1)/2; + q = salloc(nn); + while(n>1) { + sputc(q,sgetc(p)); + n -= 2; + } + r = salloc(2); + while(sfeof(p) == 0) + sputc(r,sgetc(p)); + release(p); + if(n == 1){ + s = div(r,tenptr); + release(r); + rewind(rem); + if(sfeof(rem) == 0) + sputc(q,sgetc(rem)); + release(rem); + if(neg < 0){ + chsign(s); + chsign(q); + irem = q; + return(s); + } + irem = q; + return(s); + } + if(neg < 0) { + chsign(r); + chsign(q); + irem = q; + return(r); + } + irem = q; + return(r); +} + +Blk* +dcsqrt(Blk *p) +{ + Blk *t, *r, *q, *s; + int c, n, nn; + + n = length(p); + fsfile(p); + c = sbackc(p); + if((n&1) != 1) + c = c*100+(sfbeg(p)?0:sbackc(p)); + n = (n+1)>>1; + r = salloc(n); + zero(r); + seekc(r,n); + nn=1; + while((c -= nn)>=0) + nn+=2; + c=(nn+1)>>1; + fsfile(r); + backc(r); + if(c>=100) { + c -= 100; + salterc(r,c); + sputc(r,1); + } else + salterc(r,c); + for(;;){ + q = div(p,r); + s = add(q,r); + release(q); + release(rem); + q = div(s,sqtemp); + release(s); + release(rem); + s = copy(r,length(r)); + chsign(s); + t = add(s,q); + release(s); + fsfile(t); + nn = sfbeg(t)?0:sbackc(t); + if(nn>=0) + break; + release(r); + release(t); + r = q; + } + release(t); + release(q); + release(p); + return(r); +} + +Blk* +dcexp(Blk *base, Blk *ex) +{ + Blk *r, *e, *p, *e1, *t, *cp; + int temp, c, n; + + r = salloc(1); + sputc(r,1); + p = copy(base,length(base)); + e = copy(ex,length(ex)); + fsfile(e); + if(sfbeg(e) != 0) + goto edone; + temp=0; + c = sbackc(e); + if(c<0) { + temp++; + chsign(e); + } + while(length(e) != 0) { + e1=div(e,sqtemp); + release(e); + e = e1; + n = length(rem); + release(rem); + if(n != 0) { + e1=mult(p,r); + release(r); + r = e1; + } + t = copy(p,length(p)); + cp = mult(p,t); + release(p); + release(t); + p = cp; + } + if(temp != 0) { + if((c = length(base)) == 0) { + goto edone; + } + if(c>1) + create(r); + else { + rewind(base); + if((c = sgetc(base))<=1) { + create(r); + sputc(r,c); + } else + create(r); + } + } +edone: + release(p); + release(e); + return(r); +} + +void +init(int argc, char *argv[]) +{ + Sym *sp; + Dir *d; + + ARGBEGIN { + default: + dbg = 1; + break; + } ARGEND + ifile = 1; + curfile = &bin; + if(*argv){ + d = dirstat(*argv); + if(d == nil) { + fprint(2, "dc: can't open file %s\n", *argv); + exits("open"); + } + if(d->mode & DMDIR) { + fprint(2, "dc: file %s is a directory\n", *argv); + exits("open"); + } + free(d); + if((curfile = Bopen(*argv, OREAD)) == 0) { + fprint(2,"dc: can't open file %s\n", *argv); + exits("open"); + } + } +/* dummy = malloc(0); *//* prepare for garbage-collection */ + scalptr = salloc(1); + sputc(scalptr,0); + basptr = salloc(1); + sputc(basptr,10); + obase=10; + logten=log2(10L); + ll=70; + fw=1; + fw1=0; + tenptr = salloc(1); + sputc(tenptr,10); + obase=10; + inbas = salloc(1); + sputc(inbas,10); + sqtemp = salloc(1); + sputc(sqtemp,2); + chptr = salloc(0); + strptr = salloc(0); + divxyz = salloc(0); + stkbeg = stkptr = &stack[0]; + stkend = &stack[STKSZ]; + stkerr = 0; + readptr = &readstk[0]; + k=0; + sp = sptr = &symlst[0]; + while(sptr < &symlst[TBLSZ]) { + sptr->next = ++sp; + sptr++; + } + sptr->next=0; + sfree = &symlst[0]; +} + +void +pushp(Blk *p) +{ + if(stkptr == stkend) { + Bprint(&bout,"out of stack space\n"); + return; + } + stkerr=0; + *++stkptr = p; + return; +} + +Blk* +pop(void) +{ + if(stkptr == stack) { + stkerr=1; + return(0); + } + return(*stkptr--); +} + +Blk* +readin(void) +{ + Blk *p, *q; + int dp, dpct, c; + + dp = dpct=0; + p = salloc(0); + for(;;){ + c = readc(); + switch(c) { + case '.': + if(dp != 0) + goto gotnum; + dp++; + continue; + case '\\': + readc(); + continue; + default: + if(c >= 'A' && c <= 'F') + c = c - 'A' + 10; + else + if(c >= '0' && c <= '9') + c -= '0'; + else + goto gotnum; + if(dp != 0) { + if(dpct >= 99) + continue; + dpct++; + } + create(chptr); + if(c != 0) + sputc(chptr,c); + q = mult(p,inbas); + release(p); + p = add(chptr,q); + release(q); + } + } +gotnum: + unreadc(c); + if(dp == 0) { + sputc(p,0); + return(p); + } else { + q = scale(p,dpct); + return(q); + } +} + +/* + * returns pointer to struct with ct 0's & p + */ +Blk* +add0(Blk *p, int ct) +{ + Blk *q, *t; + + q = salloc(length(p)+(ct+1)/2); + while(ct>1) { + sputc(q,0); + ct -= 2; + } + rewind(p); + while(sfeof(p) == 0) { + sputc(q,sgetc(p)); + } + release(p); + if(ct == 1) { + t = mult(tenptr,q); + release(q); + return(t); + } + return(q); +} + +Blk* +mult(Blk *p, Blk *q) +{ + Blk *mp, *mq, *mr; + int sign, offset, carry; + int cq, cp, mt, mcr; + + offset = sign = 0; + fsfile(p); + mp = p; + if(sfbeg(p) == 0) { + if(sbackc(p)<0) { + mp = copy(p,length(p)); + chsign(mp); + sign = ~sign; + } + } + fsfile(q); + mq = q; + if(sfbeg(q) == 0){ + if(sbackc(q)<0) { + mq = copy(q,length(q)); + chsign(mq); + sign = ~sign; + } + } + mr = salloc(length(mp)+length(mq)); + zero(mr); + rewind(mq); + while(sfeof(mq) == 0) { + cq = sgetc(mq); + rewind(mp); + rewind(mr); + mr->rd += offset; + carry=0; + while(sfeof(mp) == 0) { + cp = sgetc(mp); + mcr = sfeof(mr)?0:slookc(mr); + mt = cp*cq + carry + mcr; + carry = mt/100; + salterc(mr,mt%100); + } + offset++; + if(carry != 0) { + mcr = sfeof(mr)?0:slookc(mr); + salterc(mr,mcr+carry); + } + } + if(sign < 0) { + chsign(mr); + } + if(mp != p) + release(mp); + if(mq != q) + release(mq); + return(mr); +} + +void +chsign(Blk *p) +{ + int carry; + char ct; + + carry=0; + rewind(p); + while(sfeof(p) == 0) { + ct=100-slookc(p)-carry; + carry=1; + if(ct>=100) { + ct -= 100; + carry=0; + } + salterc(p,ct); + } + if(carry != 0) { + sputc(p,-1); + fsfile(p); + backc(p); + ct = sbackc(p); + if(ct == 99 /*&& !sfbeg(p)*/) { + truncate(p); + sputc(p,-1); + } + } else{ + fsfile(p); + ct = sbackc(p); + if(ct == 0) + truncate(p); + } + return; +} + +int +readc(void) +{ +loop: + if((readptr != &readstk[0]) && (*readptr != 0)) { + if(sfeof(*readptr) == 0) + return(lastchar = sgetc(*readptr)); + release(*readptr); + readptr--; + goto loop; + } + lastchar = Bgetc(curfile); + if(lastchar != -1) + return(lastchar); + if(readptr != &readptr[0]) { + readptr--; + if(*readptr == 0) + curfile = &bin; + goto loop; + } + if(curfile != &bin) { + Bterm(curfile); + curfile = &bin; + goto loop; + } + exits(0); + return 0; /* shut up ken */ +} + +void +unreadc(char c) +{ + + if((readptr != &readstk[0]) && (*readptr != 0)) { + sungetc(*readptr,c); + } else + Bungetc(curfile); + return; +} + +void +binop(char c) +{ + Blk *r; + + r = 0; + switch(c) { + case '+': + r = add(arg1,arg2); + break; + case '*': + r = mult(arg1,arg2); + break; + case '/': + r = div(arg1,arg2); + break; + } + release(arg1); + release(arg2); + sputc(r,savk); + pushp(r); +} + +void +dcprint(Blk *hptr) +{ + Blk *p, *q, *dec; + int dig, dout, ct, sc; + + rewind(hptr); + while(sfeof(hptr) == 0) { + if(sgetc(hptr)>99) { + rewind(hptr); + while(sfeof(hptr) == 0) { + Bprint(&bout,"%c",sgetc(hptr)); + } + Bprint(&bout,"\n"); + return; + } + } + fsfile(hptr); + sc = sbackc(hptr); + if(sfbeg(hptr) != 0) { + Bprint(&bout,"0\n"); + return; + } + count = ll; + p = copy(hptr,length(hptr)); + sclobber(p); + fsfile(p); + if(sbackc(p)<0) { + chsign(p); + OUTC('-'); + } + if((obase == 0) || (obase == -1)) { + oneot(p,sc,'d'); + return; + } + if(obase == 1) { + oneot(p,sc,'1'); + return; + } + if(obase == 10) { + tenot(p,sc); + return; + } + /* sleazy hack to scale top of stack - divide by 1 */ + pushp(p); + sputc(p, sc); + p=salloc(0); + create(p); + sputc(p, 1); + sputc(p, 0); + pushp(p); + if(dscale() != 0) + return; + p = div(arg1, arg2); + release(arg1); + release(arg2); + sc = savk; + + create(strptr); + dig = logten*sc; + dout = ((dig/10) + dig) / logo; + dec = getdec(p,sc); + p = removc(p,sc); + while(length(p) != 0) { + q = div(p,basptr); + release(p); + p = q; + (*outdit)(rem,0); + } + release(p); + fsfile(strptr); + while(sfbeg(strptr) == 0) + OUTC(sbackc(strptr)); + if(sc == 0) { + release(dec); + Bprint(&bout,"\n"); + return; + } + create(strptr); + OUTC('.'); + ct=0; + do { + q = mult(basptr,dec); + release(dec); + dec = getdec(q,sc); + p = removc(q,sc); + (*outdit)(p,1); + } while(++ct < dout); + release(dec); + rewind(strptr); + while(sfeof(strptr) == 0) + OUTC(sgetc(strptr)); + Bprint(&bout,"\n"); +} + +Blk* +getdec(Blk *p, int sc) +{ + int cc; + Blk *q, *t, *s; + + rewind(p); + if(length(p)*2 < sc) { + q = copy(p,length(p)); + return(q); + } + q = salloc(length(p)); + while(sc >= 1) { + sputc(q,sgetc(p)); + sc -= 2; + } + if(sc != 0) { + t = mult(q,tenptr); + s = salloc(cc = length(q)); + release(q); + rewind(t); + while(cc-- > 0) + sputc(s,sgetc(t)); + sputc(s,0); + release(t); + t = div(s,tenptr); + release(s); + release(rem); + return(t); + } + return(q); +} + +void +tenot(Blk *p, int sc) +{ + int c, f; + + fsfile(p); + f=0; + while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) { + c = sbackc(p); + if((c<10) && (f == 1)) + Bprint(&bout,"0%d",c); + else + Bprint(&bout,"%d",c); + f=1; + TEST2; + } + if(sc == 0) { + Bprint(&bout,"\n"); + release(p); + return; + } + if((p->rd-p->beg)*2 > sc) { + c = sbackc(p); + Bprint(&bout,"%d.",c/10); + TEST2; + OUTC(c%10 +'0'); + sc--; + } else { + OUTC('.'); + } + while(sc>(p->rd-p->beg)*2) { + OUTC('0'); + sc--; + } + while(sc > 1) { + c = sbackc(p); + if(c<10) + Bprint(&bout,"0%d",c); + else + Bprint(&bout,"%d",c); + sc -= 2; + TEST2; + } + if(sc == 1) { + OUTC(sbackc(p)/10 +'0'); + } + Bprint(&bout,"\n"); + release(p); +} + +void +oneot(Blk *p, int sc, char ch) +{ + Blk *q; + + q = removc(p,sc); + create(strptr); + sputc(strptr,-1); + while(length(q)>0) { + p = add(strptr,q); + release(q); + q = p; + OUTC(ch); + } + release(q); + Bprint(&bout,"\n"); +} + +void +hexot(Blk *p, int flg) +{ + int c; + + USED(flg); + rewind(p); + if(sfeof(p) != 0) { + sputc(strptr,'0'); + release(p); + return; + } + c = sgetc(p); + release(p); + if(c >= 16) { + Bprint(&bout,"hex digit > 16"); + return; + } + sputc(strptr,c<10?c+'0':c-10+'a'); +} + +void +bigot(Blk *p, int flg) +{ + Blk *t, *q; + int neg, l; + + if(flg == 1) { + t = salloc(0); + l = 0; + } else { + t = strptr; + l = length(strptr)+fw-1; + } + neg=0; + if(length(p) != 0) { + fsfile(p); + if(sbackc(p)<0) { + neg=1; + chsign(p); + } + while(length(p) != 0) { + q = div(p,tenptr); + release(p); + p = q; + rewind(rem); + sputc(t,sfeof(rem)?'0':sgetc(rem)+'0'); + release(rem); + } + } + release(p); + if(flg == 1) { + l = fw1-length(t); + if(neg != 0) { + l--; + sputc(strptr,'-'); + } + fsfile(t); + while(l-- > 0) + sputc(strptr,'0'); + while(sfbeg(t) == 0) + sputc(strptr,sbackc(t)); + release(t); + } else { + l -= length(strptr); + while(l-- > 0) + sputc(strptr,'0'); + if(neg != 0) { + sclobber(strptr); + sputc(strptr,'-'); + } + } + sputc(strptr,' '); +} + +Blk* +add(Blk *a1, Blk *a2) +{ + Blk *p; + int carry, n, size, c, n1, n2; + + size = length(a1)>length(a2)?length(a1):length(a2); + p = salloc(size); + rewind(a1); + rewind(a2); + carry=0; + while(--size >= 0) { + n1 = sfeof(a1)?0:sgetc(a1); + n2 = sfeof(a2)?0:sgetc(a2); + n = n1 + n2 + carry; + if(n>=100) { + carry=1; + n -= 100; + } else + if(n<0) { + carry = -1; + n += 100; + } else + carry = 0; + sputc(p,n); + } + if(carry != 0) + sputc(p,carry); + fsfile(p); + if(sfbeg(p) == 0) { + c = 0; + while(sfbeg(p) == 0 && (c = sbackc(p)) == 0) + ; + if(c != 0) + salterc(p,c); + truncate(p); + } + fsfile(p); + if(sfbeg(p) == 0 && sbackc(p) == -1) { + while((c = sbackc(p)) == 99) { + if(c == -1) + break; + } + skipc(p); + salterc(p,-1); + truncate(p); + } + return(p); +} + +int +eqk(void) +{ + Blk *p, *q; + int skp, skq; + + p = pop(); + EMPTYS; + q = pop(); + EMPTYSR(p); + skp = sunputc(p); + skq = sunputc(q); + if(skp == skq) { + arg1=p; + arg2=q; + savk = skp; + return(0); + } + if(skp < skq) { + savk = skq; + p = add0(p,skq-skp); + } else { + savk = skp; + q = add0(q,skp-skq); + } + arg1=p; + arg2=q; + return(0); +} + +Blk* +removc(Blk *p, int n) +{ + Blk *q, *r; + + rewind(p); + while(n>1) { + skipc(p); + n -= 2; + } + q = salloc(2); + while(sfeof(p) == 0) + sputc(q,sgetc(p)); + if(n == 1) { + r = div(q,tenptr); + release(q); + release(rem); + q = r; + } + release(p); + return(q); +} + +Blk* +scalint(Blk *p) +{ + int n; + + n = sunputc(p); + p = removc(p,n); + return(p); +} + +Blk* +scale(Blk *p, int n) +{ + Blk *q, *s, *t; + + t = add0(p,n); + q = salloc(1); + sputc(q,n); + s = dcexp(inbas,q); + release(q); + q = div(t,s); + release(t); + release(s); + release(rem); + sputc(q,n); + return(q); +} + +int +subt(void) +{ + arg1=pop(); + EMPTYS; + savk = sunputc(arg1); + chsign(arg1); + sputc(arg1,savk); + pushp(arg1); + if(eqk() != 0) + return(1); + binop('+'); + return(0); +} + +int +command(void) +{ + char line[100], *sl; + int pid, p, c; + + switch(c = readc()) { + case '<': + return(cond(NL)); + case '>': + return(cond(NG)); + case '=': + return(cond(NE)); + default: + sl = line; + *sl++ = c; + while((c = readc()) != '\n') + *sl++ = c; + *sl = 0; + if((pid = fork()) == 0) { + execl("/bin/rc","rc","-c",line,0); + exits("shell"); + } + for(;;) { + if((p = waitpid()) < 0) + break; + if(p== pid) + break; + } + Bprint(&bout,"!\n"); + return(0); + } +} + +int +cond(char c) +{ + Blk *p; + int cc; + + if(subt() != 0) + return(1); + p = pop(); + sclobber(p); + if(length(p) == 0) { + release(p); + if(c == '<' || c == '>' || c == NE) { + getstk(); + return(0); + } + load(); + return(1); + } + if(c == '='){ + release(p); + getstk(); + return(0); + } + if(c == NE) { + release(p); + load(); + return(1); + } + fsfile(p); + cc = sbackc(p); + release(p); + if((cc<0 && (c == '<' || c == NG)) || + (cc >0) && (c == '>' || c == NL)) { + getstk(); + return(0); + } + load(); + return(1); +} + +void +load(void) +{ + int c; + Blk *p, *q, *t, *s; + + c = getstk() & 0377; + sptr = stable[c]; + if(sptr != 0) { + p = sptr->val; + if(c >= ARRAYST) { + q = salloc(length(p)); + rewind(p); + while(sfeof(p) == 0) { + s = dcgetwd(p); + if(s == 0) { + putwd(q, (Blk*)0); + } else { + t = copy(s,length(s)); + putwd(q,t); + } + } + pushp(q); + } else { + q = copy(p,length(p)); + pushp(q); + } + } else { + q = salloc(1); + if(c <= LASTFUN) { + Bprint(&bout,"function %c undefined\n",c+'a'-1); + sputc(q,'c'); + sputc(q,'0'); + sputc(q,' '); + sputc(q,'1'); + sputc(q,'Q'); + } + else + sputc(q,0); + pushp(q); + } +} + +int +log2(long n) +{ + int i; + + if(n == 0) + return(0); + i=31; + if(n<0) + return(i); + while((n= n<<1) >0) + i--; + return i-1; +} + +Blk* +salloc(int size) +{ + Blk *hdr; + char *ptr; + + all++; + lall++; + if(all - rel > active) + active = all - rel; + nbytes += size; + lbytes += size; + if(nbytes >maxsize) + maxsize = nbytes; + if(size > longest) + longest = size; + ptr = malloc((unsigned)size); + if(ptr == 0){ + garbage("salloc"); + if((ptr = malloc((unsigned)size)) == 0) + ospace("salloc"); + } + if((hdr = hfree) == 0) + hdr = morehd(); + hfree = (Blk *)hdr->rd; + hdr->rd = hdr->wt = hdr->beg = ptr; + hdr->last = ptr+size; + return(hdr); +} + +Blk* +morehd(void) +{ + Blk *h, *kk; + + headmor++; + nbytes += HEADSZ; + hfree = h = (Blk *)malloc(HEADSZ); + if(hfree == 0) { + garbage("morehd"); + if((hfree = h = (Blk*)malloc(HEADSZ)) == 0) + ospace("headers"); + } + kk = h; + while(h<hfree+(HEADSZ/BLK)) + (h++)->rd = (char*)++kk; + (h-1)->rd=0; + return(hfree); +} + +Blk* +copy(Blk *hptr, int size) +{ + Blk *hdr; + unsigned sz; + char *ptr; + + all++; + lall++; + lcopy++; + nbytes += size; + lbytes += size; + if(size > longest) + longest = size; + if(size > maxsize) + maxsize = size; + sz = length(hptr); + ptr = nalloc(hptr->beg, size); + if(ptr == 0) { + garbage("copy"); + if((ptr = nalloc(hptr->beg, size)) == 0) { + Bprint(&bout,"copy size %d\n",size); + ospace("copy"); + } + } + if((hdr = hfree) == 0) + hdr = morehd(); + hfree = (Blk *)hdr->rd; + hdr->rd = hdr->beg = ptr; + hdr->last = ptr+size; + hdr->wt = ptr+sz; + ptr = hdr->wt; + while(ptr<hdr->last) + *ptr++ = '\0'; + return(hdr); +} + +void +sdump(char *s1, Blk *hptr) +{ + char *p; + + Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n", + s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last); + p = hptr->beg; + while(p < hptr->wt) + Bprint(&bout,"%d ",*p++); + Bprint(&bout,"\n"); +} + +void +seekc(Blk *hptr, int n) +{ + char *nn,*p; + + nn = hptr->beg+n; + if(nn > hptr->last) { + nbytes += nn - hptr->last; + if(nbytes > maxsize) + maxsize = nbytes; + lbytes += nn - hptr->last; + if(n > longest) + longest = n; +/* free(hptr->beg); *//**/ + p = realloc(hptr->beg, n); + if(p == 0) { +/* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg); +** garbage("seekc"); +** if((p = realloc(hptr->beg, n)) == 0) +*/ ospace("seekc"); + } + hptr->beg = p; + hptr->wt = hptr->last = hptr->rd = p+n; + return; + } + hptr->rd = nn; + if(nn>hptr->wt) + hptr->wt = nn; +} + +void +salterwd(Blk *ahptr, Blk *n) +{ + Wblk *hptr; + + hptr = (Wblk*)ahptr; + if(hptr->rdw == hptr->lastw) + more(ahptr); + *hptr->rdw++ = n; + if(hptr->rdw > hptr->wtw) + hptr->wtw = hptr->rdw; +} + +void +more(Blk *hptr) +{ + unsigned size; + char *p; + + if((size=(hptr->last-hptr->beg)*2) == 0) + size=2; + nbytes += size/2; + if(nbytes > maxsize) + maxsize = nbytes; + if(size > longest) + longest = size; + lbytes += size/2; + lmore++; +/* free(hptr->beg);*//**/ + p = realloc(hptr->beg, size); + + if(p == 0) { +/* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg)); +** garbage("more"); +** if((p = realloc(hptr->beg,size)) == 0) +*/ ospace("more"); + } + hptr->rd = p + (hptr->rd - hptr->beg); + hptr->wt = p + (hptr->wt - hptr->beg); + hptr->beg = p; + hptr->last = p+size; +} + +void +ospace(char *s) +{ + Bprint(&bout,"out of space: %s\n",s); + Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor); + Bprint(&bout,"nbytes %ld\n",nbytes); + sdump("stk",*stkptr); + abort(); +} + +void +garbage(char *s) +{ + USED(s); +} + +void +release(Blk *p) +{ + rel++; + lrel++; + nbytes -= p->last - p->beg; + p->rd = (char*)hfree; + hfree = p; + free(p->beg); +} + +Blk* +dcgetwd(Blk *p) +{ + Wblk *wp; + + wp = (Wblk*)p; + if(wp->rdw == wp->wtw) + return(0); + return(*wp->rdw++); +} + +void +putwd(Blk *p, Blk *c) +{ + Wblk *wp; + + wp = (Wblk*)p; + if(wp->wtw == wp->lastw) + more(p); + *wp->wtw++ = c; +} + +Blk* +lookwd(Blk *p) +{ + Wblk *wp; + + wp = (Wblk*)p; + if(wp->rdw == wp->wtw) + return(0); + return(*wp->rdw); +} + +char* +nalloc(char *p, unsigned nbytes) +{ + char *q, *r; + + q = r = malloc(nbytes); + if(q==0) + return(0); + while(nbytes--) + *q++ = *p++; + return(r); +} + +int +getstk(void) +{ + int n; + uchar c; + + c = readc(); + if(c != '<') + return c; + n = 0; + while(1) { + c = readc(); + if(c == '>') + break; + n = n*10+c-'0'; + } + return n; +}