|
|
1.1 root 1: #include "hoc.h"
2: #include "y.tab.h"
3: #include <stdio.h>
4:
5: #define NSTACK 256
6:
7: static Datum stack[NSTACK]; /* the stack */
8: static Datum *stackp; /* next free spot on stack */
9:
10: #define NPROG 2000
11: Inst prog[NPROG]; /* the machine */
12: Inst *progp; /* next free spot for code generation */
13: Inst *pc; /* program counter during execution */
14: Inst *progbase = prog; /* start of current subprogram */
15: int returning; /* 1 if return stmt seen */
16:
17: typedef struct Frame { /* proc/func call stack frame */
18: Symbol *sp; /* symbol table entry */
19: Inst *retpc; /* where to resume after return */
20: Datum *argn; /* n-th argument on stack */
21: int nargs; /* number of arguments */
22: } Frame;
23: #define NFRAME 100
24: Frame frame[NFRAME];
25: Frame *fp; /* frame pointer */
26:
27: initcode() {
28: progp = progbase;
29: stackp = stack;
30: fp = frame;
31: returning = 0;
32: }
33:
34: push(d)
35: Datum d;
36: {
37: if (stackp >= &stack[NSTACK])
38: execerror("stack too deep", (char *)0);
39: *stackp++ = d;
40: }
41:
42: Datum pop()
43: {
44: if (stackp == stack)
45: execerror("stack underflow", (char *)0);
46: return *--stackp;
47: }
48:
49: xpop() /* for when no value is wanted */
50: {
51: if (stackp == stack)
52: execerror("stack underflow", (char *)0);
53: --stackp;
54: }
55:
56: constpush()
57: {
58: Datum d;
59: d.val = ((Symbol *)*pc++)->u.val;
60: push(d);
61: }
62:
63: varpush()
64: {
65: Datum d;
66: d.sym = (Symbol *)(*pc++);
67: push(d);
68: }
69:
70: whilecode()
71: {
72: Datum d;
73: Inst *savepc = pc;
74:
75: execute(savepc+2); /* condition */
76: d = pop();
77: while (d.val) {
78: execute(*((Inst **)(savepc))); /* body */
79: if (returning)
80: break;
81: execute(savepc+2); /* condition */
82: d = pop();
83: }
84: if (!returning)
85: pc = *((Inst **)(savepc+1)); /* next stmt */
86: }
87:
88: forcode()
89: {
90: Datum d;
91: Inst *savepc = pc;
92:
93: execute(savepc+4); /* precharge */
94: (void) pop();
95: execute(*((Inst **)(savepc))); /* condition */
96: d = pop();
97: while (d.val) {
98: execute(*((Inst **)(savepc+2))); /* body */
99: if (returning)
100: break;
101: execute(*((Inst **)(savepc+1))); /* post loop */
102: (void) pop();
103: execute(*((Inst **)(savepc))); /* condition */
104: d = pop();
105: }
106: if (!returning)
107: pc = *((Inst **)(savepc+3)); /* next stmt */
108: }
109: ifcode()
110: {
111: Datum d;
112: Inst *savepc = pc; /* then part */
113:
114: execute(savepc+3); /* condition */
115: d = pop();
116: if (d.val)
117: execute(*((Inst **)(savepc)));
118: else if (*((Inst **)(savepc+1))) /* else part? */
119: execute(*((Inst **)(savepc+1)));
120: if (!returning)
121: pc = *((Inst **)(savepc+2)); /* next stmt */
122: }
123:
124: define(sp) /* put func/proc in symbol table */
125: Symbol *sp;
126: {
127: sp->u.defn = progbase; /* start of code */
128: progbase = progp; /* next code starts here */
129: }
130:
131: call() /* call a function */
132: {
133: Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */
134: /* for function */
135: if (fp++ >= &frame[NFRAME-1])
136: execerror(sp->name, "call nested too deeply");
137: fp->sp = sp;
138: fp->nargs = (int)pc[1];
139: fp->retpc = pc + 2;
140: fp->argn = stackp - 1; /* last argument */
141: execute(sp->u.defn);
142: returning = 0;
143: }
144:
145: ret() /* common return from func or proc */
146: {
147: int i;
148: for (i = 0; i < fp->nargs; i++)
149: pop(); /* pop arguments */
150: pc = (Inst *)fp->retpc;
151: --fp;
152: returning = 1;
153: }
154:
155: funcret() /* return from a function */
156: {
157: Datum d;
158: if (fp->sp->type == PROCEDURE)
159: execerror(fp->sp->name, "(proc) returns value");
160: d = pop(); /* preserve function return value */
161: ret();
162: push(d);
163: }
164:
165: procret() /* return from a procedure */
166: {
167: if (fp->sp->type == FUNCTION)
168: execerror(fp->sp->name,
169: "(func) returns no value");
170: ret();
171: }
172:
173: double *getarg() /* return pointer to argument */
174: {
175: int nargs = (int) *pc++;
176: if (nargs > fp->nargs)
177: execerror(fp->sp->name, "not enough arguments");
178: return &fp->argn[nargs - fp->nargs].val;
179: }
180:
181: arg() /* push argument onto stack */
182: {
183: Datum d;
184: d.val = *getarg();
185: push(d);
186: }
187:
188: argassign() /* store top of stack in argument */
189: {
190: Datum d;
191: d = pop();
192: push(d); /* leave value on stack */
193: *getarg() = d.val;
194: }
195:
196: argaddeq() /* store top of stack in argument */
197: {
198: Datum d;
199: d = pop();
200: d.val = *getarg() += d.val;
201: push(d); /* leave value on stack */
202: }
203:
204: argsubeq() /* store top of stack in argument */
205: {
206: Datum d;
207: d = pop();
208: d.val = *getarg() -= d.val;
209: push(d); /* leave value on stack */
210: }
211:
212: argmuleq() /* store top of stack in argument */
213: {
214: Datum d;
215: d = pop();
216: d.val = *getarg() *= d.val;
217: push(d); /* leave value on stack */
218: }
219:
220: argdiveq() /* store top of stack in argument */
221: {
222: Datum d;
223: d = pop();
224: d.val = *getarg() /= d.val;
225: push(d); /* leave value on stack */
226: }
227:
228: argmodeq() /* store top of stack in argument */
229: {
230: Datum d;
231: double *x;
232: long y;
233: d = pop();
234: /* d.val = *getarg() %= d.val; */
235: x = getarg();
236: y = *x;
237: d.val = *x = y %= (long) d.val;
238: push(d); /* leave value on stack */
239: }
240:
241: bltin()
242: {
243:
244: Datum d;
245: d = pop();
246: d.val = (*(double (*)())*pc++)(d.val);
247: push(d);
248: }
249:
250: add()
251: {
252: Datum d1, d2;
253: d2 = pop();
254: d1 = pop();
255: d1.val += d2.val;
256: push(d1);
257: }
258:
259: sub()
260: {
261: Datum d1, d2;
262: d2 = pop();
263: d1 = pop();
264: d1.val -= d2.val;
265: push(d1);
266: }
267:
268: mul()
269: {
270: Datum d1, d2;
271: d2 = pop();
272: d1 = pop();
273: d1.val *= d2.val;
274: push(d1);
275: }
276:
277: div()
278: {
279: Datum d1, d2;
280: d2 = pop();
281: if (d2.val == 0.0)
282: execerror("division by zero", (char *)0);
283: d1 = pop();
284: d1.val /= d2.val;
285: push(d1);
286: }
287:
288: mod()
289: {
290: Datum d1, d2;
291: long x;
292: d2 = pop();
293: if (d2.val == 0.0)
294: execerror("division by zero", (char *)0);
295: d1 = pop();
296: /* d1.val %= d2.val; */
297: x = d1.val;
298: x %= (long) d2.val;
299: d1.val = d2.val = x;
300: push(d1);
301: }
302:
303: negate()
304: {
305: Datum d;
306: d = pop();
307: d.val = -d.val;
308: push(d);
309: }
310:
311: verify(s)
312: Symbol *s;
313: {
314: if (s->type != VAR && s->type != UNDEF)
315: execerror("attempt to evaluate non-variable", s->name);
316: if (s->type == UNDEF)
317: execerror("undefined variable", s->name);
318: }
319:
320: eval() /* evaluate variable on stack */
321: {
322: Datum d;
323: d = pop();
324: verify(d.sym);
325: d.val = d.sym->u.val;
326: push(d);
327: }
328:
329: preinc()
330: {
331: Datum d;
332: d.sym = (Symbol *)(*pc++);
333: verify(d.sym);
334: d.val = d.sym->u.val += 1.0;
335: push(d);
336: }
337:
338: predec()
339: {
340: Datum d;
341: d.sym = (Symbol *)(*pc++);
342: verify(d.sym);
343: d.val = d.sym->u.val -= 1.0;
344: push(d);
345: }
346:
347: postinc()
348: {
349: Datum d;
350: double v;
351: d.sym = (Symbol *)(*pc++);
352: verify(d.sym);
353: v = d.sym->u.val;
354: d.sym->u.val += 1.0;
355: d.val = v;
356: push(d);
357: }
358:
359: postdec()
360: {
361: Datum d;
362: double v;
363: d.sym = (Symbol *)(*pc++);
364: verify(d.sym);
365: v = d.sym->u.val;
366: d.sym->u.val -= 1.0;
367: d.val = v;
368: push(d);
369: }
370:
371: gt()
372: {
373: Datum d1, d2;
374: d2 = pop();
375: d1 = pop();
376: d1.val = (double)(d1.val > d2.val);
377: push(d1);
378: }
379:
380: lt()
381: {
382: Datum d1, d2;
383: d2 = pop();
384: d1 = pop();
385: d1.val = (double)(d1.val < d2.val);
386: push(d1);
387: }
388:
389: ge()
390: {
391: Datum d1, d2;
392: d2 = pop();
393: d1 = pop();
394: d1.val = (double)(d1.val >= d2.val);
395: push(d1);
396: }
397:
398: le()
399: {
400: Datum d1, d2;
401: d2 = pop();
402: d1 = pop();
403: d1.val = (double)(d1.val <= d2.val);
404: push(d1);
405: }
406:
407: eq()
408: {
409: Datum d1, d2;
410: d2 = pop();
411: d1 = pop();
412: d1.val = (double)(d1.val == d2.val);
413: push(d1);
414: }
415:
416: ne()
417: {
418: Datum d1, d2;
419: d2 = pop();
420: d1 = pop();
421: d1.val = (double)(d1.val != d2.val);
422: push(d1);
423: }
424:
425: and()
426: {
427: Datum d1, d2;
428: d2 = pop();
429: d1 = pop();
430: d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
431: push(d1);
432: }
433:
434: or()
435: {
436: Datum d1, d2;
437: d2 = pop();
438: d1 = pop();
439: d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
440: push(d1);
441: }
442:
443: not()
444: {
445: Datum d;
446: d = pop();
447: d.val = (double)(d.val == 0.0);
448: push(d);
449: }
450:
451: power()
452: {
453: Datum d1, d2;
454: extern double Pow();
455: d2 = pop();
456: d1 = pop();
457: d1.val = Pow(d1.val, d2.val);
458: push(d1);
459: }
460:
461: assign()
462: {
463: Datum d1, d2;
464: d1 = pop();
465: d2 = pop();
466: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
467: execerror("assignment to non-variable",
468: d1.sym->name);
469: d1.sym->u.val = d2.val;
470: d1.sym->type = VAR;
471: push(d2);
472: }
473:
474: addeq()
475: {
476: Datum d1, d2;
477: d1 = pop();
478: d2 = pop();
479: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
480: execerror("assignment to non-variable",
481: d1.sym->name);
482: d2.val = d1.sym->u.val += d2.val;
483: d1.sym->type = VAR;
484: push(d2);
485: }
486:
487: subeq()
488: {
489: Datum d1, d2;
490: d1 = pop();
491: d2 = pop();
492: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
493: execerror("assignment to non-variable",
494: d1.sym->name);
495: d2.val = d1.sym->u.val -= d2.val;
496: d1.sym->type = VAR;
497: push(d2);
498: }
499:
500: muleq()
501: {
502: Datum d1, d2;
503: d1 = pop();
504: d2 = pop();
505: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
506: execerror("assignment to non-variable",
507: d1.sym->name);
508: d2.val = d1.sym->u.val *= d2.val;
509: d1.sym->type = VAR;
510: push(d2);
511: }
512:
513: diveq()
514: {
515: Datum d1, d2;
516: d1 = pop();
517: d2 = pop();
518: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
519: execerror("assignment to non-variable",
520: d1.sym->name);
521: d2.val = d1.sym->u.val /= d2.val;
522: d1.sym->type = VAR;
523: push(d2);
524: }
525:
526: modeq()
527: {
528: Datum d1, d2;
529: long x;
530: d1 = pop();
531: d2 = pop();
532: if (d1.sym->type != VAR && d1.sym->type != UNDEF)
533: execerror("assignment to non-variable",
534: d1.sym->name);
535: /* d2.val = d1.sym->u.val %= d2.val; */
536: x = d1.sym->u.val;
537: x %= (long) d2.val;
538: d2.val = d1.sym->u.val = x;
539: d1.sym->type = VAR;
540: push(d2);
541: }
542:
543: print() /* pop top value from stack, print it */
544: {
545: Datum d;
546: static Symbol *s; /* last value computed */
547: if (s == NULL)
548: s = install("_", VAR, 0.0);
549: d = pop();
550: printf("%.*g\n", (int)lookup("PREC")->u.val, d.val);
551: s->u.val = d.val;
552: }
553:
554: prexpr() /* print numeric value */
555: {
556: Datum d;
557: d = pop();
558: printf("%.*g ", (int)lookup("PREC")->u.val, d.val);
559: }
560:
561: prstr() /* print string value */
562: {
563: printf("%s", (char *) *pc++);
564: }
565:
566: varread() /* read into variable */
567: {
568: Datum d;
569: extern FILE *fin;
570: Symbol *var = (Symbol *) *pc++;
571: Again:
572: switch (fscanf(fin, "%lf", &var->u.val)) {
573: case EOF:
574: if (moreinput())
575: goto Again;
576: d.val = var->u.val = 0.0;
577: break;
578: case 0:
579: execerror("non-number read into", var->name);
580: break;
581: default:
582: d.val = 1.0;
583: break;
584: }
585: var->type = VAR;
586: push(d);
587: }
588:
589: Inst *code(f) /* install one instruction or operand */
590: Inst f;
591: {
592: Inst *oprogp = progp;
593: if (progp >= &prog[NPROG])
594: execerror("program too big", (char *)0);
595: *progp++ = f;
596: return oprogp;
597: }
598:
599: /*
600: This one blows up if the increment of pc is done after the function is called.
601: Sigh.
602: *execute(p)
603: * Inst *p;
604: *{
605: * for (pc = p; *pc != STOP && !returning; )
606: * (*(*pc++))();
607: *}
608: */
609:
610: execute(p)
611: Inst *p;
612: {
613: Inst *fp;
614:
615: for (pc = p; *pc != STOP && !returning; ) {
616: fp = pc++;
617: (*(*fp))();
618: }
619: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.