|
|
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: Symptr getvar();
8: Stkptr nextframe();
9:
10:
11: /*
12: * def --- define a function (just save input pointer for now)
13: */
14:
15: def()
16: {
17: register Symptr v;
18: int type;
19:
20: if (*inptr != FN)
21: badsyn();
22: v = getvar(&type, NO);
23: v->v_un.v_fn.fn_curline = curline;
24: v->v_un.v_fn.fn_inptr = inptr;
25: while (!endtest())
26: ++inptr;
27: }
28:
29:
30: /*
31: * fn --- invoke a previously defined function
32: */
33:
34: fn()
35: {
36: register Symptr f;
37: register char *s;
38: Stkfr var;
39: int type, vtype, i, n;
40: char *base, *v, *saveptr;
41: Linep saveline;
42:
43: base = stkptr;
44: f = getvar(&type, NO);
45: if (f->v_un.v_fn.fn_inptr == NULL)
46: err("function undefined");
47: expectc(LPAR);
48: for (n = 0; !endtest(); ) {
49: expr();
50: ++n;
51: if (*inptr == RPAR)
52: break;
53: expectc(COMMA);
54: }
55: expectc(RPAR);
56: s = stkptr;
57:
58: saveline = curline;
59: saveptr = inptr;
60: curline = f->v_un.v_fn.fn_curline;
61: inptr = f->v_un.v_fn.fn_inptr;
62: expectc(LPAR);
63: for (i = 1; i <= n; ++i) {
64: var.k_un.k_symp = getvar(&vtype, NO);
65: var.k_type = vtype;
66: var.k_len = VARFRLEN;
67: push(&var);
68: if (i < n)
69: expectc(COMMA);
70: }
71: expectc(RPAR);
72: expectc(EQ);
73: v = stkptr; /* variables on stack */
74: exchange(s, v, n);
75: expr();
76: endchk();
77: exchange(s, v, n);
78: s = stkptr; /* the current expression */
79: stkptr = base; /* restore the original stack */
80: push((Stkptr)s); /* push the result onto the stack */
81: curline = saveline;
82: inptr = saveptr;
83: }
84:
85:
86: /*
87: * exchange --- swap n contiguous stack frames pointed to by sp and vp
88: */
89:
90: exchange(sp, vp, n)
91: char *sp, *vp;
92: {
93: register Stkptr s, v;
94: register Symptr p;
95: int i, len;
96: char *ptr;
97: double f;
98:
99: s = (Stkptr)sp;
100: v = (Stkptr)vp;
101: for (i = 0; i < n; ++i) {
102: p = v->k_un.k_symp; /* pointer to variable */
103: if (s->k_type != v->k_type + EXPR)
104: err("types don't match");
105: if (tflg)
106: fprintf(stderr, "exchange value %.2s ", p->v_name);
107: switch(v->k_type) {
108: case FLOAT:
109: if (tflg) {
110: f = (SINGLE)? p->v_un.v_float : p->v_un.v_double;
111: fprintf(stderr, " %.6f <==> %.6f\n",
112: f, s->k_un.k_dbl);
113: }
114: f = s->k_un.k_dbl;
115: if (SINGLE) {
116: s->k_un.k_dbl = p->v_un.v_float;
117: p->v_un.v_float = f;
118: }
119: else {
120: s->k_un.k_dbl = p->v_un.v_double;
121: p->v_un.v_double = f;
122: }
123: break;
124: case INT:
125: if (tflg)
126: fprintf(stderr, " %d <==> %d\n",
127: p->v_un.v_int, (int)s->k_un.k_dbl);
128: f = s->k_un.k_dbl;
129: s->k_un.k_dbl = p->v_un.v_int;
130: p->v_un.v_int = f;
131: break;
132: case STRING:
133: ptr = s->k_un.k_str.s_ptr;
134: len = s->k_un.k_str.s_len;
135: s->k_un.k_str.s_ptr = p->v_un.v_str.s_ptr;
136: s->k_un.k_str.s_len = p->v_un.v_str.s_len;
137: p->v_un.v_str.s_ptr = ptr;
138: p->v_un.v_str.s_len = len;
139: break;
140: }
141: s = nextframe(s);
142: v = nextframe(v);
143: }
144: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.