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
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
#include <ctype.h>
include <tbset.h>
include "../../lib/ptkeysdef.h"
# PT_DEFTABLE -- Set up and create the table for the conversion of
# the APPHOT text file.
int procedure pt_deftable (td, key, fields, columns)
pointer td # output table descriptor
pointer key # key structure
char fields[ARB] # fields to be output to the table
int columns[ARB] # pointer to array of column pointers
int ncols
int pt_defcols()
begin
# Define the table columns.
ncols = pt_defcols (td, key, fields, columns)
if (ncols <= 0)
return (0)
# Define the table header.
call pt_defheader (td, key)
return (ncols)
end
# PT_DEFHEADER -- Define the header structure.
procedure pt_defheader (td, key)
pointer td # table descriptor
pointer key # pointer to the keys structure
int i, index, type, len, ival, ip
pointer sp, kname, value, ptr
real rval
bool streq()
int pt_strwrd(), pt_kstati(), ctoi(), ctor()
begin
call smark (sp)
call salloc (kname, SZ_KEYWORD, TY_CHAR)
call salloc (value, KY_SZPAR, TY_CHAR)
# Define the columns determining datatype from the format string.
do i = 1, KY_NPKEYS(key) {
index = pt_strwrd (i, Memc[kname], SZ_KEYWORD, Memc[KY_WORDS(key)])
if (index <= 0)
next
ptr = Memi[KY_PTRS(key)+index-1]
len = pt_kstati (key, Memc[kname], KY_LENGTH)
call strcpy (Memc[ptr], Memc[value], len)
type = pt_kstati (key, Memc[kname], KY_DATATYPE)
switch (type) {
case TY_INT:
ip = 1
if (ctoi (Memc[value], ip, ival) <= 0)
call tbhadi (td, Memc[kname], INDEFI)
else
call tbhadi (td, Memc[kname], ival)
case TY_REAL:
ip = 1
if (ctor (Memc[value], ip, rval) <= 0)
call tbhadr (td, Memc[kname], INDEFR)
else
call tbhadr (td, Memc[kname], rval)
case TY_BOOL:
if (streq ("yes", Memc[value]))
call tbhadb (td, Memc[kname], true)
else
call tbhadb (td, Memc[kname], false)
default:
call tbhadt (td, Memc[kname], Memc[value])
}
}
call sfree (sp)
end
# PT_DEFCOLS -- Define the data columns to be output.
int procedure pt_defcols (td, key, fields, columns)
pointer td # table Descriptor
pointer key # key structure
char fields[ARB] # fields selected
pointer columns[ARB] # array of pointers for columns
int max_nkeys, index, ncols, element, nelems, type, len
pointer sp, kname, aranges, ranges, rangeset, colname, colunits, colformat
pointer list
int pt_gnfn(), strdic(), pt_ranges(), get_next_number()
int decode_ranges(), pt_kstati()
pointer pt_ofnl()
real asumi()
errchk tbcdef()
begin
# Allocate working space.
call smark (sp)
call salloc (kname, KY_SZPAR, TY_CHAR)
call salloc (aranges, SZ_FNAME, TY_CHAR)
call salloc (ranges, SZ_FNAME, TY_CHAR)
call salloc (rangeset, 3 * KY_MAXNRANGES, TY_INT)
call salloc (colname, SZ_COLNAME, TY_CHAR)
call salloc (colunits, SZ_COLUNITS, TY_CHAR)
call salloc (colformat, SZ_COLFMT, TY_CHAR)
# Initialize the select buffers. The select keyword, format
# and units string buffers are not necessary in this application.
max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
if (KY_SELECT(key) != NULL)
call mfree (KY_SELECT(key), TY_INT)
call malloc (KY_SELECT(key), max_nkeys, TY_INT)
if (KY_ELEM_SELECT(key) != NULL)
call mfree (KY_ELEM_SELECT(key), TY_INT)
call malloc (KY_ELEM_SELECT(key), max_nkeys, TY_INT)
if (KY_LEN_SELECT(key) != NULL)
call mfree (KY_LEN_SELECT(key), TY_INT)
call malloc (KY_LEN_SELECT(key), max_nkeys, TY_INT)
# Initialize the number of columns.
ncols = 0
# Open the list of fields.
list = pt_ofnl (key, fields)
# Loop over the fields.
while (pt_gnfn (list, Memc[kname], Memc[aranges], KY_SZPAR) != EOF) {
# Find location of the field in the keyword dictionary and
# expand the ranges string if it is defined.
index = strdic (Memc[kname], Memc[kname], KY_SZPAR,
Memc[KY_WORDS(key)])
if (pt_ranges (Memc[aranges], Memc[ranges], element, SZ_LINE) ==
ERR)
call error (0, "Cannot decode DAOPHOT range string")
# The field was not found.
if (index == 0) {
next
# Reject keyword fields.
} else if (index <= KY_NPKEYS (key)) {
next
# The field is single valued.
} else if (Memi[KY_NELEMS(key)+index-1] == 1) {
# Enter the pointers into the select buffer.
Memi[KY_SELECT(key)+ncols] = index
Memi[KY_ELEM_SELECT(key)+ncols] = 1
len = pt_kstati (key, Memc[kname], KY_LENGTH)
Memi[KY_LEN_SELECT(key)+ncols] = len
ncols = ncols + 1
# Get the column name, the units and the formats.
call strcpy (Memc[kname], Memc[colname], SZ_COLNAME)
call pt_kstats (key, Memc[kname], KY_UNITSTR, Memc[colunits],
SZ_COLUNITS)
call pt_kstats (key, Memc[kname], KY_FMTSTR, Memc[colformat],
SZ_COLFMT)
# Create the column determining the datatype from the
# format string.
type = pt_kstati (key, Memc[kname], KY_DATATYPE)
if (type != TY_CHAR)
call tbcdef (td, columns[ncols], Memc[colname],
Memc[colunits], Memc[colformat], type, 1, 1)
else
call tbcdef (td, columns[ncols], Memc[colname],
Memc[colunits], Memc[colformat], -len, 1, 1)
# The field is multi-valued.
} else {
if (Memc[ranges] == EOS) {
call sprintf (Memc[ranges], SZ_FNAME, "1-%d")
call pargi (Memi[KY_NELEMS(key)+index-1])
}
if (decode_ranges (Memc[ranges], Memi[rangeset], KY_MAXNRANGES,
nelems) == ERR)
call error (0, "Cannot decode ranges string")
nelems = 0
while (get_next_number (Memi[rangeset], nelems) != EOF) {
if (nelems < 1 || nelems > Memi[KY_NELEMS(key)+index-1])
break
len = pt_kstati (key, Memc[kname], KY_LENGTH)
Memi[KY_SELECT(key)+ncols] = index
Memi[KY_ELEM_SELECT(key)+ncols] = nelems
Memi[KY_LEN_SELECT(key)+ncols] = len
ncols = ncols + 1
# Get the column name, units and format.
call sprintf (Memc[colname], SZ_COLNAME, "%s[%d]")
call pargstr (Memc[kname])
call pargi (nelems)
call pt_kstats (key, Memc[kname], KY_UNITSTR,
Memc[colunits], SZ_COLUNITS)
call pt_kstats (key, Memc[kname], KY_FMTSTR,
Memc[colformat], SZ_COLFMT)
# Create the column determining the datatype from the
# format string.
type = pt_kstati (key, Memc[kname], KY_DATATYPE)
if (type != TY_CHAR)
call tbcdef (td, columns[ncols], Memc[colname],
Memc[colunits], Memc[colformat], type, 1, 1)
else
call tbcdef (td, columns[ncols], Memc[colname],
Memc[colunits], Memc[colformat], -len, 1, 1)
}
}
}
# Create the table.
call tbpset (td, TBL_MAXPAR, KY_NPKEYS(key))
call tbtcre (td)
# Free the space
call pt_cfnl (list)
call sfree (sp)
# Reallocate select buffer space
KY_NSELECT(key) = ncols
call realloc (KY_SELECT(key), KY_NSELECT(key), TY_INT)
call realloc (KY_ELEM_SELECT(key), KY_NSELECT(key), TY_INT)
call realloc (KY_LEN_SELECT(key), KY_NSELECT(key), TY_INT)
return (ncols)
end
# PT_APPTABLE -- Find the array of column pointers for appending to an
# existing ST table.
int procedure pt_apptable (td, key, fields, columns)
pointer td # the table descriptor
pointer key # key structure
char fields[ARB] # string containing fields to include in table
pointer columns[ARB] # Array of pointers for columns
int max_nkeys, index, ncols, element, nelems
pointer list, sp, kname, aranges, ranges, rangeset, colname
int pt_gnfn(), strdic(), pt_ranges(), get_next_number(), decode_ranges()
int pt_kstati()
pointer pt_ofnl()
real asumi()
begin
# Allocate buffer space.
call smark (sp)
call salloc (kname, KY_SZPAR, TY_CHAR)
call salloc (aranges, SZ_FNAME, TY_CHAR)
call salloc (ranges, SZ_FNAME, TY_CHAR)
call salloc (rangeset, 3 * KY_MAXNRANGES, TY_INT)
call salloc (colname, SZ_COLNAME, TY_CHAR)
# Initialize the select buffers. The select keyword, format
# and units string buffers are not necessary in this application.
max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
if (KY_SELECT(key) != NULL)
call mfree (KY_SELECT(key), TY_INT)
call malloc (KY_SELECT(key), max_nkeys, TY_INT)
if (KY_ELEM_SELECT(key) != NULL)
call mfree (KY_ELEM_SELECT(key), TY_INT)
call malloc (KY_ELEM_SELECT(key), max_nkeys, TY_INT)
if (KY_LEN_SELECT(key) != NULL)
call mfree (KY_LEN_SELECT(key), TY_INT)
call malloc (KY_LEN_SELECT(key), max_nkeys, TY_INT)
# Initialize the number of columns.
ncols = 0
# Initialize the list of fields.
ncols = 0
list = pt_ofnl (key, fields)
# Loop over the fields.
while (pt_gnfn (list, Memc[kname], Memc[aranges], KY_SZPAR) != EOF) {
# Find the column.
index = strdic (Memc[kname], Memc[kname], KY_SZPAR,
Memc[KY_WORDS(key)])
if (pt_ranges (Memc[aranges], Memc[ranges], element,
SZ_LINE) == ERR)
call error (0, "Cannot decode DAOPHOT range string")
# Skip if the column does exist in the text database.
if (index == 0)
next
# Skip the header keywords.
else if (index <= KY_NPKEYS (key))
next
# Convert single-valued elements.
else if (Memi[KY_NELEMS(key)+index-1] == 1) {
call strcpy (Memc[kname], Memc[colname], SZ_COLNAME)
call tbcfnd (td, Memc[colname], columns[ncols+1], 1)
if (columns[ncols+1] == NULL) {
call eprintf ("Column %s not found\n")
call pargstr (Memc[colname])
} else {
Memi[KY_SELECT(key)+ncols] = index
Memi[KY_ELEM_SELECT(key)+ncols] = 1
Memi[KY_LEN_SELECT(key)+ncols] = pt_kstati (key,
Memc[kname], KY_LENGTH)
ncols = ncols + 1
}
# Convert multivalued elements.
} else {
if (Memc[ranges] == EOS) {
call sprintf (Memc[ranges], SZ_FNAME, "1-%d")
call pargi (Memi[KY_NELEMS(key)+index-1])
}
if (decode_ranges (Memc[ranges], Memi[rangeset], KY_MAXNRANGES,
nelems) == ERR)
call error (0, "Cannot decode ranges string")
nelems = 0
while (get_next_number (Memi[rangeset], nelems) != EOF) {
if (nelems < 1 || nelems > Memi[KY_NELEMS(key)+index-1])
break
call sprintf (Memc[colname], SZ_COLNAME, "%s[%d]")
call pargstr (Memc[kname])
call pargi (nelems)
call tbcfnd (td, Memc[colname], columns[ncols+1], 1)
if (columns[ncols+1] == NULL) {
call eprintf ("Column %s not found\n")
call pargstr (Memc[colname])
} else {
Memi[KY_SELECT(key)+ncols] = index
Memi[KY_ELEM_SELECT(key)+ncols] = nelems
Memi[KY_LEN_SELECT(key)+ncols] = pt_kstati (key,
Memc[kname], KY_LENGTH)
ncols = ncols + 1
}
}
}
}
# Free the space
call pt_cfnl (list)
call sfree (sp)
# Reallocate select buffer space
KY_NSELECT(key) = ncols
call realloc (KY_SELECT(key), KY_NSELECT(key), TY_INT)
call realloc (KY_ELEM_SELECT(key), KY_NSELECT(key), TY_INT)
call realloc (KY_LEN_SELECT(key), KY_NSELECT(key), TY_INT)
return (ncols)
end
|
