1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
include "vex.h"
# VEX_EVAL -- Evaluate the pseudocode
#
# This procedure evaluates the pseudocode produced by vex_compile(). Evaluation
# is performed on an entire vector at a time. The calling program must
# supply a subroutine which returns the vector associated with a variable name.
# The procedure is called as follows: call getvar(stack, name), where
# stack is a pointer to the stack structure and name is the variable name.
# This procedure should call stk_alloc(stack, len, type) passing it the stack
# pointer, the length of the new array, and the type of the new array. The
# pointer to the new array is returned as the function value. The procedure
# should then fill in the values in the array. Code is the pointer returned
# by vex_compile(). Nil is a value substituted for the result of an illegal
# operation, such as division by zero. Type is the data type of expression.
# To retrieve the results of the expression, call vex_copy[dir], which
# retrieves the result as a double, integer, or real array and clears the
# stack for the next call of vex_eval.
#
# B.Simon 21-May-90 Original
# B.Simon 24-Apr-91 Revised to handle multiple types
# B.Simon 15-Oct-98 Embed strings in pseudocode
procedure vex_eval (code, getvar, nil, type)
pointer code # i: Pointer to pseudocode structure
extern getvar # i: Function which returns a vector given a name
double nil # i: Nil value used to replace illegal ops
int type # o: Data type of expression
#--
double junk
int len, toktype
pointer sp, token, errmsg, stack, op, var
string fn1tok FN1STR
string fn2tok FN2STR
int word_match
double vex_nilf()
errchk vex_push
string badcode "vex_eval : Illegal opcode (%d)"
string badfunc "vex_eval : Illegal function name (%s)"
begin
# Allocate dynamic memory for strings
call smark (sp)
call salloc (token, MAX_TOKEN, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
# Initialize the undefined operation function
junk = vex_nilf (nil)
# Execute each code token until stop token found
stack = VEX_STACK(code)
for (op = VEX_CODE(code); Memi[op] != Y_DONE; op = op + 1) {
call pargi (Memi[op])
# Perform the indicated operation on the stack variables
switch (Memi[op]) {
case Y_VAR, Y_INT, Y_REAL, Y_DOUBLE:
toktype = Memi[op]
call vex_getstr (op, Memc[token], MAX_TOKEN)
call vex_push (stack, getvar, toktype, Memc[token])
case Y_FN1:
call vex_getstr (op, Memc[token], MAX_TOKEN)
switch (word_match (Memc[token], fn1tok)) {
case FN1_ABS:
call vex_abs (stack)
case FN1_ACOS:
call vex_acos (stack)
case FN1_ASIN:
call vex_asin (stack)
case FN1_ATAN:
call vex_atan (stack)
case FN1_COS:
call vex_cos (stack)
case FN1_COSH:
call vex_cosh (stack)
case FN1_CUBE:
call vex_cube (stack)
case FN1_DOUBLE:
call vex_double (stack)
case FN1_EXP:
call vex_exp (stack)
case FN1_INT:
call vex_int (stack)
case FN1_LOG:
call vex_log (stack)
case FN1_LOG10:
call vex_log10 (stack)
case FN1_NINT:
call vex_nint (stack)
case FN1_REAL:
call vex_real (stack)
case FN1_SIN:
call vex_sin (stack)
case FN1_SINH:
call vex_sinh (stack)
case FN1_SQR:
call vex_sqr (stack)
case FN1_SQRT:
call vex_sqrt (stack)
case FN1_TAN:
call vex_tan (stack)
case FN1_TANH:
call vex_tanh (stack)
default:
call sprintf (Memc[errmsg], SZ_LINE, badfunc)
call pargstr (Memc[token])
call error (1, Memc[errmsg])
}
case Y_FN2:
call vex_getstr (op, Memc[token], MAX_TOKEN)
switch (word_match (Memc[token], fn2tok)) {
case FN2_ATAN2:
call vex_atan2 (stack)
case FN2_DIM:
call vex_dim (stack)
case FN2_MAX:
call vex_max (stack)
case FN2_MIN:
call vex_min (stack)
case FN2_MOD:
call vex_mod (stack)
case FN2_SIGN:
call vex_sig (stack)
default:
call sprintf (Memc[errmsg], SZ_LINE, badfunc)
call pargstr (Memc[token])
call error (1, Memc[errmsg])
}
case Y_IF:
call vex_if (stack)
case Y_OR:
call vex_or (stack)
case Y_AND:
call vex_and (stack)
case Y_NOT:
call vex_not (stack)
case Y_EQ:
call vex_eq (stack)
case Y_NE:
call vex_ne (stack)
case Y_LT:
call vex_lt (stack)
case Y_GT:
call vex_gt (stack)
case Y_LE:
call vex_le (stack)
case Y_GE:
call vex_ge (stack)
case Y_ADD:
call vex_add (stack)
case Y_SUB:
call vex_sub (stack)
case Y_MUL:
call vex_mul (stack)
case Y_DIV:
call vex_div (stack)
case Y_NEG:
call vex_neg (stack)
case Y_POW:
call vex_pow (stack)
default:
call sprintf (Memc[errmsg], SZ_LINE, badcode)
call pargs (Memi[op])
call error (1, Memc[errmsg])
}
}
# Retrieve the result of the expression,
# but only return the type to the user
call stk_fetch (stack, 1, var, len, type)
call sfree (sp)
end
|
