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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include "qpoe.h"
include "qpex.h"
# QP_PARSEFL -- Parse the field list, or declarations string for a user
# defined datatype (structure or domain).
#
# Syntax: { type1, type2, ..., typeN }
#
# e.g., {d,s:x,s:y,s,s,s,s} (Rosat/PROS event structure)
#
# where the TYPEi are primitive types, e.g., "r" or "real", "i" or "int",
# etc. Selected fields may have ":x" or ":y" appended to indicate that these
# are the default coordinate fields to be used for position based extraction.
# Fields will be automatically aligned as necessary, and the computed structure
# size will be forced to be an integral multiple of the largest datatype
# within the structure, to ensure proper alignment in arrays of the structures.
int procedure qp_parsefl (qp, fieldlist, dd)
pointer qp #I QPOE descriptor
char fieldlist[ARB] #I field list defining new datatype (domain)
pointer dd #U pointer to domain descriptor
pointer sp, tokbuf, dsym, in
int nfields, offset, maxsize, xfield, yfield, token, dtype, fsize
pointer qp_opentext()
int qp_gettok(), qp_nexttok(), sizeof(), qp_dtype()
errchk qp_gettok, qp_opentext, qp_nexttok
string qperr "QPOE structdef"
define nextfield_ 91
begin
call smark (sp)
call salloc (tokbuf, SZ_TOKBUF, TY_CHAR)
# Open declarations string for non macro expanded token input.
in = qp_opentext (NULL, fieldlist)
# Advance to structure terms list.
while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
if (Memc[tokbuf] == '{')
break
nfields = 0
offset = 0
maxsize = 0
xfield = 0
yfield = 0
# Process the structure terms list.
repeat {
token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
switch (token) { # {
case EOF, '}':
break
case TOK_IDENTIFIER:
# Get field datatype and size.
dtype = qp_dtype (qp, Memc[tokbuf], dsym)
if (dtype < TY_BOOL || dtype > TY_COMPLEX) {
call eprintf ("%s: bad field type `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
goto nextfield_
} else
fsize = sizeof (dtype)
# Output field descriptor.
nfields = nfields + 1
if (nfields > MAX_FIELDS) {
call eprintf ("%s: too many fields `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
break
}
DD_FOFFSET(dd,nfields) = (offset + fsize-1) / fsize
DD_FTYPE(dd,nfields) = dtype
# Update structure size parameters.
offset = (DD_FOFFSET(dd,nfields) * fsize) + fsize
maxsize = max (maxsize, fsize)
# Process any :[XY] field modifiers.
if (qp_nexttok(in) == ':') {
repeat {
token = qp_gettok (in, Memc[tokbuf], SZ_TOKBUF)
switch (Memc[tokbuf]) {
case ':':
next
case 'x':
if (xfield != 0) {
call eprintf ("%s: duplicate X field `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
}
xfield = nfields
break
case 'y':
if (yfield != 0) {
call eprintf ("%s: duplicate Y field `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
}
yfield = nfields
break
default:
call eprintf ("%s: unknown : field modifier `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
}
}
goto nextfield_
}
case ',':
next
default:
call eprintf ("%s: unexpected token `%s'\n")
call pargstr (qperr)
call pargstr (Memc[tokbuf])
}
nextfield_
# Read and discard tokens until we get to the next field.
while (qp_gettok (in, Memc[tokbuf], SZ_TOKBUF) != EOF)
if (Memc[tokbuf] == ',')
break
}
# Complete the domain descriptor initialization.
DD_NFIELDS(dd) = nfields
DD_XFIELD(dd) = xfield
DD_YFIELD(dd) = yfield
# Pad the struct size to an integral multiple of the max field size.
if (nfields > 0) {
maxsize = max (SZ_STRUCT, maxsize)
DD_STRUCTLEN(dd) = (offset+maxsize-1)/maxsize*maxsize / SZ_STRUCT
} else
DD_STRUCTLEN(dd) = 0
call qp_closetext (in)
call sfree (sp)
return (nfields)
end
|
