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
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
include "../lib/parser.h"
include "../lib/preval.h"
# Evaluation stack depth
define STACK_DEPTH 50
# PR_EVAL - Evaluate an RPN code expression generated by the parser. This
# procedure checks for consistency in the input, although the code generated
# by the parser should be correct, and for stack underflow and overflow.
# The underflow can only happen under wrong generated code, but overflow
# can happen in complex expressions. This is not a syntactic, but related
# with the number of parenthesis used in the original source code expression.
# Illegal operations, such as division by zero, return and undefined value.
real procedure pr_eval (code, vdata, pdata)
pointer code # RPN code buffer
real vdata[ARB] # variables
real pdata[ARB] # parameters
real pr_evs ()
begin
return (pr_evs (code, vdata, pdata))
end
# PR_EV[SILRDX] - These procedures are called in chain, one for each indirect
# call to an equation expression (recursion). In this way it is possible to
# have up to six levels of indirection. Altough it works well, this is a patch,
# and should be replaced with a more elegant procedure that keeps a stack of
# indirect calls.
$for (silrdx)
real procedure pr_ev$t (code, vdata, pdata)
pointer code # RPN code buffer
real vdata[ARB] # variables
real pdata[ARB] # parameters
char str[SZ_LINE]
int ip # instruction pointer
int sp # stack pointer
int ins # current instruction
int sym # equation symbol
real stack[STACK_DEPTH] # evaluation stack
real dummy
pointer caux, paux
$if (datatype == s)
real pr_evi ()
$endif
$if (datatype == i)
real pr_evl ()
$endif
$if (datatype == l)
real pr_evr ()
$endif
$if (datatype == r)
real pr_evd ()
$endif
$if (datatype == d)
real pr_evx ()
$endif
pointer pr_gsym(), pr_gsymp()
begin
# Set the instruction pointer (offset from the
# beginning) to the first instruction in the buffer
ip = 0
# Get first instruction from the code buffer
ins = Memi[code + ip]
# Reset execution stack pointer
sp = 0
# Returned value when recursion overflows
dummy = INDEFR
# Loop reading instructions from the code buffer
# until the end-of-code instruction is found
while (ins != PEV_EOC) {
# Branch on the instruction type
switch (ins) {
case PEV_NUMBER:
ip = ip + 1
sp = sp + 1
stack[sp] = Memr[code + ip]
if (IS_INDEFR (stack[sp]))
break
case PEV_CATVAR:
ip = ip + 1
sp = sp + 1
stack[sp] = vdata[Memi[code + ip]]
if (IS_INDEFR (stack[sp]))
break
case PEV_OBSVAR:
ip = ip + 1
sp = sp + 1
stack[sp] = vdata[Memi[code + ip]]
if (IS_INDEFR (stack[sp]))
break
case PEV_PARAM:
ip = ip + 1
sp = sp + 1
stack[sp] = pdata[Memi[code + ip]]
if (IS_INDEFR (stack[sp]))
break
case PEV_SETEQ:
ip = ip + 1
sp = sp + 1
sym = pr_gsym (Memi[code + ip], PTY_SETEQ)
caux = pr_gsymp (sym, PSEQRPNEQ)
$if (datatype == s)
stack[sp] = pr_evi (caux, vdata, pdata)
$endif
$if (datatype == i)
stack[sp] = pr_evl (caux, vdata, pdata)
$endif
$if (datatype == l)
stack[sp] = pr_evr (caux, vdata, pdata)
$endif
$if (datatype == r)
stack[sp] = pr_evd (caux, vdata, pdata)
$endif
$if (datatype == d)
stack[sp] = pr_evx (caux, vdata, pdata)
$endif
$if (datatype == x)
stack[sp] = dummy
$endif
if (IS_INDEFR (stack[sp]))
break
case PEV_EXTEQ:
# not yet implemented
ip = ip + 1
sp = sp + 1
stack[sp] = INDEFR
if (IS_INDEFR (stack[sp]))
break
case PEV_TRNEQ:
ip = ip + 1
sp = sp + 1
sym = pr_gsym (Memi[code + ip], PTY_TRNEQ)
caux = pr_gsymp (sym, PTEQRPNFIT)
paux = pr_gsymp (sym, PTEQSPARVAL)
$if (datatype == s)
stack[sp] = pr_evi (caux, vdata, Memr[paux])
$endif
$if (datatype == i)
stack[sp] = pr_evl (caux, vdata, Memr[paux])
$endif
$if (datatype == l)
stack[sp] = pr_evr (caux, vdata, Memr[paux])
$endif
$if (datatype == r)
stack[sp] = pr_evd (caux, vdata, Memr[paux])
$endif
$if (datatype == d)
stack[sp] = pr_evx (caux, vdata, Memr[paux])
$endif
$if (datatype == x)
stack[sp] = dummy
$endif
if (IS_INDEFR (stack[sp]))
break
case PEV_UPLUS:
# do nothing
case PEV_UMINUS:
stack[sp] = - stack[sp]
case PEV_PLUS:
stack[sp - 1] = stack[sp - 1] + stack[sp]
sp = sp - 1
case PEV_MINUS:
stack[sp - 1] = stack[sp - 1] - stack[sp]
sp = sp - 1
case PEV_STAR:
stack[sp - 1] = stack[sp - 1] * stack[sp]
sp = sp - 1
case PEV_SLASH:
if (stack[sp] != 0) {
stack[sp - 1] = stack[sp - 1] / stack[sp]
sp = sp - 1
} else {
stack[sp - 1] = INDEFR
sp = sp - 1
break
}
case PEV_EXPON:
if (stack[sp - 1] != 0)
stack[sp - 1] = stack[sp - 1] ** stack[sp]
else
stack[sp - 1] = 0.0
sp = sp - 1
case PEV_ABS:
stack[sp] = abs (stack[sp])
case PEV_ACOS:
if (abs (stack[sp]) <= 1.0)
stack[sp] = acos (stack[sp])
else {
stack[sp] = INDEFR
break
}
case PEV_ASIN:
if (abs (stack[sp]) <= 1.0)
stack[sp] = asin (stack[sp])
else {
stack[sp] = INDEFR
break
}
case PEV_ATAN:
stack[sp] = atan (stack[sp])
case PEV_COS:
stack[sp] = cos (stack[sp])
case PEV_EXP:
stack[sp] = exp (stack[sp])
case PEV_LOG:
if (stack[sp] > 0.0)
stack[sp] = log (stack[sp])
else {
stack[sp] = INDEFR
break
}
case PEV_LOG10:
if (stack[sp] > 0.0)
stack[sp] = log10 (stack[sp])
else {
stack[sp] = INDEFR
break
}
case PEV_SIN:
stack[sp] = sin (stack[sp])
case PEV_SQRT:
if (stack[sp] >= 0.0)
stack[sp] = sqrt (stack[sp])
else {
stack[sp] = INDEFR
break
}
case PEV_TAN:
stack[sp] = tan (stack[sp])
default: # (just in case)
call sprintf (str, SZ_LINE,
"pr_eval: Evaluation code error (code=%d ip=%d ins=%d sp=%d)")
call pargi (code)
call pargi (ip)
call pargi (ins)
call pargi (sp)
call error (0, str)
}
# Check for stack overflow. This is the
# only check really needed.
if (sp >= STACK_DEPTH) {
call sprintf (str, SZ_LINE,
"pr_eval: Evaluation stack overflow (code=%d ip=%d ins=%d sp=%d)")
call pargi (code)
call pargi (ip)
call pargi (ins)
call pargi (sp)
call error (0, str)
}
# Check for stack underflow (just in case)
if (sp < 1) {
call sprintf (str, SZ_LINE,
"pr_eval: Evaluation stack underflow (code=%d ip=%d ins=%d sp=%d)")
call pargi (code)
call pargi (ip)
call pargi (ins)
call pargi (sp)
call error (0, str)
}
# Get next instruction
ip = ip + 1
ins = Memi[code + ip]
}
# Return expression value
return (stack[sp])
end
$endfor
|
