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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <mach.h>
include "qpoe.h"
include "qpex.h"
# QPEX_MODFILTER -- Compile an event attribute expression to be used for event
# attribute filtering, modifying the the current EAF as directed by the expr.
# An event attribute expression consists of a sequence of independent terms
# of the form "attribute = expr", e.g.,
#
# pha=%104B, e=100:, t=(:9,11:29,33,42:65,67:99,!(82,87),103), ...
#
#
# Variants on "attr = expr" are "attr := expr" and "attr += expr". In the
# case of :=, any expression terms already entered for the named attribute
# will be REPLACED by the new expression. In the case of +=, the given
# expression denotes an additional condition which the attribute must satisfy
# to pass the filter, i.e., a new term is added to the existing filter. The
# case = is the same as +=, i.e., the default action is to modify rather than
# replace any existing filter.
#
#
# Our function is to extract each attribute=expr term and compile it into a
# series of instructions to be repeatedly executed (interpreted) at runtime
# to evaluate the expression for a particular event structure. Terms are
# compiled and evaluated in the order in which they appear in the expression
# list (except for replacement terms), allowing the user to manually optimize
# the filter by giving terms which are most likely to fail first.
#
# The expression list may contain references to predefined global or local
# (datafile) macros, external macro files, or back-quoted CL commands for
# which the output is to be substituted as for a macro. In all cases, macro
# substitution is handled at a lower level in the gettok routine. In
# particular, the logical names of the fields of the event structure are
# implemented as predefined datafile-local macros, hence we are concerned only
# with physical field names here. The form of a physical field name is
# a datatype code [SIRD] followed by the decimal zero-indexed byte offset
# of the field in the event structure, e.g., S0, S2, R4, etc. (short integer
# field at offset 0, same at offset 2, Real*4 field at offset 4, etc.).
#
# The function value is OK if the expression list compiles without any errors,
# or ERR if some compilation error occurs. Compilation errors cause an error
# message to be output to STDERR and the affected terms to be skipped, but are
# otherwise ignored.
int procedure qpex_modfilter (ex, exprlist)
pointer ex #I qpex descriptor
char exprlist[ARB] #I list of attribute=expr expressions
bool replace
int boffset, offset, max_offset, dtype
int status, sz_expr, token, parenlevel, nchars, buflen
pointer sp, atname, assignop, tokbuf, expr, qp, ip, op, in, et_tail
pointer qp_opentext()
int qpex_codegeni(), qpex_codegenr(), qpex_codegend()
int qp_gettok(), strlen(), gstrcpy(), ctoi(), sizeof()
errchk malloc, qp_opentext, qp_gettok, realloc, qpex_delete
string qpexwarn "QPEX Warning"
define eatup_ 91
define badatt_ 92
begin
call smark (sp)
call salloc (atname, SZ_TOKBUF, TY_CHAR)
call salloc (assignop, SZ_TOKBUF, TY_CHAR)
call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
status = OK
sz_expr = DEF_SZEXPRBUF
et_tail = EX_ETTAIL(ex)
qp = EX_QP(ex)
# Allocate a variable size expression buffer.
call malloc (expr, sz_expr, TY_CHAR)
# Open the expression list for token input with macro expansion.
in = qp_opentext (qp, exprlist)
# Accumulate and compile successive attribute=expr terms of the
# expression list.
repeat {
# Get attribute name.
switch (qp_gettok (in, Memc[atname], SZ_TOKBUF)) {
case EOF:
break # input exhausted
case ',', ';':
next # null statement
case TOK_IDENTIFIER:
; # got one
default:
call eprintf ("%s: unexpected token `%s'\n")
call pargstr (qpexwarn)
call pargstr (Memc[atname])
goto eatup_
}
# Get operator.
switch (qp_gettok (in, Memc[assignop], SZ_TOKBUF)) {
case TOK_PLUSEQUALS, '=':
replace = false
case TOK_COLONEQUALS:
replace = true
default:
call eprintf ("%s: missing assignment token (`%s')\n")
call pargstr (qpexwarn)
call pargstr (Memc[atname])
eatup_
# A half-hearted attempt to ignore the offending statement...
while (qp_gettok (in, Memc[expr], sz_expr) != EOF)
if (Memc[expr] == ',')
break
# The default is to add to any existing filter.
replace = false
}
parenlevel = 0
token = NULL
# Accumulate expression.
for (op=expr; token != EOF; ) {
# Get next token from input stream.
token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
# Process any special tokens.
switch (token) {
case EOF:
break
case '(':
parenlevel = parenlevel + 1
case ')':
parenlevel = parenlevel - 1
if (parenlevel < 0) {
call eprintf ("%s: missing left parenthesis\n")
call pargstr (qpexwarn)
parenlevel = 0
status = ERR
next
}
case ',', ';':
# An unparenthesized comma terminates the expression.
if (parenlevel <= 0)
break
}
# Allocate more storage if expr buf fills.
nchars = strlen (Memc[tokbuf])
buflen = op - expr
if (buflen + nchars > sz_expr) {
sz_expr = sz_expr + INC_SZEXPRBUF
call realloc (expr, sz_expr, TY_CHAR)
op = expr + buflen
}
# Concatenate token string to expr.
op = op + gstrcpy (Memc[tokbuf], Memc[op], SZ_TOKBUF)
}
Memc[op] = EOS
if (parenlevel > 0) {
call eprintf ("%s: missing right parenthesis in expression\n")
call pargstr (qpexwarn)
status = ERR
}
# Parse the attribute name to determine the datatype and offset.
# Get byte offset of field.
ip = atname + 1
if (ctoi (Memc, ip, boffset) <= 0)
goto badatt_
# Get datatype and scaled offset; check field alignment.
switch (Memc[atname]) {
case 'S', 's':
dtype = TY_SHORT
offset = boffset / (SZ_SHORT * SZB_CHAR)
if (offset * SZ_SHORT * SZB_CHAR != boffset)
goto badatt_
case 'I', 'i':
dtype = TY_INT
offset = boffset / (SZ_INT * SZB_CHAR)
if (offset * SZ_INT * SZB_CHAR != boffset)
goto badatt_
case 'R', 'r':
dtype = TY_REAL
offset = boffset / (SZ_REAL * SZB_CHAR)
if (offset * SZ_REAL * SZB_CHAR != boffset)
goto badatt_
case 'D', 'd':
dtype = TY_DOUBLE
offset = boffset / (SZ_DOUBLE * SZB_CHAR)
if (offset * SZ_DOUBLE * SZB_CHAR != boffset)
goto badatt_
default:
goto badatt_
}
# Verify that the field is in range in the event struct.
# (Actually, we don't know the event struct at compile time...)
max_offset = (boffset / SZB_CHAR) + sizeof(dtype) - 1
if (boffset < 0 || max_offset > ARB) {
badatt_ call eprintf ("%s: bad attribute name `%s'\n")
call pargstr (qpexwarn)
call pargstr (Memc[atname])
status = ERR
next
}
# Clobber any old expression for the given attribute if replace
# mode is in effect. Only previous expression terms are affected,
# hence in single expressions like "pha=x,pha=y", the second entry
# does not clobber the first.
if (replace)
call qpex_delete (ex, et_tail, offset, dtype)
# Compile the expression.
switch (dtype) {
case TY_SHORT, TY_INT:
if (qpex_codegeni (ex, Memc[atname], Memc[assignop],
Memc[expr], offset, dtype) == ERR)
status = ERR
case TY_REAL:
if (qpex_codegenr (ex, Memc[atname], Memc[assignop],
Memc[expr], offset, dtype) == ERR)
status = ERR
case TY_DOUBLE:
if (qpex_codegend (ex, Memc[atname], Memc[assignop],
Memc[expr], offset, dtype) == ERR)
status = ERR
}
}
call qp_closetext (in)
call mfree (expr, TY_CHAR)
call sfree (sp)
return (status)
end
|
