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