dc.c - 9base - revived minimalist port of Plan 9 userland to Unix
HTML git clone git://git.suckless.org/9base
DIR Log
DIR Files
DIR Refs
DIR README
DIR LICENSE
---
dc.c (36375B)
---
1 #include <u.h>
2 #include <libc.h>
3 #include <bio.h>
4
5 typedef void* pointer;
6
7 #define div dcdiv
8
9 #define FATAL 0
10 #define NFATAL 1
11 #define BLK sizeof(Blk)
12 #define PTRSZ sizeof(int*)
13 #define HEADSZ 1024
14 #define STKSZ 100
15 #define RDSKSZ 100
16 #define TBLSZ 256
17 #define ARRAYST 221
18 #define MAXIND 2048
19 #define NL 1
20 #define NG 2
21 #define NE 3
22 #define length(p) ((p)->wt-(p)->beg)
23 #define rewind(p) (p)->rd=(p)->beg
24 #undef create
25 #define create(p) (p)->rd = (p)->wt = (p)->beg
26 #define fsfile(p) (p)->rd = (p)->wt
27 #define truncate(p) (p)->wt = (p)->rd
28 #define sfeof(p) (((p)->rd==(p)->wt)?1:0)
29 #define sfbeg(p) (((p)->rd==(p)->beg)?1:0)
30 #define sungetc(p,c) *(--(p)->rd)=c
31 #define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++)
32 #define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;}
33 #define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd)
34 #define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd))
35 #define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;}
36 #define sputc(p,c) {if((p)->wt==(p)->last)more(p);\
37 *(p)->wt++ = c; }
38 #define salterc(p,c) {if((p)->rd==(p)->last)more(p);\
39 *(p)->rd++ = c;\
40 if((p)->rd>(p)->wt)(p)->wt=(p)->rd;}
41 #define sunputc(p) (*((p)->rd = --(p)->wt))
42 #define sclobber(p) ((p)->rd = --(p)->wt)
43 #define zero(p) for(pp=(p)->beg;pp<(p)->last;)\
44 *pp++='\0'
45 #define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} }
46 #define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}}
47 #define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; }
48 #define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;}
49 #define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);}
50 #define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);}
51 #define error(p) {Bprint(&bout,p); continue; }
52 #define errorrt(p) {Bprint(&bout,p); return(1); }
53 #define LASTFUN 026
54
55 typedef struct Blk Blk;
56 struct Blk
57 {
58 char *rd;
59 char *wt;
60 char *beg;
61 char *last;
62 };
63 typedef struct Sym Sym;
64 struct Sym
65 {
66 Sym *next;
67 Blk *val;
68 };
69 typedef struct Wblk Wblk;
70 struct Wblk
71 {
72 Blk **rdw;
73 Blk **wtw;
74 Blk **begw;
75 Blk **lastw;
76 };
77
78 Biobuf *curfile, *fsave;
79 Blk *arg1, *arg2;
80 uchar savk;
81 int dbg;
82 int ifile;
83 Blk *scalptr, *basptr, *tenptr, *inbas;
84 Blk *sqtemp, *chptr, *strptr, *divxyz;
85 Blk *stack[STKSZ];
86 Blk **stkptr,**stkbeg;
87 Blk **stkend;
88 Blk *hfree;
89 int stkerr;
90 int lastchar;
91 Blk *readstk[RDSKSZ];
92 Blk **readptr;
93 Blk *rem;
94 int k;
95 Blk *irem;
96 int skd,skr;
97 int neg;
98 Sym symlst[TBLSZ];
99 Sym *stable[TBLSZ];
100 Sym *sptr, *sfree;
101 long rel;
102 long nbytes;
103 long all;
104 long headmor;
105 long obase;
106 int fw,fw1,ll;
107 void (*outdit)(Blk *p, int flg);
108 int logo;
109 int logten;
110 int count;
111 char *pp;
112 char *dummy;
113 long longest, maxsize, active;
114 int lall, lrel, lcopy, lmore, lbytes;
115 int inside;
116 Biobuf bin;
117 Biobuf bout;
118
119 void main(int argc, char *argv[]);
120 void commnds(void);
121 Blk* readin(void);
122 Blk* div(Blk *ddivd, Blk *ddivr);
123 int dscale(void);
124 Blk* removr(Blk *p, int n);
125 Blk* dcsqrt(Blk *p);
126 void init(int argc, char *argv[]);
127 void onintr(void);
128 void pushp(Blk *p);
129 Blk* pop(void);
130 Blk* readin(void);
131 Blk* add0(Blk *p, int ct);
132 Blk* mult(Blk *p, Blk *q);
133 void chsign(Blk *p);
134 int readc(void);
135 void unreadc(char c);
136 void binop(char c);
137 void dcprint(Blk *hptr);
138 Blk* dcexp(Blk *base, Blk *ex);
139 Blk* getdec(Blk *p, int sc);
140 void tenot(Blk *p, int sc);
141 void oneot(Blk *p, int sc, char ch);
142 void hexot(Blk *p, int flg);
143 void bigot(Blk *p, int flg);
144 Blk* add(Blk *a1, Blk *a2);
145 int eqk(void);
146 Blk* removc(Blk *p, int n);
147 Blk* scalint(Blk *p);
148 Blk* scale(Blk *p, int n);
149 int subt(void);
150 int command(void);
151 int cond(char c);
152 void load(void);
153 #define log2 dclog2
154 int log2(long n);
155 Blk* salloc(int size);
156 Blk* morehd(void);
157 Blk* copy(Blk *hptr, int size);
158 void sdump(char *s1, Blk *hptr);
159 void seekc(Blk *hptr, int n);
160 void salterwd(Blk *hptr, Blk *n);
161 void more(Blk *hptr);
162 void ospace(char *s);
163 void garbage(char *s);
164 void release(Blk *p);
165 Blk* dcgetwd(Blk *p);
166 void putwd(Blk *p, Blk *c);
167 Blk* lookwd(Blk *p);
168 int getstk(void);
169
170 /********debug only**/
171 void
172 tpr(char *cp, Blk *bp)
173 {
174 print("%s-> ", cp);
175 print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd,
176 bp->wt, bp->last);
177 for (cp = bp->beg; cp != bp->wt; cp++) {
178 print("%d", *cp);
179 if (cp != bp->wt-1)
180 print("/");
181 }
182 print("\n");
183 }
184 /************/
185
186 void
187 main(int argc, char *argv[])
188 {
189 Binit(&bin, 0, OREAD);
190 Binit(&bout, 1, OWRITE);
191 init(argc,argv);
192 commnds();
193 exits(0);
194 }
195
196 void
197 commnds(void)
198 {
199 Blk *p, *q, **ptr, *s, *t;
200 long l;
201 Sym *sp;
202 int sk, sk1, sk2, c, sign, n, d;
203
204 while(1) {
205 Bflush(&bout);
206 if(((c = readc())>='0' && c <= '9') ||
207 (c>='A' && c <='F') || c == '.') {
208 unreadc(c);
209 p = readin();
210 pushp(p);
211 continue;
212 }
213 switch(c) {
214 case ' ':
215 case '\n':
216 case -1:
217 continue;
218 case 'Y':
219 sdump("stk",*stkptr);
220 Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor);
221 Bprint(&bout, "nbytes %ld\n",nbytes);
222 Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,
223 active, maxsize);
224 Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",
225 lall, lrel, lcopy, lmore, lbytes);
226 lall = lrel = lcopy = lmore = lbytes = 0;
227 continue;
228 case '_':
229 p = readin();
230 savk = sunputc(p);
231 chsign(p);
232 sputc(p,savk);
233 pushp(p);
234 continue;
235 case '-':
236 subt();
237 continue;
238 case '+':
239 if(eqk() != 0)
240 continue;
241 binop('+');
242 continue;
243 case '*':
244 arg1 = pop();
245 EMPTY;
246 arg2 = pop();
247 EMPTYR(arg1);
248 sk1 = sunputc(arg1);
249 sk2 = sunputc(arg2);
250 savk = sk1+sk2;
251 binop('*');
252 p = pop();
253 if(savk>k && savk>sk1 && savk>sk2) {
254 sclobber(p);
255 sk = sk1;
256 if(sk<sk2)
257 sk = sk2;
258 if(sk<k)
259 sk = k;
260 p = removc(p,savk-sk);
261 savk = sk;
262 sputc(p,savk);
263 }
264 pushp(p);
265 continue;
266 case '/':
267 casediv:
268 if(dscale() != 0)
269 continue;
270 binop('/');
271 if(irem != 0)
272 release(irem);
273 release(rem);
274 continue;
275 case '%':
276 if(dscale() != 0)
277 continue;
278 binop('/');
279 p = pop();
280 release(p);
281 if(irem == 0) {
282 sputc(rem,skr+k);
283 pushp(rem);
284 continue;
285 }
286 p = add0(rem,skd-(skr+k));
287 q = add(p,irem);
288 release(p);
289 release(irem);
290 sputc(q,skd);
291 pushp(q);
292 continue;
293 case 'v':
294 p = pop();
295 EMPTY;
296 savk = sunputc(p);
297 if(length(p) == 0) {
298 sputc(p,savk);
299 pushp(p);
300 continue;
301 }
302 if(sbackc(p)<0) {
303 error("sqrt of neg number\n");
304 }
305 if(k<savk)
306 n = savk;
307 else {
308 n = k*2-savk;
309 savk = k;
310 }
311 arg1 = add0(p,n);
312 arg2 = dcsqrt(arg1);
313 sputc(arg2,savk);
314 pushp(arg2);
315 continue;
316
317 case '^':
318 neg = 0;
319 arg1 = pop();
320 EMPTY;
321 if(sunputc(arg1) != 0)
322 error("exp not an integer\n");
323 arg2 = pop();
324 EMPTYR(arg1);
325 if(sfbeg(arg1) == 0 && sbackc(arg1)<0) {
326 neg++;
327 chsign(arg1);
328 }
329 if(length(arg1)>=3) {
330 error("exp too big\n");
331 }
332 savk = sunputc(arg2);
333 p = dcexp(arg2,arg1);
334 release(arg2);
335 rewind(arg1);
336 c = sgetc(arg1);
337 if(c == -1)
338 c = 0;
339 else
340 if(sfeof(arg1) == 0)
341 c = sgetc(arg1)*100 + c;
342 d = c*savk;
343 release(arg1);
344 /* if(neg == 0) { removed to fix -exp bug*/
345 if(k>=savk)
346 n = k;
347 else
348 n = savk;
349 if(n<d) {
350 q = removc(p,d-n);
351 sputc(q,n);
352 pushp(q);
353 } else {
354 sputc(p,d);
355 pushp(p);
356 }
357 /* } else { this is disaster for exp <-127 */
358 /* sputc(p,d); */
359 /* pushp(p); */
360 /* } */
361 if(neg == 0)
362 continue;
363 p = pop();
364 q = salloc(2);
365 sputc(q,1);
366 sputc(q,0);
367 pushp(q);
368 pushp(p);
369 goto casediv;
370 case 'z':
371 p = salloc(2);
372 n = stkptr - stkbeg;
373 if(n >= 100) {
374 sputc(p,n/100);
375 n %= 100;
376 }
377 sputc(p,n);
378 sputc(p,0);
379 pushp(p);
380 continue;
381 case 'Z':
382 p = pop();
383 EMPTY;
384 n = (length(p)-1)<<1;
385 fsfile(p);
386 backc(p);
387 if(sfbeg(p) == 0) {
388 if((c = sbackc(p))<0) {
389 n -= 2;
390 if(sfbeg(p) == 1)
391 n++;
392 else {
393 if((c = sbackc(p)) == 0)
394 n++;
395 else
396 if(c > 90)
397 n--;
398 }
399 } else
400 if(c < 10)
401 n--;
402 }
403 release(p);
404 q = salloc(1);
405 if(n >= 100) {
406 sputc(q,n%100);
407 n /= 100;
408 }
409 sputc(q,n);
410 sputc(q,0);
411 pushp(q);
412 continue;
413 case 'i':
414 p = pop();
415 EMPTY;
416 p = scalint(p);
417 release(inbas);
418 inbas = p;
419 continue;
420 case 'I':
421 p = copy(inbas,length(inbas)+1);
422 sputc(p,0);
423 pushp(p);
424 continue;
425 case 'o':
426 p = pop();
427 EMPTY;
428 p = scalint(p);
429 sign = 0;
430 n = length(p);
431 q = copy(p,n);
432 fsfile(q);
433 l = c = sbackc(q);
434 if(n != 1) {
435 if(c<0) {
436 sign = 1;
437 chsign(q);
438 n = length(q);
439 fsfile(q);
440 l = c = sbackc(q);
441 }
442 if(n != 1) {
443 while(sfbeg(q) == 0)
444 l = l*100+sbackc(q);
445 }
446 }
447 logo = log2(l);
448 obase = l;
449 release(basptr);
450 if(sign == 1)
451 obase = -l;
452 basptr = p;
453 outdit = bigot;
454 if(n == 1 && sign == 0) {
455 if(c <= 16) {
456 outdit = hexot;
457 fw = 1;
458 fw1 = 0;
459 ll = 70;
460 release(q);
461 continue;
462 }
463 }
464 n = 0;
465 if(sign == 1)
466 n++;
467 p = salloc(1);
468 sputc(p,-1);
469 t = add(p,q);
470 n += length(t)*2;
471 fsfile(t);
472 if(sbackc(t)>9)
473 n++;
474 release(t);
475 release(q);
476 release(p);
477 fw = n;
478 fw1 = n-1;
479 ll = 70;
480 if(fw>=ll)
481 continue;
482 ll = (70/fw)*fw;
483 continue;
484 case 'O':
485 p = copy(basptr,length(basptr)+1);
486 sputc(p,0);
487 pushp(p);
488 continue;
489 case '[':
490 n = 0;
491 p = salloc(0);
492 for(;;) {
493 if((c = readc()) == ']') {
494 if(n == 0)
495 break;
496 n--;
497 }
498 sputc(p,c);
499 if(c == '[')
500 n++;
501 }
502 pushp(p);
503 continue;
504 case 'k':
505 p = pop();
506 EMPTY;
507 p = scalint(p);
508 if(length(p)>1) {
509 error("scale too big\n");
510 }
511 rewind(p);
512 k = 0;
513 if(!sfeof(p))
514 k = sgetc(p);
515 release(scalptr);
516 scalptr = p;
517 continue;
518 case 'K':
519 p = copy(scalptr,length(scalptr)+1);
520 sputc(p,0);
521 pushp(p);
522 continue;
523 case 'X':
524 p = pop();
525 EMPTY;
526 fsfile(p);
527 n = sbackc(p);
528 release(p);
529 p = salloc(2);
530 sputc(p,n);
531 sputc(p,0);
532 pushp(p);
533 continue;
534 case 'Q':
535 p = pop();
536 EMPTY;
537 if(length(p)>2) {
538 error("Q?\n");
539 }
540 rewind(p);
541 if((c = sgetc(p))<0) {
542 error("neg Q\n");
543 }
544 release(p);
545 while(c-- > 0) {
546 if(readptr == &readstk[0]) {
547 error("readstk?\n");
548 }
549 if(*readptr != 0)
550 release(*readptr);
551 readptr--;
552 }
553 continue;
554 case 'q':
555 if(readptr <= &readstk[1])
556 exits(0);
557 if(*readptr != 0)
558 release(*readptr);
559 readptr--;
560 if(*readptr != 0)
561 release(*readptr);
562 readptr--;
563 continue;
564 case 'f':
565 if(stkptr == &stack[0])
566 Bprint(&bout,"empty stack\n");
567 else {
568 for(ptr = stkptr; ptr > &stack[0];) {
569 dcprint(*ptr--);
570 }
571 }
572 continue;
573 case 'p':
574 if(stkptr == &stack[0])
575 Bprint(&bout,"empty stack\n");
576 else {
577 dcprint(*stkptr);
578 }
579 continue;
580 case 'P':
581 p = pop();
582 EMPTY;
583 sputc(p,0);
584 Bprint(&bout,"%s",p->beg);
585 release(p);
586 continue;
587 case 'd':
588 if(stkptr == &stack[0]) {
589 Bprint(&bout,"empty stack\n");
590 continue;
591 }
592 q = *stkptr;
593 n = length(q);
594 p = copy(*stkptr,n);
595 pushp(p);
596 continue;
597 case 'c':
598 while(stkerr == 0) {
599 p = pop();
600 if(stkerr == 0)
601 release(p);
602 }
603 continue;
604 case 'S':
605 if(stkptr == &stack[0]) {
606 error("save: args\n");
607 }
608 c = getstk() & 0377;
609 sptr = stable[c];
610 sp = stable[c] = sfree;
611 sfree = sfree->next;
612 if(sfree == 0)
613 goto sempty;
614 sp->next = sptr;
615 p = pop();
616 EMPTY;
617 if(c >= ARRAYST) {
618 q = copy(p,length(p)+PTRSZ);
619 for(n = 0;n < PTRSZ;n++) {
620 sputc(q,0);
621 }
622 release(p);
623 p = q;
624 }
625 sp->val = p;
626 continue;
627 sempty:
628 error("symbol table overflow\n");
629 case 's':
630 if(stkptr == &stack[0]) {
631 error("save:args\n");
632 }
633 c = getstk() & 0377;
634 sptr = stable[c];
635 if(sptr != 0) {
636 p = sptr->val;
637 if(c >= ARRAYST) {
638 rewind(p);
639 while(sfeof(p) == 0)
640 release(dcgetwd(p));
641 }
642 release(p);
643 } else {
644 sptr = stable[c] = sfree;
645 sfree = sfree->next;
646 if(sfree == 0)
647 goto sempty;
648 sptr->next = 0;
649 }
650 p = pop();
651 sptr->val = p;
652 continue;
653 case 'l':
654 load();
655 continue;
656 case 'L':
657 c = getstk() & 0377;
658 sptr = stable[c];
659 if(sptr == 0) {
660 error("L?\n");
661 }
662 stable[c] = sptr->next;
663 sptr->next = sfree;
664 sfree = sptr;
665 p = sptr->val;
666 if(c >= ARRAYST) {
667 rewind(p);
668 while(sfeof(p) == 0) {
669 q = dcgetwd(p);
670 if(q != 0)
671 release(q);
672 }
673 }
674 pushp(p);
675 continue;
676 case ':':
677 p = pop();
678 EMPTY;
679 q = scalint(p);
680 fsfile(q);
681 c = 0;
682 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
683 error("neg index\n");
684 }
685 if(length(q)>2) {
686 error("index too big\n");
687 }
688 if(sfbeg(q) == 0)
689 c = c*100+sbackc(q);
690 if(c >= MAXIND) {
691 error("index too big\n");
692 }
693 release(q);
694 n = getstk() & 0377;
695 sptr = stable[n];
696 if(sptr == 0) {
697 sptr = stable[n] = sfree;
698 sfree = sfree->next;
699 if(sfree == 0)
700 goto sempty;
701 sptr->next = 0;
702 p = salloc((c+PTRSZ)*PTRSZ);
703 zero(p);
704 } else {
705 p = sptr->val;
706 if(length(p)-PTRSZ < c*PTRSZ) {
707 q = copy(p,(c+PTRSZ)*PTRSZ);
708 release(p);
709 p = q;
710 }
711 }
712 seekc(p,c*PTRSZ);
713 q = lookwd(p);
714 if(q!=0)
715 release(q);
716 s = pop();
717 EMPTY;
718 salterwd(p, s);
719 sptr->val = p;
720 continue;
721 case ';':
722 p = pop();
723 EMPTY;
724 q = scalint(p);
725 fsfile(q);
726 c = 0;
727 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
728 error("neg index\n");
729 }
730 if(length(q)>2) {
731 error("index too big\n");
732 }
733 if(sfbeg(q) == 0)
734 c = c*100+sbackc(q);
735 if(c >= MAXIND) {
736 error("index too big\n");
737 }
738 release(q);
739 n = getstk() & 0377;
740 sptr = stable[n];
741 if(sptr != 0){
742 p = sptr->val;
743 if(length(p)-PTRSZ >= c*PTRSZ) {
744 seekc(p,c*PTRSZ);
745 s = dcgetwd(p);
746 if(s != 0) {
747 q = copy(s,length(s));
748 pushp(q);
749 continue;
750 }
751 }
752 }
753 q = salloc(1); /*so uninitialized array elt prints as 0*/
754 sputc(q, 0);
755 pushp(q);
756 continue;
757 case 'x':
758 execute:
759 p = pop();
760 EMPTY;
761 if((readptr != &readstk[0]) && (*readptr != 0)) {
762 if((*readptr)->rd == (*readptr)->wt)
763 release(*readptr);
764 else {
765 if(readptr++ == &readstk[RDSKSZ]) {
766 error("nesting depth\n");
767 }
768 }
769 } else
770 readptr++;
771 *readptr = p;
772 if(p != 0)
773 rewind(p);
774 else {
775 if((c = readc()) != '\n')
776 unreadc(c);
777 }
778 continue;
779 case '?':
780 if(++readptr == &readstk[RDSKSZ]) {
781 error("nesting depth\n");
782 }
783 *readptr = 0;
784 fsave = curfile;
785 curfile = &bin;
786 while((c = readc()) == '!')
787 command();
788 p = salloc(0);
789 sputc(p,c);
790 while((c = readc()) != '\n') {
791 sputc(p,c);
792 if(c == '\\')
793 sputc(p,readc());
794 }
795 curfile = fsave;
796 *readptr = p;
797 continue;
798 case '!':
799 if(command() == 1)
800 goto execute;
801 continue;
802 case '<':
803 case '>':
804 case '=':
805 if(cond(c) == 1)
806 goto execute;
807 continue;
808 default:
809 Bprint(&bout,"%o is unimplemented\n",c);
810 }
811 }
812 }
813
814 Blk*
815 div(Blk *ddivd, Blk *ddivr)
816 {
817 int divsign, remsign, offset, divcarry,
818 carry, dig, magic, d, dd, under, first;
819 long c, td, cc;
820 Blk *ps, *px, *p, *divd, *divr;
821
822 dig = 0;
823 under = 0;
824 divcarry = 0;
825 rem = 0;
826 p = salloc(0);
827 if(length(ddivr) == 0) {
828 pushp(ddivr);
829 Bprint(&bout,"divide by 0\n");
830 return(p);
831 }
832 divsign = remsign = first = 0;
833 divr = ddivr;
834 fsfile(divr);
835 if(sbackc(divr) == -1) {
836 divr = copy(ddivr,length(ddivr));
837 chsign(divr);
838 divsign = ~divsign;
839 }
840 divd = copy(ddivd,length(ddivd));
841 fsfile(divd);
842 if(sfbeg(divd) == 0 && sbackc(divd) == -1) {
843 chsign(divd);
844 divsign = ~divsign;
845 remsign = ~remsign;
846 }
847 offset = length(divd) - length(divr);
848 if(offset < 0)
849 goto ddone;
850 seekc(p,offset+1);
851 sputc(divd,0);
852 magic = 0;
853 fsfile(divr);
854 c = sbackc(divr);
855 if(c < 10)
856 magic++;
857 c = c * 100 + (sfbeg(divr)?0:sbackc(divr));
858 if(magic>0){
859 c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2;
860 c /= 25;
861 }
862 while(offset >= 0) {
863 first++;
864 fsfile(divd);
865 td = sbackc(divd) * 100;
866 dd = sfbeg(divd)?0:sbackc(divd);
867 td = (td + dd) * 100;
868 dd = sfbeg(divd)?0:sbackc(divd);
869 td = td + dd;
870 cc = c;
871 if(offset == 0)
872 td++;
873 else
874 cc++;
875 if(magic != 0)
876 td = td<<3;
877 dig = td/cc;
878 under=0;
879 if(td%cc < 8 && dig > 0 && magic) {
880 dig--;
881 under=1;
882 }
883 rewind(divr);
884 rewind(divxyz);
885 carry = 0;
886 while(sfeof(divr) == 0) {
887 d = sgetc(divr)*dig+carry;
888 carry = d / 100;
889 salterc(divxyz,d%100);
890 }
891 salterc(divxyz,carry);
892 rewind(divxyz);
893 seekc(divd,offset);
894 carry = 0;
895 while(sfeof(divd) == 0) {
896 d = slookc(divd);
897 d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
898 carry = 0;
899 if(d < 0) {
900 d += 100;
901 carry = 1;
902 }
903 salterc(divd,d);
904 }
905 divcarry = carry;
906 backc(p);
907 salterc(p,dig);
908 backc(p);
909 fsfile(divd);
910 d=sbackc(divd);
911 if((d != 0) && /*!divcarry*/ (offset != 0)) {
912 d = sbackc(divd) + 100;
913 salterc(divd,d);
914 }
915 if(--offset >= 0)
916 divd->wt--;
917 }
918 if(under) { /* undershot last - adjust*/
919 px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/
920 chsign(px);
921 ps = add(px,divd);
922 fsfile(ps);
923 if(length(ps) > 0 && sbackc(ps) < 0) {
924 release(ps); /*only adjust in really undershot*/
925 } else {
926 release(divd);
927 salterc(p, dig+1);
928 divd=ps;
929 }
930 }
931 if(divcarry != 0) {
932 salterc(p,dig-1);
933 salterc(divd,-1);
934 ps = add(divr,divd);
935 release(divd);
936 divd = ps;
937 }
938
939 rewind(p);
940 divcarry = 0;
941 while(sfeof(p) == 0){
942 d = slookc(p)+divcarry;
943 divcarry = 0;
944 if(d >= 100){
945 d -= 100;
946 divcarry = 1;
947 }
948 salterc(p,d);
949 }
950 if(divcarry != 0)salterc(p,divcarry);
951 fsfile(p);
952 while(sfbeg(p) == 0) {
953 if(sbackc(p) != 0)
954 break;
955 truncate(p);
956 }
957 if(divsign < 0)
958 chsign(p);
959 fsfile(divd);
960 while(sfbeg(divd) == 0) {
961 if(sbackc(divd) != 0)
962 break;
963 truncate(divd);
964 }
965 ddone:
966 if(remsign<0)
967 chsign(divd);
968 if(divr != ddivr)
969 release(divr);
970 rem = divd;
971 return(p);
972 }
973
974 int
975 dscale(void)
976 {
977 Blk *dd, *dr, *r;
978 int c;
979
980 dr = pop();
981 EMPTYS;
982 dd = pop();
983 EMPTYSR(dr);
984 fsfile(dd);
985 skd = sunputc(dd);
986 fsfile(dr);
987 skr = sunputc(dr);
988 if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) {
989 sputc(dr,skr);
990 pushp(dr);
991 Bprint(&bout,"divide by 0\n");
992 return(1);
993 }
994 if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) {
995 sputc(dd,skd);
996 pushp(dd);
997 return(1);
998 }
999 c = k-skd+skr;
1000 if(c < 0)
1001 r = removr(dd,-c);
1002 else {
1003 r = add0(dd,c);
1004 irem = 0;
1005 }
1006 arg1 = r;
1007 arg2 = dr;
1008 savk = k;
1009 return(0);
1010 }
1011
1012 Blk*
1013 removr(Blk *p, int n)
1014 {
1015 int nn, neg;
1016 Blk *q, *s, *r;
1017
1018 fsfile(p);
1019 neg = sbackc(p);
1020 if(neg < 0)
1021 chsign(p);
1022 rewind(p);
1023 nn = (n+1)/2;
1024 q = salloc(nn);
1025 while(n>1) {
1026 sputc(q,sgetc(p));
1027 n -= 2;
1028 }
1029 r = salloc(2);
1030 while(sfeof(p) == 0)
1031 sputc(r,sgetc(p));
1032 release(p);
1033 if(n == 1){
1034 s = div(r,tenptr);
1035 release(r);
1036 rewind(rem);
1037 if(sfeof(rem) == 0)
1038 sputc(q,sgetc(rem));
1039 release(rem);
1040 if(neg < 0){
1041 chsign(s);
1042 chsign(q);
1043 irem = q;
1044 return(s);
1045 }
1046 irem = q;
1047 return(s);
1048 }
1049 if(neg < 0) {
1050 chsign(r);
1051 chsign(q);
1052 irem = q;
1053 return(r);
1054 }
1055 irem = q;
1056 return(r);
1057 }
1058
1059 Blk*
1060 dcsqrt(Blk *p)
1061 {
1062 Blk *t, *r, *q, *s;
1063 int c, n, nn;
1064
1065 n = length(p);
1066 fsfile(p);
1067 c = sbackc(p);
1068 if((n&1) != 1)
1069 c = c*100+(sfbeg(p)?0:sbackc(p));
1070 n = (n+1)>>1;
1071 r = salloc(n);
1072 zero(r);
1073 seekc(r,n);
1074 nn=1;
1075 while((c -= nn)>=0)
1076 nn+=2;
1077 c=(nn+1)>>1;
1078 fsfile(r);
1079 backc(r);
1080 if(c>=100) {
1081 c -= 100;
1082 salterc(r,c);
1083 sputc(r,1);
1084 } else
1085 salterc(r,c);
1086 for(;;){
1087 q = div(p,r);
1088 s = add(q,r);
1089 release(q);
1090 release(rem);
1091 q = div(s,sqtemp);
1092 release(s);
1093 release(rem);
1094 s = copy(r,length(r));
1095 chsign(s);
1096 t = add(s,q);
1097 release(s);
1098 fsfile(t);
1099 nn = sfbeg(t)?0:sbackc(t);
1100 if(nn>=0)
1101 break;
1102 release(r);
1103 release(t);
1104 r = q;
1105 }
1106 release(t);
1107 release(q);
1108 release(p);
1109 return(r);
1110 }
1111
1112 Blk*
1113 dcexp(Blk *base, Blk *ex)
1114 {
1115 Blk *r, *e, *p, *e1, *t, *cp;
1116 int temp, c, n;
1117
1118 r = salloc(1);
1119 sputc(r,1);
1120 p = copy(base,length(base));
1121 e = copy(ex,length(ex));
1122 fsfile(e);
1123 if(sfbeg(e) != 0)
1124 goto edone;
1125 temp=0;
1126 c = sbackc(e);
1127 if(c<0) {
1128 temp++;
1129 chsign(e);
1130 }
1131 while(length(e) != 0) {
1132 e1=div(e,sqtemp);
1133 release(e);
1134 e = e1;
1135 n = length(rem);
1136 release(rem);
1137 if(n != 0) {
1138 e1=mult(p,r);
1139 release(r);
1140 r = e1;
1141 }
1142 t = copy(p,length(p));
1143 cp = mult(p,t);
1144 release(p);
1145 release(t);
1146 p = cp;
1147 }
1148 if(temp != 0) {
1149 if((c = length(base)) == 0) {
1150 goto edone;
1151 }
1152 if(c>1)
1153 create(r);
1154 else {
1155 rewind(base);
1156 if((c = sgetc(base))<=1) {
1157 create(r);
1158 sputc(r,c);
1159 } else
1160 create(r);
1161 }
1162 }
1163 edone:
1164 release(p);
1165 release(e);
1166 return(r);
1167 }
1168
1169 void
1170 init(int argc, char *argv[])
1171 {
1172 Sym *sp;
1173 Dir *d;
1174
1175 ARGBEGIN {
1176 default:
1177 dbg = 1;
1178 break;
1179 } ARGEND
1180 ifile = 1;
1181 curfile = &bin;
1182 if(*argv){
1183 d = dirstat(*argv);
1184 if(d == nil) {
1185 fprint(2, "dc: can't open file %s\n", *argv);
1186 exits("open");
1187 }
1188 if(d->mode & DMDIR) {
1189 fprint(2, "dc: file %s is a directory\n", *argv);
1190 exits("open");
1191 }
1192 free(d);
1193 if((curfile = Bopen(*argv, OREAD)) == 0) {
1194 fprint(2,"dc: can't open file %s\n", *argv);
1195 exits("open");
1196 }
1197 }
1198 /* dummy = malloc(0); *//* prepare for garbage-collection */
1199 scalptr = salloc(1);
1200 sputc(scalptr,0);
1201 basptr = salloc(1);
1202 sputc(basptr,10);
1203 obase=10;
1204 logten=log2(10L);
1205 ll=70;
1206 fw=1;
1207 fw1=0;
1208 tenptr = salloc(1);
1209 sputc(tenptr,10);
1210 obase=10;
1211 inbas = salloc(1);
1212 sputc(inbas,10);
1213 sqtemp = salloc(1);
1214 sputc(sqtemp,2);
1215 chptr = salloc(0);
1216 strptr = salloc(0);
1217 divxyz = salloc(0);
1218 stkbeg = stkptr = &stack[0];
1219 stkend = &stack[STKSZ];
1220 stkerr = 0;
1221 readptr = &readstk[0];
1222 k=0;
1223 sp = sptr = &symlst[0];
1224 while(sptr < &symlst[TBLSZ-1]) {
1225 sptr->next = ++sp;
1226 sptr++;
1227 }
1228 sptr->next=0;
1229 sfree = &symlst[0];
1230 }
1231
1232 void
1233 pushp(Blk *p)
1234 {
1235 if(stkptr == stkend) {
1236 Bprint(&bout,"out of stack space\n");
1237 return;
1238 }
1239 stkerr=0;
1240 *++stkptr = p;
1241 return;
1242 }
1243
1244 Blk*
1245 pop(void)
1246 {
1247 if(stkptr == stack) {
1248 stkerr=1;
1249 return(0);
1250 }
1251 return(*stkptr--);
1252 }
1253
1254 Blk*
1255 readin(void)
1256 {
1257 Blk *p, *q;
1258 int dp, dpct, c;
1259
1260 dp = dpct=0;
1261 p = salloc(0);
1262 for(;;){
1263 c = readc();
1264 switch(c) {
1265 case '.':
1266 if(dp != 0)
1267 goto gotnum;
1268 dp++;
1269 continue;
1270 case '\\':
1271 readc();
1272 continue;
1273 default:
1274 if(c >= 'A' && c <= 'F')
1275 c = c - 'A' + 10;
1276 else
1277 if(c >= '0' && c <= '9')
1278 c -= '0';
1279 else
1280 goto gotnum;
1281 if(dp != 0) {
1282 if(dpct >= 99)
1283 continue;
1284 dpct++;
1285 }
1286 create(chptr);
1287 if(c != 0)
1288 sputc(chptr,c);
1289 q = mult(p,inbas);
1290 release(p);
1291 p = add(chptr,q);
1292 release(q);
1293 }
1294 }
1295 gotnum:
1296 unreadc(c);
1297 if(dp == 0) {
1298 sputc(p,0);
1299 return(p);
1300 } else {
1301 q = scale(p,dpct);
1302 return(q);
1303 }
1304 }
1305
1306 /*
1307 * returns pointer to struct with ct 0's & p
1308 */
1309 Blk*
1310 add0(Blk *p, int ct)
1311 {
1312 Blk *q, *t;
1313
1314 q = salloc(length(p)+(ct+1)/2);
1315 while(ct>1) {
1316 sputc(q,0);
1317 ct -= 2;
1318 }
1319 rewind(p);
1320 while(sfeof(p) == 0) {
1321 sputc(q,sgetc(p));
1322 }
1323 release(p);
1324 if(ct == 1) {
1325 t = mult(tenptr,q);
1326 release(q);
1327 return(t);
1328 }
1329 return(q);
1330 }
1331
1332 Blk*
1333 mult(Blk *p, Blk *q)
1334 {
1335 Blk *mp, *mq, *mr;
1336 int sign, offset, carry;
1337 int cq, cp, mt, mcr;
1338
1339 offset = sign = 0;
1340 fsfile(p);
1341 mp = p;
1342 if(sfbeg(p) == 0) {
1343 if(sbackc(p)<0) {
1344 mp = copy(p,length(p));
1345 chsign(mp);
1346 sign = ~sign;
1347 }
1348 }
1349 fsfile(q);
1350 mq = q;
1351 if(sfbeg(q) == 0){
1352 if(sbackc(q)<0) {
1353 mq = copy(q,length(q));
1354 chsign(mq);
1355 sign = ~sign;
1356 }
1357 }
1358 mr = salloc(length(mp)+length(mq));
1359 zero(mr);
1360 rewind(mq);
1361 while(sfeof(mq) == 0) {
1362 cq = sgetc(mq);
1363 rewind(mp);
1364 rewind(mr);
1365 mr->rd += offset;
1366 carry=0;
1367 while(sfeof(mp) == 0) {
1368 cp = sgetc(mp);
1369 mcr = sfeof(mr)?0:slookc(mr);
1370 mt = cp*cq + carry + mcr;
1371 carry = mt/100;
1372 salterc(mr,mt%100);
1373 }
1374 offset++;
1375 if(carry != 0) {
1376 mcr = sfeof(mr)?0:slookc(mr);
1377 salterc(mr,mcr+carry);
1378 }
1379 }
1380 if(sign < 0) {
1381 chsign(mr);
1382 }
1383 if(mp != p)
1384 release(mp);
1385 if(mq != q)
1386 release(mq);
1387 return(mr);
1388 }
1389
1390 void
1391 chsign(Blk *p)
1392 {
1393 int carry;
1394 char ct;
1395
1396 carry=0;
1397 rewind(p);
1398 while(sfeof(p) == 0) {
1399 ct=100-slookc(p)-carry;
1400 carry=1;
1401 if(ct>=100) {
1402 ct -= 100;
1403 carry=0;
1404 }
1405 salterc(p,ct);
1406 }
1407 if(carry != 0) {
1408 sputc(p,-1);
1409 fsfile(p);
1410 backc(p);
1411 ct = sbackc(p);
1412 if(ct == 99 /*&& !sfbeg(p)*/) {
1413 truncate(p);
1414 sputc(p,-1);
1415 }
1416 } else{
1417 fsfile(p);
1418 ct = sbackc(p);
1419 if(ct == 0)
1420 truncate(p);
1421 }
1422 return;
1423 }
1424
1425 int
1426 readc(void)
1427 {
1428 loop:
1429 if((readptr != &readstk[0]) && (*readptr != 0)) {
1430 if(sfeof(*readptr) == 0)
1431 return(lastchar = sgetc(*readptr));
1432 release(*readptr);
1433 readptr--;
1434 goto loop;
1435 }
1436 lastchar = Bgetc(curfile);
1437 if(lastchar != -1)
1438 return(lastchar);
1439 if(readptr != &readptr[0]) {
1440 readptr--;
1441 if(*readptr == 0)
1442 curfile = &bin;
1443 goto loop;
1444 }
1445 if(curfile != &bin) {
1446 Bterm(curfile);
1447 curfile = &bin;
1448 goto loop;
1449 }
1450 exits(0);
1451 return 0; /* shut up ken */
1452 }
1453
1454 void
1455 unreadc(char c)
1456 {
1457
1458 if((readptr != &readstk[0]) && (*readptr != 0)) {
1459 sungetc(*readptr,c);
1460 } else
1461 Bungetc(curfile);
1462 return;
1463 }
1464
1465 void
1466 binop(char c)
1467 {
1468 Blk *r;
1469
1470 r = 0;
1471 switch(c) {
1472 case '+':
1473 r = add(arg1,arg2);
1474 break;
1475 case '*':
1476 r = mult(arg1,arg2);
1477 break;
1478 case '/':
1479 r = div(arg1,arg2);
1480 break;
1481 }
1482 release(arg1);
1483 release(arg2);
1484 sputc(r,savk);
1485 pushp(r);
1486 }
1487
1488 void
1489 dcprint(Blk *hptr)
1490 {
1491 Blk *p, *q, *dec;
1492 int dig, dout, ct, sc;
1493
1494 rewind(hptr);
1495 while(sfeof(hptr) == 0) {
1496 if(sgetc(hptr)>99) {
1497 rewind(hptr);
1498 while(sfeof(hptr) == 0) {
1499 Bprint(&bout,"%c",sgetc(hptr));
1500 }
1501 Bprint(&bout,"\n");
1502 return;
1503 }
1504 }
1505 fsfile(hptr);
1506 sc = sbackc(hptr);
1507 if(sfbeg(hptr) != 0) {
1508 Bprint(&bout,"0\n");
1509 return;
1510 }
1511 count = ll;
1512 p = copy(hptr,length(hptr));
1513 sclobber(p);
1514 fsfile(p);
1515 if(sbackc(p)<0) {
1516 chsign(p);
1517 OUTC('-');
1518 }
1519 if((obase == 0) || (obase == -1)) {
1520 oneot(p,sc,'d');
1521 return;
1522 }
1523 if(obase == 1) {
1524 oneot(p,sc,'1');
1525 return;
1526 }
1527 if(obase == 10) {
1528 tenot(p,sc);
1529 return;
1530 }
1531 /* sleazy hack to scale top of stack - divide by 1 */
1532 pushp(p);
1533 sputc(p, sc);
1534 p=salloc(0);
1535 create(p);
1536 sputc(p, 1);
1537 sputc(p, 0);
1538 pushp(p);
1539 if(dscale() != 0)
1540 return;
1541 p = div(arg1, arg2);
1542 release(arg1);
1543 release(arg2);
1544 sc = savk;
1545
1546 create(strptr);
1547 dig = logten*sc;
1548 dout = ((dig/10) + dig) / logo;
1549 dec = getdec(p,sc);
1550 p = removc(p,sc);
1551 while(length(p) != 0) {
1552 q = div(p,basptr);
1553 release(p);
1554 p = q;
1555 (*outdit)(rem,0);
1556 }
1557 release(p);
1558 fsfile(strptr);
1559 while(sfbeg(strptr) == 0)
1560 OUTC(sbackc(strptr));
1561 if(sc == 0) {
1562 release(dec);
1563 Bprint(&bout,"\n");
1564 return;
1565 }
1566 create(strptr);
1567 OUTC('.');
1568 ct=0;
1569 do {
1570 q = mult(basptr,dec);
1571 release(dec);
1572 dec = getdec(q,sc);
1573 p = removc(q,sc);
1574 (*outdit)(p,1);
1575 } while(++ct < dout);
1576 release(dec);
1577 rewind(strptr);
1578 while(sfeof(strptr) == 0)
1579 OUTC(sgetc(strptr));
1580 Bprint(&bout,"\n");
1581 }
1582
1583 Blk*
1584 getdec(Blk *p, int sc)
1585 {
1586 int cc;
1587 Blk *q, *t, *s;
1588
1589 rewind(p);
1590 if(length(p)*2 < sc) {
1591 q = copy(p,length(p));
1592 return(q);
1593 }
1594 q = salloc(length(p));
1595 while(sc >= 1) {
1596 sputc(q,sgetc(p));
1597 sc -= 2;
1598 }
1599 if(sc != 0) {
1600 t = mult(q,tenptr);
1601 s = salloc(cc = length(q));
1602 release(q);
1603 rewind(t);
1604 while(cc-- > 0)
1605 sputc(s,sgetc(t));
1606 sputc(s,0);
1607 release(t);
1608 t = div(s,tenptr);
1609 release(s);
1610 release(rem);
1611 return(t);
1612 }
1613 return(q);
1614 }
1615
1616 void
1617 tenot(Blk *p, int sc)
1618 {
1619 int c, f;
1620
1621 fsfile(p);
1622 f=0;
1623 while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) {
1624 c = sbackc(p);
1625 if((c<10) && (f == 1))
1626 Bprint(&bout,"0%d",c);
1627 else
1628 Bprint(&bout,"%d",c);
1629 f=1;
1630 TEST2;
1631 }
1632 if(sc == 0) {
1633 Bprint(&bout,"\n");
1634 release(p);
1635 return;
1636 }
1637 if((p->rd-p->beg)*2 > sc) {
1638 c = sbackc(p);
1639 Bprint(&bout,"%d.",c/10);
1640 TEST2;
1641 OUTC(c%10 +'0');
1642 sc--;
1643 } else {
1644 OUTC('.');
1645 }
1646 while(sc>(p->rd-p->beg)*2) {
1647 OUTC('0');
1648 sc--;
1649 }
1650 while(sc > 1) {
1651 c = sbackc(p);
1652 if(c<10)
1653 Bprint(&bout,"0%d",c);
1654 else
1655 Bprint(&bout,"%d",c);
1656 sc -= 2;
1657 TEST2;
1658 }
1659 if(sc == 1) {
1660 OUTC(sbackc(p)/10 +'0');
1661 }
1662 Bprint(&bout,"\n");
1663 release(p);
1664 }
1665
1666 void
1667 oneot(Blk *p, int sc, char ch)
1668 {
1669 Blk *q;
1670
1671 q = removc(p,sc);
1672 create(strptr);
1673 sputc(strptr,-1);
1674 while(length(q)>0) {
1675 p = add(strptr,q);
1676 release(q);
1677 q = p;
1678 OUTC(ch);
1679 }
1680 release(q);
1681 Bprint(&bout,"\n");
1682 }
1683
1684 void
1685 hexot(Blk *p, int flg)
1686 {
1687 int c;
1688
1689 USED(flg);
1690 rewind(p);
1691 if(sfeof(p) != 0) {
1692 sputc(strptr,'0');
1693 release(p);
1694 return;
1695 }
1696 c = sgetc(p);
1697 release(p);
1698 if(c >= 16) {
1699 Bprint(&bout,"hex digit > 16");
1700 return;
1701 }
1702 sputc(strptr,c<10?c+'0':c-10+'a');
1703 }
1704
1705 void
1706 bigot(Blk *p, int flg)
1707 {
1708 Blk *t, *q;
1709 int neg, l;
1710
1711 if(flg == 1) {
1712 t = salloc(0);
1713 l = 0;
1714 } else {
1715 t = strptr;
1716 l = length(strptr)+fw-1;
1717 }
1718 neg=0;
1719 if(length(p) != 0) {
1720 fsfile(p);
1721 if(sbackc(p)<0) {
1722 neg=1;
1723 chsign(p);
1724 }
1725 while(length(p) != 0) {
1726 q = div(p,tenptr);
1727 release(p);
1728 p = q;
1729 rewind(rem);
1730 sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');
1731 release(rem);
1732 }
1733 }
1734 release(p);
1735 if(flg == 1) {
1736 l = fw1-length(t);
1737 if(neg != 0) {
1738 l--;
1739 sputc(strptr,'-');
1740 }
1741 fsfile(t);
1742 while(l-- > 0)
1743 sputc(strptr,'0');
1744 while(sfbeg(t) == 0)
1745 sputc(strptr,sbackc(t));
1746 release(t);
1747 } else {
1748 l -= length(strptr);
1749 while(l-- > 0)
1750 sputc(strptr,'0');
1751 if(neg != 0) {
1752 sclobber(strptr);
1753 sputc(strptr,'-');
1754 }
1755 }
1756 sputc(strptr,' ');
1757 }
1758
1759 Blk*
1760 add(Blk *a1, Blk *a2)
1761 {
1762 Blk *p;
1763 int carry, n, size, c, n1, n2;
1764
1765 size = length(a1)>length(a2)?length(a1):length(a2);
1766 p = salloc(size);
1767 rewind(a1);
1768 rewind(a2);
1769 carry=0;
1770 while(--size >= 0) {
1771 n1 = sfeof(a1)?0:sgetc(a1);
1772 n2 = sfeof(a2)?0:sgetc(a2);
1773 n = n1 + n2 + carry;
1774 if(n>=100) {
1775 carry=1;
1776 n -= 100;
1777 } else
1778 if(n<0) {
1779 carry = -1;
1780 n += 100;
1781 } else
1782 carry = 0;
1783 sputc(p,n);
1784 }
1785 if(carry != 0)
1786 sputc(p,carry);
1787 fsfile(p);
1788 if(sfbeg(p) == 0) {
1789 c = 0;
1790 while(sfbeg(p) == 0 && (c = sbackc(p)) == 0)
1791 ;
1792 if(c != 0)
1793 salterc(p,c);
1794 truncate(p);
1795 }
1796 fsfile(p);
1797 if(sfbeg(p) == 0 && sbackc(p) == -1) {
1798 while((c = sbackc(p)) == 99) {
1799 if(c == -1)
1800 break;
1801 }
1802 skipc(p);
1803 salterc(p,-1);
1804 truncate(p);
1805 }
1806 return(p);
1807 }
1808
1809 int
1810 eqk(void)
1811 {
1812 Blk *p, *q;
1813 int skp, skq;
1814
1815 p = pop();
1816 EMPTYS;
1817 q = pop();
1818 EMPTYSR(p);
1819 skp = sunputc(p);
1820 skq = sunputc(q);
1821 if(skp == skq) {
1822 arg1=p;
1823 arg2=q;
1824 savk = skp;
1825 return(0);
1826 }
1827 if(skp < skq) {
1828 savk = skq;
1829 p = add0(p,skq-skp);
1830 } else {
1831 savk = skp;
1832 q = add0(q,skp-skq);
1833 }
1834 arg1=p;
1835 arg2=q;
1836 return(0);
1837 }
1838
1839 Blk*
1840 removc(Blk *p, int n)
1841 {
1842 Blk *q, *r;
1843
1844 rewind(p);
1845 while(n>1) {
1846 skipc(p);
1847 n -= 2;
1848 }
1849 q = salloc(2);
1850 while(sfeof(p) == 0)
1851 sputc(q,sgetc(p));
1852 if(n == 1) {
1853 r = div(q,tenptr);
1854 release(q);
1855 release(rem);
1856 q = r;
1857 }
1858 release(p);
1859 return(q);
1860 }
1861
1862 Blk*
1863 scalint(Blk *p)
1864 {
1865 int n;
1866
1867 n = sunputc(p);
1868 p = removc(p,n);
1869 return(p);
1870 }
1871
1872 Blk*
1873 scale(Blk *p, int n)
1874 {
1875 Blk *q, *s, *t;
1876
1877 t = add0(p,n);
1878 q = salloc(1);
1879 sputc(q,n);
1880 s = dcexp(inbas,q);
1881 release(q);
1882 q = div(t,s);
1883 release(t);
1884 release(s);
1885 release(rem);
1886 sputc(q,n);
1887 return(q);
1888 }
1889
1890 int
1891 subt(void)
1892 {
1893 arg1=pop();
1894 EMPTYS;
1895 savk = sunputc(arg1);
1896 chsign(arg1);
1897 sputc(arg1,savk);
1898 pushp(arg1);
1899 if(eqk() != 0)
1900 return(1);
1901 binop('+');
1902 return(0);
1903 }
1904
1905 int
1906 command(void)
1907 {
1908 char line[100], *sl;
1909 int pid, p, c;
1910
1911 switch(c = readc()) {
1912 case '<':
1913 return(cond(NL));
1914 case '>':
1915 return(cond(NG));
1916 case '=':
1917 return(cond(NE));
1918 default:
1919 sl = line;
1920 *sl++ = c;
1921 while((c = readc()) != '\n')
1922 *sl++ = c;
1923 *sl = 0;
1924 if((pid = fork()) == 0) {
1925 execl("/bin/rc","rc","-c",line,0);
1926 exits("shell");
1927 }
1928 for(;;) {
1929 if((p = waitpid()) < 0)
1930 break;
1931 if(p== pid)
1932 break;
1933 }
1934 Bprint(&bout,"!\n");
1935 return(0);
1936 }
1937 }
1938
1939 int
1940 cond(char c)
1941 {
1942 Blk *p;
1943 int cc;
1944
1945 if(subt() != 0)
1946 return(1);
1947 p = pop();
1948 sclobber(p);
1949 if(length(p) == 0) {
1950 release(p);
1951 if(c == '<' || c == '>' || c == NE) {
1952 getstk();
1953 return(0);
1954 }
1955 load();
1956 return(1);
1957 }
1958 if(c == '='){
1959 release(p);
1960 getstk();
1961 return(0);
1962 }
1963 if(c == NE) {
1964 release(p);
1965 load();
1966 return(1);
1967 }
1968 fsfile(p);
1969 cc = sbackc(p);
1970 release(p);
1971 if((cc<0 && (c == '<' || c == NG)) ||
1972 (cc >0) && (c == '>' || c == NL)) {
1973 getstk();
1974 return(0);
1975 }
1976 load();
1977 return(1);
1978 }
1979
1980 void
1981 load(void)
1982 {
1983 int c;
1984 Blk *p, *q, *t, *s;
1985
1986 c = getstk() & 0377;
1987 sptr = stable[c];
1988 if(sptr != 0) {
1989 p = sptr->val;
1990 if(c >= ARRAYST) {
1991 q = salloc(length(p));
1992 rewind(p);
1993 while(sfeof(p) == 0) {
1994 s = dcgetwd(p);
1995 if(s == 0) {
1996 putwd(q, (Blk*)0);
1997 } else {
1998 t = copy(s,length(s));
1999 putwd(q,t);
2000 }
2001 }
2002 pushp(q);
2003 } else {
2004 q = copy(p,length(p));
2005 pushp(q);
2006 }
2007 } else {
2008 q = salloc(1);
2009 if(c <= LASTFUN) {
2010 Bprint(&bout,"function %c undefined\n",c+'a'-1);
2011 sputc(q,'c');
2012 sputc(q,'0');
2013 sputc(q,' ');
2014 sputc(q,'1');
2015 sputc(q,'Q');
2016 }
2017 else
2018 sputc(q,0);
2019 pushp(q);
2020 }
2021 }
2022
2023 int
2024 log2(long n)
2025 {
2026 int i;
2027
2028 if(n == 0)
2029 return(0);
2030 i=31;
2031 if(n<0)
2032 return(i);
2033 while((n= n<<1) >0)
2034 i--;
2035 return i-1;
2036 }
2037
2038 Blk*
2039 salloc(int size)
2040 {
2041 Blk *hdr;
2042 char *ptr;
2043
2044 all++;
2045 lall++;
2046 if(all - rel > active)
2047 active = all - rel;
2048 nbytes += size;
2049 lbytes += size;
2050 if(nbytes >maxsize)
2051 maxsize = nbytes;
2052 if(size > longest)
2053 longest = size;
2054 ptr = malloc((unsigned)size);
2055 if(ptr == 0){
2056 garbage("salloc");
2057 if((ptr = malloc((unsigned)size)) == 0)
2058 ospace("salloc");
2059 }
2060 if((hdr = hfree) == 0)
2061 hdr = morehd();
2062 hfree = (Blk *)hdr->rd;
2063 hdr->rd = hdr->wt = hdr->beg = ptr;
2064 hdr->last = ptr+size;
2065 return(hdr);
2066 }
2067
2068 Blk*
2069 morehd(void)
2070 {
2071 Blk *h, *kk;
2072
2073 headmor++;
2074 nbytes += HEADSZ;
2075 hfree = h = (Blk *)malloc(HEADSZ);
2076 if(hfree == 0) {
2077 garbage("morehd");
2078 if((hfree = h = (Blk*)malloc(HEADSZ)) == 0)
2079 ospace("headers");
2080 }
2081 kk = h;
2082 while(h<hfree+(HEADSZ/BLK))
2083 (h++)->rd = (char*)++kk;
2084 (h-1)->rd=0;
2085 return(hfree);
2086 }
2087
2088 Blk*
2089 copy(Blk *hptr, int size)
2090 {
2091 Blk *hdr;
2092 unsigned sz;
2093 char *ptr;
2094
2095 all++;
2096 lall++;
2097 lcopy++;
2098 nbytes += size;
2099 lbytes += size;
2100 if(size > longest)
2101 longest = size;
2102 if(size > maxsize)
2103 maxsize = size;
2104 sz = length(hptr);
2105 ptr = malloc(size);
2106 if(ptr == 0) {
2107 Bprint(&bout,"copy size %d\n",size);
2108 ospace("copy");
2109 }
2110 memmove(ptr, hptr->beg, sz);
2111 memset(ptr+sz, 0, size-sz);
2112 if((hdr = hfree) == 0)
2113 hdr = morehd();
2114 hfree = (Blk *)hdr->rd;
2115 hdr->rd = hdr->beg = ptr;
2116 hdr->last = ptr+size;
2117 hdr->wt = ptr+sz;
2118 ptr = hdr->wt;
2119 while(ptr<hdr->last)
2120 *ptr++ = '\0';
2121 return(hdr);
2122 }
2123
2124 void
2125 sdump(char *s1, Blk *hptr)
2126 {
2127 char *p;
2128
2129 Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n",
2130 s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
2131 p = hptr->beg;
2132 while(p < hptr->wt)
2133 Bprint(&bout,"%d ",*p++);
2134 Bprint(&bout,"\n");
2135 }
2136
2137 void
2138 seekc(Blk *hptr, int n)
2139 {
2140 char *nn,*p;
2141
2142 nn = hptr->beg+n;
2143 if(nn > hptr->last) {
2144 nbytes += nn - hptr->last;
2145 if(nbytes > maxsize)
2146 maxsize = nbytes;
2147 lbytes += nn - hptr->last;
2148 if(n > longest)
2149 longest = n;
2150 /* free(hptr->beg); */
2151 p = realloc(hptr->beg, n);
2152 if(p == 0) {
2153 /* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg);
2154 ** garbage("seekc");
2155 ** if((p = realloc(hptr->beg, n)) == 0)
2156 */ ospace("seekc");
2157 }
2158 hptr->beg = p;
2159 hptr->wt = hptr->last = hptr->rd = p+n;
2160 return;
2161 }
2162 hptr->rd = nn;
2163 if(nn>hptr->wt)
2164 hptr->wt = nn;
2165 }
2166
2167 void
2168 salterwd(Blk *ahptr, Blk *n)
2169 {
2170 Wblk *hptr;
2171
2172 hptr = (Wblk*)ahptr;
2173 if(hptr->rdw == hptr->lastw)
2174 more(ahptr);
2175 *hptr->rdw++ = n;
2176 if(hptr->rdw > hptr->wtw)
2177 hptr->wtw = hptr->rdw;
2178 }
2179
2180 void
2181 more(Blk *hptr)
2182 {
2183 unsigned size;
2184 char *p;
2185
2186 if((size=(hptr->last-hptr->beg)*2) == 0)
2187 size=2;
2188 nbytes += size/2;
2189 if(nbytes > maxsize)
2190 maxsize = nbytes;
2191 if(size > longest)
2192 longest = size;
2193 lbytes += size/2;
2194 lmore++;
2195 /* free(hptr->beg);*/
2196 p = realloc(hptr->beg, size);
2197
2198 if(p == 0) {
2199 /* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg));
2200 ** garbage("more");
2201 ** if((p = realloc(hptr->beg,size)) == 0)
2202 */ ospace("more");
2203 }
2204 hptr->rd = p + (hptr->rd - hptr->beg);
2205 hptr->wt = p + (hptr->wt - hptr->beg);
2206 hptr->beg = p;
2207 hptr->last = p+size;
2208 }
2209
2210 void
2211 ospace(char *s)
2212 {
2213 Bprint(&bout,"out of space: %s\n",s);
2214 Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor);
2215 Bprint(&bout,"nbytes %ld\n",nbytes);
2216 sdump("stk",*stkptr);
2217 abort();
2218 }
2219
2220 void
2221 garbage(char *s)
2222 {
2223 USED(s);
2224 }
2225
2226 void
2227 release(Blk *p)
2228 {
2229 rel++;
2230 lrel++;
2231 nbytes -= p->last - p->beg;
2232 p->rd = (char*)hfree;
2233 hfree = p;
2234 free(p->beg);
2235 }
2236
2237 Blk*
2238 dcgetwd(Blk *p)
2239 {
2240 Wblk *wp;
2241
2242 wp = (Wblk*)p;
2243 if(wp->rdw == wp->wtw)
2244 return(0);
2245 return(*wp->rdw++);
2246 }
2247
2248 void
2249 putwd(Blk *p, Blk *c)
2250 {
2251 Wblk *wp;
2252
2253 wp = (Wblk*)p;
2254 if(wp->wtw == wp->lastw)
2255 more(p);
2256 *wp->wtw++ = c;
2257 }
2258
2259 Blk*
2260 lookwd(Blk *p)
2261 {
2262 Wblk *wp;
2263
2264 wp = (Wblk*)p;
2265 if(wp->rdw == wp->wtw)
2266 return(0);
2267 return(*wp->rdw);
2268 }
2269
2270 int
2271 getstk(void)
2272 {
2273 int n;
2274 uchar c;
2275
2276 c = readc();
2277 if(c != '<')
2278 return c;
2279 n = 0;
2280 while(1) {
2281 c = readc();
2282 if(c == '>')
2283 break;
2284 n = n*10+c-'0';
2285 }
2286 return n;
2287 }