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
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <ctype.h>
include <clio.h>
.help clcache
.nf ___________________________________________________________________________
CLCACHE -- A package for cacheing the values of static parameters, i.e.,
parameters with values fixed at task invocation time.
The purpose of this package is to improve the runtime performance of the
parameter passing mechanism. The runtime semantics of the CLIO interface are
not affected. Transmission of the static parameters during task invocation
can save many runtime context switches, saving seconds of clock time when
running tasks which have many (dozens of) parameters.
clc_init () # initialize the cache
clc_compress () # rebuild the cache
clc_newtask (taskname) # set name of root pset
clc_mark (sp) # mark cache status
clc_free (sp) # free to last mark
clc_enter (param, value) # cache a parameter
nchars = clc_fetch (param, out, maxch) # fetch cached parameter
symp = clc_find (param, out, maxch) # find cached parameter
clc_scan (cmd) # scan a param=value stmt
clc_list (fd, pset, format) # list params to a file
The cache is initialized by the IRAF main with CLC_INIT during process
startup and whenever a new task is run. Parameter value pairs are entered
into the cache with CLC_ENTER during processing of the command line.
Runtime get parameter requests from the task are satisfied from the cache if
possible, querying the CL only if the cached value cannot be found. Note
that query mode and list type parameters are never cached since they do not
have static values.
A task can be called either with named parameters or with unnamed, positional
parameters. In the latter case the parameters are passed as "$1", "$2", etc.
If we receive one or more numbered parameters they will be entered into the
symbol table in the usual way but a list of offsets of the positional
arguments will be saved in the clio common. Subsequent runtime parameter
requests will be satisfied by trying to find the parameter by name in the
symbol table, returning the next positional argument if the named parameter
cannot be found. This is the mechanism used by the CL to satisfy requests
for parameters from a task which has no parameter file.
The values of all parameters are saved in the cache in string format. Since
all parameters come from the CL in string format this makes for an easy
interface to the high level CLIO code. The internal storage format for the
cache is a SYMTAB hash table, simplifying the implementation and providing
optimal performance. There is no fixed limit on the size of the cache.
.endhelp _____________________________________________________________________
# SYMTAB default allocation parameters (non-limiting).
define LEN_INDEX 128 # nbuckets in symtab hash index
define LEN_STAB 512 # initial symbol table size
define SZ_SBUF 2048 # initial string buffer size
# Symbol table structure (not much to it).
define LEN_SYMSTRUCT 1
define SYM_VALUE Memi[$1] # sbuf offset of value string
# CLC_INIT -- Initialize the parameter cache. Called during process
# startup. May be called repeatedly to reinitialize the cache.
procedure clc_init()
pointer stopen()
bool first_time
data first_time /true/
include "clio.com"
errchk stopen
begin
if (first_time) {
cl_stp = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF)
first_time = false
} else
call stfree (cl_stp, cl_stmark)
call stmark (cl_stp, cl_stmark)
call aclri (cl_posarg, MAX_POSARGS)
cl_nposargs = 0
cl_nextarg = 1
end
# CLC_NEWTASK -- Set the name of the task whose parameters are to be
# entered into the cache (the taskname is the root pset).
procedure clc_newtask (taskname)
char taskname[ARB] # name of the task being run
int gstrcpy()
include "clio.com"
begin
cl_psetop = gstrcpy (taskname, cl_psetname, SZ_PSETNAMEBUF) + 2
cl_psetindex[1] = 1
cl_npsets = 1
end
# CLC_MARK -- Mark storage in the cache for subsequent restoration by
# clc_free.
procedure clc_mark (marker)
pointer marker # receives marked position
include "clio.com"
begin
call stmark (cl_stp, marker)
end
# CLC_FREE -- Free storage in the cache back to the marked position. Any
# positional arguments are lost.
procedure clc_free (marker)
pointer marker # marked position
include "clio.com"
begin
call stfree (cl_stp, marker)
cl_nposargs = 0
cl_nextarg = 1
call aclri (cl_posarg, MAX_POSARGS)
end
# CLC_ENTER -- Enter a parameter-value pair into the cache. If the parameter
# is an unnamed positional parameter ($N) it is entered in the usual way
# with name $N, but its symtab pointer is also saved in the positional argument
# list. It is safe to save the pointer rather than the index because tasks
# which do not have pfiles never have more than a few arguments, hence the
# symtab will not be reallocated during entry.
#
# If the parameter name is of the form psetname.paramname, extract the pset
# name and add it to the list of pset names for the task. The order in which
# the pset names are defined will be the order in which they are later searched
# when satifying ambiguous references (where the psetname is not specified).
procedure clc_enter (param, value)
char param[ARB] # parameter name
char value[ARB] # parameter value string
pointer sym
int off, ch, pp, op, ip, n
bool streq()
pointer stenter()
int stpstr(), ctoi()
errchk stenter, syserrs
include "clio.com"
begin
sym = stenter (cl_stp, param, LEN_SYMSTRUCT)
SYM_VALUE(sym) = stpstr (cl_stp, value, 0)
if (param[1] == '$') {
# Positional argument (no pfile/pset).
ip = 2
if (ctoi (param, ip, n) > 0) {
n = max(1, min(MAX_POSARGS, n))
cl_posarg[n] = sym
cl_nposargs = max (cl_nposargs, n)
}
} else {
# Check if the parameter name includes the psetname prefix,
# and if so, append the pset name to the pset name list if
# not already there.
pp = cl_psetop
op = pp
# Extract psetname.
do ip = 1, SZ_PNAME {
ch = param[ip]
if (ch == EOS) {
return # no psetname given
} else if (ch == '.') {
cl_psetname[op] = EOS
break
} else {
cl_psetname[op] = ch
op = op + 1
}
}
# If pset already in list we are done.
ch = param[1]
do ip = cl_npsets, 1, -1 {
off = cl_psetindex[ip]
if (cl_psetname[off] == ch)
if (streq (cl_psetname[pp], cl_psetname[off]))
return
}
# Pset not found, so enter new pset name into list.
cl_npsets = cl_npsets + 1
if (cl_npsets > MAX_PSETS)
call syserrs (SYS_CLNPSETS, cl_psetname[pp])
cl_psetindex[cl_npsets] = pp
cl_psetop = op + 1
if (cl_psetop > SZ_PSETNAMEBUF)
call syserrs (SYS_CLPSETOOS, cl_psetname[pp])
}
end
# CLC_FETCH -- Search the CL parameter cache for the named parameter and
# return its value if found. If the parameter is not found and there are
# positional arguments, return the value of the next positional argument.
# The number of characters in the output string is returned as the function
# value if the parameter is found, else ERR is returned.
int procedure clc_fetch (param, outstr, maxch)
char param[ARB] # parameter to be fetched
char outstr[maxch] # receives value string of parameter
int maxch
pointer sym, vp
int gstrcpy()
pointer strefsbuf(), clc_find()
include "clio.com"
begin
# Search the symbol table for the named parameter.
sym = clc_find (param, outstr, maxch)
# If the named parameter could not be found using the given name or
# in any pset in the table, use the next positional argument if there
# is one.
while (sym == NULL)
if (cl_nextarg <= cl_nposargs) {
sym = cl_posarg[cl_nextarg]
cl_nextarg = cl_nextarg + 1
} else {
outstr[1] = EOS
return (ERR)
}
vp = strefsbuf (cl_stp, SYM_VALUE(sym))
return (gstrcpy (Memc[vp], outstr, maxch))
end
# CLC_FIND -- Search the CL parameter cache for the named parameter and
# return its symtab pointer and full name if found.
pointer procedure clc_find (param, outstr, maxch)
char param[ARB] # parameter to be fetched
char outstr[maxch] # receives full name of parameter
int maxch
pointer sym
int op, ip, ch, i
pointer stfind()
include "clio.com"
begin
# Look first for the named parameter, and if that is not found,
# search each pset for the named parameter, i.e., prepend the name
# of each pset to produce a name of the form "pset.param", and
# look that up in the symbol table. The first entry in the pset
# name list is the name of the task itself.
sym = stfind (cl_stp, param)
if (sym == NULL) {
do i = 1, cl_npsets {
op = 1
# Start with pset name.
do ip = cl_psetindex[i], SZ_PSETNAMEBUF {
ch = cl_psetname[ip]
if (ch == EOS)
break
else {
cl_pname[op] = ch
op = op + 1
}
}
# Add dot delimiter.
cl_pname[op] = '.'
op = op + 1
# Lastly add the parameter name.
do ip = 1, SZ_FNAME {
ch = param[ip]
if (ch == EOS)
break
else {
cl_pname[op] = ch
op = op + 1
}
}
# Look it up in the symbol table.
cl_pname[op] = EOS
sym = stfind (cl_stp, cl_pname)
if (sym != NULL)
break
}
} else
call strcpy (param, cl_pname, SZ_FNAME)
if (sym != NULL)
call strcpy (cl_pname, outstr, maxch)
return (sym)
end
# CLC_SCAN -- Extract the param and value substrings from a param=value
# statement and enter them into the CL parameter cache.
procedure clc_scan (cmd)
char cmd[ARB] #I command to be scanned
int ip
pointer sp, param, value, op, nchars
int stridx(), ctowrd()
begin
call smark (sp)
call salloc (param, SZ_FNAME, TY_CHAR)
call salloc (value, SZ_COMMAND, TY_CHAR)
# Skip any leading whitespace.
for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1)
;
# Do nothing if blank line or comment.
if (cmd[ip] == EOS || cmd[ip] == '\n' || cmd[ip] == '#') {
call sfree (sp)
return
}
# Extract the param field.
op = param
while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) {
Memc[op] = cmd[ip]
op = op + 1
ip = ip + 1
}
Memc[op] = EOS
# Advance past the assignment operator.
while (IS_WHITE (cmd[ip]) || cmd[ip] == '=')
ip = ip + 1
# Get the value string.
nchars = ctowrd (cmd, ip, Memc[value], SZ_COMMAND)
# Enter the param=value pair into the CL parameter cache.
call clc_enter (Memc[param], Memc[value])
call sfree (sp)
end
# CLC_LIST -- List the parameters in the named pset to an output file using
# a caller supplied format. If no pset is specified the entire contents of
# the parameter cache are output. A sample format is "set %s = \"%s\"\n".
procedure clc_list (fd, pset, format)
int fd #I output file
char pset[ARB] #I pset to be listed, or EOS for full cache
char format[ARB] #I output format - one %s each for param,value
int nsyms, i
pointer sp, syms, sympset, ip, op, sym, np
bool strne()
pointer sthead(), stnext(), stname(), strefsbuf()
include "clio.com"
begin
# Count the number of parameters.
nsyms = 0
for (sym=sthead(cl_stp); sym != NULL; sym=stnext(cl_stp,sym))
nsyms = nsyms + 1
call smark (sp)
call salloc (syms, nsyms, TY_POINTER)
call salloc (sympset, SZ_FNAME, TY_CHAR)
# Get a reversed list of symbol pointers.
op = syms + nsyms - 1
for (sym=sthead(cl_stp); sym != NULL; sym=stnext(cl_stp,sym)) {
Memi[op] = sym
op = op - 1
}
# Output the list.
do i = 1, nsyms {
sym = Memi[syms+i-1]
np = stname (cl_stp, sym)
# Check the pset name if the user named a specific pset.
if (pset[1] != EOS) {
# Get the pset name of the parameter.
op = sympset
for (ip=np; Memc[ip] != EOS && Memc[ip] != '.'; ip=ip+1) {
Memc[op] = Memc[ip]
op = op + 1
}
Memc[op] = EOS
# Skip if the wrong pset.
if (strne (Memc[sympset], pset))
next
}
call fprintf (fd, format)
call pargstr (Memc[np])
call pargstr (Memc[strefsbuf(cl_stp,SYM_VALUE(sym))])
}
call sfree (sp)
end
# CLC_COMPRESS -- Compress the parameter cache. Since every parameter
# modification results in a new parameter entry (redef), the symbol table
# can grow quite large if there are many clput type parameter accesses.
# This operator rebuilds the parameter cache eliminating all old entries.
procedure clc_compress ()
pointer n_st, o_st
pointer sym, newsym, np, vp
int stpstr()
pointer strefsbuf(), stopen(), stname()
pointer sthead(), stnext(), stfind(), stenter()
errchk stopen, stenter, stpstr
include "clio.com"
begin
n_st = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF)
o_st = cl_stp
# Copy the symbol table, saving only the most recent entry for
# each symbol.
for (sym=sthead(o_st); sym != NULL; sym=stnext(o_st,sym)) {
np = stname (o_st, sym)
if (stfind (n_st, Memc[np]) == NULL) {
vp = strefsbuf (o_st, SYM_VALUE(sym))
newsym = stenter (n_st, Memc[np], LEN_SYMSTRUCT)
SYM_VALUE(newsym) = stpstr (n_st, Memc[vp], 0)
}
}
# Copy back the saved symbols. The "push/pop" way in which we use
# the temporary symbol table to save the symbols automatically
# preserves the original symbol table ordering.
call stfree (o_st, cl_stmark)
call stmark (o_st, cl_stmark)
for (sym=sthead(n_st); sym != NULL; sym=stnext(n_st,sym)) {
np = stname (n_st, sym)
vp = strefsbuf (n_st, SYM_VALUE(sym))
newsym = stenter (o_st, Memc[np], LEN_SYMSTRUCT)
SYM_VALUE(newsym) = stpstr (o_st, Memc[vp], 0)
}
call stclose (n_st)
call stsqueeze (o_st)
end
|