Repatch (from linux) of OSX IRAF

1 files changed, 222 insertions, 0 deletions

diff --git a/pkg/vocl/doc/pset.sys b/pkg/vocl/doc/pset.sys
new file mode 100644
index 00000000..143d3b2a
--- /dev/null
+++ b/pkg/vocl/doc/pset.sys
@@ -0,0 +1,222 @@
+1. Procedures
+
+	  ltp = cmdsrch (path)
+	ltp = ltasksrch (path)
+	 pp = paramsrch (path, &field)
+
+	pfp = pfilesrch (path)
+	pfp = pfileload (ltp)
+	    pfileupdate (pfp)
+	     pfilemerge (pfp, oldpfile)
+	pfp = pfileread (pfilename)
+	     pfilewrite (pfp, pfilename)
+
+
+2. Pseudocode
+
+
+# PFILESRCH -- Given a pfile name or the name of an ltask which has a pfile,
+# allocate a pfile descriptor and read the pfile into that descriptor.
+
+pfp procedure pfilesrch (path)
+
+begin
+	if (path is a filename)
+	    return (pfp = pfileread (fname))
+	else {
+	    ltp = ltasksrch (path)
+	    return (pfp = pfileload (ltp))
+	}
+end
+
+
+# PFILELOAD -- Load the pfile for an ltask, given its descriptor ltp.
+
+pfp procedure pfileload (ltp)
+
+begin
+	pfp = NULL
+
+	if (ltp references a pset task) {
+	    Descend the control stack task-list and examine the pset of
+	    each task to locate the most recently executed task which
+	    references this pset task.  The value of the pset parameter
+	    for that task determines which pfile to use.
+
+	    if (pset_param_value is a filename (.par or .cl extn))
+		return (pfp = pfileread (fname))
+	    else if (pset_param_value is an ltaskname)
+		ltp = ltask descriptor of that task
+	    else
+		do nothing - use pset of pset-task on ltp
+	}
+
+	make usr_pfile name = uparm$pkgltask.par
+	if (pfileload already called for this task)
+	    return (pfp = pfileread (usr_pfile))
+
+	get finfo of usr_pfile
+	get filename, finfo of pkg_pfile
+	    (check for .par, and if not found, use .cl)
+
+	if (usr pfile exists and has a nonzero extent) {
+	    if (usr pfile is older than pkg_pfile) {
+		# Merge old usr_pfile into pkg_pfile, update usr_pfile.
+		pfp = pfileread (pkg_pfile)
+		pfp->pfilename = usr_pfile
+		pfilemerge (pfp, usr_pfile)
+	    }
+	} else if (uparm exists and learning is enabled) {
+	    # Make user copy of pkg pfile.
+	    pfp = pfileread (pkg_pfile)
+	    pfp->pfilename = usr_pfile
+	} else
+	    return (pfileread (pkg_pfile))
+
+	set bit in ltask descriptor so that we don't do this again
+	    (must be cleared if pfile is unlearned)
+end
+
+
+# PFILEUPDATE -- Update a parameter set in the pfile from which it was
+# originally read.
+
+procedure pfileupdate (pfp)
+
+begin
+	if (fake pset or pset has not been modified)
+	    return
+	else if (pset is cl.par)
+	    return
+
+	call pfilewrite (pfp, pfp->pfilename)
+end
+
+
+# PFILEMERGE -- Merge the parameter values from the named pfile into the
+# given parameter set.
+
+procedure pfilemerge (pfp, pfile)
+
+begin
+	mark topd
+	ofp = pfileread (pfile)
+
+	for (each parameter in ofp) {
+	    find associated parameter in pfp
+	    if (param not found)
+		warn user
+	    else if (illegal datatype conversion)
+		warn user
+	    else
+		set value of parameter in pfp version
+	}
+
+	restore topd
+end
+
+
+# PFILEREAD -- Allocate a pfile descriptor and read the named pfile into it.
+# The input pfile may be either a parameter file or a CL procedure script.
+
+pfp procedure pfileread (pfilename)
+
+begin
+	allocate pfile descriptor
+
+	open pfile
+
+	if (pfilename has a .cl extension)
+	    parse pfile into pfile descriptor
+	else
+	    scan pfile into pfile descriptor
+
+	close pfile
+end
+
+
+# PFILEWRITE -- Write the parameter set in the pfile descriptor to the
+# named file.  Any existing file is overwritten.
+
+procedure pfilewrite (pfp, pfilename)
+
+begin
+	if (pfilename does not have .par extension)
+	    add or modify extension to .par
+
+	delete old pfile
+	disable interrupts
+
+	open new pfile
+	write parameters
+	close pfile
+
+	reenable interrupts
+end
+
+
+--------------
+path procedure paramsrch (path, &param)
+
+begin
+	parse arg list
+
+	# Get field name.
+	if (argc > 1 && last arg is a p_field reference) {
+	    map field name to field code
+	    decrement arg count
+	}
+
+	# Get parameter name.
+	if (argc < 1)
+	    error
+	else {
+	    last arg is param name
+	    decrement arg count
+	}
+	    
+	if (no args left) {
+	    search for the parameter via the usual param search path,
+		i.e., task, package, cl.
+	} else {
+	    compose path to ltask
+	    call ltasksrch to find task
+	    readin pfile for task
+	    search pfilelist for named parameter
+	}
+
+	return p_name field code
+	return (pp)
+end
+
+
+ltask procedure ltasksrch (path)
+
+begin
+	parse arg list
+
+	# Find defined task.
+	search task list for first arg,
+	    via circular search of the loaded packages
+	while (arg is a package)
+	    search pkg task list for next arg
+	
+	# Deal with pset task references.
+	while (arg list is not exhausted) {
+	    readin pfile for task
+	    search pfilelist for next arg
+	    if (param found and it is a pset parameter) {
+		if (value is null)
+		    search pkg list for task of the same name
+		else if (value is a taskname)
+		    search pkg list for named task
+		else if (value is a pfilename) {
+		    setup dummy ltask struct at topd
+		    readin pfile, attach to ltask
+		}
+	    } else
+		break
+	}
+
+	return (ltp pointer to ltask descriptor)
+end