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
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <error.h>
include <ctotok.h>
include <lexnum.h>
include <imhdr.h>
include "fxf.h"
# FXFKSECTION.X -- Routines to parse the FITS kernel section into
# parameter names and values.
define KS_EXTNAME 1
define KS_EXTVER 2
define KS_APPEND 3
define KS_NOAPPEND 4
define KS_OVERWRITE 5
define KS_DUPNAME 6
define KS_INHERIT 7
define KS_NOINHERIT 8
define KS_NODUPNAME 9
define KS_NOOVERWRITE 10
define KS_EXPAND 11
define KS_PHULINES 12
define KS_EHULINES 13
define KS_PADLINES 14
define KS_NOEXPAND 15
define KS_CACHESIZE 16
define KS_TYPE 17
define ERROR -2
# FXF_KSECTION -- Procedure to parse and analyze a string of the form:
#
# "keyword=value,keyword+,keyword-,..."
# e.g.,
# "[extname=]name,[extver=]23,append,inherit+,overwrite+,dupname-"
#
# The 'extver' numeric field is position dependent if it does not have
# the parameter name. The 'group' output variable is not -1 when specified
# as the 1st number in the section.
procedure fxf_ksection (ksection, fit, group)
char ksection[ARB] #I String with kernel section
pointer fit #I Fits structure pointer
int group #O Extension number
bool extn
char outstr[LEN_CARD]
char identif[LEN_CARD]
int ip, jp, nident, nexpr, junk, nch, ty, token, ival
int lex_type, fxf_ks_lex(), ctoi(), ctotok(), lexnum()
errchk syserr, syserrs
begin
# The default values should have been already initialized
# with a call fxf_ksinit().
ip = 1
nexpr = 0
nident = 0
extn = false
group = -1
identif[1] = EOS
repeat {
# Advance to the next keyword.
token = ctotok (ksection, ip, outstr, LEN_CARD)
switch (token) {
case TOK_EOS:
break
case TOK_NEWLINE:
break
case TOK_NUMBER:
if (nexpr != 1 && nexpr != 2 && extn)
call syserr (SYS_FXFKSNV)
jp = 1
ty = lexnum (outstr, jp, nch)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
jp = 1
junk = ctoi (outstr, jp, ival)
if (nexpr == 0) {
group = ival
identif[1] = 1
} else
FKS_EXTVER(fit) = ival
nexpr = nexpr + 1
case TOK_PUNCTUATION:
if (outstr[1] == ',' && identif[1] == EOS)
call syserr (SYS_FXFKSSYN)
case TOK_STRING:
if (nexpr != 0 && nexpr != 1)
call syserr (SYS_FXFKSSVAL)
call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
nexpr = nexpr + 1
extn = true
case TOK_IDENTIFIER:
nident = nident + 1
call strcpy (outstr, identif, LEN_CARD]
call strlwr (outstr)
lex_type = fxf_ks_lex (outstr)
# look for =<value>, + or -
if (lex_type > 0) {
call fxf_ks_gvalue (lex_type, ksection, ip, fit)
} else {
if (nexpr == 0 || nexpr == 1)
call strcpy (identif, FKS_EXTNAME(fit), LEN_CARD)
else
call syserr (SYS_FXFKSSVAL)
}
nexpr = nexpr + 1
extn = true
default:
call syserr (SYS_FXFKSSYN)
}
}
end
# FXF_KS_LEX -- Map an identifier into a FITS kernel parameter code.
int procedure fxf_ks_lex (outstr)
char outstr[ARB]
int len, strlen(), strncmp()
errchk syserr, syserrs
begin
len = strlen (outstr)
# Allow for small string to be taken as extname values and not
# kernel paramaters; like 'ap' instead of 'ap(ppend)'.
if (len < 3)
return(0)
# See if it is extname or extver.
if (strncmp (outstr, "ext", 3) == 0 && len < 8 ) {
if (len == 3)
call syserr (SYS_FXFKSEXT)
if (strncmp (outstr[4], "name", len-3) == 0)
return (KS_EXTNAME)
else if (strncmp (outstr[4], "ver", len-3) == 0)
return (KS_EXTVER)
# Check for the "no" versions of selected keywords.
} else if (strncmp (outstr, "no", 2) == 0 && len < 12) {
if (strncmp (outstr[3], "append", len-2) == 0)
return (KS_NOAPPEND)
if (strncmp (outstr[3], "inherit", len-2) == 0)
return (KS_NOINHERIT)
if (strncmp (outstr[3], "overwrite", len-2) == 0)
return (KS_NOOVERWRITE)
if (strncmp (outstr[3], "dupname", len-2) == 0)
return (KS_NODUPNAME)
if (strncmp (outstr[3], "expand", len-2) == 0)
return (KS_NOEXPAND)
}
# Other kernel keywords.
if (strncmp (outstr, "inherit", len) == 0)
return (KS_INHERIT)
if (strncmp (outstr, "overwrite", len) == 0)
return (KS_OVERWRITE)
if (strncmp (outstr, "dupname", len) == 0)
return (KS_DUPNAME)
if (strncmp (outstr, "append", len) == 0)
return (KS_APPEND)
if (strncmp (outstr, "noappend", len) == 0)
return (KS_NOAPPEND)
if (strncmp (outstr, "type", len) == 0)
return (KS_TYPE)
if (strncmp (outstr, "expand", len) == 0)
return (KS_EXPAND)
if (strncmp (outstr, "phulines", len) == 0)
return (KS_PHULINES)
if (strncmp (outstr, "ehulines", len) == 0)
return (KS_EHULINES)
if (strncmp (outstr, "padlines", len) == 0)
return (KS_PADLINES)
if (strncmp (outstr, "cachesize", len) == 0)
return (KS_CACHESIZE)
return (0) # not recognized; probably a value
end
# FXF_KS_GVALUE -- Given a parameter code get its value at the 'ip' character
# position in the 'ksection' string. Put the values in the FKS structure.
procedure fxf_ks_gvalue (param, ksection, ip, fit)
int param #I parameter code
char ksection[ARB] #I Ksection
int ip #I Current parsing pointer in ksection
pointer fit #U Update the values in the FKS structure
pointer sp, ln
int jp, token
int ctotok()
errchk syserr, syserrs
begin
jp = ip
call smark (sp)
call salloc (ln, LEN_CARD, TY_CHAR)
# See if the parameter value is given as par=<value> or '+/-'
if (ctotok (ksection, jp, Memc[ln], LEN_CARD) == TOK_OPERATOR) {
if (Memc[ln] == '=' ) {
token = ctotok (ksection, jp, Memc[ln], LEN_CARD)
if (token != TOK_IDENTIFIER &&
token != TOK_STRING && token != TOK_NUMBER) {
call syserr (SYS_FXFKSSYN)
} else {
call fxf_ks_val (Memc[ln], param, fit)
ip = jp
}
} else if (Memc[ln] == '+' || Memc[ln] == '-') {
call fxf_ks_pm (Memc[ln], param, fit)
ip = jp
}
} else {
switch (param) {
case KS_APPEND:
FKS_APPEND(fit) = YES
case KS_NOAPPEND:
FKS_APPEND(fit) = NO
case KS_OVERWRITE:
FKS_OVERWRITE(fit) = YES
case KS_NOOVERWRITE:
FKS_OVERWRITE(fit) = NO
case KS_DUPNAME:
FKS_DUPNAME(fit) = YES
case KS_INHERIT:
FKS_INHERIT(fit) = YES
case KS_NOINHERIT:
FKS_INHERIT(fit) = NO
case KS_EXPAND:
FKS_EXPAND(fit) = YES
case KS_NOEXPAND:
FKS_EXPAND(fit) = NO
default:
call syserr (SYS_FXFKSSYN)
}
}
call sfree (sp)
end
# FXF_KS_VALUE -- Returns the value of a parameter in the kernel section.
procedure fxf_ks_val (outstr, param, fit)
char outstr[ARB] #I Input string with value
int param #I Parameter code
pointer fit #U Fits kernel descriptor
int ty, ip, ival, nchars
int lexnum(), ctoi(), strcmp()
errchk syserr, syserrs
begin
call strlwr (outstr)
if (strcmp (outstr, "yes") == 0)
ival = YES
else if (strcmp (outstr, "no") == 0)
ival = NO
else
ival = ERROR
switch (param) {
case KS_EXTNAME:
call strcpy (outstr, FKS_EXTNAME(fit), LEN_CARD)
case KS_TYPE:
call strlwr (outstr)
if (strcmp ("mask", outstr) == 0)
FKS_SUBTYPE(fit) = FK_PLIO
else
call syserrs (SYS_FXFKSINVAL, "type")
case KS_EXTVER:
ip = 1
ty = lexnum (outstr, ip, nchars)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
ip = 1
nchars = ctoi (outstr, ip, ival)
if (nchars <= 0)
call syserrs (SYS_FXFKSINVAL, "extver")
FKS_EXTVER(fit) = ival
case KS_APPEND:
if (ival != ERROR)
FKS_APPEND(fit) = ival
else
call syserrs (SYS_FXFKSINVAL, "append")
case KS_OVERWRITE:
if (ival != ERROR)
FKS_OVERWRITE(fit) = ival
else
call syserrs (SYS_FXFKSINVAL, "overwrite")
case KS_DUPNAME:
if (ival != ERROR)
FKS_DUPNAME(fit) = ival
else
call syserrs (SYS_FXFKSINVAL, "dupname")
case KS_INHERIT:
if (ival != ERROR)
FKS_INHERIT(fit) = ival
else
call syserrs (SYS_FXFKSINVAL, "inherit")
case KS_EXPAND:
if (ival != ERROR)
FKS_EXPAND(fit) = ival
else
call syserrs (SYS_FXFKSINVAL, "expand")
case KS_PHULINES:
ip = 1
ty = lexnum (outstr, ip, nchars)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
ip = 1
nchars = ctoi (outstr, ip, ival)
if (nchars <= 0 || ival < 0)
call syserrs (SYS_FXFKSPVAL, "phulines")
FKS_PHULINES(fit) = ival
case KS_EHULINES:
ip = 1
ty = lexnum (outstr, ip, nchars)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
ip = 1
nchars = ctoi (outstr, ip, ival)
if (nchars <= 0 || ival < 0)
call syserrs (SYS_FXFKSPVAL, "ehulines")
FKS_EHULINES(fit) = ival
case KS_PADLINES:
ip = 1
ty = lexnum (outstr, ip, nchars)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
ip = 1
nchars = ctoi (outstr, ip, ival)
if (nchars <= 0 || ival < 0)
call syserrs (SYS_FXFKSPVAL, "padlines")
FKS_PADLINES(fit) = ival
case KS_CACHESIZE:
ip = 1
ty = lexnum (outstr, ip, nchars)
if (ty != LEX_DECIMAL)
call syserr (SYS_FXFKSNDEC)
ip = 1
nchars = ctoi (outstr, ip, ival)
if (nchars <= 0 || ival < 0)
call syserrs (SYS_FXFKSPVAL, "cachesize")
FKS_CACHESIZE(fit) = ival
default:
call syserr (SYS_FXFKSSYN)
}
end
# FXF_KS_PM -- Return the character YES or NO based on the value '+' or '-'
procedure fxf_ks_pm (pm, param, fit)
char pm[1] #I contains "+" or "-"
int param #I Parameter code
pointer fit #U Fits kernel descriptor
int ival
errchk syserr, syserrs
begin
if (pm[1] == '+')
ival = YES
else
ival = NO
switch (param) {
case KS_APPEND:
FKS_APPEND(fit) = ival
case KS_OVERWRITE:
FKS_OVERWRITE(fit) = ival
case KS_DUPNAME:
FKS_DUPNAME(fit) = ival
case KS_INHERIT:
FKS_INHERIT(fit) = ival
case KS_EXPAND:
FKS_EXPAND(fit) = ival
default:
call syserr (SYS_FXFKSSYN)
}
end
# FXF_KS_ERRORS -- Handle an error condition in the kernel section.
procedure fxf_ks_errors (fit, acmode)
pointer fit #I fits kernel descriptor
int acmode #I image access mode
int group
errchk syserr, syserrs
begin
group = FIT_GROUP(fit)
if (FKS_OVERWRITE(fit) == YES) {
if (FIT_NEWIMAGE(fit) == YES)
iferr (call syserrs (SYS_FOPNNEXFIL, IM_HDRFILE(FIT_IM(fit))))
call erract (EA_WARN)
if (acmode == APPEND)
call syserrs (SYS_FXFKSNOVR, "APPEND")
if (group == -1 &&
(FKS_EXTNAME(fit) == EOS && IS_INDEFL(FKS_EXTVER(fit))))
call syserr (SYS_FXFKSOVR)
} else {
switch (acmode) {
case NEW_COPY:
if (group != -1 && FKS_APPEND(fit) == NO)
call syserr (SYS_FXFKSBOP)
case NEW_IMAGE:
if (group != -1)
call syserrs (SYS_FXFKSNEXT, "NEW_IMAGE" )
case APPEND:
if (group != -1)
call syserrs (SYS_FXFKSNEXT, "APPEND" )
}
}
end
# FXF_KSINIT -- Initialize default values for ks parameters.
procedure fxf_ksinit (fit)
pointer fit #I fits kernel descriptor
begin
FKS_EXTNAME(fit) = EOS
FKS_SUBTYPE(fit) = NO
FKS_EXTVER(fit) = INDEFL
FKS_APPEND(fit) = NO
FKS_OVERWRITE(fit) = NO
FKS_DUPNAME(fit) = NO
FKS_EXPAND(fit) = YES
FKS_PHULINES(fit) = DEF_PHULINES
FKS_EHULINES(fit) = DEF_EHULINES
FKS_PADLINES(fit) = DEF_PADLINES
FKS_INHERIT(fit) = YES
FKS_CACHESIZE(fit) = DEF_CACHE
end
|
