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
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
|
include <ctype.h>
include "cqdef.h"
include "cq.h"
# These are the catalog configuration file access routines used by the
# catalog access interface. These routines should not normally be called
# directly from the applications program.
# CQ_DGETI -- Get an integer field from the database record.
int procedure cq_dgeti (cq, record, field)
pointer cq #I The catalog database descriptor
int record #I The catalog record index
char field[ARB] #I The record field
int ival #O Field value
char name[SZ_LINE]
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargi (ival)
if (nscan() == 2)
return (ival)
else
call error (0, "Error reading catalog integer field value")
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGETR -- Get a real field from the catalog database record.
real procedure cq_dgetr (cq, record, field)
pointer cq #I The catalog database descriptor
int record #I The catalog database record index
char field[ARB] #I The catalog record field
real rval
char name[SZ_LINE]
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargr (rval)
if (nscan() == 2)
return (rval)
else
call error (0, "Error reading real catalog field value")
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGETD -- Get a double precision field from a record.
double procedure cq_dgetd (cq, record, field)
pointer cq #I The catalog database descriptor
int record #I The catalog database index
char field[ARB] #I The catalog database field
double dval
char name[SZ_LINE]
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargd (dval)
if (nscan() == 2)
return (dval)
else
call error (0, "Error reading double catalog field value")
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGWRD -- Get a string field from the database file.
procedure cq_dgwrd (cq, record, field, str, maxchar)
pointer cq #I The catalog access descriptor
int record #I The catalog record index
char field[ARB] #I The field name
char str[maxchar] #O The output string value
int maxchar #I The maximum characters for string
char name[SZ_LINE]
int i, fscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "Catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargwrd (str, maxchar)
for (i=1; IS_WHITE(str[i]); i=i+1)
;
if (i > 1)
call strcpy (str[i], str, maxchar)
return
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGSTR -- Get a string field from the database file.
procedure cq_dgstr (cq, record, field, str, maxchar)
pointer cq #I The catalog access descriptor
int record #I The catalog record index
char field[ARB] #I The field name
char str[maxchar] #O The output string value
int maxchar #I The maximum characters for string
char name[SZ_LINE]
int i, fscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "Catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargstr (str, maxchar)
for (i=1; IS_WHITE(str[i]); i=i+1)
;
if (i > 1)
call strcpy (str[i], str, maxchar)
return
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGAI -- Get an integer array field from a record.
procedure cq_dgai (cq, record, field, array, len_array, npts)
pointer cq #I The database catalog record
int record #I The database record index
char field[ARB] #I The database field
int array[len_array] #O The output array values
int len_array #I The length of array
int npts #O The number of points in the array
char name[SZ_LINE]
int i
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargi (npts)
if (nscan() != 2)
call error (0, "Error reading size of integer array")
npts = min (npts, len_array)
for (i = 1; i <= npts; i = i + 1) {
if (fscan (CQ_FD(cq)) == EOF)
call error (0, "The integer array is truncated")
call gargi (array[i])
if (nscan() != 1)
call error (0, "Error decoding integer array")
}
return
}
}
call error (0, "The catalog record field not found")
end
# CQ_DGAR -- Get a real array field from a record.
procedure cq_dgar (cq, record, field, array, len_array, npts)
pointer cq #I The database catalog record
int record #I The database record index
char field[ARB] #I The database field
real array[len_array] #O The output array values
int len_array #I The length of array
int npts #O The number of points in the array
char name[SZ_LINE]
int i
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargi (npts)
if (nscan() != 2)
call error (0, "Error reading real array size value")
npts = min (npts, len_array)
for (i = 1; i <= npts; i = i + 1) {
if (fscan (CQ_FD(cq)) == EOF)
call error (0, "The real array is truncated")
call gargr (array[i])
if (nscan() != 1)
call error (0, "Error reading real array")
}
return
}
}
call error (0, "The catalog record field not found")
end
# CQ_DGAD -- Get a double array field from a catalog.
procedure cq_dgad (cq, record, field, array, len_array, npts)
pointer cq #I The catalog database descriptor
int record #I The catalog record index
char field[ARB] #I The database field
double array[len_array] #O The array values
int len_array #I The length of array
int npts #O The number of points in the array
char name[SZ_LINE]
int i
int fscan(), nscan()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "The catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargi (npts)
if (nscan() != 2)
call error (0, "Error the double array size")
npts = min (npts, len_array)
for (i = 1; i <= npts; i = i + 1) {
if (fscan (CQ_FD(cq)) == EOF)
call error (0, "The double array is truncated")
call gargd (array[i])
if (nscan() != 1)
call error (0, "Error reading the double array")
}
return
}
}
call error (0, "Catalog record field not found")
end
# CQ_DGATXT -- Get newline delimited text from a database file.
procedure cq_dgatxt (cq, record, field, str, maxchar, nlines)
pointer cq #I The catalog access descriptor
int record #I The catalog record index
char field[ARB] #I The field name
char str[maxchar] #O The output string value
int maxchar #I The maximum characters for string
int nlines #I the number of text lines
char name[SZ_LINE]
int i, op
int fscan(), nscan(), gstrcpy()
bool streq()
begin
if ((record < 1) || (record > CQ_NRECS(cq)))
call error (0, "Catalog record is out of bounds")
call seek (CQ_FD(cq), CQ_OFFSET(cq, record))
while (fscan (CQ_FD(cq)) != EOF) {
call gargwrd (name, SZ_LINE)
if (streq (name, "begin"))
break
else if (streq (name, field)) {
call gargi (nlines)
if (nscan() != 2)
call error (0, "Error text array length")
op = 1
do i = 1, nlines {
if (fscan (CQ_FD(cq)) == EOF)
call error (0, "The text array is truncated")
call gargstr (name, SZ_LINE)
op = op + gstrcpy (name, str[op], maxchar - op +1)
if (op > maxchar)
break
str[op] = '\n'
op = op + 1
str[op] = EOS
}
return
}
}
call error (0, "Catalog record field not found")
end
## DTPTIME -- Put a time string with a comment
#
#procedure dtptime (dt)
#
#pointer dt # DTTEXT pointer
#
#char timestr[SZ_TIME]
#long time, clktime()
#
#begin
# time = clktime (0)
# call cnvtime (time, timestr, SZ_TIME)
# call fprintf (DT(dt), "# %s\n")
# call pargstr (timestr)
#end
#
#
## DTPUT -- Print to database.
#
#procedure dtput (dt, format)
#
#pointer dt # DTTEXT pointer
#char format[ARB] # String format
#
#begin
# call fprintf (DT(dt), format)
#end
# CQ_DSCAN -- Scan database.
int procedure cq_dscan (cq)
pointer cq # The catalog database descriptor.
int fscan()
begin
return (fscan (CQ_FD(cq)))
end
|
