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