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