added dc to 9base as requested - 9base - revived minimalist port of Plan 9 user… | |
git clone git://git.suckless.org/9base | |
Log | |
Files | |
Refs | |
README | |
LICENSE | |
--- | |
commit fbd05cbd195a12683bcc05dfb6d54955c18fef19 | |
parent 877adeba5fbe1704ba41961099e452eb8e88ebd7 | |
Author: Anselm R. Garbe <[email protected]> | |
Date: Tue, 24 Jan 2006 16:23:07 +0200 | |
added dc to 9base as requested | |
Diffstat: | |
M Makefile | 2 +- | |
A dc/Makefile | 6 ++++++ | |
A dc/dc.1 | 257 +++++++++++++++++++++++++++++… | |
A 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 … | |
+\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,… | |
+#define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=… | |
+#define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); co… | |
+#define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");… | |
+#define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); r… | |
+#define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x… | |
+#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,… | |
+ Bprint(&bout, "nbytes %ld\n",nbytes); | |
+ Bprint(&bout, "longest %ld active %ld maxsize %ld\n", … | |
+ active, maxsize); | |
+ Bprint(&bout, "new all %d rel %d copy %d more %d lbyte… | |
+ 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 bu… | |
+ 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 pri… | |
+ 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 ddi… | |
+ 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; | |
+} |