|
|
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;
594: long c,td,cc;
595: struct blk *ps;
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 = 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: fsfile(divd);
635: td = sbackc(divd) * 100;
636: dd = sfbeg(divd)?0:sbackc(divd);
637: td = (td + dd) * 100;
638: dd = sfbeg(divd)?0:sbackc(divd);
639: td = td + dd;
640: cc = c;
641: if(offset == 0)td++;
642: else cc++;
643: if(magic != 0)td = td<<3;
644: dig = td/cc;
645: if(td%cc < 8 && dig > 0 && magic){
646: dig--;
647: }
648: rewind(divr);
649: rewind(divxyz);
650: carry = 0;
651: while(sfeof(divr) == 0){
652: d = sgetc(divr)*dig+carry;
653: carry = d / 100;
654: salterc(divxyz,d%100);
655: }
656: salterc(divxyz,carry);
657: rewind(divxyz);
658: seekc(divd,offset);
659: carry = 0;
660: while(sfeof(divd) == 0){
661: d = slookc(divd);
662: d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
663: carry = 0;
664: if(d < 0){
665: d += 100;
666: carry = 1;
667: }
668: salterc(divd,d);
669: }
670: divcarry = carry;
671: sbackc(p);
672: salterc(p,dig);
673: sbackc(p);
674: fsfile(divd);
675: d=sbackc(divd);
676: if((d != 0) && /*!divcarry*/ (offset != 0)){
677: d = sbackc(divd) + 100;
678: salterc(divd,d);
679: }
680: if(--offset >= 0)divd->wt--;
681: }
682: if(divcarry != 0){
683: salterc(p,dig-1);
684: salterc(divd,-1);
685: ps = add(divr,divd);
686: release(divd);
687: divd = ps;
688: }
689:
690: rewind(p);
691: divcarry = 0;
692: while(sfeof(p) == 0){
693: d = slookc(p)+divcarry;
694: divcarry = 0;
695: if(d >= 100){
696: d -= 100;
697: divcarry = 1;
698: }
699: salterc(p,d);
700: }
701: if(divcarry != 0)salterc(p,divcarry);
702: fsfile(p);
703: while(sfbeg(p) == 0){
704: if(sbackc(p) == 0)truncate(p);
705: else break;
706: }
707: if(divsign < 0)chsign(p);
708: fsfile(divd);
709: while(sfbeg(divd) == 0){
710: if(sbackc(divd) == 0)truncate(divd);
711: else break;
712: }
713: ddone:
714: if(remsign<0)chsign(divd);
715: if(divr != ddivr)release(divr);
716: rem = divd;
717: return(p);
718: }
719: dscale(){
720: register struct blk *dd,*dr;
721: register struct blk *r;
722: int c;
723:
724: dr = pop();
725: EMPTYS;
726: dd = pop();
727: EMPTYSR(dr);
728: fsfile(dd);
729: skd = sunputc(dd);
730: fsfile(dr);
731: skr = sunputc(dr);
732: if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)){
733: sputc(dr,skr);
734: pushp(dr);
735: printf("divide by 0\n");
736: return(1);
737: }
738: if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)){
739: sputc(dd,skd);
740: pushp(dd);
741: return(1);
742: }
743: c = k-skd+skr;
744: if(c < 0)r = removr(dd,-c);
745: else {
746: r = add0(dd,c);
747: irem = 0;
748: }
749: arg1 = r;
750: arg2 = dr;
751: savk = k;
752: return(0);
753: }
754: struct blk *
755: removr(p,n)
756: struct blk *p;
757: {
758: int nn, neg;
759: register struct blk *q,*s,*r, *t;
760: fsfile(p);
761: neg = sbackc(p);
762: if(neg < 0)
763: chsign(p);
764: rewind(p);
765: nn = (n+1)/2;
766: q = salloc(nn);
767: while(n>1){
768: sputc(q,sgetc(p));
769: n -= 2;
770: }
771: r = salloc(2);
772: while(sfeof(p) == 0)sputc(r,sgetc(p));
773: release(p);
774: if(n == 1){
775: s = div(r,tenptr);
776: release(r);
777: rewind(rem);
778: if(sfeof(rem) == 0)
779: sputc(q,sgetc(rem));
780: release(rem);
781: if(neg < 0){
782: chsign(s);
783: chsign(q);
784: irem = q;
785: return(s);
786: }
787: irem = q;
788: return(s);
789: }
790: if(neg < 0){
791: chsign(r);
792: chsign(q);
793: irem = q;
794: return(r);
795: }
796: irem = q;
797: return(r);
798: }
799: struct blk *
800: sqrt(p)
801: struct blk *p;
802: {
803: struct blk *t;
804: struct blk *r,*q,*s;
805: int c,n,nn;
806:
807: n = length(p);
808: fsfile(p);
809: c = sbackc(p);
810: if((n&1) != 1)c = c*100+(sfbeg(p)?0:sbackc(p));
811: n = (n+1)>>1;
812: r = salloc(n);
813: zero(r);
814: seekc(r,n);
815: nn=1;
816: while((c -= nn)>=0)nn+=2;
817: c=(nn+1)>>1;
818: fsfile(r);
819: sbackc(r);
820: if(c>=100){
821: c -= 100;
822: salterc(r,c);
823: sputc(r,1);
824: }
825: else salterc(r,c);
826: while(1){
827: q = div(p,r);
828: s = add(q,r);
829: release(q);
830: release(rem);
831: q = div(s,sqtemp);
832: release(s);
833: release(rem);
834: s = copy(r,length(r));
835: chsign(s);
836: t = add(s,q);
837: release(s);
838: fsfile(t);
839: nn = sfbeg(t)?0:sbackc(t);
840: if(nn>=0)break;
841: release(r);
842: release(t);
843: r = q;
844: }
845: release(t);
846: release(q);
847: release(p);
848: return(r);
849: }
850: struct blk *
851: exp(base,ex)
852: struct blk *base,*ex;
853: {
854: register struct blk *r,*e,*p;
855: struct blk *e1,*t,*cp;
856: int temp,c,n;
857: r = salloc(1);
858: sputc(r,1);
859: p = copy(base,length(base));
860: e = copy(ex,length(ex));
861: fsfile(e);
862: if(sfbeg(e) != 0)goto edone;
863: temp=0;
864: c = sbackc(e);
865: if(c<0){
866: temp++;
867: chsign(e);
868: }
869: while(length(e) != 0){
870: e1=div(e,sqtemp);
871: release(e);
872: e = e1;
873: n = length(rem);
874: release(rem);
875: if(n != 0){
876: e1=mult(p,r);
877: release(r);
878: r = e1;
879: }
880: t = copy(p,length(p));
881: cp = mult(p,t);
882: release(p);
883: release(t);
884: p = cp;
885: }
886: if(temp != 0){
887: if((c = length(base)) == 0){
888: goto edone;
889: }
890: if(c>1)create(r);
891: else{
892: rewind(base);
893: if((c = sgetc(base))<=1){
894: create(r);
895: sputc(r,c);
896: }
897: else create(r);
898: }
899: }
900: edone:
901: release(p);
902: release(e);
903: return(r);
904: }
905: init(argc,argv)
906: int argc;
907: char *argv[];
908: {
909: register struct sym *sp;
910:
911: if (signal(SIGINT, SIG_IGN) != SIG_IGN)
912: signal(SIGINT,onintr);
913: setbuf(stdout,(char *)NULL);
914: svargc = --argc;
915: svargv = argv;
916: while(svargc>0 && svargv[1][0] == '-'){
917: switch(svargv[1][1]){
918: default:
919: dbg=1;
920: }
921: svargc--;
922: svargv++;
923: }
924: ifile=1;
925: if(svargc<=0)curfile = stdin;
926: else if((curfile = fopen(svargv[1],"r")) == NULL){
927: printf("can't open file %s\n",svargv[1]);
928: exit(1);
929: }
930: dummy = malloc(0);
931: scalptr = salloc(1);
932: sputc(scalptr,0);
933: basptr = salloc(1);
934: sputc(basptr,10);
935: obase=10;
936: log10=log2(10L);
937: ll=70;
938: fw=1;
939: fw1=0;
940: tenptr = salloc(1);
941: sputc(tenptr,10);
942: obase=10;
943: inbas = salloc(1);
944: sputc(inbas,10);
945: sqtemp = salloc(1);
946: sputc(sqtemp,2);
947: chptr = salloc(0);
948: strptr = salloc(0);
949: divxyz = salloc(0);
950: stkbeg = stkptr = &stack[0];
951: stkend = &stack[STKSZ];
952: stkerr = 0;
953: readptr = &readstk[0];
954: k=0;
955: sp = sptr = &symlst[0];
956: while(sptr < &symlst[TBLSZ-1]){
957: sptr->next = ++sp;
958: sptr++;
959: }
960: sptr->next=0;
961: sfree = &symlst[0];
962: return;
963: }
964: onintr(){
965:
966: signal(SIGINT,onintr);
967: while(readptr != &readstk[0]){
968: if(*readptr != 0){release(*readptr);}
969: readptr--;
970: }
971: curfile = stdin;
972: commnds();
973: }
974: pushp(p)
975: struct blk *p;
976: {
977: if(stkptr == stkend){
978: printf("out of stack space\n");
979: return;
980: }
981: stkerr=0;
982: *++stkptr = p;
983: return;
984: }
985: struct blk *
986: pop(){
987: if(stkptr == stack){
988: stkerr=1;
989: return(0);
990: }
991: return(*stkptr--);
992: }
993: struct blk *
994: readin(){
995: register struct blk *p,*q;
996: int dp,dpct;
997: register int c;
998:
999: dp = dpct=0;
1000: p = salloc(0);
1001: while(1){
1002: c = readc();
1003: switch(c){
1004: case '.':
1005: if(dp != 0)
1006: goto gotnum;
1007: dp++;
1008: continue;
1009: case '\\':
1010: readc();
1011: continue;
1012: default:
1013: if(c >= 'A' && c <= 'F')c = c - 'A' + 10;
1014: else if(c >= '0' && c <= '9')c -= '0';
1015: else goto gotnum;
1016: if(dp != 0){
1017: if(dpct >= 99)continue;
1018: dpct++;
1019: }
1020: create(chptr);
1021: if(c != 0)sputc(chptr,c);
1022: q = mult(p,inbas);
1023: release(p);
1024: p = add(chptr,q);
1025: release(q);
1026: }
1027: }
1028: gotnum:
1029: unreadc(c);
1030: if(dp == 0){
1031: sputc(p,0);
1032: return(p);
1033: }
1034: else{
1035: q = scale(p,dpct);
1036: return(q);
1037: }
1038: }
1039: struct blk *
1040: add0(p,ct)
1041: int ct;
1042: struct blk *p;
1043: {
1044: /* returns pointer to struct with ct 0's & p */
1045: register struct blk *q,*t;
1046:
1047: q = salloc(length(p)+(ct+1)/2);
1048: while(ct>1){
1049: sputc(q,0);
1050: ct -= 2;
1051: }
1052: rewind(p);
1053: while(sfeof(p) == 0){
1054: sputc(q,sgetc(p));
1055: }
1056: release(p);
1057: if(ct == 1){
1058: t = mult(tenptr,q);
1059: release(q);
1060: return(t);
1061: }
1062: return(q);
1063: }
1064: struct blk *
1065: mult(p,q)
1066: struct blk *p,*q;
1067: {
1068: register struct blk *mp,*mq,*mr;
1069: int sign,offset,carry;
1070: int cq,cp,mt,mcr;
1071:
1072: offset = sign = 0;
1073: fsfile(p);
1074: mp = p;
1075: if(sfbeg(p) == 0){
1076: if(sbackc(p)<0){
1077: mp = copy(p,length(p));
1078: chsign(mp);
1079: sign = ~sign;
1080: }
1081: }
1082: fsfile(q);
1083: mq = q;
1084: if(sfbeg(q) == 0){
1085: if(sbackc(q)<0){
1086: mq = copy(q,length(q));
1087: chsign(mq);
1088: sign = ~sign;
1089: }
1090: }
1091: mr = salloc(length(mp)+length(mq));
1092: zero(mr);
1093: rewind(mq);
1094: while(sfeof(mq) == 0){
1095: cq = sgetc(mq);
1096: rewind(mp);
1097: rewind(mr);
1098: mr->rd += offset;
1099: carry=0;
1100: while(sfeof(mp) == 0){
1101: cp = sgetc(mp);
1102: mcr = sfeof(mr)?0:slookc(mr);
1103: mt = cp*cq + carry + mcr;
1104: carry = mt/100;
1105: salterc(mr,mt%100);
1106: }
1107: offset++;
1108: if(carry != 0){
1109: mcr = sfeof(mr)?0:slookc(mr);
1110: salterc(mr,mcr+carry);
1111: }
1112: }
1113: if(sign < 0){
1114: chsign(mr);
1115: }
1116: if(mp != p)release(mp);
1117: if(mq != q)release(mq);
1118: return(mr);
1119: }
1120: chsign(p)
1121: struct blk *p;
1122: {
1123: register int carry;
1124: register char ct;
1125:
1126: carry=0;
1127: rewind(p);
1128: while(sfeof(p) == 0){
1129: ct=100-slookc(p)-carry;
1130: carry=1;
1131: if(ct>=100){
1132: ct -= 100;
1133: carry=0;
1134: }
1135: salterc(p,ct);
1136: }
1137: if(carry != 0){
1138: sputc(p,-1);
1139: fsfile(p);
1140: sbackc(p);
1141: ct = sbackc(p);
1142: if(ct == 99 /*&& !sfbeg(p)*/){
1143: truncate(p);
1144: sputc(p,-1);
1145: }
1146: }
1147: else{
1148: fsfile(p);
1149: ct = sbackc(p);
1150: if(ct == 0)truncate(p);
1151: }
1152: return;
1153: }
1154: readc(){
1155: loop:
1156: if((readptr != &readstk[0]) && (*readptr != 0)){
1157: if(sfeof(*readptr) == 0)return(lastchar = sgetc(*readptr));
1158: release(*readptr);
1159: readptr--;
1160: goto loop;
1161: }
1162: lastchar = getc(curfile);
1163: if(lastchar != EOF)return(lastchar);
1164: if(readptr != &readptr[0]){
1165: readptr--;
1166: if(*readptr == 0)curfile = stdin;
1167: goto loop;
1168: }
1169: if(curfile != stdin){
1170: fclose(curfile);
1171: curfile = stdin;
1172: goto loop;
1173: }
1174: exit(0);
1175: }
1176: unreadc(c)
1177: char c;
1178: {
1179:
1180: if((readptr != &readstk[0]) && (*readptr != 0)){
1181: sungetc(*readptr,c);
1182: }
1183: else ungetc(c,curfile);
1184: return;
1185: }
1186: binop(c)
1187: char c;
1188: {
1189: register struct blk *r;
1190:
1191: switch(c){
1192: case '+':
1193: r = add(arg1,arg2);
1194: break;
1195: case '*':
1196: r = mult(arg1,arg2);
1197: break;
1198: case '/':
1199: r = div(arg1,arg2);
1200: break;
1201: }
1202: release(arg1);
1203: release(arg2);
1204: sputc(r,savk);
1205: pushp(r);
1206: return;
1207: }
1208: print(hptr)
1209: struct blk *hptr;
1210: {
1211: int sc;
1212: register struct blk *p,*q,*dec;
1213: int dig,dout,ct;
1214:
1215: rewind(hptr);
1216: while(sfeof(hptr) == 0){
1217: if(sgetc(hptr)>99){
1218: rewind(hptr);
1219: while(sfeof(hptr) == 0){
1220: printf("%c",sgetc(hptr));
1221: }
1222: printf("\n");
1223: return;
1224: }
1225: }
1226: fsfile(hptr);
1227: sc = sbackc(hptr);
1228: if(sfbeg(hptr) != 0){
1229: printf("0\n");
1230: return;
1231: }
1232: count = ll;
1233: p = copy(hptr,length(hptr));
1234: sunputc(p);
1235: fsfile(p);
1236: if(sbackc(p)<0){
1237: chsign(p);
1238: OUTC('-');
1239: }
1240: if((obase == 0) || (obase == -1)){
1241: oneot(p,sc,'d');
1242: return;
1243: }
1244: if(obase == 1){
1245: oneot(p,sc,'1');
1246: return;
1247: }
1248: if(obase == 10){
1249: tenot(p,sc);
1250: return;
1251: }
1252: create(strptr);
1253: dig = log10*sc;
1254: dout = ((dig/10) + dig) /logo;
1255: dec = getdec(p,sc);
1256: p = removc(p,sc);
1257: while(length(p) != 0){
1258: q = div(p,basptr);
1259: release(p);
1260: p = q;
1261: (*outdit)(rem,0);
1262: }
1263: release(p);
1264: fsfile(strptr);
1265: while(sfbeg(strptr) == 0)OUTC(sbackc(strptr));
1266: if(sc == 0){
1267: release(dec);
1268: printf("\n");
1269: return;
1270: }
1271: create(strptr);
1272: OUTC('.');
1273: ct=0;
1274: do{
1275: q = mult(basptr,dec);
1276: release(dec);
1277: dec = getdec(q,sc);
1278: p = removc(q,sc);
1279: (*outdit)(p,1);
1280: }while(++ct < dout);
1281: release(dec);
1282: rewind(strptr);
1283: while(sfeof(strptr) == 0)OUTC(sgetc(strptr));
1284: printf("\n");
1285: return;
1286: }
1287:
1288: struct blk *
1289: getdec(p,sc)
1290: struct blk *p;
1291: {
1292: int cc;
1293: register struct blk *q,*t,*s;
1294:
1295: rewind(p);
1296: if(length(p)*2 < sc){
1297: q = copy(p,length(p));
1298: return(q);
1299: }
1300: q = salloc(length(p));
1301: while(sc >= 1){
1302: sputc(q,sgetc(p));
1303: sc -= 2;
1304: }
1305: if(sc != 0){
1306: t = mult(q,tenptr);
1307: s = salloc(cc = length(q));
1308: release(q);
1309: rewind(t);
1310: while(cc-- > 0)sputc(s,sgetc(t));
1311: sputc(s,0);
1312: release(t);
1313: t = div(s,tenptr);
1314: release(s);
1315: release(rem);
1316: return(t);
1317: }
1318: return(q);
1319: }
1320: tenot(p,sc)
1321: struct blk *p;
1322: {
1323: register int c,f;
1324:
1325: fsfile(p);
1326: f=0;
1327: while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)){
1328: c = sbackc(p);
1329: if((c<10) && (f == 1))printf("0%d",c);
1330: else printf("%d",c);
1331: f=1;
1332: TEST2;
1333: }
1334: if(sc == 0){
1335: printf("\n");
1336: release(p);
1337: return;
1338: }
1339: if((p->rd-p->beg)*2 > sc){
1340: c = sbackc(p);
1341: printf("%d.",c/10);
1342: TEST2;
1343: OUTC(c%10 +'0');
1344: sc--;
1345: }
1346: else {
1347: OUTC('.');
1348: }
1349: if(sc > (p->rd-p->beg)*2){
1350: while(sc>(p->rd-p->beg)*2){
1351: OUTC('0');
1352: sc--;
1353: }
1354: }
1355: while(sc > 1){
1356: c = sbackc(p);
1357: if(c<10)printf("0%d",c);
1358: else printf("%d",c);
1359: sc -= 2;
1360: TEST2;
1361: }
1362: if(sc == 1){
1363: OUTC(sbackc(p)/10 +'0');
1364: }
1365: printf("\n");
1366: release(p);
1367: return;
1368: }
1369: oneot(p,sc,ch)
1370: struct blk *p;
1371: char ch;
1372: {
1373: register struct blk *q;
1374:
1375: q = removc(p,sc);
1376: create(strptr);
1377: sputc(strptr,-1);
1378: while(length(q)>0){
1379: p = add(strptr,q);
1380: release(q);
1381: q = p;
1382: OUTC(ch);
1383: }
1384: release(q);
1385: printf("\n");
1386: return;
1387: }
1388: hexot(p,flg)
1389: struct blk *p;
1390: {
1391: register int c;
1392: rewind(p);
1393: if(sfeof(p) != 0){
1394: sputc(strptr,'0');
1395: release(p);
1396: return;
1397: }
1398: c = sgetc(p);
1399: release(p);
1400: if(c >= 16){
1401: printf("hex digit > 16");
1402: return;
1403: }
1404: sputc(strptr,c<10?c+'0':c-10+'A');
1405: return;
1406: }
1407: bigot(p,flg)
1408: struct blk *p;
1409: {
1410: register struct blk *t,*q;
1411: register int l;
1412: int neg;
1413:
1414: if(flg == 1)t = salloc(0);
1415: else{
1416: t = strptr;
1417: l = length(strptr)+fw-1;
1418: }
1419: neg=0;
1420: if(length(p) != 0){
1421: fsfile(p);
1422: if(sbackc(p)<0){
1423: neg=1;
1424: chsign(p);
1425: }
1426: while(length(p) != 0){
1427: q = div(p,tenptr);
1428: release(p);
1429: p = q;
1430: rewind(rem);
1431: sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');
1432: release(rem);
1433: }
1434: }
1435: release(p);
1436: if(flg == 1){
1437: l = fw1-length(t);
1438: if(neg != 0){
1439: l--;
1440: sputc(strptr,'-');
1441: }
1442: fsfile(t);
1443: while(l-- > 0)sputc(strptr,'0');
1444: while(sfbeg(t) == 0)sputc(strptr,sbackc(t));
1445: release(t);
1446: }
1447: else{
1448: l -= length(strptr);
1449: while(l-- > 0)sputc(strptr,'0');
1450: if(neg != 0){
1451: sunputc(strptr);
1452: sputc(strptr,'-');
1453: }
1454: }
1455: sputc(strptr,' ');
1456: return;
1457: }
1458: struct blk *
1459: add(a1,a2)
1460: struct blk *a1,*a2;
1461: {
1462: register struct blk *p;
1463: register int carry,n;
1464: int size;
1465: int c,n1,n2;
1466:
1467: size = length(a1)>length(a2)?length(a1):length(a2);
1468: p = salloc(size);
1469: rewind(a1);
1470: rewind(a2);
1471: carry=0;
1472: while(--size >= 0){
1473: n1 = sfeof(a1)?0:sgetc(a1);
1474: n2 = sfeof(a2)?0:sgetc(a2);
1475: n = n1 + n2 + carry;
1476: if(n>=100){
1477: carry=1;
1478: n -= 100;
1479: }
1480: else if(n<0){
1481: carry = -1;
1482: n += 100;
1483: }
1484: else carry = 0;
1485: sputc(p,n);
1486: }
1487: if(carry != 0)sputc(p,carry);
1488: fsfile(p);
1489: if(sfbeg(p) == 0){
1490: while(sfbeg(p) == 0 && (c = sbackc(p)) == 0);
1491: if(c != 0)salterc(p,c);
1492: truncate(p);
1493: }
1494: fsfile(p);
1495: if(sfbeg(p) == 0 && sbackc(p) == -1){
1496: while((c = sbackc(p)) == 99){
1497: if(c == EOF)break;
1498: }
1499: sgetc(p);
1500: salterc(p,-1);
1501: truncate(p);
1502: }
1503: return(p);
1504: }
1505: eqk(){
1506: register struct blk *p,*q;
1507: register int skp;
1508: int skq;
1509:
1510: p = pop();
1511: EMPTYS;
1512: q = pop();
1513: EMPTYSR(p);
1514: skp = sunputc(p);
1515: skq = sunputc(q);
1516: if(skp == skq){
1517: arg1=p;
1518: arg2=q;
1519: savk = skp;
1520: return(0);
1521: }
1522: else if(skp < skq){
1523: savk = skq;
1524: p = add0(p,skq-skp);
1525: }
1526: else {
1527: savk = skp;
1528: q = add0(q,skp-skq);
1529: }
1530: arg1=p;
1531: arg2=q;
1532: return(0);
1533: }
1534: struct blk *
1535: removc(p,n)
1536: struct blk *p;
1537: {
1538: register struct blk *q,*r;
1539:
1540: rewind(p);
1541: while(n>1){
1542: sgetc(p);
1543: n -= 2;
1544: }
1545: q = salloc(2);
1546: while(sfeof(p) == 0)sputc(q,sgetc(p));
1547: if(n == 1){
1548: r = div(q,tenptr);
1549: release(q);
1550: release(rem);
1551: q = r;
1552: }
1553: release(p);
1554: return(q);
1555: }
1556: struct blk *
1557: scalint(p)
1558: struct blk *p;
1559: {
1560: register int n;
1561: n = sunputc(p);
1562: p = removc(p,n);
1563: return(p);
1564: }
1565: struct blk *
1566: scale(p,n)
1567: struct blk *p;
1568: {
1569: register struct blk *q,*s,*t;
1570:
1571: t = add0(p,n);
1572: q = salloc(1);
1573: sputc(q,n);
1574: s = exp(inbas,q);
1575: release(q);
1576: q = div(t,s);
1577: release(t);
1578: release(s);
1579: release(rem);
1580: sputc(q,n);
1581: return(q);
1582: }
1583: subt(){
1584: arg1=pop();
1585: EMPTYS;
1586: savk = sunputc(arg1);
1587: chsign(arg1);
1588: sputc(arg1,savk);
1589: pushp(arg1);
1590: if(eqk() != 0)return(1);
1591: binop('+');
1592: return(0);
1593: }
1594: command(){
1595: int c;
1596: char line[100],*sl;
1597: register (*savint)(),pid,rpid;
1598: int retcode;
1599:
1600: switch(c = readc()){
1601: case '<':
1602: return(cond(NL));
1603: case '>':
1604: return(cond(NG));
1605: case '=':
1606: return(cond(NE));
1607: default:
1608: sl = line;
1609: *sl++ = c;
1610: while((c = readc()) != '\n')*sl++ = c;
1611: *sl = 0;
1612: if((pid = fork()) == 0){
1613: execl("/bin/sh","sh","-c",line,0);
1614: exit(0100);
1615: }
1616: savint = signal(SIGINT, SIG_IGN);
1617: while((rpid = wait(&retcode)) != pid && rpid != -1);
1618: signal(SIGINT,savint);
1619: printf("!\n");
1620: return(0);
1621: }
1622: }
1623: cond(c)
1624: char c;
1625: {
1626: register struct blk *p;
1627: register int cc;
1628:
1629: if(subt() != 0)return(1);
1630: p = pop();
1631: sunputc(p);
1632: if(length(p) == 0){
1633: release(p);
1634: if(c == '<' || c == '>' || c == NE){
1635: readc();
1636: return(0);
1637: }
1638: load();
1639: return(1);
1640: }
1641: else {
1642: if(c == '='){
1643: release(p);
1644: readc();
1645: return(0);
1646: }
1647: }
1648: if(c == NE){
1649: release(p);
1650: load();
1651: return(1);
1652: }
1653: fsfile(p);
1654: cc = sbackc(p);
1655: release(p);
1656: if((cc<0 && (c == '<' || c == NG)) ||
1657: (cc >0) && (c == '>' || c == NL)){
1658: readc();
1659: return(0);
1660: }
1661: load();
1662: return(1);
1663: }
1664: load(){
1665: register int c;
1666: register struct blk *p,*q;
1667: struct blk *t,*s;
1668: c = readc() & 0377;
1669: sptr = stable[c];
1670: if(sptr != 0){
1671: p = sptr->val;
1672: if(c >= ARRAYST){
1673: q = salloc(length(p));
1674: rewind(p);
1675: while(sfeof(p) == 0){
1676: s = getwd(p);
1677: if(s == 0){putwd(q, (struct blk *)NULL);}
1678: else{
1679: t = copy(s,length(s));
1680: putwd(q,t);
1681: }
1682: }
1683: pushp(q);
1684: }
1685: else{
1686: q = copy(p,length(p));
1687: pushp(q);
1688: }
1689: }
1690: else{
1691: q = salloc(1);
1692: if(c <= LASTFUN){
1693: printf("function %c undefined\n",c+'a'-1);
1694: sputc(q,'c');
1695: sputc(q,'0');
1696: sputc(q,' ');
1697: sputc(q,'1');
1698: sputc(q,'Q');
1699: }
1700: else sputc(q,0);
1701: pushp(q);
1702: }
1703: return;
1704: }
1705: log2(n)
1706: long n;
1707: {
1708: register int i;
1709:
1710: if(n == 0)return(0);
1711: i=31;
1712: if(n<0)return(i);
1713: while((n= n<<1) >0)i--;
1714: return(--i);
1715: }
1716:
1717: struct blk *
1718: salloc(size)
1719: int size;
1720: {
1721: register struct blk *hdr;
1722: register char *ptr;
1723: all++;
1724: lall++;
1725: if(all - rel > active)
1726: active = all - rel;
1727: nbytes += size;
1728: lbytes += size;
1729: if(nbytes >maxsize)
1730: maxsize = nbytes;
1731: if(size > longest)
1732: longest = size;
1733: ptr = malloc((unsigned)size);
1734: if(ptr == 0){
1735: garbage("salloc");
1736: if((ptr = malloc((unsigned)size)) == 0)
1737: ospace("salloc");
1738: }
1739: if((hdr = hfree) == 0)hdr = morehd();
1740: hfree = (struct blk *)hdr->rd;
1741: hdr->rd = hdr->wt = hdr->beg = ptr;
1742: hdr->last = ptr+size;
1743: return(hdr);
1744: }
1745: struct blk *
1746: morehd(){
1747: register struct blk *h,*kk;
1748: headmor++;
1749: nbytes += HEADSZ;
1750: hfree = h = (struct blk *)malloc(HEADSZ);
1751: if(hfree == 0){
1752: garbage("morehd");
1753: if((hfree = h = (struct blk *)malloc(HEADSZ)) == 0)
1754: ospace("headers");
1755: }
1756: kk = h;
1757: while(h<hfree+(HEADSZ/BLK))(h++)->rd = (char *)++kk;
1758: (--h)->rd=0;
1759: return(hfree);
1760: }
1761: /*
1762: sunputc(hptr)
1763: struct blk *hptr;
1764: {
1765: hptr->wt--;
1766: hptr->rd = hptr->wt;
1767: return(*hptr->wt);
1768: }
1769: */
1770: struct blk *
1771: copy(hptr,size)
1772: struct blk *hptr;
1773: int size;
1774: {
1775: register struct blk *hdr;
1776: register unsigned sz;
1777: register char *ptr;
1778:
1779: all++;
1780: lall++;
1781: lcopy++;
1782: nbytes += size;
1783: lbytes += size;
1784: if(size > longest)
1785: longest = size;
1786: if(size > maxsize)
1787: maxsize = size;
1788: sz = length(hptr);
1789: ptr = nalloc(hptr->beg, (unsigned)size);
1790: if(ptr == 0){
1791: garbage("copy");
1792: if((ptr = nalloc(hptr->beg, (unsigned)size)) == NULL){
1793: printf("copy size %d\n",size);
1794: ospace("copy");
1795: }
1796: }
1797: if((hdr = hfree) == 0)hdr = morehd();
1798: hfree = (struct blk *)hdr->rd;
1799: hdr->rd = hdr->beg = ptr;
1800: hdr->last = ptr+size;
1801: hdr->wt = ptr+sz;
1802: ptr = hdr->wt;
1803: while(ptr<hdr->last)*ptr++ = '\0';
1804: return(hdr);
1805: }
1806: sdump(s1,hptr)
1807: char *s1;
1808: struct blk *hptr;
1809: {
1810: char *p;
1811: printf("%s %o rd %o wt %o beg %o last %o\n",s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
1812: p = hptr->beg;
1813: while(p < hptr->wt)printf("%d ",*p++);
1814: printf("\n");
1815: }
1816: seekc(hptr,n)
1817: struct blk *hptr;
1818: {
1819: register char *nn,*p;
1820:
1821: nn = hptr->beg+n;
1822: if(nn > hptr->last){
1823: nbytes += nn - hptr->last;
1824: if(nbytes > maxsize)
1825: maxsize = nbytes;
1826: lbytes += nn - hptr->last;
1827: if(n > longest)
1828: longest = n;
1829: free(hptr->beg);
1830: p = realloc(hptr->beg, (unsigned)n);
1831: if(p == 0){
1832: hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
1833: garbage("seekc");
1834: if((p = realloc(hptr->beg, (unsigned)n)) == 0)
1835: ospace("seekc");
1836: }
1837: hptr->beg = p;
1838: hptr->wt = hptr->last = hptr->rd = p+n;
1839: return;
1840: }
1841: hptr->rd = nn;
1842: if(nn>hptr->wt)hptr->wt = nn;
1843: return;
1844: }
1845: salterwd(hptr,n)
1846: struct wblk *hptr;
1847: struct blk *n;
1848: {
1849: if(hptr->rdw == hptr->lastw)more(hptr);
1850: *hptr->rdw++ = n;
1851: if(hptr->rdw > hptr->wtw)hptr->wtw = hptr->rdw;
1852: return;
1853: }
1854: more(hptr)
1855: struct blk *hptr;
1856: {
1857: register unsigned size;
1858: register char *p;
1859:
1860: if((size=(hptr->last-hptr->beg)*2) == 0)size=1;
1861: nbytes += size/2;
1862: if(nbytes > maxsize)
1863: maxsize = nbytes;
1864: if(size > longest)
1865: longest = size;
1866: lbytes += size/2;
1867: lmore++;
1868: /* free(hptr->beg);*/
1869: p = realloc(hptr->beg, (unsigned)size);
1870: if(p == 0){
1871: hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
1872: garbage("more");
1873: if((p = realloc(hptr->beg,size)) == 0)
1874: ospace("more");
1875: }
1876: hptr->rd = hptr->rd-hptr->beg+p;
1877: hptr->wt = hptr->wt-hptr->beg+p;
1878: hptr->beg = p;
1879: hptr->last = p+size;
1880: return;
1881: }
1882: ospace(s)
1883: char *s;
1884: {
1885: printf("out of space: %s\n",s);
1886: printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
1887: printf("nbytes %ld\n",nbytes);
1888: sdump("stk",*stkptr);
1889: abort();
1890: }
1891: garbage(s)
1892: char *s;
1893: {
1894: int i;
1895: struct blk *p, *q;
1896: struct sym *tmps;
1897: int ct;
1898:
1899: printf("got to garbage %s\n",s);
1900: for(i=0;i<TBLSZ;i++){
1901: tmps = stable[i];
1902: if(tmps != 0){
1903: if(i < ARRAYST){
1904: do {
1905: p = tmps->val;
1906: if(((int)p->beg & 01) != 0){
1907: printf("string %o\n",i);
1908: sdump("odd beg",p);
1909: }
1910: redef(p);
1911: tmps = tmps->next;
1912: } while(tmps != 0);
1913: continue;
1914: }
1915: else {
1916: do {
1917: p = tmps->val;
1918: rewind(p);
1919: ct = 0;
1920: while((q = getwd(p)) != NULL){
1921: ct++;
1922: if(q != 0){
1923: if(((int)q->beg & 01) != 0){
1924: printf("array %o elt %d odd\n",i-ARRAYST,ct);
1925: printf("tmps %o p %o\n",tmps,p);
1926: sdump("elt",q);
1927: }
1928: redef(q);
1929: }
1930: }
1931: tmps = tmps->next;
1932: } while(tmps != 0);
1933: }
1934: }
1935: }
1936: }
1937: redef(p)
1938: struct blk *p;
1939: {
1940: register offset;
1941: register char *newp;
1942:
1943: if ((int)p->beg&01) {
1944: printf("odd ptr %o hdr %o\n",p->beg,p);
1945: ospace("redef-bad");
1946: }
1947: free(p->beg);
1948: free(dummy);
1949: dummy = malloc(0);
1950: if(dummy == NULL)ospace("dummy");
1951: newp = realloc(p->beg, (unsigned)(p->last-p->beg));
1952: if(newp == NULL)ospace("redef");
1953: offset = newp - p->beg;
1954: p->beg = newp;
1955: p->rd += offset;
1956: p->wt += offset;
1957: p->last += offset;
1958: }
1959:
1960: release(p)
1961: register struct blk *p;
1962: {
1963: rel++;
1964: lrel++;
1965: nbytes -= p->last - p->beg;
1966: p->rd = (char *)hfree;
1967: hfree = p;
1968: free(p->beg);
1969: }
1970:
1971: struct blk *
1972: getwd(p)
1973: struct blk *p;
1974: {
1975: register struct wblk *wp;
1976:
1977: wp = (struct wblk *)p;
1978: if (wp->rdw == wp->wtw)
1979: return(NULL);
1980: return(*wp->rdw++);
1981: }
1982:
1983: putwd(p, c)
1984: struct blk *p, *c;
1985: {
1986: register struct wblk *wp;
1987:
1988: wp = (struct wblk *)p;
1989: if (wp->wtw == wp->lastw)
1990: more(p);
1991: *wp->wtw++ = c;
1992: }
1993:
1994: struct blk *
1995: lookwd(p)
1996: struct blk *p;
1997: {
1998: register struct wblk *wp;
1999:
2000: wp = (struct wblk *)p;
2001: if (wp->rdw == wp->wtw)
2002: return(NULL);
2003: return(*wp->rdw);
2004: }
2005: char *
2006: nalloc(p,nbytes)
2007: register char *p;
2008: unsigned nbytes;
2009: {
2010: char *malloc();
2011: register char *q, *r;
2012: q = r = malloc(nbytes);
2013: if(q==0)
2014: return(0);
2015: while(nbytes--)
2016: *q++ = *p++;
2017: return(r);
2018: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.