|
|
1.1 root 1: #include <stdio.h>
2: #include "ctype.h"
3: #include "typedef.h"
4: #include "basic.h"
5: #include "tokens.h"
6:
7: #define NOOP 0
8: #define TYPEMASK 07
9: #define min(a,b) ((a)<(b)?(a):(b))
10: #define prio(x) priority[-x]
11: #define between(a,b,c) ((a)<=(b)&&(b)<=(c))
12: #define FIRSTOP OR
13: #define LASTOP PLUS
14: #define OPCOUNT 20
15: #define MAXOP 10
16: #define MAXDIGITS 64
17:
18: static char priority[OPCOUNT];
19: static char priodefs[] = {
20: 20, EXP,
21: 11, MUL, DIV,
22: 10, PLUS, MINUS,
23: 9, EQ, NE, GE, LE, LT, GT,
24: 7, AND,
25: 6, OR,
26: 0, NOOP
27: };
28:
29: Stkptr pushvar(), nextframe();
30: Symptr getvar();
31: char *allocstr(), *getsvar();
32: double popfloat(), modf(), atof(), cvtnumber(), exp(), log(), fabs(), floor();
33:
34:
35: /*
36: * initprio --- initialize the operator-priority map
37: */
38:
39: initprio()
40: {
41: register int pri;
42: register char *p;
43:
44: for (p = priodefs; p < priodefs + sizeof priodefs; p++)
45: if (*p >= 0)
46: pri = *p;
47: else
48: prio(*p) = pri;
49: if (tflg)
50: for (pri = FIRSTOP; pri <= LASTOP; pri++)
51: fprintf(stderr, "priority[%d] == %d\n", pri, prio(pri));
52: }
53:
54:
55: /*
56: * expr --- interpret an expression, push result onto stack
57: */
58:
59: expr()
60: {
61: register int op, evop;
62: register char *opptr;
63: char opstk[MAXOP];
64: int c;
65:
66: #define getop() (between(FIRSTOP,*inptr,LASTOP)? *inptr++ : 0)
67: #define getitem() {\
68: c = *inptr;\
69: if (isalpha(c))\
70: pushvar();\
71: else if (isdigit(c))\
72: pushfloat(cvtnumber(&inptr, MAXINT));\
73: else\
74: item();\
75: }
76:
77: getitem();
78: if ((op = getop()) == 0)
79: return;
80: opptr = opstk;
81: *opptr++ = NOOP;
82: for (;;)
83: if (prio(opptr[-1]) >= prio(op)) {
84: evop = *--opptr;
85: if (evop == NOOP)
86: return;
87: eval(evop);
88: }
89: else {
90: getitem();
91: *opptr++ = op;
92: if (opptr > opstk + MAXOP)
93: err("expression too complex");
94: op = getop();
95: }
96: }
97:
98:
99: /*
100: * eval --- evaluate the specified operator using stacked operands
101: */
102:
103: eval(op)
104: {
105: double fp1, fp2;
106: register Stkptr s;
107:
108: s = (Stkptr)stkptr;
109: if (s->k_type == STRINGEXPR) {
110: streval(op);
111: return;
112: }
113: fp2 = popfloat();
114: s = (Stkptr)stkptr;
115: if (s->k_type != FLOATEXPR)
116: badstk(FLOATEXPR);
117: fp1 = s->k_un.k_dbl;
118:
119: switch(op) {
120: case PLUS:
121: fp1 += fp2;
122: break;
123: case MINUS:
124: fp1 -= fp2;
125: break;
126: case MUL:
127: fp1 *= fp2;
128: break;
129: case DIV:
130: fp1 /= fp2;
131: break;
132: case EXP:
133: if (fp1 > 0)
134: fp1 = exp(log(fp1) * fp2);
135: else if (fp1 != 0 && fp2 == 0)
136: fp1 = 1;
137: else if (fp1 == 0 && fp2 != 0)
138: fp1 = 0;
139: else if (fp1 < 0 && (fp2 - 2*floor(fp2 / 2.)) == 0)
140: fp1 = exp(log(fabs(fp1)) * fp2);
141: else if (fp1 < 0 && (fp2 - floor(fp2)) == 0)
142: fp1 = -exp(log(fabs(fp1)) * fp2);
143: else {fp1 = 0;
144: fprintf(stderr, "0 to the 0 power and negative numbers");
145: fprintf(stderr, " to noninteger powers \n");
146: fprintf(stderr, " can not be calculated. 0 was returned.\n");
147: };
148: break;
149: case GT:
150: fp1 = (fp1 > fp2);
151: break;
152: case LT:
153: fp1 = (fp1 < fp2);
154: break;
155: case LE:
156: fp1 = (fp1 <= fp2);
157: break;
158: case GE:
159: fp1 = (fp1 >= fp2);
160: break;
161: case EQ:
162: fp1 = (fp1 == fp2);
163: break;
164: case NE:
165: fp1 = (fp1 != fp2);
166: break;
167: case OR:
168: fp1 = ((fp1 != 0) || (fp2 != 0));
169: break;
170: case AND:
171: fp1 = ((fp1 != 0) && (fp2 != 0));
172: break;
173: default:
174: err("bad operator");
175: }
176: s->k_un.k_dbl = fp1;
177: }
178:
179:
180: /*
181: * streval --- evaluate an operator with string operands
182: */
183:
184: streval(op)
185: {
186: register int i;
187: char *ptr1, *ptr2;
188: int len1, len2;
189:
190: if (op == PLUS) {
191: concat();
192: return;
193: }
194: popstring(&ptr2, &len2);
195: popstring(&ptr1, &len1);
196: i = strcmpn(ptr1, len1, ptr2, len2);
197:
198: switch(op) {
199: case GT:
200: i = (i > 0);
201: break;
202: case LT:
203: i = (i < 0);
204: break;
205: case LE:
206: i = (i <= 0);
207: break;
208: case GE:
209: i = (i >= 0);
210: break;
211: case EQ:
212: i = (i == 0);
213: break;
214: case NE:
215: i = (i != 0);
216: break;
217: default:
218: err("bad operator");
219: }
220: pushint(i);
221: }
222:
223:
224: /*
225: * strcmpn --- compare fixed length strings
226: */
227:
228: strcmpn(ptr1, len1, ptr2, len2)
229: char *ptr1, *ptr2;
230: {
231: register int l;
232: register char *p1, *p2;
233:
234: l = min(len1, len2);
235: len1 -= l;
236: len2 -= l;
237: p1 = ptr1;
238: p2 = ptr2;
239: while (l > 0 && *p1++ == *p2++)
240: --l;
241: if (l != 0)
242: return(*--p1 - *--p2);
243: while (len1 > 0) { /* string 1 longer */
244: if (*p1++ != ' ')
245: return(*--p1 - ' ');
246: --len1;
247: }
248: while (len2 > 0) { /* string 2 longer */
249: if (*p2++ != ' ')
250: return(' ' - *--p2);
251: --len2;
252: }
253: return(0); /* strings are equal */
254: }
255:
256:
257: /*
258: * item --- interpret a basic expression element
259: */
260:
261: item()
262: {
263: register Stkptr s;
264: register int c;
265:
266: switch((c = *inptr++)) {
267:
268: case FN: /* function call */
269: --inptr; /* back up to FN token */
270: fn();
271: break;
272: case PLUS: /* unary + */
273: item();
274: break;
275: case MINUS: /* unary - */
276: item();
277: s = (Stkptr)stkptr;
278: if (s->k_type != FLOATEXPR)
279: err("float required");
280: s->k_un.k_dbl = -s->k_un.k_dbl;
281: break;
282: case LPAR: /* parenthesized expr */
283: expr();
284: expectc(RPAR);
285: break;
286: case QUOTE: /* string constant */
287: case PRIME:
288: strconst(c);
289: break;
290: default: /* float constant, variable, or builtin func */
291: --inptr;
292: if (isdigit(c) || c == '.')
293: pushfloat(cvtnumber(&inptr, MAXINT));
294: else if (isalpha(c))
295: pushvar();
296: else if (function())
297: ;
298: else
299: err("bad operand");
300: }
301: }
302:
303:
304: /*
305: * cvtnumber --- convert a string to floating point
306: */
307:
308: double cvtnumber(ptr, len)
309: char **ptr;
310: register int len;
311: {
312: register char *n, *p;
313: char numbuff[MAXDIGITS];
314: double f;
315:
316: p = *ptr;
317: n = numbuff;
318: if (*p == '+') {
319: ++p;
320: --len;
321: }
322: else if (*p == '-') {
323: *n++ = *p++;
324: --len;
325: }
326: for (; isdigit(*p) || *p == '.' || *p == 'e'; ) {
327: if (n >= &numbuff[MAXDIGITS-1]) {
328: *ptr = p;
329: err("too many digits");
330: }
331: *n++ = *p++;
332: if (--len <= 0)
333: break;
334: }
335: *n = 0;
336: f = atof(numbuff);
337: *ptr = p;
338: return(f);
339: }
340:
341:
342: /*
343: * strconst --- interpret a string constant in an expression
344: */
345:
346: strconst(c)
347: {
348: Stkfr s;
349:
350: s.k_un.k_str.s_ptr = inptr;
351: while (*inptr && *inptr != c)
352: ++inptr;
353: s.k_un.k_str.s_len = inptr - s.k_un.k_str.s_ptr;
354: s.k_len = STRFRLEN;
355: s.k_type = STRINGEXPR;
356: push(&s);
357: if (*inptr == c)
358: ++inptr;
359: }
360:
361:
362: /*
363: * badtype --- report a data type error
364: */
365:
366: badtype()
367: {
368:
369: err("bad type");
370: }
371:
372:
373: /*
374: * pushvar --- push the value of a variable onto the stack
375: */
376:
377: Stkptr pushvar()
378: {
379: register char *s;
380: register int i;
381: int type;
382:
383: s = getsvar(&type);
384:
385: switch(type) {
386: case STRING:
387: pushstring(((String *)s)->s_ptr, ((String *)s)->s_len);
388: break;
389: case INT:
390: pushint(*(int *)s);
391: break;
392: case FLOAT:
393: if (SINGLE)
394: pushfloat(*(float *)s);
395: else
396: pushfloat(*(double *)s);
397: break;
398: default:
399: err("value expected");
400: }
401: return((Stkptr)stkptr);
402: }
403:
404:
405: /*
406: * getsc --- convert multi-dimensional subscript to single-dimensional
407: */
408:
409: getsc(v)
410: register Symptr v;
411: {
412: register int i, j, n;
413:
414: if (nsubs != v->v_nsubs)
415: err("wrong number of subscripts");
416: for (j = 0, n = 0;; ) {
417: i = subsc[j];
418: if (i < 1 || i > v->v_un.v_vec.v_subsc[j])
419: err("subscript %d out of range (%d)", j + 1, i);
420: n += i - 1;
421: if (++j >= nsubs)
422: break;
423: n *= v->v_un.v_vec.v_subsc[j];
424: }
425: return(n);
426: }
427:
428:
429: /*
430: * intvalued --- determine if a floating point number is integral
431: */
432:
433: intvalued(f)
434: double f;
435: {
436: double ipart;
437:
438: return(modf(f, &ipart) == 0.0);
439: }
440:
441:
442: /*
443: * let --- interpret a LET statement
444: */
445:
446: let()
447: {
448: register Stkptr s;
449: register char *v;
450: register int i;
451: int type, stype;
452:
453:
454: v = getsvar(&type); /* v points to value in variable */
455:
456: expectc(EQ);
457: expr();
458: s = (Stkptr)stkptr; /* get the expression */
459:
460: stype = s->k_type & TYPEMASK;
461:
462: if (stype != type && (stype == STRING || type == STRING))
463: mixed();
464:
465: switch(type) {
466: case FLOAT:
467: if (SINGLE)
468: *(float *)v = popfloat();
469: else
470: *(double *)v = popfloat();
471: break;
472: case INT:
473: *(int *)v = popint();
474: /* pushfloat(*(double *)v); */
475: break;
476: case STRING:
477: storestring(v);
478: break;
479: default:
480: err("invalid variable");
481: }
482:
483: }
484:
485:
486: /*
487: * cvt --- convert value at top of stack to type "type"
488: */
489:
490: cvt(type)
491: {
492: register Stkptr s;
493: register int stype;
494:
495: s = (Stkptr)stkptr;
496: type &= TYPEMASK;
497: stype = s->k_type & TYPEMASK;
498: if (stype == type)
499: return;
500: switch(type) {
501: case FLOAT:
502: if (stype == INT) {
503: pushfloat((double)popint());
504: return;
505: }
506: break;
507: case INT:
508: if (stype == FLOAT) {
509: pushint((int)popfloat());
510: return;
511: }
512: }
513: err("invalid type conversion");
514: }
515:
516:
517: /*
518: * concat --- concatenate the strings at the top of the stack
519: * don't pop the strings until they have been copied
520: * to their new location in case garbage collection
521: * takes place during allocation
522: */
523:
524: concat()
525: {
526: register Stkptr s, p;
527: register char *q;
528: int slen, plen;
529:
530: s = (Stkptr)stkptr;
531: slen = s->k_un.k_str.s_len;
532: p = nextframe(s);
533: plen = p->k_un.k_str.s_len;
534: if (p->k_type != STRINGEXPR)
535: mixed();
536: if (slen + plen > MAXSTRING)
537: err("string too long");
538: q = allocstr(NULL, slen + plen, 0);
539: move(plen, p->k_un.k_str.s_ptr, q);
540: move(slen, s->k_un.k_str.s_ptr, q + plen);
541: pop(STRINGEXPR); /* get rid of topmost string */
542: p->k_un.k_str.s_ptr = q; /* replace the other */
543: p->k_un.k_str.s_len += slen;
544: }
545:
546:
547: /*
548: * getsvar --- return pointer to value of a variable
549: * return its type in "type"
550: */
551:
552: char *getsvar(type)
553: int *type;
554: {
555: register char *p;
556: register Symptr v;
557: register int i;
558:
559: v = getvar(type, NO);
560: if (nsubs == 0)
561: return((char *)&v->v_un); /* not subscripted */
562: i = getsc(v); /* get and check subscript */
563: switch(*type) {
564: case FLOAT:
565: if (SINGLE)
566: p = (char *)&v->v_un.v_vec.v_vecun.v_fltvec[i];
567: else
568: p = (char *)&v->v_un.v_vec.v_vecun.v_dblvec[i];
569: break;
570: case INT:
571: p = (char *)&v->v_un.v_vec.v_vecun.v_intvec[i];
572: break;
573: case STRING:
574: p = (char *)&v->v_un.v_vec.v_vecun.v_strvec[i];
575: break;
576: default:
577: badtype();
578: }
579: return(p);
580: }
581:
582:
583: /*
584: * mixed --- report mixed data mode error
585: */
586:
587: mixed()
588: {
589:
590: err("mixed modes");
591: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.