dc.c - 9base - revived minimalist port of Plan 9 userland to Unix | |
git clone git://git.suckless.org/9base | |
Log | |
Files | |
Refs | |
README | |
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(… | |
46 #define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");… | |
47 #define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n… | |
48 #define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empt… | |
49 #define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\… | |
50 #define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");p… | |
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",al… | |
221 Bprint(&bout, "nbytes %ld\n",nbytes); | |
222 Bprint(&bout, "longest %ld active %ld maxsize %l… | |
223 active, maxsize); | |
224 Bprint(&bout, "new all %d rel %d copy %d more %d… | |
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 -… | |
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 e… | |
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 corru… | |
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 unde… | |
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… | |
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 } |