![[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 [MW Coherent from dump] / coherent / d / bin / dc|
Return to dc.c CVS log | Up to [MW Coherent from dump] / coherent / d / bin / dc |
1.1 root 1: /*
2: * DC - Reverse Polish desk calculator (multi-precision)
3: * Depends on mint value being defined as a `char *'
4: * so mint may also be char string
5: */
6: #include <stdio.h>
7: #include "bc.h"
8:
9: char *version = "DC Version 1.00.\n";
10:
11: #define NREG 256
12: #define NSTACK 256
13:
14: struct reg_t {
15: struct reg_t *next;
16: rvalue regval;
17: } *reg[NREG];
18:
19: rvalue stack[NSTACK],
20: *sp = &stack[0];
21:
22: static char *soflmsg = "Out of pushdown",
23: *suflmsg = "stack empty",
24: *oospmsg = "Out of space",
25: *nregmsg = "Missing reg name";
26:
27: #define skiperr(m) {fprintf(stderr,"%s\n",m);return(-1);}
28:
29: #define push(x) {if(sp==&stack[NSTACK]){skiperr(soflmsg);}else{x=sp++;}}
30:
31: #define pop(x) {if(sp==&stack[0]){skiperr(suflmsg);}else{x=--sp;}}
32:
33: #define new(x) {push(x);minit(&(x)->mantissa);}
34:
35: #define temp(x) {push(x);pop(x);}
36:
37: #define tos(x) {pop(x);push(x);}
38:
39: #define getreg(c,r){if((c=getc(infile))==EOF){skiperr(nregmsg);}else{r=reg[c];}}
40:
41: #define newreg(c, r) {\
42: struct reg_t *nr=(struct reg_t *)malloc(sizeof(struct reg_t));\
43: if (nr == NULL) {\
44: skiperr(oospmsg);\
45: } else {\
46: nr->next = r;\
47: r = reg[c] = nr;\
48: }\
49: }
50:
51: #define execute(x, y) if((x)->scale<0){\
52: FILE f;char *s=(x)->mantissa.val;if(y)minit(&(x)->mantissa);\
53: _stropen(s,strlen(s),&f);c=interp(&f);infile=fp;if(y)mpfree(s);\
54: if(c)return(c-1);}
55:
56: main(argc, argv)
57: int argc;
58: char *argv[];
59: {
60: FILE *fp;
61:
62: init();
63: if (argc > 1)
64: if (!strcmp(argv[1], "-V")) {
65: fprintf(stderr, version);
66: exit(0);
67: } else if ((fp=fopen(argv[1], "r"))==NULL) {
68: fprintf(stderr, "Dc: can't open %s\n", argv[1]);
69: return (1);
70: } else if (interp(fp) > 0)
71: return (0);
72: else
73: fclose(fp);
74: while (interp(stdin) < 0)
75: ;
76: return (0);
77: }
78:
79: interp(fp)
80: FILE *fp;
81: {
82: register int c;
83: register rvalue *a, *b;
84: struct reg_t *r;
85: int (*f)();
86: int d;
87: extern int iseq(), isne(), islt(), isle(), isge(), isgt();
88: extern int dcsub(), bcadd(), bcmul(), bcdiv(), bcrem(), bcexp();
89: extern int sibase(), sobase(), output();
90:
91: infile = fp;
92: for (f=NULL;;f=NULL) switch (c = getc(infile)) {
93: case EOF:
94: return (0);
95: case ' ':
96: case '\t':
97: case '\n':
98: continue;
99: case '_':
100: c = getc(infile);
101: f = mneg;
102: /* Fall through */
103: case '0': case '1': case '2': case '3':
104: case '4': case '5': case '6': case '7':
105: case '8': case '9': case 'A': case 'B':
106: case 'C': case 'D': case 'E': case 'F':
107: case '.':
108: push(a);
109: b = getnum(c);
110: *a = *b;
111: mpfree((char *)b);
112: if (f!=NULL)
113: (*f)(&a->mantissa, &a->mantissa);
114: continue;
115: case '-':
116: f = dcsub;
117: goto binary;
118: case '+':
119: f = bcadd;
120: goto binary;
121: case '*':
122: f = bcmul;
123: goto binary;
124: case '/':
125: f = bcdiv;
126: goto binary;
127: case '%':
128: f = bcrem;
129: goto binary;
130: case '^':
131: f = bcexp;
132: /* Fall through */
133: binary:
134: pop(b);
135: pop(a);
136: (*f)(b, a);
137: push(a);
138: continue;
139: case '[':
140: push(a);
141: if (c = rdstring(a))
142: return (c);
143: continue;
144: case '<':
145: f = islt;
146: goto compare;
147: case '=':
148: f = iseq;
149: goto compare;
150: case '>':
151: f = isgt;
152: goto compare;
153: case '!':
154: switch (c=getc(infile)) {
155: case '<':
156: f = isge;
157: goto compare;
158: case '=':
159: f = isne;
160: goto compare;
161: case '>':
162: f = isle;
163: goto compare;
164: default:
165: ungetc(c, infile);
166: temp(a);
167: rdline(a, infile);
168: system(a->mantissa.val);
169: printf("!\n");
170: mvfree(&a->mantissa);
171: continue;
172: }
173: compare:
174: pop(b);
175: pop(a);
176: d = (*f)(bccmp(b, a));
177: getreg(c, r);
178: if (d && r != NULL)
179: execute(&r->regval, 0);
180: continue;
181: case '?':
182: temp(a);
183: rdline(a, stdin);
184: execute(a, 1);
185: continue;
186: case 'c':
187: while (sp != &stack[0]) {
188: pop(a);
189: mvfree(&a->mantissa);
190: }
191: continue;
192: case 'd':
193: tos(a);
194: new(b);
195: mcopy(&a->mantissa, &b->mantissa);
196: b->scale = a->scale;
197: continue;
198: case 'f':
199: for (c = 0; c != NREG; c++)
200: if ((r=reg[c]) != NULL) {
201: printf("`%c': ", c);
202: output(&r->regval);
203: }
204: printf("stack:\n");
205: for (a = &stack[0]; a < sp; a++)
206: output(a);
207: continue;
208: case 'i':
209: f = sibase;
210: goto unary;
211: case 'I':
212: case 'K':
213: new(a);
214: mitom((c=='I' ? ibase : scale), &a->mantissa);
215: a->scale = 0;
216: continue;
217: case 'k':
218: pop(a);
219: scale = rtoint(a);
220: mvfree(&a->mantissa);
221: if (scale < 0) {
222: scale = 0;
223: skiperr("Scale < 0");
224: }
225: continue;
226: case 'l':
227: case 'L':
228: getreg(c, r);
229: new(a);
230: if (r == NULL) {
231: newscalar(a);
232: } else if (c == 'l') {
233: mcopy(&r->regval.mantissa, &a->mantissa);
234: a->scale = r->regval.scale;
235: } else {
236: reg[c] = r->next;
237: *a = r->regval;
238: free((char *)r);
239: }
240: continue;
241: case 'o':
242: f = sobase;
243: goto unary;
244: case 'O':
245: new(a);
246: mcopy(&outbase, &a->mantissa);
247: a->scale = 0;
248: continue;
249: case 'p':
250: tos(a);
251: output(a);
252: continue;
253: case 'P':
254: f = output;
255: /* Fall through */
256: unary:
257: pop(a);
258: (*f)(a);
259: mvfree(&a->mantissa);
260: continue;
261: case 'q':
262: return (1);
263: continue;
264: case 'Q':
265: pop(a);
266: c = rtoint(a);
267: mvfree(&a->mantissa);
268: return (--c > 0 ? c : 0);
269: continue;
270: case 's':
271: getreg(c, r);
272: pop(a);
273: if (r != NULL) {
274: mvfree(&r->regval.mantissa);
275: } else
276: newreg(c, r);
277: r->regval = *a;
278: continue;
279: case 'S':
280: getreg(c, r);
281: pop(a);
282: newreg(c, r);
283: r->regval = *a;
284: continue;
285: case 'v':
286: tos(a);
287: bcsqrt(a);
288: continue;
289: case 'x':
290: pop(a);
291: execute(a, 1);
292: continue;
293: case 'X':
294: tos(a);
295: mitom(a->scale, &a->mantissa);
296: a->scale = 0;
297: continue;
298: case 'z':
299: new(a);
300: mitom(sp - &stack[0], &a->mantissa);
301: a->scale = 0;
302: continue;
303: case 'Z':
304: {
305: char *s;
306:
307: tos(a);
308: s = mtos(&a->mantissa);
309: mitom(strlen(s), &a->mantissa);
310: a->scale = 0;
311: mpfree(s);
312: }
313: continue;
314: default:
315: fprintf(stderr, "`%c'", c);
316: skiperr("?");
317: }
318: }
319:
320: iseq(x)
321: {
322: return (x==0);
323: }
324:
325: isne(x)
326: {
327: return (x!=0);
328: }
329:
330: islt(x)
331: {
332: return (x<0);
333: }
334:
335: isle(x)
336: {
337: return (x<=0);
338: }
339:
340: isge(x)
341: {
342: return (x>=0);
343: }
344:
345: isgt(x)
346: {
347: return (x>0);
348: }
349:
350: rdstring(v)
351: rvalue *v;
352: {
353: register int c;
354: register char *s,
355: *str;
356: unsigned int len,
357: d = 0; /* nesting depth */
358:
359: s = str = malloc(len=16);
360: while ((c=getc(infile)) != EOF) {
361: if (c == '[')
362: ++d;
363: else if (c == ']' && d-- == 0)
364: break;
365: if (str != NULL)
366: *s++ = c;
367: if (s == &str[len]) {
368: str = realloc(str, len*=2);
369: s = &str[len/2];
370: }
371: }
372: if (str == NULL) {
373: skiperr(oospmsg);
374: } else if (c == EOF) {
375: skiperr("Missing ']'");
376: } else {
377: *s = '\0';
378: v->mantissa.val = str;
379: v->mantissa.len = len;
380: v->scale = -1;
381: return (0);
382: }
383: }
384: rdline(v, fp)
385: rvalue *v;
386: FILE *fp;
387: {
388: register int c;
389: register char *s,
390: *str;
391: unsigned int len;
392:
393: s = str = malloc(len=16);
394: while ((c=getc(fp))!= EOF && c != '\n') {
395: if (str != NULL)
396: *s++ = c;
397: if (s == &str[len]) {
398: str = realloc(str, len*=2);
399: s = &str[len/2];
400: }
401: }
402: if (str == NULL) {
403: skiperr(oospmsg);
404: } else {
405: *s = '\0';
406: v->mantissa.val = str;
407: v->mantissa.len = len;
408: v->scale = -1;
409: return (0);
410: }
411: }
412:
413: output(v)
414: rvalue *v;
415: {
416: if (v->scale < 0)
417: printf("%s\n", v->mantissa.val);
418: else {
419: putnum(v);
420: pnewln();
421: }
422: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.