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
|
include <evexpr.h>
include "../ptkeysdef.h"
# PT_GETOP -- Procedure to fetch an apphot operand for evexpr.
procedure pt_getop (operand, o)
char operand[ARB] # operand name
pointer o # operand output
pointer apkey
common /kycommon/ apkey
errchk pt_getfield()
begin
call pt_getfield (apkey, operand, o)
end
# PT_APSET -- Porcedure to pass the apphot structure in a common block.
procedure pt_apset (key)
pointer key # apphot strucuture
pointer apkey
common /kycommon/ apkey
begin
apkey = key
end
# PT_GETFIELD -- Procedure to select an apphot field.
procedure pt_getfield (key, field, o)
pointer key # pointer to select strucuture
char field[ARB] # field to evaluated
pointer o # operand
int type, maxnelems, nelems
pointer sp, root, ranges, list
bool pt_kybool()
int pt_kytype(), pt_kyinteger(), decode_ranges()
real pt_kyreal()
errchk pt_kytype(), pt_kybool(), pt_kyreal(), pt_kystr()
begin
call smark (sp)
call salloc (root, SZ_FNAME, TY_CHAR)
call salloc (ranges, SZ_FNAME, TY_CHAR)
call salloc (list, 3 * KY_MAXNRANGES + 1, TY_INT)
# Select the field.
call strupr (field)
type = pt_kytype (key, field, Memc[root], Memc[ranges], maxnelems)
if (Memc[ranges] == EOS) {
nelems = 1
Memi[list] = 1
} else if (decode_ranges (Memc[ranges], Memi[list], KY_MAXNRANGES,
nelems) == ERR) {
call sfree (sp)
call error (0, "Cannot decode range string")
}
# Decode the value.
switch (type) {
case TY_BOOL:
if (nelems == 1) {
call xev_initop (o, 0, TY_BOOL)
O_VALB(o) = pt_kybool (key, Memc[root], Memi[list])
} else {
call sfree (sp)
call eprintf ("Error decoding boolean field array: %s\n")
call pargstr (field)
call error (0, "Boolean arrays not allowed in expressions.")
}
case TY_INT:
if (nelems == 1) {
call xev_initop (o, 0, TY_INT)
O_VALI(o) = pt_kyinteger (key, Memc[root], Memi[list])
} else {
call sfree (sp)
call eprintf ("Error decoding integer field array: %s\n")
call pargstr (field)
call error (0, "Integer arrays not allowed in expressions.")
}
case TY_REAL:
if (nelems == 1) {
call xev_initop (o, 0, TY_REAL)
O_VALR(o) = pt_kyreal (key, Memc[root], Memi[list])
} else {
call sfree (sp)
call eprintf ("Error decoding real array field: %s\n")
call pargstr (field)
call error (0, "Real arrays not allowed in expressions.")
}
default:
if (nelems == 1) {
call xev_initop (o, SZ_LINE, TY_CHAR)
call pt_kystr (key, Memc[root], Memi[list], O_VALC(o), SZ_LINE)
} else {
call eprintf ("Error decoding char array field: %s\n")
call sfree (sp)
call pargstr (field)
call error (0, "Character arrays not allowed in expressions.")
}
}
call sfree (sp)
end
|
