1 files changed, 490 insertions, 0 deletions
diff --git a/sys/clio/clcache.x b/sys/clio/clcache.x
new file mode 100644
index 00000000..2d6df333
--- /dev/null
+++ b/sys/clio/clcache.x
@@ -0,0 +1,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