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