Initial commit

96 files changed, 51609 insertions, 0 deletions

diff --git a/pkg/vocl/Notes.ecl b/pkg/vocl/Notes.ecl
new file mode 100644
index 00000000..e9ed3cea
--- /dev/null
+++ b/pkg/vocl/Notes.ecl
@@ -0,0 +1,1098 @@
+
+		ECL:  Enhanced CL Release Notes and User's Guide
+		================================================
+
+		           Michael Fitzpatrick
+			     NOAO/IRAF Group
+			        12/12/04
+
+			   Revised: 5/28/05
+								
+
+********************************************************************************
+Release History:
+     02/10/05		** Alpha Release for testing
+     05/06/05		** 2nd Alpha Release for testing
+     06/07/05		** 1st Beta Release for testing
+
+
+********************************************************************************
+
+Table of Contents
+-----------------
+
+    Introduction
+
+    Installation and Use
+  	To Install the CL
+  	Determine CL Version Type
+
+    Error Handling
+  	Introduction and Cautions
+  	    Example Descriptions
+  	Reporting Errors
+	    Traceback
+	Trapping Errors
+	    The 'iferr' Syntax
+	    The 'erract' Environment Variable
+	    Error Handling: Then and Now
+	New CL parameters
+	What Errors Are NOT Trapped
+
+    Command-line History and BackSpace Revisions
+	Input Command Summary
+
+    New Builtin Functions and Variables
+	Error Functions
+	String Functions
+	Trig Functions
+	Utility Functions
+	Bitwise Operations
+
+    Defined Constants
+
+    Post-Release Notes
+
+
+********************************************************************************
+
+============
+Introduction
+============
+
+    The primary goals of the ECL project were to 
+
+	o  add an error-handling capability to the existing IRAF CL, 
+	o  include other functionality which could improve the
+	   scripting environment (e.g. pre-defined language constants
+	   such as 'PI') and add any other features we found lacking
+	   (e.g. missing trig functions and string utilities), and
+	o  add commonly requested features.
+
+Where possible, small enhancements such as a new utility builtin function
+will be implemented in the "old" CL as well, however as scripts begin to
+use the more advanced features scripts will naturally become less backward
+compatible.  Future work will build on the version presented here with
+the hope that users will migrate to the new system over a short time.
+
+	This is a work in progress.  Users are encouraged to experiment with
+features, request future enhancements, and to please report any errors or
+problems to 
+		iraf@noao.edu
+
+New releases will be announced on the IRAF website (http://iraf.noao.edu)
+following the addition of any new features or when critical bugs have been
+fixed.
+
+
+
+====================
+Installation and Use
+====================
+
+	The ECL is being distributed in a self-extracting script file
+rather than the traditional IRAF external package since it is meant to
+overlay an existing IRAF system until the time when it becomes part of
+the core distribution.  Since the script creates a new command link in
+the unix system "local bin directory" and adds files to the IRAF source 
+tree, it MUST be run as the root user (the script will terminate or ask
+if you wish to proceed with a no-op installation otherwise).
+
+The installation script does the following to your system:
+
+    1)  Replaces the existing hlib$cl.csh script with a modified 
+	version after creating a hlib$cl.csh.ORIG backup file
+
+    2)  Creates an "ecl" command link in the same directory as the
+	current "cl" IRAF command link.  Both links point to the same
+	hlib$cl.csh script which checks for how it was called an 
+	invokes the proper binary.
+
+    3)  Moves the "ecl.e" binary to the proper iraf$bin.<arch> directory,
+	changing the ownership to the 'iraf' user and setting the execute
+	permissions on the file.
+
+    4)  Creates a iraf$pkg/ecl directory and moves all ECL sources there.
+
+The install script may be run from any directory on the system, it is
+unpacked in /tmp and cleans up temp files when complete.   A "personal
+installation" option is not implemented at this time but could be considered
+later for users who don't have write permission on their IRAF tree.  Please
+contact iraf@noao.edu for instructions on how to manually setup such a
+system for personal use.
+
+
+To Install the ECL
+------------------
+
+Step 1)	Download the distribution file appropriate for your system.  For
+	example, 
+
+        	% ftp iraf.noao.edu (140.252.1.1)
+        	login: anonymous
+        	password: [your email address]
+        	ftp> cd pub
+        	ftp> binary
+        	ftp> get ecl_install_redhat.csh
+        	ftp> quit
+
+Step 2) Execute the script AS ROOT:
+
+		% su				# become the root user
+		# ./ecl_install_redhat.csh
+
+	The script will prompt you for the local bin directory or any 
+	iraf paths needed, simply accept the default values determined for
+	your system or override them with others.
+
+	Once executed, the ECL source and binaries will be installed in
+	the system as described above.  The file you are reading right
+	now is available as iraf$pkg/ecl/Notes.ecl and will be updated
+	with post-release notes at the end of the file with each new
+	release.
+
+Step 3) Start the ECL from your normal IRAF login directory as either
+
+		% ecl
+	or
+		% cl -ecl
+
+	The second form of the command is needed on systems which mount
+	IRAF from another machine since the CL command links are created
+	at IRAF install time.  One reason for replacing the hlib$cl.csh
+	script is to allow for the "-ecl" argument to override the binary
+	to be used on systems where only the 'cl' command is available and
+	so that the installation isn't required on all machines mounting
+	a common IRAF.
+
+	The default ECL prompt is now "ecl>" in the new version as a visual
+	clue that the new system is being used.  Additionally, package prompts
+	default to using the complete package name rather than the familiar
+	2-character prefix as another clue.  This behavior can be changed
+	by adding the string "nolongprompt" to the CL 'ehinit' parameter,
+	e.g.
+
+	       cl> cl.ehinit = cl.ehinit // " nolongprompt"
+
+
+Except as described below, use of the ECL should be identical to the
+traditional CL for most users.
+
+
+Determining CL Version
+----------------------
+
+	As users begin to make regular use of features found only in the
+ECL, the first error to be checked is that the script is running using the
+proper version of the CL.  This needs to be done using features found in
+both the ECL and traditional CL languages.  The simplest test, for either
+package loading scripts or within tasks, is something like
+
+	if (defpar ("$errno")) {
+	    print ("You are using the ECL")
+	} else {
+	    print ("You are using the old CL")
+	}
+
+
+
+
+==============
+Error Handling
+==============
+
+Introduction and Cautions
+=========================
+    
+    The error-handling enhancements are composed of two elements: 
+
+	o  the reporting of errors within scripts, and
+	o  the ability to trap and recover those errors.  
+
+The first case addresses the long-standing problem in which an error message
+returned by a script gives a line number that has no basis in reality, and
+which gives no useful information about the underlying task that created it.
+In the second case, one often wants scripts to be able to trap errors from
+compiled tasks so that some sort of cleanup can be done in order to allow
+the script to continue, or so that an error status code can be examined
+and some specific action taken (which may simply be to ignore the error).
+
+    In the ECL, messages are now printed with the correct line number and
+with a detailed traceback to the user's command-line showing more precisely
+what was called at the time of the error.  New language constructs are
+available which allow scripts to conditionally check for errors from
+tasks they call and branch to code to deal with those errors.  Finally,
+new ECL environment variables and builtin functions allow for limited
+error-handling control over scripts already in the system which have not
+been retrofitted to specifically trap errors.  Details of each of these
+capabilities and examples of how they may be used by developers and users
+are given below.  It is also worth discussing the types of errors which
+can occur in a script task before getting into details about how they
+might be handled by the user or script programmer.
+
+Error conditions in the CL break down into roughly the following types:
+
+          Error Type	       		Examples
+          ----------			--------
+
+    Compiled Task Errors    1) A call to a compiled task in the system
+			       dies unexpectedly with an exception (e.g.
+			       FPE, segmentation violation, etc)
+			    2) A task aborts due to an error condition the
+			       task has trapped and cannot recover (e.g.
+			       invalid parameters, out of memory, etc).
+
+    CL Internal Errors	    1) Script code performs an illegal operation
+			       causing an exception (e.g. "i = j / k"
+			       where 'k' is zero.
+			    2) Script code triggers a runtime error within
+			       the CL itself (e.g. "log (string_value)")
+
+    CL Error Assertions	    1) Script programmer forces the task to exit
+			       with a call to the CL error() builtin.
+			    2) Script programmer simply prints and error
+			       message indicating a problem and returns
+			       without further processing.
+
+All of these errors can be detected at some level, however not all of
+them can be handled in a way which allows a calling script to recover
+and continue executing, nor would it always make sense to do so.
+Errors such as a floating-point-exception (FPE) may be data-dependent,
+a segmentation violation may indicate a coding error in a compiled task
+or a platform-specific bug, or an error in another script task may be
+beyond the control of the scripter to fix.  Error assertions by a script
+programmer are not meant to be recoverable, and in the second example
+an arbitrary problem message cannot be trapped by the system.
+
+    An error-handling capability in the ECL (or any language) is not a
+panacea for all error conditions one might encounter, the best a script
+programmer can hope to do is to trap an error and take some reasonable
+action at the time.  The ECL offers a way for a script to print a more
+meaningful error message, or at least abort gracefully after cleaning
+itself up.  However, depending on the type of error,  *your* script may
+still never run to completion until somebody else fixes *their* code.
+
+    Lastly, it is also important to note that trapping an error means the
+script finds itself in an unnatural state.  Proper recovery requires
+that the script programmer understand the error condition as well as
+the state of the script at that point of execution.  The error-handling
+code must restore the script to a state where it can continue running
+(if possible) and avoid potential side-effects caused by e.g. forgetting
+to clean up intermediate files or reset counter variables.  New language
+features mean new types of bugs can be introduced into a script, even if
+the irony is that these new features are meant to trap bugs!
+
+
+Example Descriptions
+--------------------
+
+	In the examples to follow we will make use of an ERRTEST package
+distributed with the ECL source and containing the following tasks used
+in the examples to follow:
+
+     nested -- Test various error conditions from layered scripts
+      nest0 -- Dummy layer for nested testing
+    errtype -- Low-level script to test compiled and CL error conditions
+    
+        fpe -- Compiled task producing an arithmetic exception
+     segvio -- Compiled task producing a segmentation violation
+     spperr -- Compiled task invoking the SPP error() function
+    
+
+
+Reporting of Errors
+===================
+    
+Traceback
+---------
+
+    The most obvious change to users will be in the traceback of errors
+reported by the ECL.  As an example, suppose we have a test script
+called NESTED that calls several layers of other scripts until it gets
+to a compiled task called FPE which simply triggers a divide-by-zero
+arithmetic exception.  The calling sequence we use is
+
+	NESTED (type)			# toplevel test task
+	    NEST0 (type)		# hidden script task
+		ERRTYPE (type)		# script task
+		    FPE ()		# compiled task giving the error
+
+(The 'type' argument here is a code used to test various types of system
+errors but its value isn't important to the current discussion.)  In the 
+traditional CL, executing this script results in the following and familiar
+message:
+		cl> nested 1
+		ERROR on line 72: floating point divide by zero
+		    errtype (type=1)
+		    nested (type=1)
+
+There are a number of issues with the error report here we wish to correct:
+
+    1)  The error is reported to be on line 72, but none of the scripts
+        called invoke any task on that line, or even have that many lines,
+        and so it is clearly wrong.
+    2)  Was it the ERRTYPE script that caused an error or something else?
+    3)  There is no mention of the FPE task we know to be the culprit.
+
+These problems are resolved in the ECL where the error report now looks like:
+
+	cl> nested 1
+	ERROR: floating point divide by zero
+	  "fpe ()"
+	     line 15: errtest$errtype.cl
+	     called as: `errtype (type=1)'
+	  "errtype (type)"
+	     line 13: errtest$nest0.cl (hidden task)
+	     called as: `nest0 (type=1)'
+	  "nest0 (type)"
+	     line 11: errtest$nested.cl
+	     called as: `nested (type=1)'
+
+The traceback is more complete and begins with the task which actually
+throws the error.  Checking the line numbers of the ERRTEST package
+scripts we find that indeed FPE is called on line 15 of 'errtype.cl',
+ERRTYPE is called from line 13 of 'nest0.cl', and so on.
+
+    For each task in the calling sequence the format of the traceback is
+
+	<script code fragment executing at the time of error>
+	   LINE <number>: <script file containing line>
+	   CALLED AS: <how this script was called>
+
+The length of the traceback may be controlled with the new 'erract'
+environment variable discussed in more detail below.  In short, 'erract'
+allows the traceback to be suppressed entirely, to print information only
+at the level where the error occurred, or to print a full calling stack
+trace (default).
+
+
+Trapping Errors
+===================
+
+The 'iferr' Syntax
+------------------
+
+    The ECL provides new language constructs to enable error actions, error
+handling and recovery.  This syntax will already be familiar to SPP programmers
+and will quickly become obvious to even novice script programmers.
+
+    Error recovery is implemented using the IFERR and IFNOERR statements
+to "post" an error handler that is called at the end of a block of code and
+which checks for error conditions that may have occurred in that block.
+The syntax for these statements is of the form:
+
+
+    iferr { <statement> } 		ifnoerr { <statement> }
+        <error action statement> 	    <success action statement>
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 	    	    <block of statements>
+    } then 				} then
+        <error action statement> 	    <success action statement>
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 		    <block of statements>
+    } then { 				} then {
+        <block of error stmts> 		    <block of success action stmts>
+    } 					}
+
+
+The IFERR is grammatically equivalent to the IF statement and means "if an
+error occurs during the processing of the enclosed code, execute the error
+action statement to follow".  IFNOERR is the same except that the sense
+of the test is reversed and the action statements are executed only if the
+enclosed code completes without error.  Additionally, these statements take
+an ELSE clause allowing both forms of the test to be combined.  For example,
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 		    <block of statements>
+    } then { 				} then {
+        <error stmts> 		    	    <success stmts>
+    } else { 				} else {
+        <success stmts>	    	    	    <error stmts>
+    } 					}
+
+
+In all cases 
+
+    o  Curly braces around the code to be checked are required,
+    o  Curly braces are required when any action is a compound block 
+    o  The THEN statement is optional if a single statement is executed
+       as part of the action block
+    o  The THEN statement is required for a compound action or when using
+       an ELSE clause
+    o  It is a syntax error for a condition block to itself directly contain
+       an IFERR or IFNOERR statement and action statements, i.e.  IFERR
+       statements may not be nested
+
+
+    To make effective use of these statements a few points need to be
+kept in mind:
+
+    o   The check for errors happens only after ALL statements in the
+	condition block are executed;
+    o   Statements which generate errors did not execute to completion,
+	subsequent code relying on that result cannot be trusted
+    o   Code in the condition block which executes following an initial
+	error may itself trigger errors due to the failure of a previous
+	statement or the resulting side-effects;
+
+This implies that IFERR statements should be used to target only critical
+pieces of code where a particular error condition might be expected, and/or
+where an action block could reasonably react to that error.  As an example
+of how ignoring these points could be problematic consider the code snippet:
+
+	iferr {
+	    task_a ()
+	    task_b () | scan (x)
+	    task_c (x)
+	} then {
+	    error (99, "An error occurred\n")
+	}
+
+All three tasks in the condition block will be executed, however the
+behavior of the code being check depends on which task in the block fails;
+If 'task_a' fails there may be no consequences for the remaining calls,
+however if 'task_b' fails the value of 'x' may never be set and 'task_c'
+may also fail (or at least produce spurious results).  Cascading errors like
+this will also be trapped and the action statement will still execute, but
+the system error message strings will be incomplete (more about that below).
+
+    While it is possible to have a failure from each statement in a condition
+block branch immediately to the action block by checking each statement
+individually, doing so would permit poor programming practices such as
+iteratively testing for the name of the failed task and taking different
+recovery methods in the action block.  If this is actually required for the
+script to recover cleanly, the recommended method is to put an IFERR block
+around smaller pieces of code where the recovery statements relate more
+directly to the code being checked.
+
+Errors trapped by IFERR statements include:
+
+    o  System exceptions (FPE, segfault, etc) thrown by compiled tasks
+    o  SPP error() returns from compiled tasks
+    o  CL script error() assertions
+
+Below we discuss errors which cannot be trapped using the IFERR syntax as
+well as strategies for how to handle those errors which can be detected.
+We'll also see how to determine which task in a condition block failed
+and why.
+
+
+The 'erract' Environment Variable
+----------------------------------
+
+	The ECL has a new 'erract' environment variable used to control the
+different aspects of the error handling.  This is a whitespace-delimited
+string comprised of the following options:
+
+
+    abort	Script task should abort at an error and begin error
+		recovery back to the command-line
+
+    noabort	Task should not abort, but continue execution if possible
+
+    trace	Print a traceback of the calling sequence including all
+		line numbers and calling statements
+
+    notrace	Print only the error message, no linenumbers or calls
+
+    clear	Clear the error params (i.e. $errmsg, $errnum, $errtask)
+		at each new task call.  This reseets the params with each
+		task invocation allowing them to be examined after each
+		call regardless of whether the code is in an IFERR block.
+
+    noclear	Do not clear the CL error params at each new task call,
+		the params are only reset when an error is encountered.
+
+    flpr	Automatically issue a 'flpr' when an error is seen.  This
+		is used to flush any failed task from the process cache to
+		avoid potential future problems caused by a corrupted task.
+
+    noflpr	Do not issue a 'flpr' when an error is seen, tasks remain
+		in the process cache, possibly in an error state.
+
+    full	Print a complete traceback of the calling sequence.
+
+    nofull	Print only the error report for the task causing the error
+		and none of its parents.
+
+
+The default value is set as:
+
+    set erract = "abort trace flpr clear full"
+
+Note that erract is implemented as an environment variable rather than
+as a new CL parameter (similar to the ehinit/epinit params) in order to
+minimize changes in the CL parameter file itself during the transition
+to the ECL.  The difference is that the 'set' (ore 'reset') command must
+be used to define the values, whereas with ehinit/epinit they may be
+assigned directly.  For this variable it is also possible to (re)define
+a single parameter without affecting other options, e.g.
+
+    cl> show erract			# print options
+    abort trace flpr clear full	
+    cl> set erract = "noabort"		# reset one of them
+    cl> show erract			# print options again
+    noabort trace flpr clear full
+
+
+
+Error Handling: Then and Now
+----------------------------
+
+    To better understand the new error detection and recovery behavior
+(and to document this for future reference), let's look at the old error
+mechanisms of the CL language:  Any command called from the CL executes in a
+context defined by the task hierarchy initiating the command, i.e. from the
+command-line CL prompt one has a "first" task context, scripts calling child
+(compiled or script) tasks push a new CL context inheriting the current
+CL environment and who's 'parent' is the context that invoked the task.
+
+    In the traditional CL with an error occuring in a compiled task,
+recovery first takes place in the SPP code who may choose to either handle
+the error itself or may abort completely by doing a long-jump back to the
+IRAF main() procedure (i.e. an EA_FATAL error type).  In this latter case,
+the process binary (running as a detached process from the CL) sends an
+error() command back to the CL telling it the task has terminated abnormally
+(a normal task shutdown leaves the executable simply waiting for more input
+from the CL, e.g. another task to execute).  This returned error() statement
+is the same CL error() command one would use to abort a script task, and its
+effect is to tell the CL to abort the current context and long-jump back
+to the command-line after cleaning up running processes and freeing the
+dictionary space (what the CL uses to catalog tasks/packages, parameters,
+etc).  [NOTE: Whether it is a system exception or a programmer-posted error,
+the error sent back to the CL has always included both the error code and
+message, it is just that the CL has never made use of these until now.]
+Similarly, errors which occur while running script tasks (e.g. 'task not
+found' errors, invalid use of string values, divide-by-zero from local
+script variables, etc) also end up in the same CL error() procedure via
+internal procedure calls made while executing the script.
+
+    Syntax errors are caught when the script is 'compiled' into the opcode
+execution stack and are reported before the script begins to execute.
+A script calling a child script containing a syntax error cannot trap
+that error even though it will not be reported until the child script is
+'compiled' just prior to execution.  We assume that all script tasks are
+well-formed and free of ntax errors.
+
+    ECL error recovery is somewhat simplified by the fact that errors,
+either from external tasks or the execution of scripts, all converge in
+a single procedure in the CL source code.  The trick is to modify the
+runtime behavior of the CL so that once we know we have an error we can
+branch to conditional code instead of simply jumping all the way back to the
+command line.  Since we also wish to improve the error reporting we'd also
+like make better use of information about how the failed code was called.
+
+    The first step is to realize that when executing a script the CL
+language is "compiled" into a series of 'opcode' instructions comprising an
+intermediate runtime language (similar to assembly language).  Scripts are
+run by executing the opcode instruction at the current 'program counter'
+location, pushing task arguments or getting labels for jumps from the
+dictionary, restoring a previous CL context, etc.  The compilation stage
+already has information about the script line being parsed so by adding
+this line-number to the opcode instruction it is now possible to trace a
+fault in any opcode back to the originating line of the script, and from
+there back up to the command line through the calling tree.  This extra
+information makes the runtime size of the script slightly larger so
+extremely large scripts may experience "dictionary full" problems not
+previously seen (various CL buffer sizes were increased to help offset
+this problem).  This relatively minor change is all that is required to
+address the problems mentioned above in error reporting.
+
+    Error trapping and recovery is done in a manner similar to the
+implementation in SPP:  The IFERR statement isn't actually an instruction
+in the runtime script, rather it is used to tell the parser to insert
+code around the block to be checked using traditional IF statements.
+As an example, consider
+
+	iferr { 
+	    task1 (arg1, arg2) 
+	    task2 (arg1)
+	} then {
+	    recovery ()
+	}
+
+When compiled this is the equivalent of writing
+
+
+	_errpsh () 
+	task1 (arg1, arg2) 
+	task2 (arg1)
+	if (_errpop () != 0) {
+	    recovery ()
+	}
+
+The _errpsh() is a hidden builtin function which "pushes" an error
+structure onto the runtime stack, the _errpop() test at the end then
+queries that structure to see whether any statement since the previous
+push set the error flag and filled in the structure with the task name,
+line number and other information.  The push also temporarily deactivates
+the behavior of the error() function so it no longer aborts entirely,
+allowing the script to continue after cleaning up the current error.
+
+	In order to keep the model simple, nested iferr statements within
+the same script are not currently implemented but are a possible future
+enhancement.  Complications arise from examples such as
+
+	iferr { 
+	    task1 (arg1, arg2) 
+	    iferr { task2 (arg1) } then 
+	        recovery2 ()
+	} then {
+	    recovery1 ()
+	}
+
+Consider the case where task1() succeeds and task2() fails and is
+recovered properly with the recovery2() procedure.  As far as the outer
+IFERR block is concerned, did an error occur or not?  If the remainder of
+the script depends on task2() succeeding then the answer is possibly 'no'
+(depending on what the recovery does) and we should additionally call
+the recovery1() procedure (who is responsible for dealing with an error
+condition in that block), if there is no dependency then we may want
+*any* failure to be considered, or perhaps even have a way to "clear"
+error conditions within the block.  Now assume instead it is the first
+task which fails and that triggers the second to fail because we depend
+on the first succeeding, how should we post the error number/message for
+the script?  We simply disallow nested IFERR statements for the moment
+to avoid dealing with these complex interactions
+
+
+New CL parameters
+===================
+
+	On order for script programmers to make use of errors that have
+been trapped by the ECL, one generally needs access to the details of
+that error, e.g. the message, task name, error number, etc.  To this end
+the ECL implements several new pseudo-parameters and builtin functions
+containing this information.  These include
+
+    Param	    Function        Meaning
+    -----	    --------        -------
+    $errno	    errno()	    The system error number
+    $errmsg	    errmsg()	    The system error message string
+    $errtask	    errtask()	    Task which created the error
+
+By default these parameters are re-defined as each task is called, in theory
+allowing a script to trap errors without the IFERR by doing something like
+
+	mytask1 () 
+	if ($errno != 0) <statement>
+	mytask2 () 
+	if ($errno != 0) <statement> 
+	    :
+
+This behavior can be modified by the 'erract' environment variable 'clear'
+or 'noclear' settings so that they only change when an error condition is
+found (i.e. erract set to 'noclear', tasks which complete successfully
+do not modify variables).
+
+	Additionally, a new $err_dzvalue pseudo-parameter is defined to
+be used by the CL interpreter when a divide-by-zero condition is encountered
+in the CL itself.  (This value has no builtin function equivalent.)
+This is an integer and will be cast to floating-point automatically if
+needed, the default value of 1 (one) was chosen to allow the script to
+continue executing but it should be noted that this value is only used
+when an error is found within an IFERR block.  For example,
+
+	ecl> = 1 / 0
+	ERROR: integer divide by zero
+	ecl> = 1. / 0.
+	ERROR: floating divide by zero
+
+However,
+
+	ecl> iferr {
+	>>>     = 1 / 0
+	>>> } then ;;
+	Warning on line 31 of : integer divide by zero - using $err_dzvalue = 1
+	1
+
+Note the warning message indicating the use of the parameter followed by the
+result.
+
+
+
+What Errors Are NOT Trapped
+===========================
+
+	As mentioned above, not all CL errors can or should be trapped
+by the new system.  The (incomplete) list of error conditions which 
+CANNOT be trapped during task execution using the IFERR or other new
+features includes:
+
+    o CL-language syntax errors
+    o CL internal errors, for example
+	- invalid procedure arguments (e.g. "parameter not found")
+	- improper usage of intrinsic procedures (e.g. log(-10) )
+	- operand type mis-matches (e.g. "s1 + x")
+	- parser errors (e.g. newline in string)
+    o CL runtime errors
+	- too many background jobs (e.g. "no available job slots")
+	- insufficient resource messages (e.g. out of memory)
+	- can't read/write/create files (e.g. permissions problem on uparm$)
+	- ambiguous task name
+	- scan/print string exceeds max length
+    o User-defined error messages and returns (i.e. the script writer
+	outputs an error message and returns from the procedure but 
+	does not use something like thea CL error() function to abort.
+	For instance, a script prints "I can't run this on Tuesdays" and
+	returns to the command-line but does not otherwise post an error
+	condition for the calling context.
+
+    
+
+============================================
+Command-line History and BackSpace Revisions
+============================================
+
+	The ECL now implements the common GNU Readline interface for input
+handing meaning that many familiar tcsh-like features such as Up/Down-Arrow
+history, Left/Right cursor-position movement, and tab-filename completion
+are now understood in the IRAF environment.  It follows that many of
+the problems encountered with the DEL/BS key to erase characters when
+entering input on the commandline have also been eliminated on most
+systems since the readline interface internally handles the delete-key
+mappings imposed on most systems.  Tab-completion of task/params names
+was not implemented in this initial release but could be added later.
+
+	It is important to note that this implementation was done so as
+to not interfere with the native IRAF ehist/epar cursor and history
+mechanism.  From the ECL prompt, all commands recognized by readline()
+interface (including user mappings defined in an ".inputrc" file) will
+be honored.  If that command is ehist/epar or one of the recognized
+IRAF history editing metacharacters then these will be processed in the
+traditional IRAF manner.
+
+	Should a problem with readline input be found, it can be disabled
+from the user's session by adding the string "noreadline" to the CL
+'ehinit' parameter, e.g.
+
+	ecl> cl.ehinit = cl.ehinit // " noreadline"
+
+
+
+Input Command Summary
+---------------------
+	
+	The following Control/Meta key sequences are understood by the 
+readline() interface for command input:
+
+  Basic Commands
+
+    Ctrl-b 	    Move cursor back one character. 
+    Ctrl-f 	    Move cursor forward one character. 
+    DEL 	    Delete the character to the left of the cursor. 
+    Backspace 	    Delete the character to the left of the cursor. 
+    Ctrl-d 	    Delete the character underneath the cursor. 
+    Ctrl-_ 	    Undo the last editing command
+    Ctrl-x Ctrl-u   Undo the last editing command
+
+    Up-Arrow 	    Move up through the command-history list
+    Down-Arrow 	    Move down through the command-history list
+    Left-Arrow 	    Move cursor left one character on command line
+    Right-Arrow     Move cursor right one character on command line
+
+  Cursor Movement Commands
+
+    Ctrl-a 	Move to the start of the line. 
+    Ctrl-e 	Move to the end of the line. 
+    Meta-f 	Move forward a word, where a word is composed of letters/digits.
+    Meta-b 	Move backward a word. 
+    Ctrl-l 	Clear the screen, reprinting the current line at the top.
+
+  Text Deletion Commands
+
+    Ctrl-k 	Kill the text from the current cursor position to the end of
+		the line.
+    Meta-d 	Kill from the cursor to the end of the current word, or, if
+		between words, to the end of the next word. Word boundaries
+		are the same as those used by Meta-f.
+    Meta-DEL 	Kill from the cursor the start of the current word, or, if
+		between words, to the start of the previous word. Word
+		boundaries are the same as those used by Meta-b.
+    Ctrl-w 	Kill from the cursor to the previous whitespace. This is
+		different than Meta-DEL because the word boundaries differ.
+
+    To yank (copy the most-recently-killed text from the kill buffer) the text
+    back into the line:
+
+    Ctrl-y 	Yank the most recently killed text back into the buffer at
+		the cursor.
+    Meta-y 	Rotate the kill-ring, and yank the new top. You can only do
+		this if the prior command is Ctrl-y or Meta-y. 
+
+  History Searching Commands
+
+    Ctrl-r	Search backward through the history for a particular string
+    Ctrl-s	Search forward through the history for a particular string
+    ESC		Terminate the search
+    Ctrl-g	Terminate the search and restore original line
+
+	As each character of the search string is typed, Readline displays
+    the next entry from the history matching the string typed so far. An
+    incremental search requires only as many characters as needed to
+    find the desired history entry.  To find other matching entries in
+    the history list, type Ctrl-r or Ctrl-s as appropriate from the current
+    search position.
+
+    NOTE:  In many terminal settings the Ctrl-s key is mapped to the tty
+   	'stop' character and the window will appear to no longer accept 
+	input.  In these cases a Ctrl-q will normally return the terminal
+	to proper function and so the forward search mechanism isn't
+	generally recommended.
+
+
+
+=====================
+New Builtin Functions
+=====================
+
+Error-Handling Functions
+------------------------
+
+	The following builtin functions were added as alternatives to the
+matching CL parameters.  The difference is almost entirely stylistic and
+the rules about the longevity of the values described above apply in either
+case.
+
+      errmsg ()		Return last error message string (i.e. cl.$errmsg)
+      errcode ()	Return last integer error code  (i.e. cl.$errno)
+      errtask ()	Return taskname posting fatal error (i.e. cl.$errtask)
+
+Examples:
+
+	iferr {
+	    sometask (par1, ....)
+	} then {
+	    printf ("Error in '%s': %s\n", errtask(), errmsg())
+	    # or equivalently
+	    printf ("Error in '%s': %s\n", $errtask, $errmsg)
+	}
+
+
+
+String Functions
+----------------
+
+	Beginning with V2.12.2 several new functions were added to the
+CL to improve string handling and the provide complementary functions
+to those which already exist.  Items marked with a '*' first appeared in
+V2.12.2, all others are new to this release.  
+
+New functions include:
+
+    isindef (expr)							(*)
+       	Can be used to check for INDEF values in expressions.  INDEF
+       	values may be tested for equality, however when otherwise used
+       	in a boolean expression the result of the boolean is also
+       	INDEF.  This function can be used to trap this particular
+       	case, or for INDEF strings/variable directly.  Result is a
+       	boolean yes/no.
+
+       	Example:
+	    cl> junk = fscan (threshold, tval)
+	    cl> if (isindef (tval) == yes) 
+	    	error (0, "INDEF 'threshold' parameter value")
+
+    strlwr (str)							(*)
+    strupr (str)							(*)
+       	Convert the string to lower/upper case, returns a string.     
+
+       	Example:
+	    cl> s1 = "test" ; s2 = "TEST"
+	    cl> = strupr (s1) ; = strlwr (s2)
+	    TEST
+	    test
+
+    strstr (str1, str2)							(*)
+       	Search for first occurance of 'str1' in 'str2', returns index
+       	of the start of 'str1' or zero if not found.
+
+       	Example:
+	    cl> = strstr ("imh", "imhead.imh")
+	    1
+	    cl> = strstr ("head", "imhead.imh")
+	    3
+
+    strldx (chars, str)							(*)
+       	Complement to the stridx() which returns the last occurance of
+       	any of 'chars' in 'str'.  Returns index of last char or zero
+       	if not found.
+
+       	Example:
+	    cl> = strldx (".", "junk.fits")
+	    5
+		
+
+    strlstr (str1, str2)						(*)
+       	Search for last occurance of 'str1' in 'str2', returns index
+       	of the start of 'str1' or zero if not found.
+
+       	Example:
+	    cl> = strlstr ("imh", "imhead.imh")
+	    8
+
+       [NOTE: String indices are 1-indexed in the CL]
+
+    trim (str [, trimchars])
+    triml (str [, trimchars])
+    trimr (str [, trimchars])
+	Trim any of the chars in 'trimchars' from the ends of 'str'.
+	The trim() function removes chars from both the front and back
+	of the string, triml() removes only from the left side of the
+	string, and trimr() removes only from the right side.  If the
+	'trimchars' argument is not specified the whitespace chars
+	(tab and space) are assumed.  
+
+			 
+       	Example:
+	    cl> printf ("'%s'\n", trim ("   test   "))
+	    'test'
+	    cl> = trimr ("/iraf/iraf///////", "/")
+	    /iraf/iraf
+
+	    To check for strings containing only whitespace:
+
+	        if (trim (foo) == "")
+	            error (0, "no legal value specified for 'foo'")
+
+
+        The new string functions are particularly useful for dealing with
+pathnames where one needs to find and extension, separate a file from a
+path prefix, trim trailing slashes. and so on.
+
+	Additionally, the existing substr() function has been modified to
+allow a 'last' index greater than a 'first' index, in which case the return
+string is reversed.
+
+
+Trig Functions
+--------------
+
+	The following trigonometric functions have been added as new builtins
+to the CL.  These complement existing functions as well as provide utility
+versions to simplify degree/radian conversion.
+
+      asin (arg)	    Inverse SIN, result in radians
+      acos (arg)	    Inverse COS, result in radians
+
+      rad (rad_arg)	    Convert arg in radians to degrees
+      deg (deg_arg)	    Convert arg in degrees to radians
+
+      dsin (deg_arg)	    Sine function, arg in degrees
+      dcos (deg_arg)	    Cosine function, arg in degrees
+      dtan (deg_arg)	    Tangent function, arg in degrees
+      dasin (arg)	    Inverse sine function, result in degrees
+      dacos (arg)	    Inverse cosine function, result in degrees
+      datan2 (y, x)	    Inverse tangent function, result in degrees
+
+
+Utility Functions
+-----------------
+
+  The following utility functions have been added.
+
+      fp_equal (arg1, arg2) Floating point compare (w/in machine precision)
+      hypot (x, y)	    Euclidean distance (i.e. sqrt (x*x + y*y))
+      sign (arg)	    Sign of argument (-1 or 1)
+
+
+  Examples:
+	cl> = fp_equal (1.2345, 1.234)
+	0
+	cl> = hypot (3, 4)	# may also take real arguments
+	5
+	cl> = sign (-23)	# may also take real arguments
+	-1
+
+
+Bitwise Operations
+------------------
+
+	The following bitwise operands have been added in the V2.12.2b.  
+Note that these are bitwise operands and not logical operands.  While there 
+is presently no direct need for these they are seen as potentially useful
+in e.g. evaluating bit-flags stored in image header keywords and support the
+goal of providing a richer scripting language.
+
+      not (arg1)	    Bitwise boolean NOT of an integer  
+      and (arg1, arg2)	    Bitwise boolean AND of two integers
+      or (arg1, arg2)	    Bitwise boolean OR of two integers
+      xor (arg1, arg2)	    Bitwise exclusive OR of two integers
+
+  Examples:
+      cl> = radix (12, 2)	# print bit pattern of number 12
+      1100
+      cl> = radix (13, 2)	# print bit pattern of number 13
+      1101
+
+      cl> = and (12, 13)	# 1100 & 1101 == 1100
+      12	
+      cl> = or (12, 13)	# 1100 | 1101 == 1101
+      13	
+      cl> = xor (12, 13)	# (1100 & ~1101) | (~1100 & 1101) == 1
+      1	
+
+      cl> = not (12)
+      -13
+      cl> = radix (not(12), 2)
+      11111111111111111111111111110011
+
+
+
+=================
+Defined Constants
+=================
+
+	The ECL also introduces the ability to use common numerical and
+physical constants in scripts as part of the language keyword set.  Constants
+are, by convention, always upper case identifiers and are listed in the table
+below:
+
+  Numerical constants				
+  +---------------------------------------------------------------------+
+  |  Name		| Value			 | Units		|
+  +---------------------------------------------------------------------+
+  |  BASE_E          	| 2.7182818284590452353	 |			|
+  |  FOURPI          	| 12.566370614359172953	 |			|
+  |  GAMMA           	| .57721566490153286061	 |			|
+  |  HALFPI          	| 1.5707963267948966192	 |			|
+  |  LN_10           	| 2.3025850929940456840	 |			|
+  |  LN_2            	| .69314718055994530942	 |			|
+  |  LN_PI           	| 1.1447298858494001741	 |			|
+  |  LOG_E           	| .43429448190325182765	 |			|
+  |  PI              	| 3.1415926535897932385	 |			|
+  |  RADIAN          	| 57.295779513082320877	 |			|
+  |  SQRTOF2         	| 1.4142135623730950488	 |			|
+  |  SQRTOFPI        	| 1.7724538509055160273	 |			|
+  |  TWOPI           	| 6.2831853071795864769	 |			|
+  +---------------------------------------------------------------------+
+
+  Physical constants				
+  +---------------------------------------------------------------------+
+  |  Name		| Value			 | Units		|
+  +---------------------------------------------------------------------+
+  |  AU              	| 1.49597870691e11       |  m            	|
+  |  GRAV_ACCEL      	| 9.80665e0              |  m / sec^2    	|
+  |  GRAV_CONST      	| 6.673e-11              |  m^3 / kg s^2 	|
+  |  LIGHT_YEAR      	| 9.46053620707e15       |  m            	|
+  |  PARSEC          	| 3.08567758135e16       |  m            	|
+  |  SPEED_OF_LIGHT  	| 299792458.0            |  m / sec      	|
+  |  SOLAR_MASS      	| 1.98892e30             |  kg           	|
+  +---------------------------------------------------------------------+
+
+  For example, these may be used in scripts as:
+
+	area = (PI * radius ** 2) 	# Compute area of circle.
+	rad = degrees / RADIAN		# Convert degrees to radians
+
+
+
+===============================================================================
+# Post-Release Notes
+===============================================================================
+
diff --git a/pkg/vocl/Notes.samp b/pkg/vocl/Notes.samp
new file mode 100644
index 00000000..5575062b
--- /dev/null
+++ b/pkg/vocl/Notes.samp
@@ -0,0 +1,241 @@
+
+							Sep 17, 2011
+
+			    IRAF SAMP Integration
+
+Introduction
+------------
+
+    The SAMP interface in IRAF is implemented in two modes:  A "Command
+Mode" provides a natural command-line interface to either control the SAMP
+messaging (e.g. to enable/disable messaging), or to send messages manually.
+As an example,
+
+    cl> samp start			# start SAMP messaging
+    on					  <-- shows status
+
+This also takes advantage CL-specific features such as logical directories
+or support for sexagesimal value.  For instance:
+
+    cl> samp loadImage data$foo.fits	# broadcast an image load message
+    ok
+    cl> samp pointAt (15 * 10:23:01) 34:12:45 to=aladin
+    ok
+
+In the first case the 'data$' logical dir is converted internally so the
+SAMP application is given the expected URI, in the second case the
+arguments are expected to be in decimal degrees and converting RA is done
+trivially.
+
+The second form, known as "Program Mode", provides the same functionality
+in the form of CL builtin functions more suited for CL scripting.  For
+example,
+
+    if (sampStatus("on") != "on") {
+	error (0, "Cannot enable SAMP messaging")
+    } else {
+	if (sampLoadImage (img, "aladin") != "ok") {
+	    error (0, "Cannot load image " // img)
+	}
+    }
+
+A complete list of both the Command and Program mode functions is given in
+the Appendix below.
+
+    Explicitly enabling the SAMP message (e.g. with "samp start") is not
+necessary to send messages to other applications, any 'samp' command that
+requires a SAMP Hub will attempt to start a connection automatically.
+However, for the CL to receive messages from other applications the SAMP
+interface must be enabled.  This can be done explicitly as above, by
+setting the "samp_onstart" CL environment variable in the hlib$zzsetenv.def
+file, or by uncommenting the "samp on" command in the login.cl file.
+
+
+Receiving Messages in the CL
+----------------------------
+
+    By default, the CL will subscribe only to the following SAMP mtypes:
+
+	client.cmd.exec			# execute a command string
+	client.env.set			# set and environment variable
+	client.env.get			# get and environment variable (*)
+	client.param.set		# set a task parameter value
+	client.param.get		# get a task parameter value
+
+Except for the client.env.get mtype, these are all newly defined mtypes that
+may not be available to other SAMP applications.  Testing these messages
+can be done with the samp library tasks or from another CL session.
+
+Additional message types can be received by defining handlers for each 
+mtype, for example
+
+    cl> samp handler image.load.fits "imstat $url"
+or
+    cl> =sampHandler ("image.load.fits", "imstat $url")
+
+This will subscribe the current session to the 'image.load.fits' mtype, and
+when received will execute the IMSTAT command on the named URL.  The '$url'
+in the command string is replaced by the value of that parameter sent in
+the message.  The mtype parameter names are defined in the Appendix below.
+
+Proprietary messages can be defined using the same mechanism.  For instance
+
+    cl> samp handler pipeline.event "imcopy $url image.fits"
+
+will create a handler for the 'pipeline.event' mtype and execute the
+associated command.  Another client could send a message of this type
+regardless of whether this is an mtype approved by the IVOA.  Calling
+the sampHandler (or 'samp handler') function with no arguments will print
+the list of user-defined handlers, supplying only the 'mtype' argument
+will print the handler defined for just that mtype (or a null string).
+
+By default a SAMP-enabled CL session will be known as 'IRAF' to other
+applications, this can lead to a name conflict when sending directed
+messages.  To solve this, a session can define it's own name to other
+applications using any of the following:
+
+    cl> samp name iraf2
+    cl> samp meta samp.name iraf2
+    cl> =sampName ("iraf2")
+    cl> =sampMetadata ("samp.name", "iraf2")
+
+The sampMetadata() function (or 'samp meta' command) can declare arbitrary
+metadata about the session that can be discovered by other apps, the 
+name in this case is provided as a convenience function and will cause
+the name to be updated immediately.
+
+
+
+Sending Messages from the CL
+----------------------------
+
+    Sending messages from the CL can be done using either the command
+or program form of a command, high-level functions are implemented for
+the most common messages (e.g. to 'load an image') as well as one low-level
+method for sending arbitrary messages.  For example,
+
+    cl> samp loadImage http://foo.edu/test.fits	    # load an image
+    cl> samp loadVOTable images.xml		    # load a VOTable
+    cl> samp loadFITS imtab.fits		    # load a FITS bintable
+
+Or the low-level 'send' command as in
+
+    cl> samp send pipeline.event url=http://foo.edu/test.fits
+or
+    cl> =sampSend ("pipeline.event", "url=http://foo.edu/test.fits")
+
+In this case the first argument is always the mtype, remaining arguments
+are of the form "<param>=<value>" and may be used to define arbitrary
+parameters of the message.  To send a message to a specific application,
+the argument "to=<appName>" may be appended to these commands, e.g.
+
+    cl> samp loadFITS test.fits to=topcat	    # load table in Topcat
+  
+
+When using the program mode the recipent application name is one of the
+optional parameters, e.g.
+
+    cl> =sampLoadImage ("image.fits")		    # broadcast to all apps
+    cl> =sampLoadImage ("image.fits", "aladin")	    # send to aladin
+
+
+
+
+
+Appendix
+========
+
+
+Command Mode Summary
+--------------------
+
+#  The following command is a builtin but doesn't push anything on the
+#  result stack, instead result values are printed to the stdout/stderr.
+#  The intent is to provide a simple command interface without requiring
+#  the function syntax.
+
+samp status						cl_Samp
+samp on|start						   :
+samp off|stop						   :
+samp restart						   :
+samp name 	  [<appName>]				   :
+samp trace 	  [<value>]				   :
+samp access 	  [<appName>]				   :
+samp handler	  [<mtype> <cmd>]			   :
+samp meta	  [<param> <value>]			   :
+
+samp send	  <mtype> [<args> ....]			   :
+samp exec	  <cmd>					   :
+samp pointAt	  <ra> <dec>				   :
+samp setenv	  <name> <value>			   :
+samp getenv	  <name>				   :
+samp setparam	  <name> <value>			   :
+samp getparam	  <name>				   :
+samp loadImage	  <url>					   :
+samp loadVOTable  <url>					   :
+samp loadFITS	  <url>					   :
+samp showRow	  [<tblId>] [<url>] <row>		   :
+samp selectRows	  [<tblId>] [<url>] <row>,<row>,....  	   :
+
+
+Program Mode Summary
+--------------------
+
+#  The following functions do push a result on the stack.  This allows 
+#  scripts to be written to check the return value before continuing.
+
+on|off  = sampStatus ( [on|off|restart] )		func_sampStatus
+
+yes|no  = sampAccess (appName)				func_sampAccess
+ok|name = sampName ([name])				func_sampName
+ok|val  = sampMetadata ([name, [val]])			func_sampMetadata
+yes|no  = sampHandler (mtype, cmd)			func_sampAddHandler
+
+ok|err  = sampLoadImage (url[, to, id, name])		func_sampLoadImage
+ok|err  = sampLoadVOTable (url[, to, id, name])		func_sampLoadVOTable
+ok|err  = sampLoadFITS (url[, to, id, name])		func_sampLoadFITS
+ok|err  = sampLoadSpec (url[, to, id, name])		func_sampLoadImage
+ok|err  = sampLoadBibcode (bibcode[, to])		func_sampLoadBibcode
+ok|err  = sampLoadResource (url[, to, meta, id, name])	func_sampLoadResource
+
+ok|err  = sampShowRow (url, id, row[, to])		func_sampShowRow
+ok|err  = sampSelectRowList (url, id, *row[, to]) 	func_sampSelectRowList
+ok|err  = sampPointAt (ra, dec[, to])			func_sampPointAt
+
+ok|err  = sampCmdExec (cmd[, to])			func_sampCmdExec
+ok|err  = sampEnvSet (par, val[, to])			func_sampEnvSet
+val|err = sampEnvGet (par[, to])			func_sampEnvGet
+ok|err  = sampParamSet (par, val[, to])			func_sampParamSet
+val|err = sampParamGet (par[, to])			func_sampParamGet
+
+--------------------------------------------------------------------------------
+
+			Command		Function
+on|start		   Y		   .
+off|stop		   Y		   .
+restart			   Y		   .
+status			   Y		   .
+access			   Y		   .
+handler			   Y		   .
+metadata		   Y		   .
+
+send			   Y		   .
+loadImage		   Y		   .
+loadVOTable		   Y		   .
+loadFITS		   Y		   .
+
+cmdExec			   Y		   .
+envGet			   Y		   .
+envSet			   Y		   .
+paramGet		   Y		   .
+paramSet		   Y		   .
+
+pointAt			   Y		   .
+showRow			   Y		   .
+selectRows		   Y		   .
+
+resourceLoad		   .		   .
+specLoad		   .		   .
+bibcodeLoad		   .		   .
+
+
diff --git a/pkg/vocl/README b/pkg/vocl/README
new file mode 100644
index 00000000..3e0c476f
--- /dev/null
+++ b/pkg/vocl/README
@@ -0,0 +1,17 @@
+CL -- This directory contains the sources for the IRAF command language (CL).
+The command language is implemented as a C program upon the IRAF VOS, using an
+interface called LIBC (the C runtime library).  LIBC is documented in the
+source directory for the LIBC package, sys$libc.  LIBC provides a C language
+binding for the IRAF VOS, plus an implementation of the UNIX "stdio" library. 
+
+To compile the CL, the libraries comprising the IRAF VOS must first be compiled
+and installed in lib$.  In addition the CL uses LIBC and two graphics
+libraries, libstg.a (the STDGRAPH graphics kernel) and libcur.a (cursor mode,
+for cursor type CL queries).  A number of global include files are also
+required and will be found in host$hlib/libc.  The file <iraf.h> must be
+installed in a public directory where it can be found by the C compiler on your
+system. 
+
+Given these libraries the CL may be compiled and linked simply by typing
+"mkpkg" in this directory.  Typing "mkpkg update" will make the CL and
+"install" the executable in the iraf$bin directory. 
diff --git a/pkg/vocl/Revisions b/pkg/vocl/Revisions
new file mode 100644
index 00000000..aa0921b1
--- /dev/null
+++ b/pkg/vocl/Revisions
@@ -0,0 +1,31 @@
+
+CL Error Recovery Revisions Notes
+Mon Apr  5 12:12:27 MST 2004
+---------------------------------
+
+decl.c
+	When parsing a script the procscript()/skip_to() procedures were
+	positioning the file at the 'procedure' or some other arbitrary
+	line.  This was causing the t_scriptln task structure to improperly
+	ignore the lines at the start of the script and causing an incorrect
+	line count.
+
+grammar.y
+	Modified the const_expr rule to use 'const' rather than Y_CONSTANT
+	to allow negative values for case args.
+
+gram.c
+debug.c
+grammar.y
+opcodes.c
+opcodes.h
+	The size of an opcode entry on the stack was used as a hardwired
+	constant (3) in this code, along with implicit assumptions about
+	the location of the c_length and c_args values as well.  Replaced
+	all instances with a SZ_CE (sizeof codeentry) macro to allow 
+	flexibility in the codeentry structure defined in <opcodes.h>.
+	    There is still a requirement that this struct define 'c_opcode'
+	as the first element, and that c_length/c_args are the last to
+	elements respectively, however new values to the struct may be 
+	added (such as the compilation line number), provided SZ_CE is also
+	modified.
diff --git a/pkg/vocl/TODO b/pkg/vocl/TODO
new file mode 100644
index 00000000..f1f22567
--- /dev/null
+++ b/pkg/vocl/TODO
@@ -0,0 +1,13 @@
+
+   - start/stop/restart of SAMP sometimes fails with a segfault or
+	a pointer free error
+   - Need a 'help samp' page
+   - implement spectrum load
+
+   - with no Hub running, "samp on" produces duplicate error strings
+
+   - Test file arguments to mtypes (send/receive):
+	http URL
+	file URL
+	local path
+	logical path
diff --git a/pkg/vocl/_samp.cmds b/pkg/vocl/_samp.cmds
new file mode 100644
index 00000000..a6ebeabc
--- /dev/null
+++ b/pkg/vocl/_samp.cmds
@@ -0,0 +1,101 @@
+
+
+  cl> =sampDbg (ival)                 # explicitly set debug value
+  cl> =sampDbg ()                     # toggle debug value
+
+
+sampStatus:
+
+  cl> =samStatus()			# print current SAMP connection status
+  yes
+  cl> =samStatus("on")			# enable SAMP messaging
+  yes
+  cl> =samStatus("off")			# disable SAMP messaging
+  no
+  cl> =samStatus("on")			# enable SAMP messaging
+  yes
+  cl> =samStatus("restart")		# restart SAMP messaging
+  vocl.e(69352,0x7fff70f14cc0) malloc: *** error for object 0x101125350:
+  incorrect checksum for freed object - object was probably modified after
+  being freed.
+  *** set a breakpoint in malloc_error_break to debug
+  ERROR: abort
+
+      or
+
+  segmentation violation
+
+
+sampAccess
+
+  cl> =sampAccess("topcat")		# print whether named app is running
+  no
+
+sampName
+
+  cl> =sampName()			# print current samp.name attribute
+  IRAF
+  cl> =sampName("foo1")			# set samp.name attribute
+  foo1
+
+sampMetadata
+
+  cl> =sampMetadata ("samp.name")	# print a specific metadata attribute
+  IRAF
+  cl> =sampMetadata ("foo", "bar")	# set a new attribute
+  ok
+
+sampSend
+
+sampHandler
+
+
+------------------------------------------------------------------------------
+
+sampLoadImage
+
+  cl> =sampLoadImage (tblId, url, row, to)
+
+sampLoadVOTable
+sampLoadFITS
+sampLoadSpec
+sampLoadBibcode
+sampLoadResource
+
+
+sampShowRow
+
+  cl> =sampShowRow (tblId, url, row, to)
+
+sampSelectRows
+
+  cl> =sampSelectRows (tblId, url, rows[], to)
+
+sampPointAt
+
+  cl> =sampPointAt (ra, dec, to)
+
+sampCmdExec
+
+  cl> =sampCmdExec ("imstat dev$pix")
+  cl> =sampCmdExec ("imstat dev$pix", "iraf2")
+
+sampEnvSet
+
+  cl> =sampEnvSet ("foo", "bar")
+
+sampEnvGet
+
+  cl> =sampEnvGet ("foo")
+  bar
+
+sampParamSet
+
+  cl> =sampParamSet ("imstat.images", "dev$pix")
+  ok
+
+sampParamGet
+
+  cl> =sampParamGet ("imstat.images")
+  dev$pix
+
diff --git a/pkg/vocl/_samp.funcs b/pkg/vocl/_samp.funcs
new file mode 100644
index 00000000..f30b8925
--- /dev/null
+++ b/pkg/vocl/_samp.funcs
@@ -0,0 +1,25 @@
+samp
+
+sampLoadImage
+sampLoadVOTable
+sampLoadFITS
+sampLoadSpec
+sampLoadBibcode
+sampLoadResource
+
+sampShowRow
+sampSelectRows
+sampPointAt
+
+sampCmdExec
+sampEnvGet
+sampEnvSet
+sampParamGet
+sampParamSet
+
+sampHandler
+sampAccess
+sampStatus
+sampMeta
+sampName
+
diff --git a/pkg/vocl/binop.c b/pkg/vocl/binop.c
new file mode 100644
index 00000000..58b7e1ab
--- /dev/null
+++ b/pkg/vocl/binop.c
@@ -0,0 +1,826 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_xnames
+#define import_math
+#define import_ctype
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "errs.h"
+#include "param.h"
+#include "mem.h"
+#include "task.h"
+#include "proto.h"
+
+			    
+
+/*
+ * BINOP.C -- Perform binary operations or expressions on two operands.
+ *
+ * Try to perform the arithmetic in native machine type, eg, don't do integer
+ * arithmetic by converting to floating and back.
+ */
+
+/* Strint() looks for an integer on the left or right side of string s.
+ * If none found return NULL, else return pointer to the first
+ *   character after it if looking on leftside or pointer to
+ *   first of the digit characters if looking on right side.
+ * Make a few defines to make it easier to communicate with.
+ * Used by binop() to handle fancy string arithmetic.
+ *
+ * N.B.: The use of the '+' operator to increment the number part of
+ * a string has been restricted to strings of the form "abcde0123".
+ * Hence, the "leftside" logic in the following routine is no longer used.
+ */
+
+#define	LEFTSIDE	0		/* value of side		*/
+#define	RIGHTSIDE	1
+
+#define RADIAN          57.295779513082320877
+
+
+char *
+strint (register char *s, int side)
+{
+	if (side == LEFTSIDE) {
+	    while (isdigit (*s))
+		s++;
+	} else {
+	    char *sstart = s;
+	    while (*s)
+		s++;
+	    while (s > sstart && isdigit (s[-1]))
+		--s;
+	}
+
+	return (*s == '\0' ? NULL : s);
+}
+
+
+/* BINOP -- Pop the top two operands from the stack and perform the binary
+ * operation whose code is in opcode.  Push an operand with the proper result
+ *   and (possibly promoted) type.
+ * If either is of type OT_STRING, result will be string and care must be
+ *   taken not to pushop() the result to avoid clobbering them until done.
+ * Order of operands will be as stacked from left to right during parser
+ *   recognition, eg, a-b pushes a, then b.
+ * Booleans are 0/1 arithmetically, or truestr/falsetr stringly.
+ * INDEF operands propagate through.  We should never see an UNDEF operand.
+ * Call error() and do not return if internal error or undefined string
+ *   operation.
+ */
+void 
+binop (int opcode)
+{
+	register int typ1, typ2;
+	struct	operand o1, o2, result;
+	char	res[2*SZ_LINE];
+	char	*o1sp;
+	double	dresult=0.0;
+	int	iresult=0, typecode=0;	/*  > 0 if real		*/
+	long	lval;
+	extern  int errorline, err_abort, err_trace, do_error;
+	extern  ErrCom errcom;
+
+
+	o2 = popop();		/* operands will be on stack backwards	*/
+	o1 = popop();
+	typ1 = o1.o_type & OT_BASIC;
+	typ2 = o2.o_type & OT_BASIC;
+
+	if (opindef (&o1) || opindef (&o2)) {
+	    setopindef (&result);
+	    goto pushresult;
+	}
+
+	/* Verify that no illegal datatype conversions are implied.  Arithmetic
+	 * on booleans is illegal; arithmetic is legal on strings only in
+	 * certain circumstances.
+	 */
+	if (typ1 == OT_BOOL || typ2 == OT_BOOL)
+	    switch (opcode) {
+	    case OP_ADD:
+	    case OP_SUB:
+	    case OP_MUL:
+	    case OP_DIV:
+	    case OP_POW:
+		cl_error (E_UERR,
+		    "Illegal boolean operand in arithmetic expression");
+		break;
+
+	    case OP_MAX:
+	    case OP_MIN:
+	    case OP_MOD:
+	    case OP_RADIX:
+	    case OP_ATAN2:
+	    case OP_DATAN2:
+	    case OP_STRIDX:
+	    case OP_STRLDX:
+	    case OP_STRSTR:
+	    case OP_STRLSTR:
+	    case OP_STRDIC:
+	    case OP_BAND:
+	    case OP_BOR:
+	    case OP_BXOR:
+	    case OP_FPEQUAL:
+	    case OP_HYPOT:
+		cl_error (E_UERR,
+		"Intrinsic function called with illegal boolean argument");
+		break;
+
+	    case OP_CONCAT:
+		;				/* bool -> string ok. */
+	    }
+
+	if (typ1 == OT_REAL || typ2 == OT_REAL)
+	    typecode = OT_REAL;
+	else
+	    typecode = OT_INT;
+
+	switch (opcode) {
+	case OP_ADD:
+	    break;			/* any datatype is ok here	*/
+	case OP_CONCAT:
+	    typecode = OT_STRING;
+	    break;			/* any datatype is ok here	*/
+	case OP_RADIX:
+	    if (typ2 != OT_INT)
+		cl_error (E_UERR, "radix: second arg must be integer radix");
+	    typecode = OT_STRING;
+	    break;
+	case OP_STRIDX:
+	    if (typ1 != OT_STRING || typ2 != OT_STRING)
+		cl_error (E_UERR, "stridx: both args must be of type string");
+	    typecode = OT_INT;
+	    break;
+	case OP_STRLDX:
+	    if (typ1 != OT_STRING || typ2 != OT_STRING)
+		cl_error (E_UERR, "strldx: both args must be of type string");
+	    typecode = OT_INT;
+	    break;
+	case OP_STRSTR:
+	    if (typ1 != OT_STRING || typ2 != OT_STRING)
+		cl_error (E_UERR, "strstr: both args must be of type string");
+	    typecode = OT_INT;
+	    break;
+	case OP_STRLSTR:
+	    if (typ1 != OT_STRING || typ2 != OT_STRING)
+		cl_error (E_UERR, "strlstr: both args must be of type string");
+	    typecode = OT_INT;
+	    break;
+	case OP_STRDIC:
+	    if (typ1 != OT_STRING || typ2 != OT_STRING)
+		cl_error (E_UERR, "strdic: both args must be of type string");
+	    typecode = OT_INT;
+	    break;
+	case OP_SUB:
+	case OP_MUL:
+	case OP_DIV:
+	case OP_POW:
+	case OP_MAX:
+	case OP_MIN:
+	case OP_MOD:
+	case OP_ATAN2:
+	case OP_DATAN2:
+	case OP_HYPOT:
+	case OP_FPEQUAL:
+	    if (typ1 == OT_STRING || typ2 == OT_STRING) {
+		if (typ1 == OT_STRING)
+		    cl_error (E_UERR, e_badstrop, o1.o_val.v_s);
+		else
+		    cl_error (E_UERR, e_badstrop, o2.o_val.v_s);
+	    }
+	    break;
+
+	case OP_BAND:
+	    if (typ1 != OT_INT || typ2 != OT_INT)
+		cl_error (E_UERR, "and(): both arguments must be of type int");
+	    break;
+	case OP_BOR:
+	    if (typ1 != OT_INT || typ2 != OT_INT)
+		cl_error (E_UERR, "or(): both arguments must be of type int");
+	    break;
+	case OP_BXOR:
+	    if (typ1 != OT_INT || typ2 != OT_INT)
+		cl_error (E_UERR, "xor(): both arguments must be of type int");
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "binop()");
+	}
+
+	/* The following code deals with operations which take string type
+	 * operands or which produce a string result.
+	 */
+	if (typ1 == OT_STRING || typ2 == OT_STRING || typecode == OT_STRING) {
+	    switch (opcode) {
+	    case OP_ADD:
+		o1sp = o1.o_val.v_s;
+
+		if (typ1 != OT_STRING)
+		    cl_error (E_UERR,
+			"Illegal expression of the form 'number + string'");
+
+		if (typ2 == OT_STRING) {
+		    strcpy (res, o1sp);
+		    strcat (res, o2.o_val.v_s);
+		} else if (typ2 == OT_REAL) {
+		    cl_error (E_UERR, e_strplusreal, o1sp);
+
+		} else {			/* typ2 is OT_INT	*/
+		    char    *cp, format[MAX_DIGITS];
+		    int	    newnum;
+
+		    cp = strint (o1sp, RIGHTSIDE);
+		    if (cp != NULL) {
+			/* Crack numeric string on rightside of string
+			 * operand; add integer; reformat new string,
+			 * trying to maintain number of digits in number.
+			 */
+			strncpy (res, o1sp, cp - o1sp);
+			newnum = atoi(cp) + (int)VALU(&o2);
+			sprintf (format, "%%0%dd", strlen (cp));
+			sprintf ((char *)(res + (cp - o1sp)),
+			    format, newnum);
+			if (newnum < 0)
+			    cl_error (E_UERR,
+			    "String + integer expression produces '%s' ", res);
+
+		    } else {
+			strcpy (res, o1sp);
+			for (cp=res;  *cp;  cp++)
+			    ;
+			sprintf (cp, "%d", (int)VALU(&o2));
+		    }
+		}
+		break;
+
+	    case OP_CONCAT:
+		/* Convert operands to type string if necessary.
+		 */
+                {
+		    char s2[SZ_LINE];
+
+		    if (typ1 != OT_STRING) {
+			/* Save the o2 string since the operand cast here
+			 * will overwrite it.
+			 */
+			if (typ2 == OT_STRING) 
+		            strcpy (s2, o2.o_val.v_s);
+			pushop (&o1);
+			opcast (OT_STRING);
+			o1 = popop();
+		    }
+		    strcpy (res, o1.o_val.v_s);
+
+		    if (typ2 != OT_STRING) {
+			pushop (&o2);
+			opcast (OT_STRING);
+			o2 = popop();
+		    } 
+
+		    /* If we had to convert the first operand, use the saved
+		     * string.
+		     */
+		    if (typ1 != OT_STRING && typ2 == OT_STRING)
+			strcat (res, s2);
+		    else
+			strcat (res, o2.o_val.v_s);
+
+		    break;
+		}
+
+	    case OP_RADIX:
+		if (typ1 == OT_STRING) {
+		    if (sscanf (o1.o_val.v_s, "%ld", &lval) != 1)
+			cl_error (E_UERR, "Cannot coerce '%s' to integer",
+			    o1.o_val.v_s);
+		} else if (typ1 == OT_REAL) {
+		    lval = (long) o1.o_val.v_r;
+		} else
+		    lval = (long) o1.o_val.v_i;
+
+		sprintf (res, "%r*", o2.o_val.v_i, lval);
+		break;
+
+	    case OP_STRIDX:
+		/* index = stridx (chars, string); "chars" may be a string.
+		 * Return index of first occurence of any of the "chars"
+		 * in "string", or ZERO if none found.
+		 */
+		{
+		    char    *ip, *cp, ch;
+
+		    iresult = 0;
+		    for (ip=o2.o_val.v_s; !iresult && (ch = *ip) != EOS; ip++) {
+			for (cp=o1.o_val.v_s;  *cp != EOS;  cp++) {
+			    if (*cp == ch) {
+				iresult = (ip - o2.o_val.v_s + 1);
+				break;
+			    }
+		        }
+		    }
+		}
+
+		result.o_val.v_i = iresult;
+		result.o_type = OT_INT;
+		goto pushresult;
+		break;
+
+	    case OP_STRLDX:
+		/* index = strldx (chars, string); "chars" may be a string.
+		 * Return index of last occurence of any of the "chars"
+		 * in "string", or ZERO if none found.
+		 */
+		{
+		    char    *ip, *cp, ch;
+		    short    len;
+
+		    iresult = 0;
+		    len = strlen (o2.o_val.v_s);
+		    for (ip=&o2.o_val.v_s[len-1]; 
+			!iresult && (ch = *ip) != EOS && ip >= o2.o_val.v_s;
+			ip--) {
+			    for (cp=o1.o_val.v_s;  *cp != EOS;  cp++) {
+			        if (*cp == ch) {
+				    iresult = (ip - o2.o_val.v_s + 1);
+				    break;
+			        }
+			    }
+		    }
+		}
+
+		result.o_val.v_i = iresult;
+		result.o_type = OT_INT;
+		goto pushresult;
+		break;
+
+	    case OP_STRSTR:
+		/* index = strstr (s1, s2);
+		 * Return index of first occurance of the string 's1' in 's2',
+		 * or ZERO if none found.
+		 */
+		{
+		    char    *ip, *cp, *fp, *tp, first_char, ch;
+
+		    first_char = o1.o_val.v_s[0];
+		    
+		    /* Null patterns match any string. */
+		    if (first_char == NULL) {
+			result.o_val.v_i = 1;
+			result.o_type = OT_INT;
+			goto pushresult;
+		    } else
+		        iresult = 0;
+
+		    /* Search s2 for first_char, if found check for complete
+		     * match of s1, else move on.
+		     */
+		    for (ip=o2.o_val.v_s; !iresult && (ch = *ip) != EOS; ip++) {
+			if (ch == first_char) {
+			    fp = ip;
+			    cp = o1.o_val.v_s;  
+			    tp = ip;
+			    while (*cp != EOS && *cp == *tp) {
+				cp++; tp++;
+			    }
+			    if (*cp == EOS) {
+				iresult = (fp - o2.o_val.v_s + 1);
+				break;
+			    }
+		        }
+		    }
+		}
+
+		result.o_val.v_i = iresult;
+		result.o_type = OT_INT;
+		goto pushresult;
+
+	    case OP_STRLSTR:
+		/* index = strstr (s1, s2);
+		 * Return index of last occurance of the string 's1' in 's2',
+		 * or ZERO if none found.
+		 */
+		{
+		    char    *ip, *cp, *fp, first_char, ch;
+		    int	    len;
+
+		    first_char = o1.o_val.v_s[0];
+		    
+		    /* Null patterns match any string. */
+		    if (first_char == NULL) {
+			result.o_val.v_i = 1;
+			result.o_type = OT_INT;
+			goto pushresult;
+		    } else
+		        iresult = 0;
+
+		    /* Search s2 for first_char, if found check for complete
+		     * match of s1, else move on.
+		     */
+		    len = strlen (o2.o_val.v_s);
+		    for (ip=&o2.o_val.v_s[len-1];
+			!iresult && (ch = *ip) != EOS && ip >= o2.o_val.v_s;
+			ip--) {
+			    if (ch == first_char) {
+			        fp = ip;
+			        cp = o1.o_val.v_s;  
+			        while (*cp != EOS && *cp == *ip) {
+				    cp++; ip++;
+				}
+			        if (*cp == EOS) {
+				    iresult = (fp - o2.o_val.v_s + 1);
+				    break;
+			        } else
+				    ip = fp;
+		            }
+		    }
+		}
+
+		result.o_val.v_i = iresult;
+		result.o_type = OT_INT;
+		goto pushresult;
+
+            case OP_STRDIC:
+                /* index = strdic (str, dicstr); "str" must be a string,
+                 * 'dicstr' is a dictionary string where the first character
+                 * is used as a delimiter.  Return a 1-based index of
+                 * occurence of any of the "str" in "dicstr", or ZERO if not
+                 * found.
+                 */
+                {
+                    char    *ip, *cp, *fp, ch, delim, first_char;
+                    short    len, index;
+
+                    iresult = 0;
+                    index = 0;
+                    len = strlen (o2.o_val.v_s);
+
+                    delim = o2.o_val.v_s[0];
+                    first_char = o1.o_val.v_s[0];
+
+                    /* Search s2 for first_char, if found check for complete
+                     * match of s1, else move on.
+                     */
+                    ch = o2.o_val.v_s;
+                    for (ip=o2.o_val.v_s; !iresult && (ch=*ip) != EOS; ip++) {
+                        if (ch == delim) {
+                            index++;
+                        } else if (*ip == first_char) {
+                            fp = ip;
+                            cp = o1.o_val.v_s;
+                            while (*cp != EOS && *cp == *ip && *ip != delim ) {
+                                cp++; ip++;
+                            }
+                            if (*cp == EOS) {
+                                iresult = index;
+                                break;
+                            } else if (*ip == delim) {
+				index++;
+			    }
+                        }
+                    }
+                }
+
+                result.o_val.v_i = iresult;
+                result.o_type = OT_INT;
+                goto pushresult;
+                break;
+
+	    }
+
+	    /* Cannot "goto pushresult" because would lose res core */
+	    result.o_type = OT_STRING;
+	    result.o_val.v_s = res;
+	    pushop (&result);
+	    return;
+	}
+
+
+	/* Hereafter, we only deal with operands of type int or real.
+	 */
+	if (typecode != OT_REAL)
+	    typecode = 0;
+
+	switch (opcode) {
+	case OP_ADD:
+		if (typecode)	dresult = VALU(&o1) + VALU(&o2); 
+			else	iresult = o1.o_val.v_i + o2.o_val.v_i;
+		break;
+
+	case OP_SUB:
+		if (typecode)	dresult = VALU(&o1) - VALU(&o2); 
+			else	iresult = o1.o_val.v_i - o2.o_val.v_i;
+		break;
+
+	case OP_MUL:
+		if (typecode)	dresult = VALU(&o1) * VALU(&o2); 
+			else	iresult = o1.o_val.v_i * o2.o_val.v_i;
+		break;
+
+	case OP_DIV:
+		erract_init();
+		if (typecode) {
+		    if (VALU(&o2) == 0.0) {
+			if (err_abort == NO || do_error == NO) {
+			    /* If we're not aborting errors try to recover
+			     * from a divide-by-zero using the err_dzvalue
+			     * fake param.
+			     */
+			    struct param *pp = 
+				paramfind (firstask->t_pfp, "$err_dzvalue",
+				0, YES);
+			    dresult = (double) pp->p_val.v_i;
+			    if (err_trace == YES) {
+			        eprintf("Warning on line %d of %s: %s = %d\n",
+				    errorline, errcom.script,
+				    e_fdzvalue, pp->p_val.v_i);
+			    }
+			    
+			} else
+			    cl_error (E_UERR, e_fdivzero, opcode, "binop()");
+		    } else
+			dresult = VALU(&o1) / VALU(&o2); 
+
+		} else {
+		    if (o2.o_val.v_i == 0) {
+			if (err_abort == NO || do_error == NO) {
+			    /* If we're not aborting errors try to recover
+			     * from a divide-by-zero using the err_dzvalue
+			     * fake param.
+			     */
+			    struct param *pp = 
+				paramfind (firstask->t_pfp, "$err_dzvalue",
+				0, YES);
+			    iresult = pp->p_val.v_i;
+			    if (err_trace == YES) {
+			        eprintf("Warning on line %d of %s: %s = %d\n",
+				    errorline, errcom.script,
+				    e_idzvalue, pp->p_val.v_i);
+			    }
+
+			} else
+			    cl_error (E_UERR, e_idivzero, opcode, "binop()");
+		    } else
+			iresult = o1.o_val.v_i / o2.o_val.v_i;
+		}
+		break;
+
+	case OP_POW:
+		{		/* VMS & inconsistancy */
+		    double val1 = VALU(&o1),val2 = VALU(&o2);
+		    double sign = 1;
+
+		    /* Exponentiation of negative numbers to real powers
+		     * is not defined in general, so if we have coerced
+		     * an integer exponent to real we change the mantissa to
+		     * positive and deal with the sign separately.
+		     */
+		    if ((o2.o_type == OT_INT)  &&  (val1 < 0)) {
+			sign = (o2.o_val.v_i % 2) ? -1 : 1 ;
+			if (val1 < 0)
+			    val1 = -val1;
+		    }
+
+		    dresult = sign * pow (val1, val2);
+		    if (!typecode)
+			iresult = dresult+0.5*sign; /* round */
+		}
+		break;
+
+	case OP_MAX:
+		if (typecode) {
+			/* ritchie compiler doesn't seem to allow ?: here.
+			 * result = (VALU(&o1) > VALU(&o2)) ? o1 : o2;
+			 */
+			if (VALU(&o1) > VALU(&o2))
+			    result = o1;
+			else
+			    result = o2;
+		} else {
+			if (o1.o_val.v_i > o2.o_val.v_i)
+			    result = o1;
+			else
+			    result = o2;
+		}
+		goto pushresult;
+
+	case OP_MIN:
+		if (typecode) {
+			/* ritchie compiler doesn't seem to allow ?: here.
+			 * result = (VALU(&o1) < VALU(&o2)) ? o1 : o2;
+			 */
+			if (VALU(&o1) < VALU(&o2))
+			    result = o1;
+			else
+			    result = o2;
+		} else {
+			if (o1.o_val.v_i < o2.o_val.v_i)
+			    result = o1;
+			else
+			    result = o2;
+		}
+		goto pushresult;
+
+	case OP_MOD:
+		if (typecode) {
+			double x1 = VALU(&o1), x2 = VALU(&o2);
+			dresult = x1 - ((int)(x1/x2))*x2;
+		} else
+			iresult = o1.o_val.v_i % o2.o_val.v_i;
+		break;
+
+	case OP_BAND:
+		iresult = o1.o_val.v_i & o2.o_val.v_i;
+		break;
+	case OP_BXOR:
+		{   int a = o1.o_val.v_i, 
+			b = o2.o_val.v_i, 
+			na = ~a, 
+			nb = ~b;
+		    iresult = (a & nb) | (na & b);
+		} 
+		break;
+	case OP_BOR:
+		iresult = o1.o_val.v_i | o2.o_val.v_i;
+		break;
+
+	case OP_ATAN2:
+	case OP_DATAN2:
+		{	/* VMS & inconsistancy.	*/
+		double val1 = VALU(&o1), val2 = VALU(&o2);
+		dresult = atan2 (val1, val2);
+		if (opcode == OP_DATAN2) 
+		    dresult *= RADIAN;
+		}
+		typecode++;	/* force real result		*/
+		break;
+
+	case OP_FPEQUAL:
+		/* Note: need to move fp_equald() to libc */
+		if (typecode) {
+		    double x1 = VALU(&o1), x2 = VALU(&o2);
+		    iresult = btoi (fpequd_ (&x1, &x2));
+		} else {
+		    double x1 = o1.o_val.v_i, x2 = o2.o_val.v_i;
+		    iresult = btoi (fpequd_ (&x1, &x2));
+		}
+		typecode = 0;	/* force integer result		*/
+		break;
+
+	case OP_HYPOT:
+		if (typecode)	
+		    dresult = sqrt (VALU(&o1)*VALU(&o1) + VALU(&o2)*VALU(&o2)); 
+		else	
+		    iresult = sqrt (o1.o_val.v_i*o1.o_val.v_i + 
+			o2.o_val.v_i*o2.o_val.v_i);
+		break;
+
+	default:
+		cl_error (E_IERR, e_badsw, opcode, "binop()");
+	}
+
+	if (typecode) {
+		result.o_val.v_r = dresult;
+		result.o_type = OT_REAL; 
+	} else {
+		result.o_val.v_i = iresult;
+		result.o_type = OT_INT;
+	}
+	
+pushresult:
+	pushop (&result);
+}
+
+
+/* BINEXP -- pop top two operands and push result of applying operand.
+ * result o_type will be OT_BOOL and o_val.v_i as returned from relation.
+ * both or neither operand may be a string; cannot be mixed.
+ * order of operands  will be as stacked from left to right during parser
+ *   recognition, eg, a<b pushes a, then b.
+ * INDEF operands propagate through. we should never see an UNDEF operand.
+ * all error() and do not return on internal error or bad string operations.
+ */
+void 
+binexp (int opcode)
+{
+	register int typ1, typ2;
+	struct	operand o1, o2, result;
+	int	strres = NULL, dostr;
+
+	o2 = popop();		/* operands will be on stack backwards	*/
+	o1 = popop();
+	typ1 = o1.o_type & OT_BASIC;
+	typ2 = o2.o_type & OT_BASIC;
+	dostr = 0;
+
+	if ((typ1 != OT_BOOL || typ2 != OT_BOOL) &&
+	    (opcode == OP_OR || opcode == OP_AND))
+		cl_error (E_UERR,
+		    "Non-boolean operand in a boolean expression");
+
+	if (opcode != OP_EQ && opcode != OP_NE)
+	    if (opindef (&o1) || opindef (&o2)) {
+		result.o_type = OT_BOOL;
+		/*
+		result.o_val.v_i = 0;
+		printf ("Warning: INDEF operand value in a boolean expression");
+		*/
+		setopindef (&result);
+		goto pushresult;
+	    }
+
+	if ((typ1 == OT_STRING) && (typ2 == OT_STRING)) {
+	    strres = strcmp (o1.o_val.v_s, o2.o_val.v_s);
+	    dostr++;
+
+	} else if ((typ1 == OT_STRING) || (typ2 == OT_STRING)) {
+	    if (typ1 == OT_STRING)
+		cl_error (E_UERR, e_badstrop, o1.o_val.v_s);
+	    else
+		cl_error (E_UERR, e_badstrop, o1.o_val.v_s);
+	}
+
+
+	switch (opcode) {
+	case OP_LT:
+	    if (dostr)
+		result.o_val.v_i = strres < 0;
+	    else
+		result.o_val.v_i = VALU(&o1) < VALU(&o2); 
+	    break;
+
+	case OP_GT:
+	    if (dostr)
+		result.o_val.v_i = strres > 0;
+	    else
+		result.o_val.v_i = VALU(&o1) > VALU(&o2); 
+	    break;
+
+	case OP_LE:
+	    if (dostr)
+		result.o_val.v_i = (strres <= 0);
+	    else
+		result.o_val.v_i = (VALU(&o1) <= VALU(&o2)); 
+	    break;
+
+	case OP_GE:
+	    if (dostr)
+		result.o_val.v_i = (strres >= 0);
+	    else
+		result.o_val.v_i = (VALU(&o1) >= VALU(&o2)); 
+	    break;
+
+	case OP_EQ:
+	    if (opindef (&o1) || opindef (&o2))
+		result.o_val.v_i = (opindef (&o1) == opindef (&o2));
+	    else {
+		if (dostr)
+		    result.o_val.v_i = (strres == 0);
+		else
+		    result.o_val.v_i = (VALU(&o1) == VALU(&o2)); 
+	    }
+	    break;
+
+	case OP_NE:
+	    if (opindef (&o1) || opindef (&o2))
+		result.o_val.v_i = (opindef (&o1) != opindef (&o2));
+	    else {
+		if (dostr)
+		    result.o_val.v_i = (strres != 0);
+		else
+		    result.o_val.v_i = (VALU(&o1) != VALU(&o2)); 
+	    }
+	    break;
+
+	case OP_OR:
+	    if (dostr)
+		result.o_val.v_i = strlen (o1.o_val.v_s) ||
+				   strlen (o2.o_val.v_s);
+	    else
+		result.o_val.v_i = (o1.o_val.v_i || o2.o_val.v_i);
+	    break;
+
+	case OP_AND:
+	    if (dostr)
+		result.o_val.v_i = strlen (o1.o_val.v_s) &&
+				   strlen (o2.o_val.v_s);
+	    else
+		result.o_val.v_i = (o1.o_val.v_i && o2.o_val.v_i);
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "binexp()");
+
+	}
+
+	result.o_type = OT_BOOL;
+
+pushresult:
+	pushop (&result);
+}
diff --git a/pkg/vocl/bkg.c b/pkg/vocl/bkg.c
new file mode 100644
index 00000000..fe18a18d
--- /dev/null
+++ b/pkg/vocl/bkg.c
@@ -0,0 +1,649 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_knames
+#define import_xwhen
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "clmodes.h"
+#include "mem.h"
+#include "errs.h"
+#include "param.h"
+#include "task.h"
+#include "proto.h"
+
+
+/*
+ * BKG -- All the functions relating to background ("&" asychronous) jobs.
+ *
+ * Here's how it works: yyparse() compiles code into the stack in the usual
+ * way, incrementing pc as it goes.  If an '&' is seen, a snapshot of the
+ * dictionary, the stack, and all related pointers is written to a file
+ * immediately.  The new code is discarded (by putting the pc back where it was)
+ * and yyparse() is called again.  See the forever() loop in main.
+ * When started as a background cl, the snapshot file is read in and main
+ * jumps immediately to run() as though yyparse() had just finished compiling.
+ * Thus, background code is compiled in the parent but sent to the child cl
+ * to be executed. The t_flags T_BATCH bit is set in the new cl's currentask
+ * as well as firstask.  The former is used by bkg_abort() to abort
+ * grandchildren.
+ *
+ *		 bkg_init ()			setup bkg job
+ *		bkg_spawn (cmd)			spawn bkg job
+ *		 bkg_wait (job)			wait for termination
+ *		 bkg_kill (job)			kill bkg job
+ *	    bkg_jobstatus (fp, job)		print job status
+ *   bool = bkg_jobactive (job)			job is active
+ *	       bkg_update (pmsg)		update bkg job status
+ *
+ *	      bkg_startup ()			called in bkg job to startup
+ *	        bkg_abort ()			called by bkg job on interrupt
+ *
+ * Job numbers start at 1 and count up to the maximum number of bkg jobs
+ * permitted.  In all of the above commands, the function will be performed
+ * for a single job if job>0.  If job=0 the function is applied to all jobs.
+ */
+
+extern int cldebug;
+
+/* We need to pass the pipe file names along to the bkg cl because the name
+ * of the pipe file to use is determined AT PARSE TIME, not when the file
+ * gets opened.  Without this, rmpipe() doesn't have the right names and
+ * dreg pipe files will be left around.
+ */
+extern	int pipetable[];	/* pipe stack (pipecodes)		*/
+extern	int nextpipe;		/* pipe stack pointer (next index)	*/
+extern	int dobkg;		/* flag bkg execution 			*/
+
+extern	memel cl_dictbuf[];	/* static dictionary area		*/
+extern	long c_clktime();
+extern	char *findexe();
+
+#define	BKGHDRSIZ	(sizeof (struct bkgfilehdr))
+#define	SZ_CMD		40		/* command in jobs table	*/
+#define	SZ_BKCMD	80		/* command in bkg file		*/
+#define	SZ_ENVDEF	1024		/* max size environment define	*/
+#define	WAIT_PERIOD	5		/* bkg_wait wait interval	*/
+#define	BKG_MAGIC	237
+#define	SZ_BKGMSG	64
+#define	CLDIR		"iraf$pkg/vocl/"
+
+char	bkgmsg[SZ_BKGMSG+1];		/* passed to kernel		*/
+int	lastjobno;			/* last job slot used		*/
+int	bkgno;				/* job no. assigned by parent	*/
+int	ppid;				/* pid of parent CL		*/
+
+/* Template for all the junk that goes into the background status file.
+ * Following this is the dictionary, then the stack.
+ * TODO: avoid copying binary images of the stack and dictionary
+ * areas to permit use of dynamic memory allocation.
+ */
+struct bkgfilehdr {
+	int	b_magic;		/* file identification		*/
+	int	b_bkgno;		/* bkg job number of new CL	*/
+	int	b_ppid;			/* pid of parent CL		*/
+	char	b_cmd[SZ_BKCMD];	/* command entered by user	*/
+	int	b_pipetable[MAXPIPES];	/* pipefile database		*/
+	int	b_nextpipe;		/* more pipefile database	*/
+	int	b_szstack;		/* size of stack area, bytes	*/
+	int	b_szdict;		/* size of dictionary, bytes	*/
+	memel	*b_dict;		/* ptr to start of dict		*/
+	XINT	b_topd,			/* dict ptr			*/
+		b_maxd,			/* top of dict			*/
+		b_pachead,		/* head of package list		*/
+		b_parhead,		/* head of param list		*/
+		b_pc,			/* pointer to compiled metacode	*/
+		b_topos,		/* top of operand stack		*/
+		b_basos,		/* base of operand stack	*/
+		b_topcs;		/* top of control stack		*/
+	struct task *b_firstask,	/* first task struct		*/
+		*b_currentask;		/* current task struct		*/
+	struct package *b_curpack;	/* current package		*/
+};
+
+
+/* Job table.  Associate the ordinal job number with the job number returned
+ * by the system.  Record the command string which caused the bkg job to be
+ * submitted, for output with bkg_jobstatus().
+ */
+struct _bkgjob {
+	int	b_jobno;		/* job no. assigned by system	*/
+	short	b_flags;		/* job state flags		*/
+	short	b_exitcode;		/* exit status of job		*/
+	long	b_clock;		/* start time; elapsed time	*/
+	char	b_cmd[SZ_CMD+1];	/* command entered by user	*/
+	int	b_verbose;		/* print output from job	*/
+} jobtable[NBKG];
+
+#define	J_RUNNING	01		/* job is running or queued	*/
+#define	J_SERVICE	02		/* job needs service		*/
+#define	J_KILLED	04		/* job was killed 		*/
+#define	busy(job)	(jobtable[(job)-1].b_flags & J_RUNNING)
+
+static	void bkg_close();
+
+
+/* BKG_INIT -- Setup to execute a background job.  Called by the lexical
+ * analyzer when the & is seen.  Read in the bkg control string (anything
+ * following the & to end of line) and set the dobkg flag to flag background
+ * execution of the command block currently being parsed.
+ */
+void 
+bkg_init (
+    char *bcs		/* background control string	*/
+)
+{
+	strncpy (bkgmsg, bcs, SZ_BKGMSG);
+	dobkg++;
+}
+
+
+/* BKG_SPAWN -- Spawn a new background job.  Called by main() when we have
+ * seen an '&'.
+ */
+void 
+bkg_spawn (
+    char *cmd		/* command entered by user to spawn job	*/
+)
+{
+	register struct _bkgjob *bk;
+	register int	jobno, stat;
+	char	clprocess[SZ_PATHNAME];
+	char	*wbkgfile();
+	char	*bkgfile;
+
+	/* Find first unused slot in a circular search.
+	 */
+	bkg_update (1);
+	jobno = (lastjobno == NBKG) ? 1 : lastjobno + 1;
+	while (jobno != lastjobno) {
+	    if (!busy (jobno))
+		break;
+	    if (jobno++ >= NBKG)
+		jobno = 1;
+	}
+	if (jobno == lastjobno)
+	    cl_error (E_UERR, "no more background job slots");
+
+	/* Write bkgfile.  Delete any dreg bkg communication files.
+	 */
+	bkg_delfiles (jobno);
+	bkgfile = wbkgfile (jobno, cmd, NULL);
+
+	/* Spawn bkg job.
+	 */
+	sprintf (clprocess, "%s%s", CLDIR, CLPROCESS);
+	intr_disable();
+	jobtable[jobno-1].b_jobno = stat =
+	    c_propdpr (findexe (firstask->t_curpack, clprocess),
+		bkgfile, bkgmsg);
+
+	if (stat == NULL) {
+	    c_delete (bkgfile);
+	    intr_enable();
+	    cl_error (E_IERR, "cannot spawn background CL");
+	} else {
+	    bk = &jobtable[jobno-1];
+	    bk->b_flags = J_RUNNING;
+	    bk->b_clock = c_clktime (0L);
+            bk->b_verbose = 2;
+	    strncpy (bk->b_cmd, cmd, SZ_CMD);
+	    *(bk->b_cmd+SZ_CMD) = EOS;
+	    intr_enable();
+	}
+
+	eprintf ("[%d]\n", lastjobno = jobno);
+
+	/* Make a logfile entry, saying we started the background job.
+	 */
+	if (keeplog() && log_background()) {
+	    char  buf[SZ_LINE];
+	    sprintf (buf, "Start [%d]", jobno);
+	    putlog (0, buf);
+	}
+}
+
+
+/* BKG_WAIT -- Wait for a background job to terminate.  If job=0, wait for
+ * all bkg jobs to terminate.
+ */
+void 
+bkg_wait (register int job)
+{
+	register int	j;
+	int	active_jobs;
+
+	if (job < 0 || job > NBKG)
+	    return;
+
+	do {
+	    bkg_update (1);
+	    if (job && !busy(job))
+		return;
+	    else {
+		for (active_jobs=0, j=1;  j <= NBKG;  j++)
+		    if (busy (j)) {
+			active_jobs++;
+			c_tsleep (WAIT_PERIOD);
+			break;
+		    }
+	    }
+	} while (active_jobs);
+}
+
+
+/* BKG_KILL -- Kill a background job.  If job=0, kill all background jobs.
+ * If the job cannot be killed assume it is because it died unexpectedly.
+ */
+void 
+bkg_kill (int job)
+{
+	register struct _bkgjob *bk;
+	register int	j;
+
+	bkg_update (1);
+	if (job < 0 || job > NBKG)
+	    eprintf ("[%d] invalid job number\n", job);
+	else {
+	    for (bk=jobtable, j=1;  j <= NBKG;  j++, bk++) {
+		if ((job == 0 && busy(j)) || job == j) {
+		    if (!busy(j))
+			eprintf ("[%d] not in use\n", j);
+		    else if (c_prkill (bk->b_jobno) == ERR)
+			bkg_close (j, 2);
+		    else {
+			bk->b_flags |= J_KILLED;
+			bkg_close (j, 2);
+		    }
+		}
+	    }
+	}
+}
+
+
+/* BKG_JOBSTATUS -- Print the status of one or more background jobs.
+ * format jobno, elapsed clock time, status, user command, e.g.:
+ *
+ *		[1]   1:34  Running	command_1
+ *		[2]  14:09  Stopped	command_2
+ *		[3]   1:34 +Done 	command_3
+ *		[4]   1:34  Exit 23	command_4
+ *
+ * A job will remain in the job table until another job is submitted which uses
+ * the same slot.
+ */
+void 
+bkg_jobstatus (
+    FILE *fp,			/* output file		*/
+    int job			/* job(s)		*/
+)
+{
+	register struct _bkgjob *bk;
+	register int	j, n, ch;
+	register char	*ip;
+	long	seconds;
+	char	*outstr = NULL;
+
+	bkg_update (1);
+	for (bk=jobtable, j=1;  j <= NBKG;  j++, bk++)
+	    if ((job == 0 && bk->b_jobno) || job == j) {
+		/* Print jobno.  */
+		fprintf (fp, "    [%d] ", j);
+
+		/* If the clock is still running b_clock contains the start
+		 * time.  If the job terminated it contains the elapsed time
+		 * at job termination.
+		 */
+		if (busy(j))
+		    seconds = c_clktime (bk->b_clock);
+		else
+		    seconds = bk->b_clock;
+		fprintf (fp, "%6.0m ", (float)seconds / 60.0);
+		fputc ((j == lastjobno) ? '+' : ' ', fp);
+		    
+		/* Print job status.
+		 */
+		if (busy(j)) {
+		    if (bk->b_flags & J_SERVICE)
+			outstr = "Stopped";
+		    else
+			outstr = "Running";
+		} else if (bk->b_flags & J_KILLED) {
+		    outstr = "Killed";
+		} else if (bk->b_exitcode == OK) {
+		    outstr = "Done";
+		} else
+		    sprintf (outstr, "Exit %d", bk->b_exitcode);
+		fprintf (fp, "%-10s", outstr);
+
+		/* Finally, print user command followed by newline.
+		 */
+		n = c_envgeti ("ttyncols") - (8 + 8 + 10) - 1;
+		ip = bk->b_cmd;
+		while (--n >= 0 && (ch = *ip++) != EOS)
+		    if (ch == '\n' || ch == '\t')
+			fputc (' ', fp);
+		    else
+			fputc (ch, fp);
+		fputc ('\n', fp);
+	    }
+}
+
+
+/* BKG_JOBACTIVE -- Determine if a background job is active, i.e., if the
+ * job is still running.  It does not matter if the job is waiting for
+ * service.
+ */
+int 
+bkg_jobactive (int job)
+{
+	bkg_update (1);
+	return (busy (job));
+}
+
+
+/* BKG_UPDATE -- Update the jobtable.  Examine each running process to see if
+ * has terminated or if it needs service.  Set the appropriate bits in the
+ * state flag in the job table.  When job termination is detected compute the
+ * elapsed time and leave it in the table, along with the exit status.  If
+ * the notify option is off the done or wait message will not have been printed
+ * by the bkg job, so we output the message ourselves.
+ */
+void 
+bkg_update (
+    int pmsg			/* print event messages		*/
+)
+{
+	register struct	_bkgjob *bk;
+	register int	j;
+
+	for (bk=jobtable, j=1;  j <= NBKG;  j++, bk++) {
+	    if (busy(j)) {
+		if (c_prdone (bk->b_jobno)) {
+		    bkg_close (j, pmsg);
+		} else if (bkg_wfservice (j)) {
+		    if (pmsg && !notify() && !(bk->b_flags & J_SERVICE))
+			eprintf ("[%d] stopped waiting for parameter input\n",
+			    j);
+		    bk->b_flags |= J_SERVICE;
+		} else
+		    bk->b_flags &= ~J_SERVICE;
+	    }
+	}
+}
+
+
+/* BKG_CLOSE -- Close a bkg job.  Called after determining that the job has
+ * terminated.
+ */
+static void
+bkg_close (
+    int job,			/* job ordinal			*/
+    int pmsg			/* print termination message	*/
+)
+{
+	register struct	_bkgjob *bk = &jobtable[job-1];
+
+	bk->b_clock = c_clktime (bk->b_clock);
+	bk->b_exitcode = c_prcldpr (bk->b_jobno);
+	bk->b_flags &= ~(J_RUNNING|J_SERVICE);
+
+	if (bk->b_verbose && (pmsg > 1 || (pmsg == 1 && !notify()))) {
+	    if (bk->b_exitcode != OK)
+		eprintf ("[%d] exit %d\n", job, bk->b_exitcode);
+	    else
+		eprintf ("[%d] done\n", job);
+	}
+
+	/* Make a logfile entry, saying the background job ended.
+	 */
+	if (keeplog() && log_background()) {
+	    char  buf[SZ_LINE];
+	    sprintf (buf, "Stop [%d]", job);
+	    putlog (0, buf);
+	}
+}
+
+
+/* BKG_WFSERVICE -- Determine if a bkg job is waiting for service (for the
+ * user to answer a query).
+ */
+int 
+bkg_wfservice (int job)
+{
+	char	bkg_query_file[SZ_PATHNAME];
+	char	query_response_file[SZ_PATHNAME];
+
+	get_bkgqfiles (job, c_getpid(), bkg_query_file, query_response_file);
+	return (c_access (bkg_query_file,0,0));
+}
+
+
+/* BKG_DELFILES -- Called when a background job is spawned to make sure there
+ * are no dreg query service files lying about from a prior job which did not
+ * complete normally.
+ */
+void 
+bkg_delfiles (int job)
+{
+	char	bkg_query_file[SZ_PATHNAME];
+	char	query_response_file[SZ_PATHNAME];
+
+	get_bkgqfiles (job, c_getpid(), bkg_query_file, query_response_file);
+	c_delete (bkg_query_file);
+	c_delete (query_response_file);
+}
+
+
+/* BKG_STARTUP -- Called by a background CL during process startup.  Read in
+ * the bkgfile and restore runtime context of the parent.
+ */
+void 
+bkg_startup (char *bkgfile)
+{
+	rbkgfile (bkgfile);
+	setclmodes (firstask);
+	currentask->t_flags = firstask->t_flags = T_BATCH;
+}
+
+
+/* BKG_ABORT -- Called by onint() in main.c when we get interrupted while
+ * running as a bkg job.  Kill any and all background CL's WE may have
+ * started, flush io, close any open pipe files, remove our job seq lock
+ * file, kill all tasks back to the one that started us as background and
+ * write a message on stderr.
+ */
+void 
+bkg_abort (void)
+{
+	register int	job;
+	register struct task *tp;
+
+	for (job=1;  job <= NBKG;  job++)
+	    if (busy (job))
+		bkg_kill (job);
+
+	iofinish (currentask);
+	delpipes (0);
+
+	tp = currentask;
+	while (!(tp->t_flags & T_BATCH)) {
+	    killtask (tp);
+	    tp = poptask();
+	}
+
+	fprintf (stderr, "\n[%d] killed\n", bkgno);
+}
+
+
+/* WBKGFILE -- Create a unique file, write and close the background file.
+ * Jobno is the job number the new cl is to think its running for.
+ * We don't use the global bkgno because that's OUR number, if we ourselves
+ *   are background.
+ * Return pointer to the new name.
+ * No error return, but we may call error() and never return.
+ */
+char *
+wbkgfile (
+    int jobno,			/* ordinal jobnumber of child	*/
+    char *cmd,			/* command to be run in bkg	*/
+    char *fname			/* filename for env file	*/
+)
+{
+	static	char *bkgwerr = "error writing background job file";
+	static	char bkgfile[SZ_PATHNAME];
+	struct	bkgfilehdr bh;
+	int	n, show_redefs=NO;
+	FILE	*fp;
+
+
+	/* If we're a normal background job no name was specified so 
+	 * create a unique uparm file.  Otherwise, use the specified
+	 * filename (e.g. for special onerr handling).
+	 */
+	if (fname == (char *)NULL)
+	    c_mktemp ("uparm$bkg", bkgfile, SZ_PATHNAME);
+	else {
+	    if (c_access (fname,0,0) == YES)
+		c_delete (fname);
+	    strncpy (bkgfile, fname, strlen(fname));
+	}
+
+	/* Open the file. */
+	if ((fp = fopen (bkgfile, "wb")) == NULL)
+	    cl_error (E_IERR, "unable to create background job file `%s'",
+		bkgfile);
+
+	for (n=0;  n < MAXPIPES;  n++)
+	    bh.b_pipetable[n] = pipetable[n];
+	bh.b_nextpipe = nextpipe;
+
+	strncpy (bh.b_cmd, cmd, SZ_BKCMD);
+
+	bh.b_magic	= BKG_MAGIC;
+	bh.b_bkgno	= jobno;
+	bh.b_ppid	= c_getpid();
+	bh.b_szstack	= STACKSIZ * BPI;
+	bh.b_szdict	= topd * BPI;
+	bh.b_dict 	= dictionary;
+	bh.b_topd 	= topd;
+	bh.b_maxd 	= maxd;
+	bh.b_parhead 	= parhead;
+	bh.b_pachead 	= pachead;
+	bh.b_pc 	= pc;
+	bh.b_topos 	= topos;
+	bh.b_basos 	= basos;
+	bh.b_topcs 	= topcs;
+	bh.b_firstask 	= firstask;
+	bh.b_currentask	= currentask;
+	bh.b_curpack 	= curpack;
+
+	/* Write the header structure, followed by the stack area and the
+	 * dictionary.
+	 */
+	if (fwrite ((char *)&bh, BKGHDRSIZ, 1, fp) == NULL)
+	    cl_error (E_IERR|E_P, bkgwerr);
+	if (fwrite ((char *)stack, STACKSIZ, BPI, fp) == NULL)
+	    cl_error (E_IERR|E_P, bkgwerr);
+	if (fwrite ((char *)dictionary, topd, BPI, fp) == NULL)
+	    cl_error (E_IERR|E_P, bkgwerr);
+
+	/* Write the environment as a sequence of SET statements in binary.
+	 * Append a blank line as a terminator.
+	 */
+	c_envlist (fileno(fp), "set ", show_redefs);
+	fputs ("\n", fp);
+
+	fclose (fp);
+	return (bkgfile);
+}
+
+
+/* RBKGFILE -- Read in and use background status file with given name.
+ * Do not remove the file -- the system does that upon process termination
+ * to signal the parent.  If an error occurs do not call cl_error since
+ * we are called during process startup and error recovery is not yet
+ * possible (a memory fault will result).
+ */
+void 
+rbkgfile (char *bkgfile)
+{
+	char	set[SZ_ENVDEF];
+	struct	bkgfilehdr bh;
+	int	n;
+	FILE	*fp;
+
+
+	if ((fp = fopen (bkgfile, "rb")) == NULL) {
+	    fprintf (stderr,
+		"[B] ERROR: unable to open background job file `%s'\n",
+		bkgfile);
+	    clexit();
+	}
+
+	if (fread ((char *)&bh, BKGHDRSIZ, 1, fp) == NULL)
+	    goto abort_;
+	if (bh.b_magic != BKG_MAGIC) {
+	    fprintf (stderr, "[B] ERROR: bad magic in bkgfile '%s'\n", bkgfile);
+	    clexit();
+	}
+
+	/* The following assumes that the dictionary is statically allocated
+	 * and cannot move around.
+	 */
+	if (bh.b_dict != cl_dictbuf) {
+	    fprintf (stderr,
+		"BKG ERROR: new CL installed; logout and try again\n");
+	    clexit();
+	}
+
+	intr_disable();
+
+	for (n=0;  n < MAXPIPES;  n++)
+	    pipetable[n] = bh.b_pipetable[n];
+	nextpipe = bh.b_nextpipe;
+
+	bkgno		= bh.b_bkgno;
+	ppid		= bh.b_ppid;
+	dictionary 	= bh.b_dict;
+	topd	 	= bh.b_topd;
+	maxd 		= bh.b_maxd;
+	pachead 	= bh.b_pachead;
+	parhead 	= bh.b_parhead;
+	pc 		= bh.b_pc;
+	topos 		= bh.b_topos;
+	basos 		= bh.b_basos;
+	topcs 		= bh.b_topcs;
+	firstask 	= bh.b_firstask;
+	currentask 	= bh.b_currentask;
+	curpack 	= bh.b_curpack;
+
+	/* Read stack area and dictionary.
+	 */
+	if (fread ((char *)stack, bh.b_szstack, 1, fp) == NULL)
+	    goto abort_;
+	if (fread ((char *)dictionary, bh.b_szdict, 1, fp) == NULL)
+	    goto abort_;
+
+	/* Read and restore the environment.
+	 */
+	do {
+	    if (fgets (set, SZ_ENVDEF, fp) == NULL)
+		goto abort_;
+	} while (c_envscan (set));
+
+	intr_enable();
+	fclose (fp);
+	return;
+abort_:
+	intr_enable();
+	eprintf ("[B] ERROR: error reading background file\n");
+	clexit();
+}
diff --git a/pkg/vocl/builtin.c b/pkg/vocl/builtin.c
new file mode 100644
index 00000000..21063471
--- /dev/null
+++ b/pkg/vocl/builtin.c
@@ -0,0 +1,2596 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_fset
+#define import_error
+#define import_ctype
+#define import_stdio
+#define import_alloc
+#define import_ttset
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "mem.h"
+#include "operand.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+/*
+ * BUILTIN -- This file contains the functions that perform the built-in
+ *   commands of the cl, such as task, set, and package. also here is the
+ *   code that adds these functions to the initial set of ltasks within the
+ *   cl when it first starts up.
+ * Setbuiltins() contains a table of functions and their user names; add
+ *   to this table when adding new builtin functions.
+ * The first comment line for each of the functions indicates the syntax of
+ *   how it should be used by the user.  The grammar allows the arguments
+ *   to be optionally surrounded by parentheses.
+ *
+ * It must be emphasized that these builtin commands do, in fact, run as tasks
+ * just as any other task. the currentask pointer is pointing to this task.
+ * since most of the commands manipulate the dictionary and these changes were
+ * intended for the previous task (the one that did the command) the builtins
+ * must modify the topd value saved in the previous task so the effect stays
+ * when the builtin's task finishes; thus, the builtins do a kind of "keep".
+ *
+ * Further, when called, the dictionary contains the fake parameter file
+ * manufactured for the builtin, as pointed to by currentask->t_pfp, but topd
+ * and parhead have been put back the way they were before the command was
+ * started.  Thus, if the builtin adds to the dictionary, it will overwrite its
+ * parameters.  This is avoided by using pushxparams() which pushes the value
+ * and name fields of the parameters in a pfile as operands.  The builtin may
+ * then access these fields of its parameters, by popping them off the stack,
+ * yet make dictionary additions.  The number of parameters is given by
+ * the function nargs().
+ */
+
+extern	int cldebug, cltrace;		/* debug/trace flags		     */
+extern	int lastjobno;			/* last background job spawned	     */
+extern	int gologout;			/* flag to execute() to cause logout */
+extern  int logout_status;      	/* optional arg to logout()          */
+extern  int errorline;			/* error recover line		     */
+extern  int currentline;		/* line currently being executed     */
+extern	char *findexe();
+
+extern	int do_error;			/* for error recovery/trapping 	     */
+
+extern  void cl_Samp (void);		/* SAMP builtins		     */
+
+
+
+/* Device Allocation stuff (really should be in a separate package).
+ */
+#define	SZ_DEVNAME	12
+#define	MAX_ALLOCDEV	10
+
+struct d_alloc {
+	short	allocated;
+	char	devname[SZ_DEVNAME+1];
+};
+
+static	int nallocdev = 0;		/* Count of allocated devices	     */
+static	int nlogouts = 0;		/* Count of logout attempts	     */
+static	struct d_alloc
+	allocdev[MAX_ALLOCDEV];		/* Save names of alloc devices	     */
+
+
+
+/* BYE -- Called by our parent as the regular "bye" directive when it is
+ * finished.  All we need to do is pop the currentask.  The normal handling
+ * of builtins does an oneof() which will perform the actions for our parent. 
+ * See execnewtask() for builtins.
+ */
+void 
+clbye (void)
+{
+	currentask = poptask();
+}
+
+
+/* LOGOUT -- Logout from a CL session.  Ignore the first attempts if there
+ * are allocated devices, but if the user persists permit the logout with
+ * the devices still allocated.
+ */
+void 
+cllogout (void)
+{
+	register int	n;
+	register struct	d_alloc	*dv;
+	register struct pfile *pfp;
+	struct   operand o;
+	char	 owner[SZ_FNAME+1];
+
+
+        /* Set logout status value.
+	 */
+        pfp = newtask->t_pfp;
+        if ((n = nargs (pfp)) > 0) {
+            pushbparams (pfp->pf_pp);   /* push so first popped is 1st param */
+            popop();                    /* discard the $n name               */
+            o = popop();                /* pop logout status number          */
+  
+            if ((o.o_type & OT_BASIC) == OT_STRING) {
+                eprintf ("Warning: logout status `%s' not a number\n",
+                    o.o_val.v_s);
+                nlogouts++;
+                gologout = 1;           /* LOGOUT on third attempt */
+                return;
+            }
+  
+            pushop (&o);
+            opcast (OT_INT);
+            o = popop();
+            logout_status = o.o_val.v_i;
+        } else
+            logout_status = 0;
+
+
+        /* Clean up any allocated devices.
+	 */
+	if (nallocdev > 0) {
+	    /* Examine each apparently allocated device to see if it is in
+	     * fact still allocated.
+	     */
+	    for (n=0;  n < MAX_ALLOCDEV;  n++) {
+		dv = &allocdev[n];
+		if (dv->allocated)
+		    if (c_devowner(dv->devname,owner,SZ_FNAME) != DV_DEVALLOC) {
+			dv->allocated = NO;
+			--nallocdev;
+		    }
+	    }
+
+	    /* Always print message if devices are allocated.
+	     */
+	    if (nallocdev) {
+		eprintf ("The following devices are still allocated:");
+		for (n=0;  n < MAX_ALLOCDEV;  n++)
+		    if (allocdev[n].allocated)
+			eprintf (" %s", allocdev[n].devname);
+		eprintf ("\n");
+	    }
+
+	    if (nallocdev <= 0 || nlogouts++ > 1)
+		gologout = 1;		/* LOGOUT on third attempt */
+
+	} else
+	    gologout = 1;		/* LOGOUT */
+}
+
+
+/* CLBYE -- Like cl(), but sets end of file on the current file.  This is
+ * done by the simple expedient of reopening the currentasks t_in as the null
+ * file, to ensure that anything which reads from the stream will see EOF.
+ * The reopen is performed in exec.c.
+ */
+void 
+clclbye (void)
+{
+}
+
+
+/* CACHE ltask [, ltask...]
+ * read in and keep pfiles for given ltasks. since they are pre-loaded,
+ *   used to avoid reading pfile for each invokation of tasks. since they
+ *   will not be above the new topd when the task bye's, they won't get
+ *   flushed out either unless an explicit UPDATE is done or until the task
+ *   that called us bye's.
+ * we check that the pfile is not already loaded and do nothing if it is.
+ */
+void 
+clcache (void)
+{
+	register struct pfile *pfp;
+	char	pfilename[SZ_PATHNAME];
+	char	**list, **next;
+	struct	operand o;
+	int	n, npfile;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1) {
+	    static  int first_col=7, maxch=20, ncol=0;
+	    int	    last_col;
+
+	    last_col = c_envgeti ("ttyncols");
+
+	    /* List all currently loaded paramfiles.
+	     */
+	    for (npfile=0, pfp = reference (pfile, parhead);  pfp != NULL;
+	    pfp = pfp->pf_npf) {
+		if (!(pfp->pf_flags & (PF_FAKE|PF_COPY)))
+		    npfile++;
+	    }
+
+	    list = next = (char **)memneed (npfile);
+	    for (pfp = reference (pfile, parhead);  pfp != NULL;
+	    pfp = pfp->pf_npf)
+		if (!(pfp->pf_flags & (PF_FAKE|PF_COPY))) {
+		    strcpy (pfilename, pfp->pf_ltp->lt_pkp->pk_name);
+		    strcat (pfilename, ".");
+		    strcat (pfilename, pfp->pf_ltp->lt_lname);
+		    *next++ = comdstr (pfilename);
+		}
+	    strsort (list, npfile);
+	    strtable (newtask->t_stdout, list, npfile, first_col, last_col,
+		maxch, ncol);
+
+	} else {
+	    /* Add listed pfiles to the cache.
+	     */
+	    pushbparams (pfp->pf_pp);
+	    while (n--) {
+		popop();			/* discard fake name.	*/
+		o = popop();			/* get ltask		*/
+		pfilesrch (o.o_val.v_s);
+	    }
+
+	    /* Retain the pfiles read in. */
+	    keep (prevtask);
+	}
+}
+
+
+/* CL_LOCATE -- Locate the named task in the package list.
+ */
+void 
+cl_locate (char *task_spec, int first_only)
+{
+	char	buf[SZ_LINE];
+	char	*pkname, *ltname, *junk;
+	struct	package *pkp;
+	struct  ltask   *stat;
+	int	found = 0;
+
+
+	strcpy (buf, task_spec);
+	breakout (buf, &junk, &pkname, &ltname, &junk);
+
+	if (pkname[0] != '\0') {	/* explicit package named	*/
+	    if ((pkp = pacfind (pkname)) == NULL)
+		cl_error (E_UERR, e_pcknonexist, pkname);
+	    if ((stat = ltaskfind (pkp, ltname, 1)) == (struct ltask *) NULL)
+		oprintf ("%s'\n", pkname);
+
+	} else {			/* search all packages		*/
+	    pkp = reference (package, pachead);
+	    stat = NULL;
+
+	    while (pkp != NULL) {
+		stat = ltaskfind (pkp, ltname, 1);
+		if (stat == (struct ltask *) ERR)
+	    	    cl_error (E_UERR, e_tambig, ltname);
+		else if (stat != (struct ltask *) NULL) {
+	            oprintf ("%s", pkp->pk_name);
+		    found++;
+		    if (first_only == YES)
+			break;
+	            oprintf (" ");
+		}
+		pkp = pkp->pk_npk;
+	    }
+	}
+
+	if (found == NULL)
+	    oprintf ("%s: task not found.\n", task_spec);
+	else
+	    oprintf ("\n");
+}
+
+
+/* CLWHICH -- Locate the named task in the package list.
+ */
+void 
+clwhich (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, e_geonearg, "which");
+
+	pushbparams (pfp->pf_pp);
+	while (n--) {
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get ltask			*/
+
+	    cl_locate (o.o_val.v_s, YES);
+	}
+}
+
+
+
+/* CLWHEREIS -- Locate all occurances of named task in the package list.
+ */
+void 
+clwhereis (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, e_geonearg, "whereis");
+
+	pushbparams (pfp->pf_pp);
+	while (n--) {
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get ltask			*/
+
+	    cl_locate (o.o_val.v_s, NO);
+	}
+}
+
+
+/* FLPRCACHE -- Flush the process cache.  If no args, flush all but locked
+ * processes.  If arg=0, flush all processes and override locks.  If argn=N,
+ * flush process N.
+ */
+void 
+clflprcache (void)
+{
+	register struct pfile *pfp;
+	register int n, pid;
+	struct	operand o;
+	struct	ltask *ltp;
+	int	break_locks = 1;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0) {
+	    pr_dumpcache (0, !break_locks);
+	    return;
+	}
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+	while (--n >= 0) {
+	    popop();			/* discard the $n name		*/
+	    o = popop();		/* pop proc name or number	*/
+
+	    if ((o.o_type & OT_BASIC) == OT_STRING) {
+		ltp = ltasksrch ("", o.o_val.v_s);
+		if (ltp->lt_flags & (LT_SCRIPT|LT_BUILTIN|LT_FOREIGN|LT_PSET))
+		    pid = NULL;
+		else
+		    pid = pr_pnametopid (findexe(ltp->lt_pkp,
+			ltp->lt_u.ltu_pname));
+		if (pid == NULL) {
+		    eprintf ("Warning: task `%s' not in cache\n", o.o_val.v_s);
+		    continue;
+		}
+	    } else {
+		pushop (&o);
+		opcast (OT_INT);
+		o = popop();
+		pid = o.o_val.v_i;
+	    }
+
+	    pr_dumpcache (pid, break_locks);
+	}
+}
+
+
+/* FLPR_TASK -- Flush the named task from the process cache.  
+ */
+void 
+flpr_task (char *task)
+{
+	register int pid, break_locks = 1;
+	struct	ltask *ltp;
+
+	if (strcmp (task, "cl") == 0)
+	    return;
+
+	ltp = ltasksrch ("", task);
+	if (ltp->lt_flags & (LT_SCRIPT|LT_BUILTIN|LT_FOREIGN|LT_PSET))
+	    pid = NULL;
+	else
+	    pid = pr_pnametopid (findexe(ltp->lt_pkp, ltp->lt_u.ltu_pname));
+
+	if (pid)
+	    pr_dumpcache (pid, break_locks);
+}
+
+
+/* CLPRCACHE -- If no args list the contents of the process cache, else lock
+ * the named tasks into the cache, connecting the associated process if
+ * necessary.
+ */
+void 
+clprcache (void)
+{
+	register struct pfile *pfp;
+	register int n, pid;
+	struct	operand o;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0) {
+	    pr_listcache (currentask->t_stdout);
+	    return;
+	}
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+	while (--n >= 0) {
+	    popop();			/* discard the $n name		*/
+	    o = popop();
+
+	    if ((o.o_type & OT_BASIC) == OT_STRING) {
+		if ((pid = pr_cachetask (o.o_val.v_s)) == ERR)
+		    continue;
+	    } else {
+		pushop (&o);
+		opcast (OT_INT);
+		o = popop();
+		pid = o.o_val.v_i;
+	    }
+
+	    pr_lock (pid);
+	}
+}
+
+
+/* CLGFLUSH -- Flush any buffered graphics output.  Output to stdplot is
+ * buffered to permit appending to a plot.  We are called to flush this
+ * last plot to the plotter.
+ */
+void 
+clgflush (void)
+{
+	c_gflush (STDGRAPH);
+	c_gflush (STDIMAGE);
+	c_gflush (STDPLOT);
+}
+
+
+static	char cd_curr[SZ_PATHNAME];	/* current directory	*/
+static	char cd_prev[SZ_PATHNAME];	/* previous directory	*/
+static	char cd_emsg[] = "Cannot change directory to `%s'";
+
+/* CHDIR -- Change the current working directory.  If the change is successful
+ * update the cwd of all child processes as well.
+ */
+void 
+clchdir (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	char	*dirname;
+	char	*index(), *envget();
+
+	pfp = newtask->t_pfp;
+	if (nargs (pfp) <= 0) {
+	    o.o_type = OT_STRING;
+	    if ((o.o_val.v_s = envget ("home")) == NULL)
+		cl_error (E_UERR, "No home directory defined in environment");
+	} else {
+	    pushbparams (pfp->pf_pp);
+	    popop();				/* discard the $1 	*/
+	    opcast (OT_STRING);
+	    o = popop();			/* get directory spec	*/
+	}
+
+	/* Record the current directory the first time we are called.
+	 */
+	if (cd_curr[0] == EOS)
+	    c_fpathname ("", cd_curr, SZ_PATHNAME);
+
+	/* Attempt to change the directory.
+	 */
+	dirname = o.o_val.v_s;
+	if (o.o_type != OT_STRING)
+	    cl_error (E_UERR, cd_emsg, "??");
+	else if (c_fchdir (dirname) == ERR)
+	    cl_error (E_UERR, cd_emsg, dirname);
+
+	/* Update cwd in all connected child processes. */
+	pr_chdir (0, dirname);
+
+	/* Update current and previous directory names. */
+	strcpy (cd_prev, cd_curr);
+	c_fpathname ("", cd_curr, SZ_PATHNAME);
+}
+
+
+/* BACK -- Return to the previous directory.
+ */
+void 
+clback (void)
+{
+	char	dirname[SZ_PATHNAME];
+
+	if (cd_prev[0] == EOS)
+	    cl_error (E_UERR, "no previous directory");
+	else
+	    strcpy (dirname, cd_prev);
+
+	if (c_fchdir (dirname) == ERR)
+	    cl_error (E_UERR, cd_emsg, dirname);
+
+	/* Update cwd in all connected child processes. */
+	pr_chdir (0, dirname);
+
+	/* Update current and previous directory names. */
+	strcpy (cd_prev, cd_curr);
+	strcpy (cd_curr, dirname);
+
+	/* Since we are the source of the directory name, rather than the
+	 * user, print new directory name to ensure that there are no
+	 * surprises.
+	 */
+	oprintf ("%s\n", dirname);
+}
+
+
+/* ERROR -- error code, message
+ * Print message on our stderr and pop back to a terminal cl task
+ * by handling it just like any other abortive type error.
+ */
+void 
+clerror (void)
+{
+	register struct	param *arg1, *arg2, *pp;
+	register struct pfile *pfp;
+	int	errcode;
+	char	*errmsg;
+	extern  char *onerr_handler;
+	extern  ErrCom errcom;
+	
+	erract_init();
+	if (currentline < currentask->t_scriptln)
+	    errorline = currentline;
+
+	pfp = newtask->t_pfp;
+	if (nargs (pfp) != 2)
+	    cl_error (E_IERR, e_twoargs, "error()");
+	arg1 = pfp->pf_pp;
+	arg2 = arg1->p_np;
+
+	if (arg1 && (arg1->p_valo.o_type & OT_BASIC) == OT_INT)
+	    errcode = arg1->p_val.v_i;
+	else
+	    errcode = 1;
+	if (arg2 && (arg2->p_valo.o_type & OT_BASIC) == OT_STRING)
+	    errmsg = arg2->p_val.v_s;
+	else
+	    errmsg = "";
+
+	/* Call any posted error handlers.
+	 */
+	if (onerr_handler) {
+	    /* Context:
+    	     *    onerr_handler			- handler task
+	     *    prevtask->t_ltp->lt_lname	- toplevel task
+	     *    currentask->t_ltp->lt_lname	- task that failed
+	     *    newtask->t_ltp->lt_lname	- "error()"
+	    if (cltrace) 
+		eprintf ("clerror: calling '%s' onerr_handler\n",
+		    onerr_handler);
+	    onerr_spawn (onerr_handler);
+	     */
+	}
+
+	/* Pop the ERROR task, i.e., us.
+	 */
+	currentask = poptask();
+
+	/* Log the error message if from a script or an executable.  Also, 
+	 * tell the CL error handler that we've already logged the error, by
+	 * setting the 'errlog' flag.
+	 */
+	if (keeplog() && log_errors()) {
+	    if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) {
+	    	char  buf[SZ_LINE];
+		extern	int  errlog;			/* see errs.c */
+
+		strcpy (buf, "ERROR: ");
+		strcat (buf, errmsg);
+	    	putlog (currentask, buf);
+		errlog = 1;
+	    }
+	}
+
+	/* Save the error state. 
+	 */
+	errcom.errcode = errcode;
+	strcpy (errcom.errmsg, errmsg);
+	strcpy (errcom.task, currentask->t_ltp->lt_lname);
+
+	pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
+	pp->p_val.v_i = errcom.errcode;
+	pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
+	pp->p_val.v_s = errcom.errmsg;
+	pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
+	pp->p_val.v_s = errcom.task;
+
+
+	/* Error Recovery -- If we're in an IFERR and ignoring errors don't
+	 * go through with the abort.  Simply clean up, print/save the message,
+	 * and return so we can continue execution.
+	 */
+	if (err_abort == NO || do_error == NO) {
+	    /* Note we don't properly check the stack before getting the
+	     * calling frame.  Could be a problem if we weren't called in
+	     * response to an error from a connected subprocess and using
+	     * this trick to get the calling script.
+	     */ 
+	    struct task *script = (struct task *)&stack[topcs+TASKSIZ];
+	    extern ErrCom errcom;
+
+	    iofinish (currentask);
+	    if (err_beep)
+		clbeep();
+	    if (err_flpr)
+	 	flpr_task (errcom.task);
+
+	    errcom.errflag++;
+	    errcom.errcode = errcode;
+	    strcpy (errcom.errmsg, errmsg);
+            if (script->t_ltp && script->t_ltp->lt_lname)
+                strcpy (errcom.script, script->t_ltp->lt_lname);
+            else
+                strcpy (errcom.script, "CL");
+
+
+	    if (err_trace == YES) {
+	        eprintf ("Error (%d): on line %d of '%s' from '%s':\n\t'%s'\n", 
+		    errcom.errcode, errcom.linenum, errcom.script,
+		    errcom.task, errmsg);
+	    }
+
+	    return;
+	}
+
+	/* ERROR terminates a task like BYE.  Pop the task which issued
+	 * the error statement, provided it was not the first task.
+	 */
+	iofinish (currentask);
+	if (err_beep)
+	    clbeep();
+	if (err_flpr)
+	    flpr_task (errcom.task);
+	if (currentask != firstask)
+	    currentask = poptask();
+
+	/* Now abort.  This will unwind us back to the last interactive
+	 * task.  Any external child processes will be interrupted.  If
+	 * a child process issued the ERROR it will not be interrupted,
+	 * because we already popped it above.
+	 */
+	cl_error (E_UERR, "%s", errmsg);
+}
+
+
+/* ? and ?? help commands.
+ * see listhelp() and listallhelp() in gram.c.
+ * note that since these names, ? and ??, do not fall under the ident lex
+ * rule, they need a special entry in the lex rule tables.
+ */
+void 
+clhelp (void)
+{
+	register struct pfile *pfp;
+	register struct package *pkp;
+	struct	operand o;
+	int	n, nleft, show_invis=NO;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    listhelp (curpack, show_invis);
+	else {
+	    pushbparams (pfp->pf_pp);
+	    for (nleft=n;  nleft > 0;  nleft--) {
+		popop();
+		o = popop();
+		if ((o.o_type & OT_BASIC) != OT_STRING)
+		    cl_error (E_UERR, "non-string argument");
+		if (o.o_val.v_s[0] == CH_INVIS) {
+		    show_invis = YES;
+		    if (n == 1)
+			listhelp (curpack, show_invis);
+		} else if ((pkp = pacfind (o.o_val.v_s)) == NULL) {
+		    eprintf ("Warning: package '%s' not found\n", o.o_val.v_s);
+		} else if ((XINT) pkp == ERR) {
+		    cl_error (E_UERR, e_pckambig, o.o_val.v_s);
+		} else {
+		    if (n > 1)
+			oprintf ("    %s:\n", pkp->pk_name);
+		    listhelp (pkp, show_invis);
+		}
+	    }
+	}
+}
+
+
+void 
+clallhelp (void)
+{
+	int	show_invis = NO;
+
+	listallhelp (show_invis);
+}
+
+
+/* CLHISTORY -- Print the command history.  We keep the number of history
+ * blocks to print in static storage, starting with a default of 20.  This
+ * number is "learned" if the user calls history with the max_history arg.
+ */
+void 
+clhistory (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	static	int default_max_history = 15;
+	int	max_history;
+
+	max_history = default_max_history;
+	pfp = newtask->t_pfp;
+
+	if (nargs (pfp) > 0) {
+	    pushbparams (pfp->pf_pp);
+	    popop();				/* discard the $1 	*/
+	    o = popop();			/* get max records 	*/
+	    if (o.o_type != OT_INT)
+		cl_error (E_UERR,
+		    "'history' arg is max number of records to print");
+	    max_history = o.o_val.v_i;
+
+	    /* Negative valued argument does not permanently change the
+	     * default.
+	     */
+	    if (max_history >= 0)
+		default_max_history = max_history;
+	    else
+		max_history = -max_history;
+	}
+
+	show_history (newtask->t_stdout, max_history);
+}
+
+
+/* CLTRACE -- Enable or disable instruction tracing (d_trace).
+ */
+void 
+dotrace (void)
+{
+	register struct pfile *pfp;
+	struct operand o;
+	int value = !cltrace;
+
+	pfp = newtask->t_pfp;
+
+	if (nargs (pfp) > 0) {
+	    pushbparams (pfp->pf_pp);
+	    popop();				/* discard the $1 	*/
+	    o = popop();
+	    if (o.o_type != OT_INT)
+		cl_error (E_UERR, "trace arg should be an integer");
+	    value = o.o_val.v_i;
+	}
+
+	d_trace (value);
+}
+
+
+/* CLEHISTORY -- Edit command history.  (dummy - see history.c)
+ */
+void 
+clehistory (void)
+{
+}
+
+
+/* CLSERVICE -- Service a query from a task in the background.  The argument
+ * is the job number, default [1].
+ */
+void 
+clservice (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	int	bkgjob;
+
+	pfp = newtask->t_pfp;
+	if (nargs (pfp) < 1)
+	    bkgjob = lastjobno;
+	else {
+	    pushbparams (pfp->pf_pp);
+	    popop();				/* discard the $1 	*/
+	    o = popop();			/* get max records 	*/
+	    if (o.o_type != OT_INT)
+		cl_error (E_UERR,
+		    "'service' arg is ordinal of bkg job to be serviced");
+	    bkgjob = o.o_val.v_i;
+	}
+
+	service_bkgquery (bkgjob);
+}
+
+
+/* keep
+ * this command is used when changes to the dictionary, as with task
+ * or package directives for example, are to be saved after the task that
+ * issues the "keep" dies. since the keep command itself is handled as a
+ * task, this means the t_topd value saved two levels above the current
+ * task has to be modified.
+ * control stack grows downward so previous tasks are higher than currentask.
+ * because it was the very first task, it makes no sense for the initial
+ * interactive cl to do a keep.
+ */
+void 
+clkeep (void)
+{
+	register struct	task *tp, *root_task = (struct task *) NULL;
+
+
+	if (strncmp ("keep", currentask->t_ltp->lt_lname, 4) == 0) {
+	    if (nargs (newtask->t_pfp) > 0)
+	        cl_error (E_UERR, "`keep' command has no arguments");
+	} else if (prevtask == firstask)
+	    return;
+
+	/* If reading from the standard input, keep only the context of our
+	 * caller.
+	 */
+	if (prevtask->t_in == firstask->t_in) {
+	    keep (next_task(prevtask));
+	    return;
+	}
+
+	/* Find the earliest task on the control stack which is reading from
+	 * the same command input stream (script file) as our caller, and
+	 * keep the context of all tasks from that point up to the present.
+	 */
+	for (tp=prevtask;  tp != firstask;  tp = next_task(tp)) {
+	    if (tp->t_in == prevtask->t_in)
+		root_task = tp;
+	}
+
+	for (tp=prevtask;  tp != firstask;  tp = next_task(tp)) {
+	    keep (next_task(tp));
+	    if (tp == root_task)
+		break;
+	}
+}
+
+
+/* kill job [, job]
+ * zap background jobs, as defined by their one-indexed "job number".
+ * job zero is a special case that means kill all jobs.
+ * see bkg.c for more discussion and bkgkill().
+ */
+void 
+clkill (void)
+{
+	register struct pfile *pfp;
+	register int n, jn;
+	struct operand o;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    cl_error (E_UERR, "must specify job number(s)");
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+
+	while (n--) {
+	    popop();		/* discard the $n name		*/
+	    opcast (OT_INT);	/* insure we get an integer	*/
+	    o = popop();		/* pop job number, as int	*/
+	    jn = o.o_val.v_i;
+
+	    bkg_kill (jn);
+	}
+}
+
+
+/* EPARAM -- Parameter set editor.
+ */
+void 
+cleparam (void)
+{
+	register struct pfile *pfp;
+	int	n, nleft, quit;
+	struct	operand o;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    return;
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+	quit = NO;
+
+	for (nleft=n;  nleft > 0;  nleft--) {
+	    popop();		/* discard the $n name			*/
+	    o = popop();	/* get task name (value of the param)	*/
+
+	    if (!quit && (o.o_type & OT_BASIC) == OT_STRING)
+		quit = (epset (o.o_val.v_s) == ERR);
+	    else
+		cl_error (E_UERR,
+		    "eparam: argument must be taskname or pfilename");
+	}
+}
+
+
+/* LPARAM name1, name2, ...
+ * go through params for each named task and list their names, current value,
+ * and prompt string. go through twice, giving all non-hidden ones first.
+ * if a pfile is needed and it is not in core already, it is read in just
+ *   long enough to display then discarded. it might be argued that lparam
+ *   should have a kind of implied pre-loading cache effect since a task whose
+ *   params are being inspected is likely to be used soon. if this effect is
+ *   wanted, just add the topd saving line as with task, cache, etc.
+ */
+void 
+cllparam (void)
+{
+	register struct ltask *ltp;
+	register struct pfile *pfp;
+	struct	operand o;
+	int	n, nleft;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    return;
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+
+	for (nleft=n;  nleft > 0;  nleft--) {
+	    popop();		/* discard the $n name			*/
+	    o = popop();	/* get task name (value of the param)	*/
+	    if ((o.o_type & OT_BASIC) == OT_STRING) {
+		pfp = pfilesrch (o.o_val.v_s);
+		ltp = pfp->pf_ltp;
+		if (n > 1)
+		    oprintf ("    %s:\n", ltp->lt_lname);
+		listparams (pfp);
+	    } else
+		cl_error (E_UERR, "lparam: argument must be a taskname");
+	}
+}
+
+
+/* DPARAM name1, name2, ...
+ * Dump the parameters for the named tasks to the standard output in the
+ * form of a series of `task.param=value' assignments.
+ */
+void 
+cldparam (void)
+{
+	register struct ltask *ltp;
+	register struct pfile *pfp;
+	struct	operand o;
+	int	n, nleft;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    return;
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+
+	for (nleft=n;  nleft > 0;  nleft--) {
+	    popop();		/* discard the $n name			*/
+	    o = popop();	/* get task name (value of the param)	*/
+
+	    if ((o.o_type & OT_BASIC) == OT_STRING) {
+		pfp = pfilesrch (o.o_val.v_s);
+		ltp = pfp->pf_ltp;
+		dumpparams (pfp);
+	    } else
+		cl_error (E_UERR, "dparam: argument must be a taskname");
+	}
+}
+
+
+/* PACKAGE name
+ * this function is to create a new package structure off pachead
+ *   so that when the previous process continues, it will be its new curpack.
+ *   the packages pfile is to be the parent's also.
+ * since we want the effect to remain for the parent, we store the new
+ *   package pointer in (currentask+1)->t_curpack so restor() will stuff it
+ *   into curpack. we also need to "keep" the new topd so that restor doesn't
+ *   lob off the new package again. this is a complexity that results from
+ *   running builtin functions as tasks in their own right.
+ * no point in setting curpack as it will get overwritten by restor() as soon
+ *   as this returns.
+ * if called without arguments, just give a list of packages, in current 
+ *   circular search order.
+ * set LT_DEFPCK if the new package name is the same as the task defining it.
+ *   used by cmdsrch() to guard against rerunning a script that defines a pkg.
+ * call error() and do not return if this would redefine the package.
+ */
+void 
+clpack (void)
+{
+	register struct pfile	*pfp;
+	register struct task	*tp;
+	register struct package *pkp;
+	char	*paknam, *bindir;
+	struct	operand o1, o2;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if (nargs (pfp) > 2)
+	    cl_error (E_UERR, "too many arguments");
+
+	if ((n = nargs(pfp)) == 0) {
+	    pkp = curpack;
+	    do {
+		oprintf ("    %s\n", pkp->pk_name);
+		if ((pkp = pkp->pk_npk) == NULL)
+		    pkp = reference (package, pachead);
+	    } until (pkp == curpack);
+	    return;
+	}
+
+	/* Get name of new package. */
+	pushbparams (pfp->pf_pp);
+	popop();		/* discard param's $n name	*/
+	opcast (OT_STRING);
+	o1 = popop();
+	paknam = o1.o_val.v_s;
+
+	/* Search up the task stack for a script task with the same name as
+	 * the new package.  Note that if other packages were loaded before
+	 * the PACKAGE statement was executed, the task descriptor for the
+	 * package script task will not be the previous task.
+	 */
+	for (tp = prevtask;  tp != firstask; tp = next_task(tp))
+	    if (!strcmp (paknam, tp->t_ltp->lt_lname))
+		break;
+
+	/* Determine the bindir for the package.  This may be given on the
+	 * command line, otherwise we inherit the bindir of the package to
+	 * which the new package being defined belongs.
+	 */
+	if (n > 1) {
+	    opcast (OT_STRING);
+	    o2 = popop();
+	    opcast (OT_STRING);
+	    o2 = popop();
+	    bindir = o2.o_val.v_s;
+	} else
+	    bindir = tp->t_ltp->lt_pkp->pk_bin;
+
+	/* Check for redefinition. */
+	if (pacfind (paknam) != NULL)
+	    cl_error (E_UERR, "package redefinition: `%s'", paknam);
+
+	/* Enter the new package definition into the dictionary.  */
+	pkp = newpac (paknam, bindir);
+
+	/* Set the pfile pointer for the new package to the pfile for the
+	 * containing script task of the same name.  Flag the ltask entry
+	 * to indicate that the ltask is a package.
+	 */
+	pkp->pk_pfp = tp->t_pfp;
+	tp->t_ltp->lt_flags |= LT_DEFPCK;
+
+	/* Set the current process cache process number (assigned in time
+	 * order) for the task immediately preceding the one which called
+	 * us.  This causes restor() to prune all recently connected processes
+	 * from the process cache when we exit.
+	 */
+	if (tp != firstask)
+	    next_task(tp)->t_pno = pr_getpno();
+
+	/* Patch the saved curpack of the previous task (whatever it was) so
+	 * that when we return the newly declared package will become the
+	 * current package.  Call KEEP so that the new entry does not go away
+	 * when the PACKAGE decl-task exits.
+	 */
+	prevtask->t_curpack = pkp;
+	keep (prevtask);
+}
+
+
+/* _CURPACK -- Print the name of the "current" package, i.e., the name of
+ * the first package in the search path for a command.
+ */
+void 
+clcurpack (void)
+{
+	tprintf ("%s\n", curpack->pk_name);
+}
+
+
+/* clpackage
+ * this is just a null function to allow changing the current package to
+ * clpackage. it is necessary due to the way cmdsrch() works, which looks
+ * for an ltask named clpackage, then checks to see if there is a package
+ * of the same name. if there is, it changes to it. thus, we need a fake
+ * "task" for cmdsrch() to find so we may change to clpackage.
+ */
+void 
+clpkg (void)
+{
+}
+
+/* language
+ * Fake task for the "language" package.
+ */
+void 
+lapkg (void)
+{
+}
+
+
+/* CLPRINT -- Formatted output.  Print arguments on the standard
+ * output.
+ */
+void 
+clprint (void)
+{
+	do_clprint ("stdout");
+}
+
+
+/* CLFPRINT -- Formatted output.  Print arguments 2-N on the stream or
+ * in the param named by the first argument.
+ */
+void 
+clfprint (void)
+{
+	do_clprint ("");
+}
+
+
+void 
+do_clprint (char *dest)
+{
+	/* x1 and x2 are just place holders for the call to breakout.
+	 */
+	struct	pfile *pfp;
+	struct	param *pp;
+	FILE	*fout;
+	char	*pkname, *ltname, *pname, *field;
+	char	outbuf[SZ_LINE];
+	struct	operand o, out;
+	int	type, op, n, nleft;
+
+	pfp = newtask->t_pfp;
+	pushbparams (pfp->pf_pp);  /* push so first popped is first param */
+
+	/* Get the number of the first argument.  If not "$1", i.e. when
+	 * calling as "print (,x,y,z)", default dest to the standard output.
+	 * Otherwise, get the first parameter (name of the destination
+	 * stream or param) and save for later.
+	 */
+
+	if ((n = nargs (pfp)) < 1)
+	    goto argerr;
+
+	out = popop();		/* get argument number "$n"		*/
+	if (strcmp (dest, "stdout") == 0 || strcmp (out.o_val.v_s, "$1") != 0) {
+	    /* n == 1 is ok here: syntax "print (,xx)"	*/
+	    pushop (&out);
+	    out.o_val.v_s = "stdout";
+	} else {
+	    out = popop();	/* get dest name (param name or stream)	*/
+	    if (n == 1)
+argerr:		cl_error (E_UERR, "Too few arguments to print or fprint");
+	    n = n - 1;
+	}
+
+	/* Format the output string.
+	 */
+	op = 0;
+	outbuf[op] = '\0';
+	for (nleft = n;  nleft > 0;  nleft--) {
+	    popop();		/* discard the $n name			*/
+	    o = popop();
+	    sprop (&outbuf[op], &o);
+	    while (outbuf[op] != '\0')
+		op++;
+	    /* If operand is a number, add a space after the number.
+	     */
+	    type = o.o_type & OT_BASIC;
+	    if (type == OT_INT || (type == OT_REAL && nleft > 1)) {
+		outbuf[op++] = ' ';
+		outbuf[op] = '\0';
+	    }
+	    if (op >= SZ_LINE)
+		cl_error (E_UERR, "Output line too long in 'print'");
+	}
+		
+	/* Examine the destination string and output the formatted
+	 * string.  Destination may be stdout, stderr, or a parameter.
+	 */
+	breakout (out.o_val.v_s, &pkname, &ltname, &pname, &field);
+
+	makelower (pname);
+	fout = NULL;
+	if (pkname[0] == '\0' && ltname[0] == '\0') {
+	    if (strcmp (pname, "stdout") == 0 || pname[0] == '\0')
+		fout = currentask->t_stdout;
+	    else if (strcmp (pname, "stderr") == 0)
+		fout = currentask->t_stderr;
+	}
+
+	if (fout != NULL) {		/* send to task stdout or err	*/
+	    outbuf[op++] = '\n';	/* append newline		*/
+	    outbuf[op] = '\0';
+	    fputs (outbuf, fout);
+	} else {
+	    o.o_type = OT_STRING;	/* destination is a param	*/
+	    o.o_val.v_s = outbuf;
+	    pushop (&o);
+	    pp = paramsrch (pkname, ltname, pname);
+	    paramset (pp, field[0]);
+	}
+}
+
+
+/* CLPRINTF -- Formatted print command (interface to VOS printf).
+ */
+void 
+clprintf (void)
+{
+	struct	pfile *pfp;
+	struct	operand o;
+	int	arg, n;
+
+	pfp = newtask->t_pfp;
+	pushbpvals (pfp->pf_pp);
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, "printf: insufficient arguments\n");
+
+	/* Output format. */
+	o = popop();
+	if ((o.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_UERR, "printf: bad format string\n");
+	c_fprintf (fileno(currentask->t_stdout), o.o_val.v_s);
+
+	/* Pass the operand values. */
+	for (arg=2;  arg <= n;  arg++) {
+	    o = popop();
+	    if (opindef(&o)) {
+		c_pargstr ("INDEF");
+	    } else if (opundef(&o)) {
+		cl_error (E_UERR, "printf: argument %d has undefined value\n",
+		    arg);
+	    } else {
+		switch (o.o_type & OT_BASIC) {
+		case OT_BOOL:
+		case OT_INT:
+		    c_pargi (o.o_val.v_i);
+		    break;
+		case OT_REAL:
+		    c_pargd (o.o_val.v_r);
+		    break;
+		case OT_STRING:
+		    c_pargstr (o.o_val.v_s);
+		    break;
+		default:
+		    cl_error (E_UERR, "printf: bad operand type\n");
+		}
+	    }
+	}
+}
+
+
+/* CLSCAN -- The scan function called as a task to scan from the standard
+ * input, e.g. a pipe.  (Name changed to clscans to avoid a name clash
+ * with fmtio.clscan).
+ */
+void 
+clscans (void)
+{
+	struct	pfile *pfp;
+
+	pfp = newtask->t_pfp;
+	pushbpvals (pfp->pf_pp);
+	cl_scan (nargs(pfp)-1, "stdin");
+	popop();
+}
+
+
+/* CLSCANF -- Formatted scan function.
+ */
+void 
+clscanf (void)
+{
+	struct	pfile *pfp;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	pushbpvals (pfp->pf_pp);
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, "scanf: insufficient arguments\n");
+
+	/* Get scan format. */
+	o = popop();
+	if ((o.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_UERR, "scanf: bad format string\n");
+
+	cl_scanf (o.o_val.v_s, nargs(pfp)-2, "stdin");
+	popop();
+}
+
+
+/* PUTLOG user-msg 
+ * Write a user message to the logfile.  The current pkg.task, bkg info, and
+ * a time stamp are added by the putlog() function (in history.c).
+ */
+void 
+clputlog (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	char	*usermsg;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    usermsg = "";
+	else {
+	    pushbparams (pfp->pf_pp);
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get user string 		*/
+	    usermsg = o.o_val.v_s;
+	    while (--n) {		/* get rid of any extra args */
+	    	popop();		/* discard fake name	*/
+	    	popop();		/* discard extra arg	*/
+	    }
+	}
+
+	/* Call putlog with the calling task and the user's message.
+	 */
+	putlog (prevtask, usermsg);
+}
+
+
+/* set [name = value]
+ * if (no arguments)
+ *   give a list of existing enviroment settings
+ * else
+ *   add an entry into the environment table name=value.
+ *   update environ list in all connected child procs.
+ */
+void 
+clset (void)
+{
+	register struct pfile *pfp;
+	struct	operand onam, oval;
+	int	scantemp, n, show_redefs=YES;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) == 0)
+	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
+	else {
+	    pushfparams (pfp->pf_pp);
+	    while (n--) {
+		opcast (OT_STRING);
+		onam = popop();
+		if (sscanf (onam.o_val.v_s, "$%d", &scantemp) == 1)
+		    cl_error (E_UERR, "set must use name=value pairs");
+		opcast (OT_STRING);
+		oval = popop();
+		c_envputs (onam.o_val.v_s, oval.o_val.v_s);
+		pr_envset (0, onam.o_val.v_s, oval.o_val.v_s);
+		if (strcmp ("erract", onam.o_val.v_s) == 0)
+		    erract_init();
+	    }
+
+	    /* Prevent envfree in poptask when SET terminates from discarding
+	     * this definition!!
+	     */
+	    c_envmark (&prevtask->t_envp);
+	}
+}
+
+
+/* reset [name = value]
+ * if (no arguments)
+ *   give a list of existing enviroment settings
+ * else
+ *   reset (overwrite) the value of the named environment variable.
+ *   update environ list in all connected child procs.
+ */
+void 
+clreset (void)
+{
+	register struct pfile *pfp;
+	struct	operand onam, oval;
+	int	scantemp, n, show_redefs=YES;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) == 0)
+	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
+	else {
+	    pushfparams (pfp->pf_pp);
+	    while (n--) {
+		opcast (OT_STRING);
+		onam = popop();
+		if (sscanf (onam.o_val.v_s, "$%d", &scantemp) == 1)
+		    cl_error (E_UERR, "reset must use name=value pairs");
+		opcast (OT_STRING);
+		oval = popop();
+		c_envreset (onam.o_val.v_s, oval.o_val.v_s);
+		pr_envset (0, onam.o_val.v_s, oval.o_val.v_s);
+		if (strcmp ("erract", onam.o_val.v_s) == 0)
+		    erract_init();
+	    }
+
+	    /* Prevent envfree in poptask when SET terminates from discarding
+	     * this definition!!
+	     */
+	    c_envmark (&prevtask->t_envp);
+	}
+}
+
+
+/* show [name]
+ * if (no arguments)
+ *   give a list of existing enviroment settings, but do not show redefinitions
+ *   as 'set' does.
+ * else
+ *   show value of specified environment variable(s).
+ */
+#define  SZ_VALUE  SZ_COMMAND
+
+void 
+clshow (void)
+{
+	register struct pfile *pfp;
+	struct	operand onam;
+	int	n, show_redefs=NO;
+	char	val[SZ_VALUE];
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) == 0)
+	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
+	else {
+	    pushbparams (pfp->pf_pp); /* push so first popped is first param */
+	    while (n--) {
+		popop();			/* discard the $n */
+		opcast (OT_STRING);
+		onam = popop();
+  	        if (c_envfind (onam.o_val.v_s, val, SZ_VALUE) < 0)
+		    cl_error (E_UERR, "No such environment variable");
+		else
+		    oprintf ("%s\n", val);
+	    }
+	}
+}
+
+
+/* STTY -- Set terminal driver options.  This is merely an interface to the VOS
+ * sttyco() procedure, which does all the work.  Our function is merely to
+ * collect the arguments into a long string and then call sttyco() to perform
+ * the operation.  The dictionary must be "kept" after the call to sttyco since
+ * new values of the terminal, ttyncols, and ttynlines variables may be set.
+ */
+void 
+clstty (void)
+{
+	register struct	pfile *pfp;
+	register char	*ip, *op;
+	char	sttycmd[2048], args[1024], *argp[100];
+	int	argc, i;
+	XINT	std_in = STDIN, std_out = STDOUT;
+
+
+	pfp = newtask->t_pfp;
+
+	/* Construct an array of pointers to the argument strings.  argp[1] is
+	 * the first argument; argp[0] is the task name.
+	 */
+	argc = mkarglist (pfp, args, argp);
+
+	/* Concatenate the stty argument list.  */
+	for (op=sttycmd, i=1;  i <= argc;  i++) {
+	    for (ip=argp[i];  (*op = *ip++);  op++)
+		;
+	    if (i < argc)
+		*op++ = ' ';
+	}
+	*op++ = EOS;
+
+	/* Call STTYCO to set the terminal driver options. */
+	c_sttyco (sttycmd, std_in, std_out, fileno(newtask->t_stdout));
+	keep (prevtask);
+}
+
+
+/* TASK [lname1, lname2, ...,] lnamen = pname
+ * Define the one or more logical tasks to be in the given physical file name.
+ * The new task defn's will built starting at topd, which has already been
+ * reset to what it was before the call to this built started.  Thus, the
+ * params pointed to by t_pfp will be overwritten and they must be saved.
+ * Also, we need to "keep" the new topd so restor doesn't lob off the new
+ * structures when going back to the previous task.  See the disclaimer with
+ * clpack().
+ *
+ * Task names which begin with underscore are invisible to the user and
+ * are not shown in menus.  The LT_INVIS flag is set by "addltask" if the
+ * first char in the task name is an underscore.
+ */
+void 
+cltask (int redef)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	int	n, scantmp;
+	char	*physname, *logname;
+	int	foreign_task, flags;
+
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    cl_error (E_UERR, e_geonearg, "task");
+
+	pushfparams (pfp->pf_pp);    /* push so first popped is last param  */
+	o = popop();
+	logname = o.o_val.v_s;
+	if (sscanf (logname, "$%d", &scantmp) == 1)
+	    cl_error (E_UERR,
+		"physical task name must be explicit in last arg");
+
+	opcast (OT_STRING);
+	o = popop();
+	physname = o.o_val.v_s;
+
+	/* Check for a foreign (host system) task, a type of builtin.
+	 */
+	if ( (foreign_task = (*physname == '$')) ) {
+	    if (strcmp (physname, "$foreign") == 0)
+		physname = "";
+	    else
+		physname++;
+	}
+
+	if (foreign_task) {
+	    flags = LT_FOREIGN;
+	    if (logname[0] == '$') {
+		logname++;
+		flags &= ~LT_PFILE;
+	    }
+	    newbuiltin (curpack, logname, clforeign, flags, physname, redef);
+	} else
+	    addltask (curpack, physname, logname, redef);
+
+	while (--n) {
+	    popop();			/* discard $n param name	*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get logical name		*/
+	    logname = o.o_val.v_s;
+
+	    if (foreign_task) {
+		flags = LT_FOREIGN;
+		if (logname[0] == '$') {
+		    logname++;
+		    flags &= ~LT_PFILE;
+		}
+		newbuiltin (curpack, logname,clforeign,flags,physname, redef);
+	    } else
+		addltask (curpack, physname, o.o_val.v_s, redef);
+	}
+
+	keep (prevtask);		/* retain changes for prev task	*/
+}
+
+/* these are hooks to cltask that just select whether redefs are to be
+ * permitted. they are both used as described for cltask().
+ */
+void 
+clrtask (void)
+{
+	cltask (YES);
+}
+
+void 
+clntask (void)
+{
+	cltask (NO);
+}
+
+
+/* CLFOREIGN -- Execute a foreign task.  A foreign task is a special type of
+ * builtin task to the CL.  All foreign tasks vector to CLFOREIGN for
+ * execution.  Our function is to build up a command line for the foreign
+ * task and submit it to the host system for execution with c_oscmd().
+ * The parameters to a foreign task are output as blank separated strings
+ * in pfile order.  The name of the foreign task defaults to the same as the
+ * name of the ltask.  Commonly foreign tasks have no pfile, hence the
+ * parameters are whatever the user entered on the command line.  Note however
+ * that a parameter string may be the result of any CL expression; the argument
+ * list of a foreign task is parsed by the CL like it is for any task.
+ * CL metacharacters must be quoted or escaped to be included as strings in
+ * the command line to the host system.  I/O redirection is supported.
+ *
+ * A foreign task command line is built up by argument substitution, scanning
+ * the so-called `ftprefix' command template string for symbolic argument
+ * references of the form $1, $2, etc., to match individual arguments, or $*
+ * to match the full argument list.  $(N) denotes the host equivalent of
+ * virtual filename argument N.  If no $arg references are found the argument
+ * list is simply appended to the ftprefix string, in which case it really is
+ * a prefix string.
+ */
+void 
+clforeign (void)
+{
+	register struct	pfile *pfp;
+	register char	*ip, *op;
+	char	oscmd[1024], args[1024], *argp[100], *ap;
+	int	dolseen, mapfname;
+	int	argc, n1, n2, ch, n;
+
+	pfp = newtask->t_pfp;
+
+	/* Construct an array of pointers to the argument strings.  argp[1] is
+	 * the first argument; argp[0] is the task name.
+	 */
+	argc = mkarglist (pfp, args, argp);
+
+	/* Build up the host command by inserting the CL command line arguments
+	 * into the command template given in the foreign task declaration.
+	 */
+	dolseen = 0;
+	for (ip=newtask->t_ltp->lt_ftprefix, op=oscmd;  (*op = *ip);  op++,ip++)
+	    if (*ip == '\\' && *(ip+1) == '$')
+		*op = *(++ip);
+	    else if (*ip == '$') {
+		dolseen++;
+		ch = *(++ip);
+
+		/* A $(N) or $(*) causes the argument strings to be treated as
+		 * virtual filenames and mapped into their host equivalents for
+		 * use in the host command string.
+		 */
+		mapfname = 0;
+		if (ch == '(') {
+		    mapfname++;
+		    ch = *(++ip);
+		    ip++;
+		}
+
+		if (isdigit (ch)) {
+		    n1 = n2 = ch - '0';
+		} else if (ch == '*') {
+		    n1 = 1;
+		    n2 = argc;
+		} else {
+		    *(++op) = ch;
+		    continue;
+		}
+
+		for (n=n1;  n <= n2;  n++) { 
+		    char    osfn[SZ_PATHNAME+1];
+
+		    if (n >= 0 && n <= argc) {
+			if (n > n1)
+			    *op++ = ' ';
+			if (mapfname) {
+			    c_fmapfn (argp[n], osfn, SZ_PATHNAME);
+			    ap = osfn;
+			} else
+			    ap = argp[n];
+			while ( (*op = *ap++) )
+			    op++;
+		    }
+		}
+
+		op--;
+	    }
+
+	/* If there were no $arg references in the command template, append
+	 * the argument list to the prefix string.
+	 */
+	if (!dolseen)
+	    for (n=1;  n <= argc;  n++) {
+		*op++ = ' ';
+		for (ap=argp[n];  (*op = *ap++);  op++)
+		    ;
+	    }
+
+	if (cltrace) {
+	    d_fmtmsg (stderr, "\t    ", oscmd, 80 - 13);
+	    eprintf ("\t--------------------------------\n");
+	}
+
+	/* Call the host system to execute the command.  If i/o redirection
+	 * was indicated on the command line pointers to the names of the
+	 * referenced files will have been stored in the task structure by
+	 * the CL metacode instructions o_redir, o_redirall, etc.  If the
+	 * task was called by a parent whose output was redirected then we
+	 * must call clsystem, which will spool the output of the OS cmd
+	 * in temporary files and then copy it to the parent's output streams.
+	 */
+	if ((newtask->t_stdout != stdout && newtask->ft_out == NULL) ||
+	    (newtask->t_stderr != stderr && newtask->ft_err == NULL)) {
+
+	    clsystem (oscmd, newtask->t_stdout, newtask->t_stderr);
+
+	} else {
+	    /* Parents i/o is not redirected, hence we can redirect i/o
+	     * directly without a temp file.
+	     */
+	    char *in, *out, *err;
+	    int append_all;
+
+	    in  = newtask->ft_in  ? newtask->ft_in  : "",
+	    out = newtask->ft_out ? newtask->ft_out : "",
+	    err = newtask->ft_err ? newtask->ft_err : "";
+	    append_all = (out == err);
+
+	    if (newtask->t_flags & T_APPEND) {
+		register int ch;
+		register FILE *fp=NULL, *outfp=NULL;
+		char tmpfile[SZ_PATHNAME];
+
+		/* Execute the command spooling the output in a temporary
+		 * file (OSCMD cannot directly append to an output file).
+		 */
+		if (!c_mktemp ("tmp$ft", tmpfile, SZ_PATHNAME))
+		    strcpy (tmpfile, "tmp$ft.out");
+		c_oscmd (oscmd, in, tmpfile, append_all ? tmpfile : err);
+
+		/* Append the spooled output to the user-specified output
+		 * redirection file.
+		 */
+		if ((fp = fopen (tmpfile, "r")) != NULL &&
+			(outfp = fopen (out, "a")) != NULL) {
+		    while ((ch = fgetc(fp)) != EOF)
+			fputc (ch, outfp);
+		}
+
+		if (fp)
+		    fclose (fp);
+		if (outfp)
+		    fclose (outfp);
+		c_delete (tmpfile);
+
+	    } else
+		c_oscmd (oscmd, in, out, err);
+	}
+}
+
+
+/* UNLEARN (ltask|package) [, (ltask|package)...]
+ * Restore the package default parameters for each ltask, or for all of
+ * the ltasks in the named package.
+ */
+void 
+clunlearn (void)
+{
+	static	char errfmt[] = "Warning: Cannot unlearn params for `%s'\n";
+	register struct pfile *pfp;
+	register struct ltask *ltp, *ltt;
+	char	*x1, *pk, *t, *x2;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, e_geonearg, "unlearn");
+
+	pushbparams (pfp->pf_pp);
+	while (n--) {
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get ltask|package name	*/
+	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
+	    if (!(ltp = cmdsrch (pk, t)))
+		continue;
+
+	    /* If package, unlearn each task. */
+	    if (ltp->lt_flags & LT_PACCL) {
+		/* Unlearn each task in the package. */
+		for (ltt=ltp->lt_pkp->pk_ltp;  ltt != NULL;  ltt=ltt->lt_nlt)
+		    if (pfileinit (ltt) == ERR)
+			eprintf (errfmt, ltt->lt_lname);
+
+		/* Unlearn the package parameters. */
+		if ( (ltt = ltasksrch (pk, t)) )
+		    if (pfileinit(ltt) == ERR)
+			eprintf (errfmt, ltt->lt_lname);
+
+	    } else if (pfileinit (ltp) == ERR)
+		eprintf (errfmt, ltp->lt_lname);
+	}
+}
+
+
+/* UPDATE ltask [, ltask...]
+ * force the in-core pfile for the given tasks to be written out.
+ * used when the pfile has been pre-loaded with cache but it is to be
+ * saved before it would automatically be due to bye'ing task.
+ * since the given task might be running, if we were run from it for example,
+ * we also force the working copy to get copied back to its original.
+ * (the check that it is indeed a copy is in pfcopyback()).
+ */
+void 
+clupdate (void)
+{
+	/* x1 and x2 are just place holders for the call to breakout.
+	 */
+	register struct pfile *pfp;
+	register struct ltask *ltp;
+	char	*x1, *pk, *t, *x2;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, e_geonearg, "update");
+
+	pushbparams (pfp->pf_pp);
+	while (n--) {
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get ltask			*/
+	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
+	    ltp = ltasksrch (pk, t);
+	    if (!(ltp->lt_flags & LT_PFILE))
+		cl_error (E_UERR, e_nopfile, ltp->lt_lname);
+	    if ((pfp = pfilefind (ltp)) == NULL)
+		cl_error (E_UERR, "pfile not loaded for `%s'",
+		    ltp->lt_lname);
+	    pfcopyback (pfp);		/* IT checks whether pfp is a copy */
+	    pfileupdate (pfp);
+	}
+}
+
+/* HIDETASK ltask [, ltask...]
+ * Set the flags for this task to LT_INVIS so that it does not
+ * become an active part of the users environment.  This function does
+ * not require the underscore to hide the task.
+ */
+void 
+clhidetask (void)
+{
+	/* x1 and x2 are just place holders for the call to breakout.
+	 */
+	register struct pfile *pfp;
+	register struct ltask *ltp;
+	char	*x1, *pk, *t, *x2;
+	struct	operand o;
+	int	n;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) < 1)
+	    cl_error (E_UERR, e_geonearg, "hidetask");
+
+	pushbparams (pfp->pf_pp);
+	while (n--) {
+	    popop();			/* discard fake name.		*/
+	    opcast (OT_STRING);
+	    o = popop();		/* get ltask			*/
+	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
+	    ltp = ltasksrch (pk, t);
+	    ltp->lt_flags |= LT_INVIS;
+	}
+}
+
+
+/* WAIT -- Wait for a job or jobs to terminate.  The default is to wait for
+ * all jobs.
+ */
+void 
+clwait (void)
+{
+	register struct pfile *pfp;
+	register int n, jn;
+	struct operand o;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0)
+	    jn = 0;
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+
+	if (n > 0) {
+	    while (n--) {
+		popop();		/* discard the $n name		*/
+	 	opcast (OT_INT);	/* insure we get an integer	*/
+		o = popop();		/* pop job number, as int	*/
+		jn = o.o_val.v_i;
+
+		bkg_wait (jn);
+	    }
+	} else
+	    bkg_wait (jn);
+}
+
+
+/* JOBS -- Show status of a job or jobs.  The default is to show the status
+ * of all jobs running or that have recently run.
+ */
+void 
+cljobs (void)
+{
+	register struct pfile *pfp;
+	register int n, jn;
+	struct operand o;
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) <= 0) {
+	    bkg_jobstatus (currentask->t_stdout, 0);
+	    return;
+	}
+
+	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
+	while (--n >= 0) {
+	    popop();			/* discard the $n name		*/
+	    opcast (OT_INT);		/* insure we get an integer	*/
+	    o = popop();		/* pop job number, as int	*/
+	    jn = o.o_val.v_i;
+
+	    bkg_jobstatus (currentask->t_stdout, jn);
+	}
+}
+
+
+/* CLFUNC -- Called when one of the dummy intrinsic functions entered in
+ * the language package (to prompt the user) is called as a task.
+ */
+void 
+clfunc (void)
+{
+	cl_error (E_UERR, "Function `%s' cannot be called as a task",
+	    currentask->t_ltp->lt_lname);
+}
+
+
+/* BEEP -- Beep the terminal.
+ */
+void 
+clbeep (void)
+{
+	putchar ('\007');
+}
+
+
+/* TIME -- Print the current time and date on the standard output.
+ */
+void 
+cltime (void)
+{
+	char	buf[SZ_LINE];
+
+	c_cnvtime (c_clktime(0L), buf, SZ_LINE);
+	oprintf ("%s\n", buf);
+}
+
+
+/* CLEAR -- Clear the terminal screen and home the cursor.  Uses the TTY
+ *  package (device independent terminal interface), which requires an entry
+ *  in the dev$termcap file for the terminal.  In addition to clearing the
+ *  screen, we also turn standout mode and raw mode off, just in case.
+ */
+void 
+clclear (void)
+{
+	XINT	tty, sout = STDOUT;
+
+	if ((tty = c_ttyodes ("terminal")) == ERR)
+	    c_erract (EA_ERROR);
+
+	c_ttyso (sout, tty, NO);
+	c_ttyclear (sout, tty);
+	c_ttycdes (tty);
+	c_fseti (sout, F_RAW, NO);
+}
+
+
+/* SLEEP -- Suspend execution for the specified number of seconds.
+ */
+void 
+clsleep (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+
+	pfp = newtask->t_pfp;
+	pushbparams (pfp->pf_pp);	/* push sofirst popped is first param */
+	if ( nargs (pfp) <= 0)
+	    return;
+	else {
+	    popop();			/* discard the $n name	*/
+	    opcast (OT_INT);
+	    o = popop();		/* get the number of seconds */
+	    c_tsleep (o.o_val.v_i);
+	}
+}
+
+
+/* EDIT -- Call up a host system editor to edit a file.  The name of the editor
+ * to be used is defined in the IRAF environment.  The command to be sent to
+ * the host system to run the editor is defined by an SPRINTF style format
+ * string in the EDCAP editor database.  The SPRINTF format is assumed to
+ * contain exactly one %s sequence to be replaced by the name of the file(s)
+ * to be edited.  If no %s sequence is present in the EDCAP entry, the
+ * host_editor() function will add one at the end so that the filenames are
+ * concatenated to the string in the EDCAP entry.
+ */
+void 
+cledit (void)
+{
+	register struct pfile *pfp;
+	char	oscmd[SZ_LINE], os_filelist[SZ_LINE];
+	char	osfn[SZ_PATHNAME];
+	struct	operand o;
+	char	*envget();
+	int	n;
+
+	pfp = newtask->t_pfp;
+
+	if ((n = nargs(pfp)) > 0) {
+	    pushbparams (pfp->pf_pp);
+
+	    /* Process the argument list into a list of files to be edited.
+	     */
+	    os_filelist[0] = EOS;
+	    while (--n >= 0) {
+		popop();		/* discard the $1 	*/
+		o = popop();
+		c_fmapfn (o.o_val.v_s, osfn, SZ_PATHNAME);
+		if (os_filelist[0] != EOS)
+		    strcat (os_filelist, " ");
+		strcat (os_filelist, osfn);
+	    }
+	}
+
+	/* Format the host editor command, and call the host system editor
+	 * to edit the file(s).
+	 */
+	sprintf (oscmd, host_editor (envget ("editor")), os_filelist);
+	c_oscmd (oscmd, "", "", "");
+}
+
+
+/* _ALLOCATE -- Allocate a device.  The parent process (i.e. the CL) allocates
+ * (or mounts, depending on the system) the device, rendering it ready for
+ * exclusive i/o by any subprocesses.  (Called from the allocate.cl and
+ * deallocate.cl scripts in the SYSTEM pkg.)
+ */
+void 
+clallocate (void)
+{
+	register struct pfile *pfp;
+	register int	n;
+	static char	noalloc[] = "cannot allocate device %s";
+	struct	operand o;
+	char	device[SZ_FNAME+1];
+	char	owner[SZ_FNAME+1];
+
+	pfp = newtask->t_pfp;
+	if ((n = nargs (pfp)) == 0)
+	    return;
+
+	pushbparams (pfp->pf_pp);
+	popop();			/* throw $1 away	*/
+	opcast (OT_STRING);		/* param 1 == device	*/
+	o = popop();
+	strcpy (device, o.o_val.v_s);
+
+	/* Verify that the device can be allocated.
+	 */
+	switch (c_devowner (device, owner, SZ_FNAME)) {
+	case DV_DEVFREE:
+	    break;			/* ok to allocate	*/
+	case DV_DEVALLOC:
+	    eprintf ("device %s is already allocated\n", device);
+	    return;			/* already allocated	*/
+	case DV_DEVINUSE:
+	    cl_error (E_UERR, "device %s is already allocated to %s\n",
+		device, owner);
+	default:
+	    cl_error (E_UERR, noalloc, device);
+	}
+
+	/* Allocate the device. */
+	if (c_allocate (device) == ERR)
+	    cl_error (E_UERR, noalloc, device);
+
+	/* Keep count and save names of allocated devices.
+	 */
+	for (n=0;  n < MAX_ALLOCDEV;  n++) {
+	    if (!allocdev[n].allocated)
+		continue;
+	    if (strcmp (allocdev[n].devname, device) == 0)
+		return;	/* device already in table */
+	}
+
+	/* Find empty slot */
+	for (n=0;  n < MAX_ALLOCDEV && allocdev[n].allocated;  n++)
+	    ;
+	if (n >= MAX_ALLOCDEV)
+	    cl_error (E_UERR, "too many allocated devices");
+
+	/* Save name of device */
+	strncpy (allocdev[n].devname, device, SZ_DEVNAME);
+	allocdev[n].devname[SZ_DEVNAME] = EOS;
+	allocdev[n].allocated = 1;
+	nallocdev++;
+}
+
+
+/* _DEALLOCATE -- Deallocate a device.
+ */
+void 
+cldeallocate (void)
+{
+	register struct pfile *pfp;
+	register int	n;
+	static char	nodealloc[] = "cannot deallocate device %s";
+	struct	operand o;
+	char	device[SZ_FNAME+1];
+	char	owner[SZ_FNAME+1];
+	int	rewind=0, n_args;
+
+	pfp = newtask->t_pfp;
+	if ((n_args = nargs (pfp)) <= 0)
+	    return;
+
+	pushbparams (pfp->pf_pp); 	/* params in correct order	*/
+	popop();			/* throw $1 away		*/
+	opcast (OT_STRING);		/* param 1 == device name	*/
+	o = popop();
+	strcpy (device, o.o_val.v_s);
+
+	if (n_args > 1) {
+	    popop();			/* throw $2 away		*/
+	    opcast (OT_BOOL);		/* param 2 == rewind flag	*/
+	    o = popop();
+	    rewind = o.o_val.v_i;
+	}
+
+	/* Verify that the device can be deallocated.
+	 */
+	switch (c_devowner (device, owner, SZ_FNAME)) {
+	case DV_DEVFREE:
+	    eprintf ("device %s is not allocated\n", device);
+	    return;
+	case DV_DEVALLOC:
+	    break;			/* ok to deallocate	*/
+	case DV_DEVINUSE:
+	    cl_error (E_UERR, "device %s is currently allocated to %s\n",
+		device, owner);
+	default:
+	    cl_error (E_UERR, nodealloc, device);
+	}
+
+	/* Deallocate the device. */
+	if (c_deallocate (device, rewind) == ERR)
+	    cl_error (E_UERR, nodealloc, device);
+
+	/* Keep count and save names of allocated devices.
+	 */
+	for (n=0;  n < MAX_ALLOCDEV;  n++) {
+	    if (!allocdev[n].allocated)
+		continue;
+	    if (strcmp (allocdev[n].devname, device) == 0) {
+		allocdev[n].allocated = 0;
+		--nallocdev;
+		break;
+	    }
+	}
+}
+
+
+/* _DEVSTATUS -- Print the status of an allocatable device on the standard
+ * output.
+ */
+void 
+cldevstatus (void)
+{
+	register struct pfile *pfp;
+	struct	operand o;
+	char	device[SZ_FNAME+1];
+
+	pfp = newtask->t_pfp;
+	if (nargs (pfp) <= 0)
+	    return;
+
+	pushbparams (pfp->pf_pp); 	/* params in correct order	*/
+	popop();			/* throw $1 away		*/
+	opcast (OT_STRING);		/* param 1 == device name	*/
+	o = popop();
+	strcpy (device, o.o_val.v_s);
+
+	/* Print the device status.  */
+	c_devstatus (device, STDOUT);
+}
+
+
+/* XERROR -- Runtime error recovery opcode procedures.
+ */
+
+void 
+clerrpsh (void)
+{
+        extern int do_error;
+	extern ErrCom errcom;
+
+        do_error = NO;
+	errcom.nhandlers++;
+	errcom.errflag = OK;
+	if (cldebug)
+	    eprintf ("in cl_errpush: do_error = %d\n", do_error);
+}
+
+
+void 
+clerreset (void)
+{
+	extern ErrCom errcom;
+
+        do_error = NO;
+	errcom.errflag = OK;
+	errcom.nhandlers = 0;
+	if (cldebug)
+	    eprintf ("in cl_erreset: do_error = %d\n", do_error);
+}
+
+
+/* CLONERROR -- Post an error handler to be called each time an error
+ * is found.  
+ *
+ * NOTE: The handler posting is implemented but the call from the error
+ * recovery itself is not due to complexities in establishing the context.
+ * We will leave this in for now but it is effectively a no-op  (5/25/05)
+ *
+ */
+void 
+clonerror (void)
+{
+	struct	operand o;
+	struct  pfile *pfp = newtask->t_pfp;
+	struct  ltask *ltp;
+	struct	package	*pkp;
+	static  char handler[SZ_FNAME+1];
+	extern  char *onerr_handler;
+
+
+	handler[0] = NULL;
+	pushbparams (pfp->pf_pp);
+	if (nargs(pfp) > 0) {
+	    popop();			/* discard the $n name		*/
+	    o = popop();		/* get the handler arg name	*/
+	    strcpy (handler, o.o_val.v_s);
+
+	    /* Search all packages for the named task. _ltasksrch() does not 
+	     * call error() and so can be used to check cleanly whether the
+	     * task exists.
+             */
+	    if (handler[0] && (ltp = _ltasksrch ("", handler, &pkp)) == NULL) {
+	        onerr_handler = NULL;
+		cl_error (E_UERR, "onerr handler '%s' not found", handler);
+
+	    } else {
+	        onerr_handler = (handler[0] ? handler : NULL);
+
+	        if (cldebug) {
+	          if (onerr_handler)
+		    eprintf ("onerror: posting handler '%s'\n", onerr_handler);
+	          else
+		    eprintf ("onerror: clearing onerr handler\n");
+	        }
+	    }
+	}
+}
+
+
+
+/* ========================================================
+ *
+ * End of builtin functions.
+ * What follows is their support code.
+ *
+ * ========================================================*/
+
+/* SETBUILTINS -- Add the builtin functions to package at pkp (this should
+ * always just be clpackage).  To add more functions, write the support function
+ * and enter it into the builtin table, btbl.  Reverse alpha due to lifo nature
+ * of list.  Aliases can be made easily with multiple b_names using the same
+ * b_f.  Setting LT_INVIS will keep it from being seen in the menu.
+ */
+void 
+setbuiltins (register struct package *pkp)
+{
+	/* Debugging functions are in debug.c.
+	 */
+	extern void d_f(), d_l(), d_d(), d_off(), d_on(), d_p(), d_t();
+	extern void d_asmark(), d_assemble(), d_prof(), d_trace();
+	extern void pr_listcache();
+
+	static struct builtin {
+		char	*b_name;
+		void	(*b_f)();
+		int	b_flags;
+	} btbl[] = {
+	  { "d_asmark", d_asmark, LT_INVIS},	/* mark assembler stack pos  */
+	  { "d_assemble", d_assemble, LT_INVIS},/* "assemble" a CL script    */
+	  { "d_f",      d_f,    LT_INVIS},/* shows available file descr	     */
+	  { "d_l",      d_l,    LT_INVIS},/* shows define  ltasks	     */
+	  { "d_m",      d_d,    LT_INVIS},/* shows memory usage		     */
+	  { "d_off",    d_off,  LT_INVIS},/* disable debugging msgs	     */
+	  { "d_on",     d_on,   LT_INVIS},/* enable debugging msgs	     */
+	  { "d_p",      d_p,    LT_INVIS},/* show loaded param files	     */
+	  { "d_t",      d_t,    LT_INVIS},/* show running tasks		     */
+	  { "d_trace",  dotrace,LT_INVIS},/* instruction tracing toggle	     */
+	  { "d_prof",   d_prof, LT_INVIS},/* script execution profiling	     */
+
+	  { "prcache",  clprcache, 0},	  /* show process cache		 */
+	  { "?",        clhelp, LT_INVIS},/* tasks in current package	 */
+	  { "??",       clallhelp, LT_INVIS},/* all tasks in all packs	 */
+	  { "wait",     clwait,    0},	  /* wait for all bkg jobs	 */
+	  { "jobs",     cljobs,    0},	  /* show status of bkg jobs	 */
+	  { "unlearn",  clunlearn, 0},	  /* unlearn params 		 */
+	  { "update",   clupdate,  0},	  /* write out a changed pfile	 */
+	  { "hidetask", clhidetask,0},    /* make these tasks invisible  */
+	  { "task",     clntask,   0},	  /* define new ltask/ptask	 */
+	  { "set",      clset,     0},	  /* make environ table entry	 */
+	  { "reset",    clreset,   0},	  /* reset value of envvar	 */
+	  { "show",     clshow,    0},	  /* show value of environ var	 */
+	  { "stty",     clstty,    0},	  /* set terminal driver options */
+	  { "redefine", clrtask,   0},	  /* redfine ltasl/ptask	 */
+	  { "package",  clpack,    0},	  /* define new package		 */
+	  { "_curpack", clcurpack,
+		LT_INVIS},		  /* name the current package	 */
+	  { "print",    clprint,   0},	  /* formatted output to stdout	 */
+	  { "printf",   clprintf,  0},	  /* formatted output to stdout	 */
+	  { "fprint",   clfprint,  0},	  /* formatted output		 */
+	  { "putlog",   clputlog,  0}, 	  /* put a message to the logfile  */
+	  { "dparam",   cldparam,  0},	  /* dump params for tasks	 */
+	  { "lparam",   cllparam,  0},	  /* list params for tasks	 */
+	  { "eparam",   cleparam,  0},	  /* edit params for tasks	 */
+	  { "ehistory", clehistory, 0},	  /* edit command history	 */
+	  { "history",  clhistory, 0},	  /* print command history	 */
+	  { "service",  clservice, 0},	  /* respond to bkg query	 */
+	  { "kill",     clkill,    0},	  /* kill a background job	 */
+	  { "keep",     clkeep,    0},	  /* keep new defn's after bye	 */
+	  { "error",    clerror,   0},	  /* error msg from child	 */
+	  { ROOTPACKAGE, lapkg,
+	    	LT_INVIS|LT_DEFPCK},	  /* fake task for language.	 */
+	  { CLPACKAGE,  clpkg,
+		LT_INVIS|LT_DEFPCK},	  /* fake task for clpackage.	 */
+	  { "chdir",    clchdir,   0},	  /* change directory		 */
+	  { "cd",       clchdir,   0},	  /* change directory		 */
+	  { "back",     clback,    0},	  /* change to previous dir      */
+	  { "flprcache",clflprcache, 0},  /* flush the process cache	 */
+	  { "gflush",   clgflush,  0},	  /* flush graphics output	 */
+	  { "cache",    clcache,   0},	  /* pre-load a tasks pfile	 */
+	  { "which",    clwhich,   0},	  /* locate named task		 */
+	  { "whereis",  clwhereis, 0},	  /* locate instances of task	 */
+	  { "clbye",    clclbye, 	  /* cl() with EOF		 */
+		LT_CL|LT_CLEOF},
+	  { "bye",      clbye,     0},	  /* restore previous state	 */
+	  { "logout",   cllogout,  0},	  /* log out of the CL		 */
+
+	  { "scan",     clscans, 0},	  /* scan from a pipe		 */
+	  { "scanf",    clscanf, 0},	  /* formatted scan 		 */
+	  { "fscan",    clfunc,  0},	  /* intrinsic function entries	 */
+	  { "defpac",   clfunc,  0},	  /* 		"		 */
+	  { "defpar",   clfunc,  0},	  /* 		"		 */
+	  { "defvar",   clfunc,  0},	  /* 		"		 */
+	  { "deftask",  clfunc,  0},	  /* 		"		 */
+	  { "access",   clfunc,  0},	  /* 		"		 */
+	  { "imaccess", clfunc,  0},	  /* 		"		 */
+	  { "mktemp",   clfunc,  0},	  /* 		"		 */
+	  { "envget",   clfunc,  0},	  /* 		"		 */
+	  { "radix",    clfunc,  0},	  /* 		"		 */
+	  { "osfn",     clfunc,  0},	  /* 		"		 */
+	  { "beep",     clbeep,  0},	  /* beep the terminal		 */
+	  { "time",     cltime,  0},	  /* show the current time	 */
+	  { "clear",    clclear, 0},	  /* clear the terminal screen	 */
+	  { "edit",     cledit,  0},	  /* edit a file or files        */
+	  { "sleep",    clsleep, 0},	  /* suspend process execution	 */
+
+	  { "_allocate",   clallocate,   LT_INVIS},
+	  { "_deallocate", cldeallocate, LT_INVIS},
+	  { "_devstatus",  cldevstatus,  LT_INVIS},
+
+	  { "_errpsh",  clerrpsh,  LT_INVIS},	/* push error handler	   */
+	  { "_erreset", clerreset, LT_INVIS},	/* reset error handler	   */
+	  { "onerror",  clonerror, 0},		/* post user error handler */
+
+	  { "samp",         cl_Samp,      0},   /* SAMP master command 	   */
+
+	  { "samp_trace",   clfunc,       0},   /* SAMP tracing toggle	   */
+	  { "sampStatus",   clfunc,       0},   /* print/set status	   */
+	  { "sampHandler",  clfunc,       0},   /* add a SAMP handler	   */
+	  { "sampHubAccess",clfunc,       0},   /* is Hub running          */
+	  { "sampAccess",   clfunc,       0},   /* is app running          */
+	  { "sampMetadata", clfunc,       0},   /* declare app metadata    */
+	};
+
+	register struct builtin *bp;
+
+	for (bp = btbl; bp < &btbl[sizeof(btbl)/sizeof(struct builtin)]; bp++)
+	    newbuiltin (pkp, bp->b_name, bp->b_f, bp->b_flags, "", 0);
+}
+
+
+/* NEWBUILTIN -- Make a new ltask off pkp that will serve as a cl directive
+ * builtin function.  Link in exactly the same fashion as newltask() but use
+ * lt_f rather than lt_pname.  See paramsrch().  FP is a pointer to the function
+ * that will perform the directive.  Flags is to be or'd in with lt_flags in
+ * the new ltask.  Call error if no more core.
+ */
+void 
+newbuiltin (
+    struct package *pkp,		/* package which owns task	*/
+    char *lname,			/* ltask name			*/
+    void (*fp)(void),		/* pointer to builtin fcn	*/
+    int flags,			/* task flags			*/
+    char *ftprefix,		/* OSCMD prefix if foreign	*/
+    int redef			/* permit redefinitions		*/
+)
+{
+	register struct ltask *newltp;
+
+	newltp = addltask (pkp, NULL, lname, redef);
+
+	/* If no OSCMD prefix string is given use the logical task name,
+	 * which must therefore be the same as the host task name.
+	 */
+	if (*ftprefix)
+	    newltp->lt_ftprefix = comdstr (ftprefix);
+	else
+	    newltp->lt_ftprefix = newltp->lt_lname;
+
+	newltp->lt_f = fp;
+	newltp->lt_flags = (flags | LT_BUILTIN);
+}
+
+
+/* MKARGLIST -- Reconstruct the argument list of a task as an array of arg
+ * pointers to arg strings of the form "expr" or "keyword=value".  Upon
+ * output, argp[0] contains the task name and the function value is the
+ * number of arguments, excluding argp[0].
+ */
+int 
+mkarglist (
+    register struct pfile *pfp,	/* pfile pointer		*/
+    char *args,			/* string buffer for arg chars	*/
+    char *argp[]		/* array of arg pointers	*/
+)
+{
+	register char	*ip, *op;
+	struct	operand o_v, o_n;
+	int	argc, n;
+
+
+	/* Construct an array of pointers to the argument strings.  argp[1] is
+	 * the first argument; argp[0] is the task name.
+	 */
+	if ((argc = nargs(pfp)) > 0) {
+	    pushbparams (pfp->pf_pp);
+	    op = args;
+
+	    argp[0] = newtask->t_ltp->lt_lname;
+
+	    for (n=1;  n <= argc;  n++) {
+		argp[n] = op;
+
+		/* Get the parameter name.  If this is $N then we have a
+		 * positional argument, otherwise we have a keyword=value
+		 * argument, and the arg should be encoded in that form.
+		 */
+		o_n = popop();
+		ip = o_n.o_val.v_s;
+		if (*ip != '$') {
+		    while ( (*op = *ip++) )
+			op++;
+		    *op++ = '=';
+		}
+
+		/* Get the parameter value. */
+		opcast (OT_STRING);
+		o_v = popop();
+		ip = opindef(&o_v) ? "INDEF" : o_v.o_val.v_s;
+		while (ip && (*op++ = *ip++))
+		    ;
+	    }
+
+	    argp[n] = NULL;
+	}
+
+	return (argc);
+}
+
+
+/* PUSHFPARAMS -- Push the parameter list starting with pp forwards, that is,
+ * push the pp first and work towards the last parameter.  Push two operands
+ * per parameter: first the value, then the name.  Used when the parameters for
+ * a builtin will be accessed right-to-left.
+ */
+void 
+pushfparams (register struct param *pp)
+{
+	struct operand onam;
+
+	onam.o_type = OT_STRING;
+	for (;  pp;  pp = pp->p_np) {
+	    paramget (pp, 'V');
+	    onam.o_val.v_s = pp->p_name;
+	    pushop (&onam);
+	}
+}
+
+
+/* PUSHBPARAMS -- Push the parameter list starting with pp backwards, that is,
+ * push the last param in the list first and work back up to pp.  Push two
+ * operands per parameter: first the value, then the name.  Used when the
+ * parameters for a builtin will be accessed left-to-right.
+ */
+void 
+pushbparams (struct param *pp)
+{
+	struct operand onam;
+	struct param *npp;
+
+	if (pp == NULL)
+	    return;		/* just a guard	*/
+	npp = pp->p_np;
+	if (npp != NULL)
+	    pushbparams (npp);
+
+	paramget (pp, 'V');
+	onam.o_type = OT_STRING;
+	onam.o_val.v_s = pp->p_name;
+	pushop (&onam);
+}
+
+
+/* PUSHBPVALS -- Like pushbparams, but only the parameter value is pushed.
+ */
+void 
+pushbpvals (struct param *pp)
+{
+	struct param *npp;
+
+
+	if (pp == NULL)
+	    return;		/* just a guard	*/
+	npp = pp->p_np;
+	if (npp != NULL)
+	    pushbpvals (npp);
+
+	paramget (pp, 'V');
+}
+
+
+/* NARGS -- Count the number of parameters in a parameter list, and hence
+ * the number of command line arguments to a builtin.
+ */
+int 
+nargs (struct pfile *pfp)
+{
+	struct	param	*pp;
+	int	n;
+
+	for (pp=pfp->pf_pp, n=0;  pp != NULL;  pp=pp->p_np)
+	    n++;
+
+	return (n);
+}
+
+
+/* KEEP -- Preserve additions to the dictionary and environment when the
+ * referenced task terminates.
+ */
+void 
+keep (register struct task *tp)
+{
+	if (cldebug) {
+	    eprintf ("currentask: %d, prevtask: %d\n",currentask,prevtask);
+	    eprintf ("keep(): tp: %d\n",tp);
+	}
+	tp->t_topd = topd;
+	c_envmark (&tp->t_envp);
+}
diff --git a/pkg/vocl/builtin_vo.c b/pkg/vocl/builtin_vo.c
new file mode 100644
index 00000000..4cb4dd29
--- /dev/null
+++ b/pkg/vocl/builtin_vo.c
@@ -0,0 +1,194 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_fset
+#define import_error
+#define import_ctype
+#define import_stdio
+#define import_alloc
+#define import_ttset
+#define import_prstat
+#define import_xwhen
+#include <iraf.h>
+
+/*
+*/
+#include "config.h"
+#include "clmodes.h"
+#include "mem.h"
+#include "operand.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+
+
+/*
+ * BUILTIN_VO -- This file contains the functions that perform the built-in
+ *   VO-related commands of the cl, such as coneCaller(), getRegistry(), etc.
+ *
+ * SetVOBuiltins() contains a table of functions and their user names; add
+ *   to this table when adding new builtin functions.
+ *
+ * See builtins.c for addition notes and details.
+ */
+
+extern	int   cldebug, cltrace;		/* debug/trace flags		     */
+extern	int   lastjobno;		/* last background job spawned	     */
+extern	int   gologout;			/* flag to execute() to cause logout */
+extern  int   logout_status;      	/* optional arg to logout()          */
+extern  int   errorline;		/* error recover line		     */
+extern  int   currentline;		/* line currently being executed     */
+extern	char *findexe();
+
+extern	int do_error;			/* for error recovery/trapping 	     */
+
+
+extern int	VOClient_initialized;
+
+typedef int (*PFI)();
+
+static PFI	old_onipc;		/* X_IPC handler		     */
+int		voc_onipc();
+
+
+/* CL_VOCINIT --  Initialize the VO Client interface.
+ */
+void
+cl_vocinit (void)
+{
+    register struct pfile *pfp;
+    struct  operand o;
+    int     n, status;
+
+    if (VOClient_initialized == 0) {
+
+	c_xwhen (X_IPC, voc_onipc, &old_onipc);
+
+        pfp = newtask->t_pfp;
+        if ((n = nargs (pfp)) > 1) {
+            cl_error (E_UERR, e_posargs, "vocinit");
+	    return;
+
+        } else if (n < 1) {
+            status = voc_initVOClient (envget("vo_runid"));
+
+	} else {
+            pushbparams (pfp->pf_pp);
+            popop();                    /* discard fake name.           */
+            opcast (OT_STRING);
+            o = popop();                /* get ltask                    */
+
+            status = voc_initVOClient (o.o_val.v_s);
+        }
+
+	if (status) {
+            cl_error (E_UERR, "Can't init VOClient", "vocinit");
+	} else
+	    VOClient_initialized = 1;
+    }
+}
+
+
+/* CL_VOCSTOP --  Stop the VO Client interface.
+ */
+void
+cl_vocstop (void)
+{
+    register struct pfile *pfp;
+    struct  operand o;
+    int     n, status;
+
+    if (VOClient_initialized == 1) {
+	c_xwhen (X_IPC, old_onipc, &old_onipc);
+
+        pfp = newtask->t_pfp;
+        if ((n = nargs (pfp)) > 1) {
+            cl_error (E_UERR, e_posargs, "vocstop");
+	    return;
+
+        } else if (n < 1) {
+            voc_closeVOClient (1);
+
+	} else {
+            pushbparams (pfp->pf_pp);
+            popop();                    /* discard fake name.           */
+            opcast (OT_INT);
+            o = popop();                /* get ltask                    */
+            voc_closeVOClient (o.o_val.v_i);
+	}
+	VOClient_initialized = 0;
+    }
+}
+
+
+/* CL_VOCRESET --  Restart the VO Client interface.
+ */
+void
+cl_vocreset ()
+{
+    int status;
+
+    voc_closeVOClient (1);
+    status = voc_initVOClient (envget("vo_runid"));
+}
+
+
+/* ========================================================
+ *
+ * End of builtin functions.
+ * What follows is their support code.
+ *
+ * ========================================================*/
+
+
+/* VO_SETBUILTINS -- Add the builtin functions to package at pkp (this should
+ * always just be clpackage).  To add more functions, write the support function
+ * and enter it into the builtin table, btbl.  Reverse alpha due to lifo nature
+ * of list.  Aliases can be made easily with multiple b_names using the same
+ * b_f.  Setting LT_INVIS will keep it from being seen in the menu.
+ */
+void
+vo_setbuiltins (
+    struct package *pkp
+)
+{
+    static struct builtin {
+    	char	*b_name;
+    	void	(*b_f)();
+    	int	b_flags;
+    } btbl[] = {
+        { "vocinit",  cl_vocinit,  0}, /* initialize the VO Client	*/
+        { "vocstop",  cl_vocstop,  0}, /* stop the VO Client	*/
+        { "vocreset", cl_vocreset, 0}, /* reset the VO Client	*/
+        NULL
+    };
+
+    register struct builtin *bp;
+
+    for (bp = btbl; bp < &btbl[sizeof(btbl)/sizeof(struct builtin)]; bp++)
+        newbuiltin (pkp, bp->b_name, bp->b_f, bp->b_flags, "", 0);
+}
+
+
+/* VOC_ONIPC -- Call this when get a signal that indicates a write to an IPC
+ * channel with no reader.  We are called after the system X_IPC handler
+ * has been called to cleanup the internal process tables and file system,
+ * disabling any further output to the process.
+ */         
+/* ARGSUSED */
+int
+voc_onipc (
+    int   *vex,                   /* virtual exception code       */
+    PFI   *next_handler           /* next handler to be called    */
+)
+{       
+    VOClient_initialized = 0;
+    cl_vocreset();
+    cl_error (E_UERR, "Abnormal termination of %s, resetting\n",
+	"VOClientd");
+
+    return (0);
+}           
diff --git a/pkg/vocl/cl.csh b/pkg/vocl/cl.csh
new file mode 100755
index 00000000..7a324d19
--- /dev/null
+++ b/pkg/vocl/cl.csh
@@ -0,0 +1,157 @@
+#!/bin/csh -f
+#
+# CL.CSH -- Startup the version of the CL executable compiled for the
+# architecture or floating point hardware appropriate for the current
+# machine.  This script can be used to invoke a number of CL flavors 
+# depending on how it is called.  The install script will create a 'cl'
+# and 'ecl' command link to this script with the intent that a different
+# binary would be started for each command.  
+
+
+# Determine CL binary to run based on how we were called.
+
+set cl_binary		= "cl.e"
+
+if (`echo $0 | egrep ecl` != "") then
+    set cl_binary	= "ecl.e"
+else if ($#argv > 0) then
+    if ("$argv[1]" == "-ecl" || "$argv[1]" == "-e") then
+        set cl_binary	= "ecl.e"
+    endif
+else if ($#argv > 0) then
+    if ("$argv[1]" == "-old" || "$argv[1]" == "-o") then
+        set cl_binary	= "cl.e"
+    endif
+endif
+
+
+# Determine IRAF root directory (value set in install script).
+set d_iraf = "/iraf/iraf/"
+if ($?iraf) then
+    if (! -e $iraf) then
+        echo "Warning: iraf=$iraf does not exist (check .cshrc or .login)"
+        echo "Session will default to iraf=$d_iraf"
+        unsetenv iraf ; sleep 3
+    endif
+endif
+if ($?iraf == 0) then
+    setenv iraf "$d_iraf"
+endif
+
+# Determine platform architecture.
+if ($?IRAFARCH) then
+    if (-e $iraf/bin.${IRAFARCH}/${cl_binary}) then
+	set MACH = $IRAFARCH
+    endif
+endif
+
+if (! $?MACH) then
+    if (-f /etc/redhat-release) then
+	if (`uname -m` == "ppc") then
+	    setenv mach linuxppc
+	else
+	    setenv mach redhat
+	endif
+    else if (-f /etc/SuSE-release) then
+	set mach = suse
+    else
+	set mach = `uname -s | tr '[A-Z]' '[a-z]'`
+    endif
+
+    if ($mach == "darwin") then
+	set mach = macosx
+    endif
+
+    if (-e $iraf/bin.$mach/$cl_binary) then
+	set MACH = $mach
+    else if (-e $iraf/bin.freebsd/$cl_binary) then
+	set MACH = freebsd
+    else if (-e $iraf/bin.macosx/$cl_binary) then
+	set MACH = macosx
+    else if (-e $iraf/bin.linux/$cl_binary) then
+	set MACH = linux
+    else if (-e $iraf/bin.redhat/$cl_binary) then
+	set MACH = redhat
+    else if (-e $iraf/bin.suse/$cl_binary) then
+	set MACH = suse
+    else if (-e $iraf/bin.linuxppc/$cl_binary) then
+	set MACH = linuxppc
+    else if (-e $iraf/bin.sunos/$cl_binary) then
+	set MACH = sunos
+    else if (-e $iraf/bin.linuz/$cl_binary) then
+	set MACH = linuz
+    else
+	echo "cannot find $iraf/bin.xxx/$cl_binary!"
+	exit 1
+    endif
+endif
+
+# Check for obsolete IRAFBIN definition.
+if ($?IRAFBIN && !($?IRAFARCH)) then
+    echo "Use IRAFARCH rather than IRAFBIN to specify the machine architecture"
+    echo "IRAFARCH, if defined, should be one of ffpa,f68881,i386,sparc, etc."
+endif
+
+# Just run the CL if IRAFARCH already defined.
+if ($?IRAFARCH) then
+    if ($IRAFARCH == "") then
+	setenv arch ""
+    else
+	setenv arch ".$IRAFARCH"
+    endif
+
+    # Recent linux systems display a problem in how pointer addresses 
+    # interact with the stack and can result in a segfault.  Remove the
+    # stacksize limit for IRAF processes until this is better understood.
+    if ("$IRAFARCH" == "redhat" || \
+        "$IRAFARCH" == "linux" || \
+        "$IRAFARCH" == "linuxppc" || \
+        "$IRAFARCH" == "suse") then
+	    limit stacksize unlimited
+    endif
+
+    setenv IRAFBIN ${iraf}bin$arch/
+    set file = ${IRAFBIN}$cl_binary
+    if (-e $file) then
+	exec $file
+    else
+	echo "$file not found"
+    endif
+endif
+
+
+# Determine the architecture to be used.
+if ("$MACH" == "freebsd") then
+    setenv IRAFARCH "freebsd"
+else if ("$MACH" == "linux") then
+    setenv IRAFARCH "linux"
+else if ("$MACH" == "redhat") then
+    setenv IRAFARCH "redhat"
+else if ("$MACH" == "suse") then
+    setenv IRAFARCH "suse"
+else if ("$MACH" == "linuxppc") then
+    setenv IRAFARCH "linuxppc"
+else if ("$MACH" == "macosx") then
+    setenv IRAFARCH "macosx"
+else if ("$MACH" == "sunos") then
+    setenv IRAFARCH "sunos"
+else if ("$MACH" == "linuz") then
+    setenv IRAFARCH "linuz"
+endif
+
+# Recent linux systems display a problem in how pointer addresses 
+# interact with the stack and can result in a segfault.  Remove the
+# stacksize limit for IRAF processes until this is better understood.
+if ("$IRAFARCH" == "redhat" || \
+    "$IRAFARCH" == "linux" || \
+    "$IRAFARCH" == "linuxppc" || \
+    "$IRAFARCH" == "suse") then
+	limit stacksize unlimited
+endif
+
+setenv arch .$IRAFARCH
+setenv IRAFBIN ${iraf}bin$arch/
+set file = ${IRAFBIN}$cl_binary
+
+# Run the desired CL.
+exec $file
diff --git a/pkg/vocl/cl.csh.SSOL b/pkg/vocl/cl.csh.SSOL
new file mode 100755
index 00000000..cf898de9
--- /dev/null
+++ b/pkg/vocl/cl.csh.SSOL
@@ -0,0 +1,94 @@
+#! /bin/csh
+# CL.CSH -- Startup the version of the CL executable compiled for the
+# architecture or floating point hardware appropriate for the current
+# machine.
+
+#set	echo
+
+# Determine platform architecture.
+setenv OSVERSION `uname -r | cut -c1`
+if ($OSVERSION == 5) then
+    set MACH = `uname -p`
+    switch ($MACH)
+    case sparc:
+	set MACH = ssol
+	breaksw
+    endsw
+else
+    set MACH = `mach`
+endif
+
+
+# Determine CL binary to run based on how we were called.
+
+set cl_binary           = "cl.e"
+
+if (`echo $0 | egrep ecl` != "") then
+    set cl_binary       = "ecl.e"
+else if ($#argv > 0) then
+    if ("$argv[1]" == "-ecl" || "$argv[1]" == "-e") then
+	set cl_binary   = "ecl.e"
+    endif
+else if ($#argv > 0) then
+    if ("$argv[1]" == "-old" || "$argv[1]" == "-o") then
+	set cl_binary   = "cl.e"
+    endif
+endif
+
+
+
+# Determine IRAF root directory (value set in install script).
+set d_iraf = "/iraf/iraf/"
+if ($?iraf) then
+    if (! -e $iraf) then
+        echo "Warning: iraf=$iraf does not exist (check .cshrc or .login)"
+        echo "Session will default to iraf=$d_iraf"
+        unsetenv iraf ; sleep 3
+    endif
+endif
+if ($?iraf == 0) then
+    setenv iraf "$d_iraf"
+endif
+
+# Check for obsolete IRAFBIN definition.
+if ($?IRAFBIN && !($?IRAFARCH)) then
+    echo "Use IRAFARCH rather than IRAFBIN to specify the machine architecture"
+    echo "IRAFARCH, if defined, should be one of ffpa,f68881,i386,sparc, etc."
+endif
+
+# Just run the CL if IRAFARCH already defined.
+if ($?IRAFARCH) then
+    if ($IRAFARCH == "") then
+	setenv arch ""
+    else
+	setenv arch ".$IRAFARCH"
+    endif
+
+    setenv IRAFBIN ${iraf}bin$arch/
+    set file = ${IRAFBIN}$cl_binary
+    if (-e $file) then
+	exec $file
+    else
+	echo "$file not found"
+    endif
+endif
+
+# Determine the architecture to be used.
+if ("$MACH" == "ssol") then
+    setenv IRAFARCH "ssun"
+else if ("$MACH" == "sparc") then
+    setenv IRAFARCH "sparc"
+else if ("$MACH" == "i386") then
+    setenv IRAFARCH "i386"
+else if (-e /dev/fpa && -e ${iraf}bin.ffpa/cl.e) then
+    setenv IRAFARCH "ffpa"
+else
+    setenv IRAFARCH "f68881"
+endif
+
+setenv arch .$IRAFARCH
+setenv IRAFBIN ${iraf}bin$arch/
+set file = ${IRAFBIN}$cl_binary
+
+# Run the desired CL.
+exec $file
diff --git a/pkg/vocl/cl.par b/pkg/vocl/cl.par
new file mode 100644
index 00000000..729ede38
--- /dev/null
+++ b/pkg/vocl/cl.par
@@ -0,0 +1,56 @@
+# Parameter file for the IRAF command language.  Defines all parameters
+# affecting the operation of the CL (mode etc.), the global cursor list
+# params, and some handy params of various data types:  string(s1,s2,s3);
+# integer(i,j,k);   real(x,y,z).
+
+# Variables effecting cl operation.
+args,s,h,,,,CL command line arguments
+gcur,*gcur,a,,,,Graphics cursor
+imcur,*imcur,a,,,,Image cursor
+ukey,*ukey,a,,,,Global user terminal keyboard keylist
+abbreviate,b,h,yes,,,Allow abbreviations in operand names?
+echo,b,h,no,,,Echo CL command input on stderr?
+ehinit,s,h,"nostandout eol noverify",,,Ehistory options string
+epinit,s,h,"standout showall",,,Eparam options string
+keeplog,b,h,no,,,Record all interactive commands in logfile?
+logfile,f,h,"home$logfile.cl",,,Name of the logfile
+logmode,s,h,"commands nobackground noerrors notrace",,,Logging control
+lexmodes,b,h,yes,,,Enable conversational mode
+menus,b,h,yes,,,Display menu when changing packages?
+showtype,b,h,no,,,Add task-type suffix in menus?
+notify,b,h,yes,,,Send done message when bkgrnd task finishes?
+szprcache,i,h,4,1,10,Size of the process cache
+version,s,h,"IRAF V2.16.1 Oct 2013",,IRAF version
+logver,s,h,"",,,login.cl version
+logregen,b,h,no,,,Updating of login.cl to current version is advised
+release,s,h,"2.16",,,IRAF release
+mode,s,h,ql,,,CL mode of execution (query or query+learn)
+
+auto,s,h,a,,,The next 4 params are read-only.
+query,s,h,q
+hidden,s,h,h
+learn,s,h,l
+menu,s,h,m
+
+# Misc scratch and temp variables.
+# Handy boolean variables for interactive use.
+b1,b,h,,,,b1
+b2,b,h,,,,b2
+b3,b,h,,,,b3
+# Handy integer variables for interactive use.
+i,i,h,,,,i
+j,i,h,,,,j
+k,i,h,,,,k
+# Handy real variables for interactive use.
+x,r,h,,,,x
+y,r,h,,,,y
+z,r,h,,,,z
+# Handy string variables for interactive use.
+s1,s,h,,,,s1
+s2,s,h,,,,s2
+s3,s,h,,,,s3
+# Handy parameter for reading lists (text files).
+list,*s,h,,,,list
+# Line buffer for list files.
+line,struct,h,,,,line
+...
diff --git a/pkg/vocl/clmodes.h b/pkg/vocl/clmodes.h
new file mode 100644
index 00000000..bbd2d4e9
--- /dev/null
+++ b/pkg/vocl/clmodes.h
@@ -0,0 +1,80 @@
+/*
+ * CLMODES.H -- Return a boolean result for the state of the various cl modes.
+ * Done by referring to the pointers declared in modes.c.
+ * The pointers are set up initially from the entry of the corresponding
+ *   parameter in the cl's pfile. see setclmodes() in modes.c.
+ *   abbreviations is hairy enough that is a real function in modes.c.
+ * A NULL pointer results in false, as does an undefined or indefinite value.
+ */
+
+extern struct param *clecho;
+#define	echocmds()	(clecho != NULL && \
+			    !(clecho->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    clecho->p_val.v_i)
+
+extern struct param *clnotify;
+#define	notify()	(clnotify != NULL && \
+			    !(clnotify->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    clnotify->p_val.v_i)
+
+extern struct param *clmenus;
+#define	menus()		(clmenus != NULL && \
+			    !(clmenus->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    clmenus->p_val.v_i)
+
+extern struct param *clshowtype;
+#define	showtype()	(clshowtype != NULL && \
+			    !(clshowtype->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    clshowtype->p_val.v_i)
+
+extern struct param *clkeeplog;
+#define	keeplog()	(clkeeplog != NULL && \
+			    !(clkeeplog->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    clkeeplog->p_val.v_i)
+
+extern struct param *cllexmodes;
+#define	lexmodes()	(cllexmodes != NULL && \
+			    !(cllexmodes->p_type & (OT_UNDEF|OT_INDEF)) && \
+			    cllexmodes->p_val.v_i)
+
+/* Return a pointer to the name of the logfile, or NULL if not defined.
+ */
+extern struct param *cllogfile;
+#define	logfile() \
+	((cllogfile == NULL || (cllogfile->p_type & (OT_UNDEF|OT_INDEF))) ? \
+	NULL : cllogfile->p_val.v_s)
+
+/* Flags and macros for logging control.
+ */
+extern int	cllogmode;		/* NOT a *(struct param), see modes.c */
+
+#define log_commands()		(cllogmode & LOG_COMMANDS)
+#define log_background() 	(cllogmode & LOG_BACKGROUND)
+#define log_errors() 		(cllogmode & LOG_ERRORS)
+#define log_trace() 		(cllogmode & LOG_TRACE)
+
+#define LOG_COMMANDS   0001
+#define LOG_BACKGROUND 0002
+#define LOG_ERRORS     0004
+#define LOG_TRACE      0010
+
+
+
+/* CL parameters for Eparam and Ehistory options.
+ */
+extern int 	ep_standout, 
+		ep_showall;
+extern int	eh_standout,
+		eh_verify, 
+		eh_bol,
+		eh_readline,
+		eh_longprompt;
+
+/* CL parameters for error recovery.
+ */
+extern int	err_abort,
+		err_beep,
+		err_trace,
+		err_full,
+		err_clear,
+		err_flpr;
diff --git a/pkg/vocl/clprintf.c b/pkg/vocl/clprintf.c
new file mode 100644
index 00000000..470a7f26
--- /dev/null
+++ b/pkg/vocl/clprintf.c
@@ -0,0 +1,205 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_stdarg
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+extern void u_doprnt ();
+
+
+/*
+ * CLPRINTF -- These are just printf's with various implied write files for
+ * convenience.  Also here are other assorted printing utilities.
+ */
+
+/* EPRINTF -- Printf that always writes to the current pseudo-file t_stderr.
+ */
+void
+eprintf (char *fmt, ...)
+{
+	va_list	args;
+	FILE *eout;
+
+	va_start (args, fmt);
+	eout = currentask->t_stderr;
+	u_doprnt (fmt, &args, eout);
+	va_end (args);
+	fflush (eout);
+}
+
+
+/* OPRINTF -- Printf that always writes to the current pseudo-file t_stdout.
+ */
+oprintf (char *fmt, ...)
+{
+	va_list	args;
+	FILE *sout;
+
+	va_start (args, fmt);
+	sout = currentask->t_stdout;
+	u_doprnt (fmt, &args, sout);
+	va_end (args);
+	fflush (sout);
+}
+
+
+/* TPRINTF -- Printf that always goes through the pipe out to the currently
+ * running task.  Be a bit more careful here in case a pipe is broken or
+ * something is going haywire.
+ */
+tprintf (char *fmt, ...)
+{
+	va_list	args;
+	FILE *out;
+
+	out = currentask->t_out;
+	if (out == NULL)
+	    cl_error (E_IERR, "no t_out for currentask `%s'",
+	    currentask->t_ltp->lt_lname);
+	else {
+	    va_start (args, fmt);
+	    u_doprnt (fmt, &args, out);
+	    va_end (args);
+	    fflush (out);
+	    if (ferror (out))
+		cl_error (E_UERR|E_P, "pipe write error to `%s'",
+		    currentask->t_ltp->lt_lname);
+	}
+}
+
+
+/* TWRITE -- Write a binary block of data to the current task.
+ *
+ * This function is currently not used by anyone.
+twrite (buf, nbytes)
+char	*buf;
+int	nbytes;
+{
+	FILE *out;
+
+	out = currentask->t_out;
+	if (out == NULL) {
+	    cl_error (E_IERR, "no t_out for currentask `%s'",
+		currentask->t_ltp->lt_lname);
+	} else if (nbytes > 0) {
+	    fwrite (buf, sizeof(*buf), nbytes, out);
+	    fflush (out);
+	    if (ferror (out))
+		cl_error (E_UERR|E_P, "pipe write error to `%s'",
+		    currentask->t_ltp->lt_lname);
+	}
+}
+*/
+
+
+/* PRPARAMVAL -- Print the value field of param pp on file fp.
+ * Give name of file if list, don't do anything if undefinded. 
+ * Do not include a trailing \n.
+ */
+int 
+prparamval (struct param *pp, FILE *fp)
+{
+	char	buf[SZ_LINE];
+
+	spparval (buf, pp);
+	fputs (buf, fp);
+}
+
+
+/* STRSORT -- Sort a list of pointers to strings.
+ */
+int 
+strsort (
+    char *list[],		/* array of string pointers */
+    int nstr			/* number of strings */
+)
+{
+	extern	qstrcmp();
+
+	qsort ((char *)list, nstr, sizeof(char *), qstrcmp);
+}
+
+
+/* QSTRCMP -- String comparison routine (strcmp interface) for STRSRT.
+ */
+int 
+qstrcmp (char *a, char *b)
+{
+	return (strcmp (*(char **)a, *(char **)b));
+}
+
+
+/* STRTABLE -- Given a list of pointers to strings as input, format and print
+ * the strings in the form of a nice table on the named output file.  Adjust
+ * the number of columns to fill the page (64 cols) as nearly as possible,
+ * with at least two spaces between strings.  Excessively long strings
+ * are truncated (adapted from "fmtio/strtbl.x").
+ */
+int 
+strtable (
+    FILE *fp,			/* output file */
+    char *list[],		/* array of string pointers */
+    int nstr,			/* number of strings */
+    int first_col,
+    int last_col,	/* where to place table on a line */
+    int maxch,			/* maximum chars to print from a string */
+    int ncol			/* desired # of columns (0 to autoscale) */
+)
+{
+	int	row, i, j, nspaces, len, maxlen, colwidth;
+	int	numcol, numrow, str;
+	char	*p;
+
+	/* Find the maximum string length.  */
+	maxlen = 0;
+	for (i=1;  i <= nstr;  i++)
+	    if ((len = strlen (list[i-1])) > maxlen)
+		maxlen = len;
+
+	/* Cannot be longer than "maxch" characters, if given.  */
+	if (maxch > 0 && maxch < maxlen)
+	    maxlen = maxch;
+
+	/* Compute the optimum number of columns. */
+	if ((numcol = (last_col - first_col + 1) / (maxlen + 2)) < 1)
+	    numcol = 1;
+	if (ncol > 0 && ncol < numcol)
+	    numcol = ncol;
+	colwidth = (last_col - first_col + 1) / numcol;
+	numrow = (nstr + numcol-1) / numcol;
+
+	/* For each row in the table:
+	 */
+	for (row=1;  row <= numrow;  row=row+1) {
+	    for (i=1;  i < first_col;  i=i+1)	/* space to first col */
+		putc (' ', fp);
+	    /* For each string in the row:
+	     */
+	    for (i=1;  i <= numcol;  i=i+1) {
+		str = row + (i-1) * numrow;
+		if (str > nstr)
+		    continue;
+		p = list[str-1];		/* output string */
+		for (j=0;  p[j] != '\0' && j < maxlen;  j=j+1)
+		    putc (p[j], fp);
+		if (i < numcol) {		/* advance to next col */
+		    if ((nspaces = colwidth - j) < 2)
+			nspaces = 2;
+		    for (j=1;  j <= nspaces;  j=j+1)
+			putc (' ', fp);
+		}
+	    }
+	    putc ('\n', fp);			/* end of row of table */
+	}
+}
diff --git a/pkg/vocl/clsamp.h b/pkg/vocl/clsamp.h
new file mode 100644
index 00000000..9db63fbe
--- /dev/null
+++ b/pkg/vocl/clsamp.h
@@ -0,0 +1,100 @@
+/**
+ *  CLSAMP.H -- Definition for the SAMP/CL interface.
+ */
+
+#include "proto.h"
+#include "sampDecl.h"
+
+
+#define MAX_HANDLERS            32      /* max user-defined handlers    */
+
+typedef struct {
+    char   mtype[SZ_FNAME];             /* message type string          */
+    char   cmd[SZ_FNAME];               /* message handler command      */
+} Handler, *HandlerP;
+
+
+
+/*  samp.c
+ */
+int 	cl_sampStart ();
+int 	cl_sampStop ();
+
+void 	cl_Samp (void);
+
+void 	sampio_handler (int signum);
+int 	samp_rl_hook (void);
+int 	get_samp_command (char *cmdbuf, int maxch);
+int 	sampop (int opcode, int op_index, int nargs);
+
+
+/*  sampCmd.c
+ */
+int 	cmd_sampDbg (int nargs);
+int 	cmd_sampAddHandler (int nargs);
+int 	cmd_sampAccess (int nargs);
+int 	cmd_sampMetadata (int nargs);
+void 	cmd_sampRestart (void);
+void 	cmd_sampStart (void);
+void 	cmd_sampStop (void);
+
+int 	cmd_sampExec (int nargs);
+char   *cmd_sampEnvGet (int nargs);
+int 	cmd_sampEnvSet (int nargs);
+char   *cmd_sampParamGet (int nargs);
+int 	cmd_sampParamSet (int nargs);
+
+int 	cmd_sampSend (int nargs);
+int 	cmd_sampLoadImage (int nargs);
+int 	cmd_sampLoadFITS (int nargs);
+int 	cmd_sampLoadVOTable (int nargs);
+
+int 	cmd_sampShowRow (int nargs);
+int 	cmd_sampSelectRowList (int nargs);
+int 	cmd_sampPointAt (int nargs);
+int 	cmd_sampSpecLoad (int nargs);
+
+
+/*  sampFuncs.c
+ */
+void 	func_sampDbg (void);
+void 	func_sampStatus (int nargs);
+void 	func_sampHubAccess (int nargs);
+void 	func_sampAccess (int nargs);
+void 	func_sampMetadata (int nargs);
+void 	func_sampRestart (void);
+void 	func_sampStart (void);
+void 	func_sampStop (void);
+void 	func_sampSend (void);
+void 	func_sampAddHandler (int nargs);
+void 	func_sampLoadImage (int nargs);
+void 	func_sampLoadFITS (int nargs);
+void 	func_sampLoadVOTable (int nargs);
+
+void 	func_sampPointAt (int nargs);
+void 	func_sampShowRow (int nargs);
+void 	func_sampSelectRowList (int nargs);
+void 	func_sampSpecLoad (int nargs);
+void 	func_sampBibcodeLoad (int nargs);
+
+
+/* sampHandlers.c
+ */
+int 	cl_addUserHandler (char *mtype, char *cmd);
+int 	cl_delUserHandler (char *mtype);
+char   *cl_getUserHandler (char *mtype);
+
+int 	cl_genericHandler (char *sender, char *mtype, char *msg_id, Map map);
+int 	cl_cmdExecHandler (char *cmd);
+int 	cl_envSetHandler (char *name, char *value);
+int 	cl_envGetHandler (char *name, char *value, int maxch);
+int 	cl_paramSetHandler (char *name, char *value);
+int 	cl_paramGetHandler (char *name, char *value, int maxch);
+int 	cl_pingHandler (char *sender);
+int 	cl_imgLoadHandler (char *url, char *imgId, char *name);
+int 	cl_tblLoadHandler (char *url, char *tblId, char *name);
+
+void 	str_replace (char **string, char *substr, char *replacement );
+int 	is_stdMType (char *mtype);
+
+
diff --git a/pkg/vocl/clsystem.c b/pkg/vocl/clsystem.c
new file mode 100644
index 00000000..2261ef9a
--- /dev/null
+++ b/pkg/vocl/clsystem.c
@@ -0,0 +1,67 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#include <iraf.h>
+#include "errs.h"
+
+/* CLSYSTEM -- Run a host system command and try to arrange for its standard
+ * output and standard error output to go where our t_stdout is going; this
+ * will let us redirect its output and use it with pipes..
+ */
+void 
+clsystem (
+    char *cmd,			/* command to be executed	*/
+    FILE *taskout,		/* stdout of task		*/
+    FILE *taskerr		/* stderr of task		*/
+)
+{
+	register char	*ip;
+	register int	ch;
+	char	outfile[SZ_PATHNAME], errfile[SZ_PATHNAME];
+	FILE	*fp;
+
+	/* Ignore null commands.
+	 */
+	for (ip=cmd;  (*ip == ' ' || *ip == '\t');  ip++)
+	    ;
+	if (*ip == EOS)
+	    return;
+
+	/* Run command with output redirected into temporary files.
+	 * This is done only if the output is redirected.
+	 */
+	outfile[0] = EOS;
+	errfile[0] = EOS;
+
+	if (taskout && taskout != stdout)
+	    c_mktemp ("tmp$tso", outfile, SZ_PATHNAME);
+
+	if (taskerr == taskout)
+	    strcpy (errfile, outfile);
+	else if (taskerr && taskerr != stderr)
+	    c_mktemp ("tmp$tse", errfile, SZ_PATHNAME);
+
+	c_oscmd (cmd, "", outfile, errfile);
+
+	/* Copy spooled output, if any, to the error streams of the current
+	 * task.
+	 */
+	if (outfile[0] != EOS)
+	    if ((fp = fopen (outfile, "r")) != NULL) {
+		while ((ch = fgetc (fp)) != EOF)
+		    fputc (ch, taskout);
+		fclose (fp);
+		c_delete (outfile);
+	    }
+
+	if (errfile[0] != EOS && taskerr != taskout)
+	    if ((fp = fopen (errfile, "r")) != NULL) {
+		while ((ch = fgetc (fp)) != EOF)
+		    fputc (ch, taskerr);
+		fclose (fp);
+		c_delete (errfile);
+	    }
+}
diff --git a/pkg/vocl/compile.c b/pkg/vocl/compile.c
new file mode 100644
index 00000000..87615d19
--- /dev/null
+++ b/pkg/vocl/compile.c
@@ -0,0 +1,253 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_stdarg
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "opcodes.h"
+#include "mem.h"
+#include "errs.h"
+#include "task.h"
+#include "proto.h"
+
+
+/*
+ * COMPILE -- compile instructions at compile time, compile constants,
+ * params and misc at runtime on stacks or dictionary.
+ */
+
+memel *dictionary;		/* base of dictionary			*/
+XINT   pc;			/* program-counter			*/
+XINT   topd, maxd;		/* current top and highest d. indices	*/
+
+extern	int	cldebug, cltrace;
+
+/* compile opcode and optional arguments into stack.
+ * interpret "args" according to what is being compiled.
+ * if (all goes well during compilation)
+ *	{advance pc, return base addr of new codeentry}
+ * else
+ *	{leave pc unchanged, return (ERR)}
+ * TODO: be more sophisticated in guarding against compiling past topcs.
+ */
+
+/*VARARGS1*/
+int 
+compile (int opcode, ... )
+{
+	register struct codeentry *cep;
+	register int status = OK;
+	va_list argp;
+
+
+	if (pc > topcs - 20) {
+	    eprintf ("INTERNAL ERROR: pc/topcs collision: %d/%d\n", pc, topcs);
+	    return (ERR);
+	}
+
+	va_start (argp, opcode);
+
+	cep = coderef (pc);
+	cep->c_opcode = opcode;
+	cep->c_scriptln = currentask->t_scriptln;
+	cep->c_length = 3;	/* initial length is opcode+scriptln+length
+				 * The order of this is important so the access
+				 * to the c_args is handled properly.
+				 */
+
+
+	switch (opcode) {
+	
+	/* all these opcodes have one string argument, at args */
+	case ABSARGSET:
+	case ADDASSIGN:
+	case ASSIGN:
+	case CALL:
+	case CATASSIGN:
+	case DIVASSIGN:
+	case GETPIPE:
+	case GSREDIR:
+	case INDIRABSSET:
+	case INSPECT:
+	case INTRINSIC:
+	case OSESC:
+	case MULASSIGN:
+	case PUSHPARAM:
+	case SUBASSIGN:
+	case SWOFF:
+ 	case SWON: {
+                char *sp = va_arg (argp, char *);
+		status = comstr (sp, &cep->c_args);
+		if (status != ERR)
+		    cep->c_length += status;
+		}
+		break;
+
+	/* these opcodes use c_args as a pointer to an operand.
+	 * it is copied in-line following the new instruction in the stack.
+	 * further, if type is OT_STRING, compile the string in-line following
+	 * the operand and change o_val.v_s to point to it.
+	 */
+	case PUSHCONST: {
+		register memel *argsaddr;
+		struct operand *op, *dp;
+
+                op = va_arg (argp, struct operand *);
+		argsaddr = (memel *) &cep->c_args;
+		dp = (struct operand *) argsaddr;
+		*dp = *op;
+		argsaddr += OPSIZ;
+		cep->c_length += OPSIZ;
+		if ((op->o_type & OT_BASIC) == OT_STRING) {
+		    status = comstr (op->o_val.v_s, argsaddr);
+		    if (status != ERR) {
+			dp->o_val.v_s = (char *) argsaddr;
+			cep->c_length += status;
+		    }
+		}
+		} /* end of case PUSHCONST */
+		break;
+
+	/* these opcodes use no arguments */
+	case ADD:
+	case ALLAPPEND:
+	case ALLREDIR:
+	case AND:
+	case APPENDOUT:
+	case CHSIGN:
+	case CONCAT:
+	case DEFAULT:
+	case DIV:
+	case END:
+	case EQ:
+	case EXEC:
+	case FSCAN:
+	case FSCANF:
+	case GE:
+	case GT:
+	case IMMED:
+	case LE:
+	case LT:
+	case MUL:
+	case NE:
+	case NOT:
+	case OR:
+	case POW:
+	case PRINT:
+	case REDIR:
+	case REDIRIN:
+	case RETURN:
+	case SCAN:
+	case SCANF:
+	case SUB:
+	case FIXLANGUAGE:
+		break;
+
+	/* these opcodes have one simple integer argument;
+	 * rather than put it after the instruction and point c_args there,
+	 * just use c_args itself.
+	 */
+	case ADDPIPE:
+	case BIFF:
+	case GOTO:
+	case INDIRPOSSET:
+	case PUSHINDEX:
+	case POSARGSET:
+	case RMPIPES:
+		cep->c_args = va_arg (argp, int);
+		cep->c_length++;
+		break;
+
+	/* SWITCH has one argument which will be supplied after the
+	 * entire switch block has been compiled.
+	 */
+	case SWITCH:
+		cep->c_length++;
+		break;
+
+
+	/* The CASE statement has a variable number of arguments
+	 * depending on how many different values are set for
+	 * this case block.  Just allocate the block and let
+	 * the parser fill in the argument list.
+	 */
+	case CASE:
+		cep->c_length += va_arg (argp, int);
+		cep->c_args = INDEFI;	    /* sentinel be filled in later */
+		break;
+
+	/* The INDXINCR statment has two integer args. */
+	case INDXINCR: {
+		memel *pargs;
+
+		cep->c_length += 2;
+		pargs = (memel *) &(cep->c_args);
+		*pargs++ = va_arg (argp, int);
+		*pargs = va_arg (argp, int);
+		break;
+		}
+
+	default:
+		cl_error (E_IERR, e_badsw, opcode, "compile()");
+		status = ERR;
+	}
+
+	if (cltrace >= 3)
+    	    d_instr (stderr, "\t", pc);
+
+	if (status != ERR) {
+	    XINT oldpc = pc;
+	    pc += cep->c_length;
+	    return (oldpc);
+	}
+	return (ERR);
+}
+
+
+/* COMSTR -- compile string s into an arbitrary core address loc, which must be
+ * on an int boundry.  Allow for trailing '\0'.  Return number of whole ints 
+ * taken up by string else ERR if no room.  
+ * (comdstr() should be used to copy a string into the dictionary)
+ */
+int 
+comstr (register char *s, memel *loc)
+{
+	register char *to, *from;
+
+	from = to = (char *)loc;
+	while ( (*to++ = *s++) )
+	    ;
+	return (btoi((memel)to - (memel)from));
+}
+
+/* copy string s into the dictionary at topd, returning pointer to its
+ *   beginning and incrementing topd properly.
+ * allow for trailing '\0'.
+ */
+char *
+comdstr (char *s)
+{
+	char *start;
+
+	start = memneed (btoi (strlen (s) + 1));
+	strcpy (start, s);
+	return (start);
+}
+
+/* concat new string, ns, after existing string, es, in dictionary.
+ * only works, of course, if memneed() was not called since es was compiled
+ * originally.
+ */
+void 
+catdstr (char *es, char *ns)
+{
+	int eslen = strlen (es) + 1;
+
+	memneed (btoi (eslen + strlen (ns)) - btoi (eslen));
+	strcat (es, ns);
+}
diff --git a/pkg/vocl/config.h b/pkg/vocl/config.h
new file mode 100644
index 00000000..0b7f2cbc
--- /dev/null
+++ b/pkg/vocl/config.h
@@ -0,0 +1,76 @@
+/*
+ * CONFIG.H -- Configuration parameters for the IRAF Command Language.
+ */
+
+#define SHARELOG	YES	/* share logfile with other processes	*/
+
+/* ----------
+ * Total size of combined control and operand stack, in ints.
+ *   Note that operands are more than 1 int big, see operand.h for OPSIZ,
+ *   and that tasks certainly are too, see task.h.
+ * Also, number of INT's dictionary is grown each time topd reaches maxd.
+ * NOTE: at present, malloc() calls (such as for fio) will fragment the
+ *   dictionary, a fatal error.  We have a static sized dictionary until
+ *   this can be fixed.
+ */
+#define	STACKSIZ	256000
+#define	DICTSIZE	1024000
+#define	MEMINCR		4096
+
+typedef unsigned long memel;	/* type for dictionary, stack, etc.	*/
+
+/* History and command block buffer dimensions.  The command block buffer
+ * must be at least one line in size, and should be large enough to hold
+ * most interactively entered multiline command blocks.  The history buffer
+ * must be at least as large as the command block buffer.
+ */
+#define SZ_CMDBLK	2048
+#define	SZ_HISTBUF	8192
+
+/* ----------
+ * char buffers sizes.
+ */
+
+#define	MAXMENU		256	/* largest menu than ? can print	*/
+#define	FAKEPARAMLEN	(24)	/* see newfakeparam(). 			*/
+#define	LEN_PKPREFIX	3	/* length of package prefix string	*/
+#define	LEN_PFILENAME	6	/* length of pfilename in uparm		*/
+
+#define	NBKG		32	/* max number of active background jobs	*/
+#define	MAXSUBPROC	10	/* max number cached subprocesses	*/
+#define	MAXPIPES	20	/* max pipes in a command		*/
+
+#define	forever		while (!0)
+#define	until(x)	while (!(x))
+
+/* Specify the names of the default cl param file and the startup file.
+ * All files are assumed to reside in iraf$lib.
+ *
+ * CLPROCESS is used as the process name to be used to spawn background
+ *   processes, and to get the directory where the default cl.par file
+ *   may be found.
+ * CLSTARTUP is executed, as a script, to set up the initial
+ *   evironment defn's, commands, and other stuff. when it starts, the package
+ *   "clpackage" and one task, "cl", are the only things defined.
+ * used in main().
+ * LOGINFILE is the name of the file which, if found in the current directory
+ *   when the cl starts, will also be run as a script, after CLSTARTUP.
+ * CLLOGOUT is the name of the system logout file, executed when the user
+ *   logs off.
+ * UPARM is the environment name whose value is used as the directory
+ *   for working copies of param files. see pfileread() and pfilewrite().
+ */
+
+#define	LOGINFILE	"login.cl"
+#define	UPARM		"uparm"
+#define	CLPROCESS	"vocl.e"
+#define	CLSTARTUP	"clpackage.cl"
+#define CLLOGOUT	"cllogout.cl"
+#define ROOTPACKAGE	"language"
+#define CLPACKAGE	"clpackage"
+
+/* Indefinite valued numbers.
+ */
+
+#define INDEFSTR	undefval	/* mode of the param structure.	*/
+extern char	*undefval;
diff --git a/pkg/vocl/construct.h b/pkg/vocl/construct.h
new file mode 100644
index 00000000..eeddfdb0
--- /dev/null
+++ b/pkg/vocl/construct.h
@@ -0,0 +1,44 @@
+/* Define variables used during compilation of loop constructs. */
+#define MAX_LOOP	50
+#define N_OPEN_ARR	15
+
+/* The LABEL structure is used to store the linked list of LABEL names.
+ */
+struct	label {
+	char	*l_name;	/* Pointer to label name. */
+	int	l_loc;		/* Location of label. */
+	int	l_defined;	/* Has actual label been seen. */
+	struct label *l_next;	/* Pointer to next in list. */
+	};
+
+/* Pointers to the names of the parameters in a PROCEDURE statement.
+ * These are used in positional references to params within a script.
+ */
+
+#define MAX_PROC_PARAMS	100
+
+extern int	nextdest[MAX_LOOP];	/* Destinations for NEXT's 	*/
+extern int	brkdest[MAX_LOOP];	/* Destinations for BREAK's 	*/
+
+extern int	nestlevel;		/* Loop nesting level		*/
+extern int	ncaseval;		/* Number of cases in switch	*/
+
+extern int	n_oarr;			/* Number of open array indices	*/
+extern int	i_oarr;			/* Current open array index	*/
+
+extern int	oarr_beg[N_OPEN_ARR];	/* Open index limits.		*/
+extern int	oarr_end[N_OPEN_ARR];
+extern int	oarr_curr[N_OPEN_ARR];	/* Current value for index.	*/
+extern int	imloopset;		/* Loop inited at run time?	*/
+extern int	n_indexes;		/* Number of indexes on stack.	*/
+
+extern int	maybeindex;		/* Could last constant be index */
+				/* range?			*/
+
+extern struct	label	*label1; /* Pointer to first top of label list. */
+extern int	igoto1;		/* Head of list of indirect GOTO's */
+
+
+extern struct	operand	*parlist[MAX_PROC_PARAMS];
+extern struct	param *last_parm;/* Last parameter before compilation.	*/
+extern int	n_procpar;		/* Number of params in proc stmt.	*/
diff --git a/pkg/vocl/debug.c b/pkg/vocl/debug.c
new file mode 100644
index 00000000..a8d0087c
--- /dev/null
+++ b/pkg/vocl/debug.c
@@ -0,0 +1,486 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "proto.h"
+
+
+/*
+ * DEBUG -- The various debugging functions.
+ *
+ * the D_XXX grammar rules use the d_xxx routines to dump various tables
+ * for debugging purposes.
+ * some of these (see setbuiltins()) are done as builtin ltasks, while others
+ *   that show dictionary or stack info are not to avoid the complication of
+ *   having to work around the fact that builtins are really separate tasks.
+ * all write to stderr.
+ */
+
+extern	char *nullstr;
+extern	int cldebug;
+extern	int cltrace;
+static	void dd_f();
+
+
+/* D_STACK -- Go through the instruction stack, starting at locpc, printing
+ * what is found until END opcode discovered.  If ss > 0, just go through ss
+ * instructions.  Done directly.
+ */
+static	int	pc_mark = 0;
+
+void 
+d_asmark (void) 
+{ 
+	/* Mark the PC to begin the instruction output.  If not defined,
+	 * do the whole script.
+	 */
+	pc_mark  = pc; 
+}
+
+
+void 
+d_assemble (void) 
+{ 
+	d_stack ((pc_mark ? pc_mark : pc), 0, pc); 
+	pc_mark = 0; 
+}
+
+void 
+d_stack (register XINT locpc, int ss, int endpc)
+{
+	register struct codeentry *cep;
+	int n, opcode, errs = 0;
+	
+	do {
+	    cep = coderef (locpc);
+	    opcode = cep->c_opcode;
+
+	    if ((n = d_instr (stderr, "", locpc)) <= 0) {
+		errs++;
+		locpc += (SZ_CE - 1);
+	    } else
+		locpc += n;
+
+	    if (ss > 0 && --ss == 0)		/* ss > 0 done first!	*/
+		errs = 100;			/* simulate end		*/
+
+	    if (endpc > 0 && locpc > (endpc - SZ_CE))
+		break;
+
+	} while (opcode != END && errs < 10);
+}
+
+
+/* D_INSTR -- Decode a single instruction on the output file.  The length of
+ * the instruction in memel is returned as the function value.
+ */
+int 
+d_instr (FILE *fp, char *prefix, register XINT locpc)
+{
+	register struct codeentry *cep;
+	int opcode, extra=0;
+
+	cep = coderef (locpc);
+	opcode = cep->c_opcode;
+
+	if (prefix[0] == '\t') {
+	    if (cltrace > 1) {
+		/* For verbose output, get the filename. */
+	        fprintf (fp, "    %4d:%s  %6d+%d:\t", cep->c_scriptln,
+		    currentask->t_ltp->lt_pname,
+	            locpc, cep->c_length);
+	    } else {
+	        fprintf (fp, "    %4d  %6d+%d:\t", cep->c_scriptln,
+	            locpc, cep->c_length);
+	    }
+	} else
+	    fprintf (fp, "%s  %4d  %6d+%d:\t", prefix, cep->c_scriptln,
+	        locpc, cep->c_length);
+
+
+	switch (opcode) {
+	case ABSARGSET:   fprintf (fp, "absargset");	goto string;
+	case ADDASSIGN:   fprintf (fp, "addassign");	goto string;
+	case ASSIGN:	  fprintf (fp, "assign\t");	goto string;
+	case CALL:	  fprintf (fp, "call\t");	goto string;
+	case CATASSIGN:	  fprintf (fp, "catassign");	goto string;
+	case DIVASSIGN:	  fprintf (fp, "divassign");	goto string;
+	case GSREDIR:	  fprintf (fp, "gsredir");	goto string;
+	case INDIRABSSET: fprintf (fp, "indirabsset");	goto string;
+	case INSPECT:	  fprintf (fp, "inspect\t");	goto string;
+	case INTRINSIC:	  fprintf (fp, "intrinsic");	goto string;
+	case MULASSIGN:	  fprintf (fp, "mulassign");	goto string;
+	case OSESC:	  fprintf (fp, "os_escape");	goto string;
+	case PUSHPARAM:	  fprintf (fp, "pushparam");	goto string;
+	case SUBASSIGN:	  fprintf (fp, "subassign");	goto string;
+	case SWOFF:	  fprintf (fp, "swoff\t");	goto string;
+	case SWON:	  fprintf (fp, "swon");		goto string;
+string:
+	    fprintf (fp, "\t%s\n", (char *)&cep->c_args);
+	    break;
+
+	case PUSHCONST:	  fprintf (fp, "pushconst"); goto op;
+op:
+	    {   struct operand *op;
+
+		op = (struct operand *) &cep->c_args;
+		fprintf (fp, "\t");
+		if ((op->o_type & OT_BASIC) == OT_STRING)
+		    fprintf (fp, "`");
+		fprop (stderr, op);
+		if ((op->o_type & OT_BASIC) == OT_STRING)
+		    fprintf (fp, "'");
+		fprintf (fp, "\n");
+	    }
+	    break;
+
+	case ADD:	  fprintf (fp, "add\n"); 	break;
+	case ADDPIPE:	  fprintf (fp, "addpipe\n"); 	break;
+	case ALLAPPEND:	  fprintf (fp, "allappend\n"); 	break;
+	case ALLREDIR:	  fprintf (fp, "allredir\n"); 	break;
+	case AND:	  fprintf (fp, "and\n"); 	break;
+	case APPENDOUT:	  fprintf (fp, "append\n"); 	break;
+	case CHSIGN:	  fprintf (fp, "chsign\n"); 	break;
+	case CONCAT:	  fprintf (fp, "concat\n"); 	break;
+	case DEFAULT:     fprintf (fp, "default\n"); 	break;
+	case DIV:	  fprintf (fp, "div\n"); 	break;
+	case END:	  fprintf (fp, "end\n"); 	break;
+	case EQ:	  fprintf (fp, "eq\n"); 	break;
+	case EXEC:	  fprintf (fp, "exec\n"); 	break;
+	case FSCAN:	  fprintf (fp, "fscan\n"); 	break;
+	case FSCANF:	  fprintf (fp, "fscanf\n"); 	break;
+	case GE:	  fprintf (fp, "ge\n"); 	break;
+	case GETPIPE:	  fprintf (fp, "getpipe\n"); 	break;
+	case GT:	  fprintf (fp, "gt\n"); 	break;
+	case IMMED:	  fprintf (fp, "immed\n"); 	break;
+	case LE:	  fprintf (fp, "le\n"); 	break;
+	case LT:	  fprintf (fp, "lt\n"); 	break;
+	case MUL:	  fprintf (fp, "mul\n"); 	break;
+	case NE:	  fprintf (fp, "ne\n"); 	break;
+	case NOT:	  fprintf (fp, "not\n"); 	break;
+	case OR:	  fprintf (fp, "or\n"); 	break;
+	case POW:	  fprintf (fp, "pow\n"); 	break;
+	case PRINT:	  fprintf (fp, "print\n"); 	break;
+	case REDIR:	  fprintf (fp, "redir\n"); 	break;
+	case REDIRIN:	  fprintf (fp, "redirin\n"); 	break;
+	case RETURN:	  fprintf (fp, "return\n"); 	break;
+	case SCAN:	  fprintf (fp, "scan\n"); 	break;
+	case SCANF:	  fprintf (fp, "scanf\n"); 	break;
+	case SUB:	  fprintf (fp, "sub\n"); 	break;
+	case SWITCH:      fprintf (fp, "switch\n"); 	break;
+
+	case BIFF:	  fprintf (fp, "biff\t"); 	goto offset;
+	case GOTO:	  fprintf (fp, "goto\t"); 	goto offset;
+offset:
+	    /* Print offset with sign, - or +, in all cases. */
+	    if ((int)cep->c_args <= 0)
+		goto oneint;	/* pick up sign there	*/
+	    else
+		 fprintf (fp, "\t+%d\n", cep->c_args);
+	    break;
+
+	case CASE:        fprintf (fp, "case\t"); 	goto oneint;
+	case INDIRPOSSET: fprintf (fp, "indirposset"); 	goto oneint;
+	case POSARGSET:	  fprintf (fp, "posargset"); 	goto oneint;
+	case RMPIPES:	  fprintf (fp, "rmpipes\t"); 	goto oneint;
+oneint:
+	    fprintf (fp, "\t%d\n", cep->c_args);
+	    break;
+
+	/* Used for arrays. */
+	case PUSHINDEX:   fprintf (fp, "pushindex"); 	goto oneint;
+	case INDXINCR:    fprintf (fp, "indxincr");
+	    /* Output two jump offsets. */
+	     fprintf (fp, "\t%d, %d\t", cep->c_args, *(&cep->c_args+1));
+
+	    /* Output array index ranges: {beg, end} * N. */
+	    {   memel *ip = (memel *) &cep->c_args;
+		int i, n = (int)ip[2];
+		for (ip += 2, i=0;  i < n;  i++, ip += 2)
+		    fprintf (fp, "%d:%d ", (XINT)*ip, (XINT)(*ip+1));
+		fprintf (fp, "\n");
+		extra = 2*n + 1;
+	    }
+	    break;
+
+	default:
+	    fprintf (fp, "bad opcode, %d, at pc %d\n", opcode, locpc);
+	    return (-1);
+	}
+
+	return (cep->c_length + extra);
+}
+
+
+/* print neat things about the dictionary and stack.
+ * done directly.
+ */
+void 
+d_d (void)
+{
+	char *stackaddr = (char *)stack;  /*  just so we may subtract	*/
+	char *otheraddr;
+
+
+	eprintf ("\ndictionary indices:\n");
+	eprintf ("\tmaxd-1\t%u (%u)\n", maxd-1, dictionary[maxd-1]);
+	eprintf ("\ttopd\t%u (%u)\n", topd, dictionary[topd]);
+	eprintf ("\tpachead\t%u (`%s')\n", pachead,
+	    reference (package, pachead)->pk_name);
+	eprintf ("\tparhead\t%u (`%s')\n", parhead,
+	    reference (pfile, parhead)->pf_ltp->lt_lname);
+
+	eprintf ("\ndictionary pointers (shown as indices)\n");
+	eprintf ("\tcurpack\t%u (`%s')\n", dereference (curpack),
+	    curpack->pk_name);
+	eprintf ("\tdictionary\t%u\n", dictionary);
+
+	eprintf ("\nstack indices\n");
+	eprintf ("\ttopcs\t%d\n", topcs);
+	eprintf ("\ttopos\t%d\n", topos);
+	eprintf ("\tbasos\t%d\n", basos);
+	eprintf ("\tpc\t%d\n", pc);
+	otheraddr = (char *)currentask;
+	eprintf ("\tcurrentask\t%u (`%s')\n", btoi (otheraddr - stackaddr),
+	    currentask->t_ltp->lt_lname);
+	otheraddr = (char *)firstask;
+	eprintf ("\tfirstask\t%u (`%s')\n", btoi (otheraddr - stackaddr),
+	    firstask->t_ltp->lt_lname);
+}
+
+
+/* print all loaded pfiles and their params from parhead.
+ * done as a builtin task. depends on the fact that the fake param file
+ * has been unlinked from parhead before the builtin is run to avoid showing
+ * it. see execnewtask().
+ */
+void 
+d_p (void)
+{
+	register struct pfile *pfp;
+	register struct param *pp;
+	register FILE *fp;
+	int flags;
+
+	fp = currentask->t_stderr;
+	eprintf ("loaded parameter files -\n");
+	for (pfp = reference (pfile, parhead); pfp; pfp = pfp->pf_npf) {
+	    eprintf ("\n\t%s: ", pfp->pf_ltp->lt_lname);
+	    flags = pfp->pf_flags;
+	    if (flags & PF_UPDATE) eprintf ("updated, ");
+	    if (flags & PF_FAKE) eprintf ("fake, ");
+	    if (flags & PF_COPY) eprintf ("copy, ");
+	    if (flags & PF_PSETREF) eprintf ("contains pset pars, ");
+	    eprintf ("\n");
+	    for (pp = pfp->pf_pp; pp != NULL; pp = pp->p_np)
+		printparam (pp, fp);
+	}
+}
+
+
+/* print info about the tasks currently on the control stack.
+ * done as a builtin. no attempt is made to hide the task running for this 
+ * builtin.
+ */
+void 
+d_t (void)
+{
+	struct task *tp;
+	int    flags;
+
+	eprintf ("stacked tasks (most recent first)\n\n");
+	for (tp=currentask; (XINT)tp<(XINT)&stack[STACKSIZ]; tp=next_task(tp)) {
+	    flags = tp->t_flags;
+	    eprintf ("%s:\t", tp->t_ltp->lt_lname);
+	    if (flags & T_SCRIPT) eprintf ("script, ");
+	    if (flags & T_CL) eprintf ("cl, ");
+	    if (flags & T_INTERACTIVE) eprintf ("interactive, ");
+	    if (flags & T_MYOUT) eprintf ("new out, ");
+	    if (flags & T_MYIN) eprintf ("new in, ");
+	    if (flags & T_MYERR) eprintf ("new err, ");
+	    if (flags & T_MYSTDGRAPH) eprintf ("new stdgraph, ");
+	    if (flags & T_MYSTDIMAGE) eprintf ("new stdimage, ");
+	    if (flags & T_MYSTDPLOT) eprintf ("new stdplot, ");
+	    if (flags & T_BUILTIN)
+		eprintf ("builtin, ");
+	    else
+		eprintf ("mode = `%s' ", tp->t_modep->p_val.v_s);
+	    eprintf ("\n");
+	}
+}
+
+
+/* print all loaded packages and their ltasks from pachead.
+ * builtin.
+ */
+void 
+d_l (void)
+{
+	register struct package *pkp;
+	register struct ltask *ltp;
+	int flags;
+
+	eprintf ("loaded packages -\n");
+	for (pkp = reference (package,pachead); pkp; pkp = pkp->pk_npk) {
+	    eprintf ("(%u) package `%s':\n", pkp, pkp->pk_name);
+	    for (ltp = pkp->pk_ltp; ltp != NULL; ltp = ltp->lt_nlt) {
+		flags = ltp->lt_flags;
+		eprintf ("\t(%u)\t%s: ", ltp, ltp->lt_lname);
+		if (flags & LT_BUILTIN)
+		    eprintf ("builtin, ");
+		else
+		    eprintf ("in %s (%d), ", ltp->lt_pname,
+			ltp->lt_pname);
+		if (flags & LT_SCRIPT) eprintf ("script, ");
+		if (!(flags & LT_PFILE)) eprintf ("no pfile, ");
+		if (flags & LT_STDINB) eprintf ("b_in, ");
+		if (flags & LT_STDOUTB) eprintf ("b_out, ");
+		if (flags & LT_INVIS) eprintf ("invisible, ");
+		eprintf ("\n");
+	    }
+	}
+}
+
+
+/* D_F -- Determine the number of logical (e.g. dev$null, stropen) and physical
+ * (host system) file slots available.
+ */
+void 
+d_f (void)
+{
+	dd_f ("logical:  ", "dev$null");
+	dd_f ("physical: ", "hlib$iraf.h");
+}
+
+static void
+dd_f (char *msg, char *fname)
+{
+	FILE	*fp[128];
+	int	fn;
+
+	eprintf (msg);
+	fn = 0;
+	while ((fp[fn] = fopen (fname, "r")) != NULL) {
+	    eprintf ("%d,", fileno(fp[fn]));
+	    if (++fn >= 128)
+		break;
+	}
+	eprintf ("\n");
+	while (fn > 0)
+	    fclose (fp[--fn]);
+}
+
+
+/* enable debugging messages.
+ * builtins.
+ */
+void 
+d_on (void)
+{
+	cldebug = 1;
+}
+
+/* disable debugging.
+ */
+void 
+d_off (void)
+{
+	cldebug = 0;
+}
+
+/* Enable/disable instruction tracing.
+ */
+void 
+d_trace (int value)
+{
+	cltrace = value;
+}
+
+
+/* Dump operand stack until underflow occurs.
+ */
+void 
+e_dumpop (void)
+{
+	struct	operand o;
+
+	forever {
+	    o = popop();
+	    oprop (&o);
+	}
+}
+
+
+/* Format a multiline exec-task message string for debug output.
+ */
+void 
+d_fmtmsg (FILE *fp, char *prefix, char *message, int width)
+{
+	register char *ip, *op, *cp;
+	char lbuf[SZ_COMMAND], obuf[SZ_COMMAND];
+	int len_prefix, nchars;
+
+	len_prefix = strlen (prefix);
+
+	for (ip=message, op=obuf;  *ip;  ) {
+	    /* Get next message line. */
+	    for (cp=lbuf, nchars=0;  (*cp++ = *ip);  ip++, nchars++) {
+		if (*ip == '\\' && *(ip+1) == '\n') {
+		    *cp++ = 'n';
+		    nchars += 2;
+		    ip += 2;
+		    break;
+		} else if (*ip == '\n') {
+		    *(cp-1) = '\\';
+		    *cp++ = 'n';
+		    nchars += 2;
+		    ip++;
+		    break;
+		}
+	    }
+	    *cp++ = '\0';
+
+	    /* Flush output line if it is full. */
+	    if (len_prefix + op-obuf + nchars > width) {
+		if (op > obuf) {
+		    *op++ = '\0';
+		    fprintf (fp, "%s%s\n", prefix, obuf);
+		    op = obuf;
+		} else {
+		    fprintf (fp, "%s%s\n", prefix, lbuf);
+		    op = obuf;
+		    continue;
+		}
+	    }
+
+	    /* Copy line to output buffer. */
+	    for (cp=lbuf;  *cp;  )
+		*op++ = *cp++;
+	}
+
+	/* Flush anything left in output buffer. */
+	if (op > obuf) {
+	    *op++ = '\0';
+	    fprintf (fp, "%s%s\n", prefix, obuf);
+	}
+}
+
+
+/* D_PROF -- Enable script execution profiling.
+ */
+void 
+d_prof (void) 
+{
+}
+
diff --git a/pkg/vocl/decl.c b/pkg/vocl/decl.c
new file mode 100644
index 00000000..c5485b80
--- /dev/null
+++ b/pkg/vocl/decl.c
@@ -0,0 +1,850 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "construct.h"
+#include "ytab.h"		/* pick up yacc token #defines		*/
+#include "proto.h"
+
+
+/*
+ * DECL -- contains routines used by the parser for referencing parameters
+ * and for parameter declarations.
+ */
+
+extern	int	cldebug;
+
+char	*badopt      = "Invalid %s option for `%s'.";
+char	*illegal_opt = "Illegal option for `%s'.";
+char	*dup_def     = "Duplicate definition of `%s' ignored.\n";
+
+
+/* GETLIMITS -- Get the limits for the n'th index of a parameter.
+ * Returns ERR if the parameter is not defined, or has fewer than n indexes.
+ */
+int 
+getlimits (char *pname, int n, int *i1, int *i2)
+{
+	struct param *pp;
+	char	*pk, *t, *p, *f;
+	int 	dim;
+	short	*len, *off;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+
+	/* Paramsrch calls error if it cannot find the param, so we
+	 * needn't check here.
+	 */
+	if (!(pp->p_type & PT_ARRAY))
+	    return (ERR);
+
+	dim = pp->p_val.v_a->a_dim;
+	if (n >= dim)
+	    return (ERR);
+
+	len = &(pp->p_val.v_a->a_len);
+	len = len + 2*n;
+	off = len + 1;
+
+	*i1 = *off;
+	*i2 = *off + *len - 1;
+	return (OK);
+}
+
+
+/* GET_DIM -- Get the dimensionality of an parameter.  If not an array return 0.
+ */
+int 
+get_dim (char *pname)
+{
+	struct param *pp, *lookup_param();
+	char	*pk, *t, *p, *f;
+	int 	dim;
+
+	breakout (pname, &pk, &t, &p, &f);
+
+	/* We can't use paramsrch here because the string we are
+	 * looking for might be a builtin, and paramsrch would fail.
+	 */
+	pp = lookup_param (pk, t, p);
+
+	if (pp == NULL || (XINT) pp == ERR)
+	    dim = -1;
+	else if (!(pp->p_type & PT_ARRAY))
+	    dim = 0;
+	else
+	    dim = pp->p_val.v_a->a_dim;
+
+	return (dim);
+}
+
+
+/* MAKETYPE -- Set the type of a parameter.
+ */
+int 
+maketype (int type, int list)
+{
+	register int	p = -1;
+
+	switch (type) {
+	case V_BOOL:	p = OT_BOOL;
+			break;
+	case V_INT:	p = OT_INT;
+			break;
+	case V_REAL:	p = OT_REAL;
+			break;
+	case V_STRING:	p = OT_STRING;
+			break;
+	case V_FILE:	p = OT_STRING | PT_FILNAM;
+			break;
+	case V_GCUR:	p = OT_STRING | PT_GCUR;
+			break;
+	case V_IMCUR:	p = OT_STRING | PT_IMCUR;
+			break;
+	case V_UKEY:	p = OT_STRING | PT_UKEY;
+			break;
+	case V_PSET:	p = OT_STRING | PT_PSET;
+			break;
+	case V_STRUCT:	p = OT_STRING | PT_STRUCT;
+			break;
+	}
+
+	if (list)
+	    p |= PT_LIST;
+
+	return (p);
+}
+
+
+/* DO_ARRAYINIT -- Initialize an array from values in a declaration statement.
+ * This routine must also allocate the array descriptor block.
+ *
+ * On entry the control stack contains pointers to operands containing
+ * the initialization info.  Buried beneath this may be the dimension
+ * and offset information needed for the the array descriptor.  The
+ * dimensionality of the array is passed in nindex, except when
+ * the user wishes to default the dimension of a one-dimensional
+ * array to the number of values in the initialization block.
+ * In that case nindex has been passed as 0.
+ * 
+ * This program ASSUMES that successive calls to memneed return
+ * contiguous blocks of memory.  This is because we don't know
+ * the size of the array at first, and we can only allocate the
+ * space needed to hold the values which have been initialized.
+ * After we have popped the stack down to array descriptor info
+ * we may find that some values are not initialized and so we
+ * may need to allocate more memory.
+ */
+void 
+do_arrayinit (struct param *pp, int nval, int nindex)
+{
+	char	*block1=NULL, *block2=NULL;
+	int	dim, asiz, asiz2, asiz2x, bastype, i;
+	int	slen=0;
+	short	*off, *len;
+	struct	arr_desc  *parr;
+	struct	operand	  *o;
+	union 	arrhead	  ar;
+
+	if (cldebug)
+	    eprintf ("do_arrayinit: nindex=%d  nval=%d\n", nindex, nval);
+	bastype = pp->p_type & OT_BASIC;
+	if (bastype == OT_STRING)
+	    slen = pp->p_lenval;
+
+	dim = nindex;
+	if (dim == 0)
+	    dim = 1;
+	asiz = 0;
+
+	/* Allocate an array descriptor.
+	 */
+	parr = (struct arr_desc *) memneed (2+dim);
+
+	if (nval > 0) {
+	    asiz = nval;
+	    if (bastype == OT_REAL)
+		asiz = dtoi (asiz);
+	    block1 = memneed (asiz);
+	    ar.a_i = (int *) block1;
+	    i = nval;
+
+	    while (i--) {
+		memel p = pop();
+		o = (struct operand *) p;
+
+		switch (bastype) {
+
+		case OT_BOOL:
+		    if (o->o_type != OT_BOOL  &&  o->o_type != OT_INT) {
+			eprintf ("Invalid type in array initialization.\n");
+			*(ar.a_i + i) = INDEFL;
+		    } else
+			*(ar.a_i + i) = o->o_val.v_i;
+		    break;
+
+		case OT_INT:
+		    if (o->o_type != OT_INT) {
+			eprintf ("Invalid type in array initialization.\n");
+			*(ar.a_i + i) = INDEFL;
+		    } else
+			*(ar.a_i + i) = o->o_val.v_i;
+		    break;
+
+		case OT_REAL:
+		    switch (o->o_type) {
+		    case OT_INT:
+			ar.a_r[i] = (double) (o->o_val.v_i);
+			break;
+		    case OT_REAL:
+			ar.a_r[i] = o->o_val.v_r;
+			break;
+		    default:
+			eprintf ("Invalid type in array initialization.\n");
+			ar.a_r[i] = INDEFR;
+			break;
+		    }
+		    break;
+
+		case OT_STRING:
+		    ar.a_s[i] = o->o_val.v_s;
+		}	/* End of switch. */
+	    }
+	}
+
+	/* Get array descriptor info.
+	 */
+	if (nindex > 0) {
+	    len = &(parr->a_len);
+	    off = &(parr->a_off);
+	    parr->a_dim = nindex;
+
+	    asiz2 = 1;
+
+	    i = nindex;
+	    while (i--) {
+		off[2*i] = pop();
+		len[2*i] = pop();
+		asiz2 *= len[2*i];
+	    }
+
+	    if (bastype == OT_REAL)
+		asiz2x = dtoi (asiz2);
+	    else
+		asiz2x = asiz2;
+
+	    if (asiz2x > asiz) {	/* Need to allocate more space. */
+		block2 = memneed (asiz2x-asiz);
+
+		if (nval == 0) {
+		    block1 = block2;
+		    ar.a_i = (int *) block1;
+		}
+
+		if (btoi(block2-block1) != asiz)
+		    cl_error (E_IERR, "Memory sync error during array init.\n");
+
+		/* Initialize undefined elements. 
+		 */
+		for (i = nval;  i < asiz2;  i++)
+		     switch (bastype) {
+			case OT_INT:
+			case OT_BOOL:
+			    ar.a_i[i] = INDEFL;
+			    break;
+			case OT_REAL:
+			    ar.a_r[i] = INDEFR;
+			    break;
+			case OT_STRING:
+			    ar.a_s[i] = memneed (btoi(slen));
+			    *(ar.a_s[i]) = '\0';
+			    *(ar.a_s[i] + SZ_FNAME - 1) = '\0';
+		    }
+	    } else if (nval > asiz2)
+		/* We just leave the extra values in the dictionary.
+		 * It's not serious enough to make it an error.
+		 */
+		eprintf ("Warning: Too many initialization values for `%s'.\n",
+		   pp->p_name);
+
+	} else {	/* User didn't give dimensions. */
+	    parr->a_len = nval;
+	    parr->a_off = 1;
+	    parr->a_dim = 1;
+	}
+
+	/* At this point initialized string parameters point to the string
+	 * which was returned as an operand.  Many array elements could
+	 * point to the same storage.  Allocate a constant amount
+	 * of storage for each of the initialized strings and copy
+	 * the initial value into it.
+	 */
+	if (bastype == OT_STRING) {
+	    for (i=0; i<nval; i++) {
+		char	*s;
+		s = memneed (btoi (slen));
+		strncpy (s, ar.a_s[i], slen-1);
+		*(s+SZ_FNAME-1) = '\0';
+		ar.a_s[i] = s;
+	    }
+	}
+
+	/* Finally connect the various elements.
+	 */
+	pp->p_val.v_a = parr;
+	pp->p_aval = ar;
+}
+
+
+/* DO_SCALARINIT -- Initialize a scalar.  Mostly copied from ADDPARAM.
+ */
+void 
+do_scalarinit (struct param *pp, int inited)
+{
+	struct	operand	*o, undefoper;
+	extern	char	*e_invaldef;
+	int 	len, bastype;
+	char	*s;
+
+	pp->p_valo.o_type = bastype = pp->p_type & OT_BASIC;
+
+	if (inited) {
+	    memel p = pop();
+	    o = (struct operand *) p;
+
+	    if (o->o_type == OT_STRING)
+		s = o->o_val.v_s;
+	    else
+		s = undefval;
+	} else {
+	    o = &undefoper;
+	    s = undefval;
+	    undefoper.o_type = OT_STRING;
+	    undefoper.o_val.v_s = undefval;
+	}
+
+	if (pp->p_type & (PT_LIST|PT_FILNAM|PT_PSET)) {
+	    if (o->o_type != OT_STRING)
+		cl_error (E_UERR, e_invaldef, pp->p_name);
+
+	    pp->p_val.v_s = memneed (btoi(SZ_FNAME));
+	    pp->p_val.v_s[SZ_FNAME-1] = '\0';
+
+	    if (pvaldefined (pp, s)) {
+	        char  *p;
+
+		/* Change a whitespace-only filename into a null string; this
+		 * makes it easier for users to check null filenames in 
+		 * scripts.  It makes sense anyway since these are invalid
+		 * filenames.
+		 */
+		p = s;
+	        while (*p == ' ' || *p == '\t')
+		    p++;
+		if (*p == '\0' || *p == '\n')
+		    pp->p_val.v_s[0] = '\0';
+		else
+		    strncpy (pp->p_val.v_s, s, SZ_FNAME-1);
+	    } else
+		pp->p_val.v_s[0] = '\0';
+
+	    if (pp->p_type & PT_LIST)
+		pp->p_listval = memneed (btoi(SZ_LINE));
+
+	    pp->p_valo.o_type = OT_STRING;
+
+	} else if (pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY)) {
+	    if (o->o_type != OT_STRING)
+		cl_error(E_UERR, e_invaldef, pp->p_name);
+
+	    len = pp->p_lenval;
+ 	    pp->p_val.v_s = memneed (btoi (len));
+
+	    if (pvaldefined (pp, s))
+		strcpy (pp->p_val.v_s, s);
+	    else
+		pp->p_val.v_s[0] = '\0';
+
+	    pp->p_val.v_s[len-1] = '\0';	 /* the permanent eos */
+	    pp->p_valo.o_type = OT_STRING;
+
+	} else if (bastype == OT_STRING || (s != NULL && *s == PF_INDIRECT)) {
+	    /* Strings are stored like structs, but are inited from s.
+	     * OT_INDEF/UNDEF refer to p_val.
+	     */
+	    pp->p_lenval = SZ_LINE;
+	    if (pvaldefined (pp, s)) {
+		/* String was something conventional.  If shorter than SZ_LINE
+		 * call memneed() to allocate sufficient space and copy
+		 * the value into it.
+		 */
+		char   *news;
+
+		pp->p_valo.o_type = OT_STRING;
+		len = strlen (s) + 1;		/* allow for eos */
+		news = memneed (btoi (pp->p_lenval));
+
+		if (len < pp->p_lenval) {
+		    strcpy (news, s);
+		    s = news;
+		} else {
+		    pp->p_lenval = len;
+		    pp->p_val.v_s = s;
+		}
+
+	    } else {
+		/* Either no string was given or it was INDEF/UNDEF.
+		 */
+		len = SZ_LINE;
+		s = memneed (btoi (pp->p_lenval));
+	    }
+
+	    pp->p_val.v_s = s;
+	    pp->p_val.v_s[len-1] = '\0'; /* add the permanent eos */
+	    pp->p_maxo.o_type = OT_INT;
+
+	} else {
+	    /* Simple non-string type.
+	     */
+	    if (inited)
+		pp->p_valo = *o;
+	    else
+		pp->p_valo.o_type = bastype | OT_UNDEF;
+	}
+
+	if (cldebug)
+	    eprintf ("do_scalar_init: pp->p_flags=%o\n", pp->p_flags);
+}
+
+
+/* SCANFTYPE -- Get file type for file parameter.
+ */
+int 
+scanftype (struct param *pp, struct operand *o)
+{
+	int	type;
+	char	*s;
+
+	if (o->o_type != OT_STRING)
+	    return (ERR);
+
+	type = 0;
+	s = o->o_val.v_s;
+
+	while (*++s != '\0')
+	    switch (*s) {
+	    case 'b': case 'B': type |= PT_FBIN; break;
+	    case 'n': case 'N': type |= PT_FNOE; break;
+	    case 'r': case 'R': type |= PT_FER;  break;
+	    case 't': case 'T': type |= PT_FTXT; break;
+	    case 'w': case 'W': type |= PT_FEW;  break;
+	    default: return (ERR);
+	    }
+
+	pp->p_type |= type;
+	return (OK);
+}
+
+
+/* C_SCANMODE -- Get the mode for a parameter.
+ */
+int 
+c_scanmode (struct param *pp, struct operand *o)
+{
+	if (o->o_type != OT_STRING)
+	    return (ERR);
+
+	pp->p_mode = scanmode (o->o_val.v_s);
+	return (OK);
+}
+
+
+/* SCANLEN -- Get the length for structs and strings.
+ */
+int 
+scanlen (struct param *pp, struct operand *o)
+{
+	if (o->o_type != OT_INT  ||
+	    !(pp->p_type & (OT_STRING|PT_LIST|PT_STRUCT)))
+	    return (ERR);
+
+	pp->p_lenval = o->o_val.v_i;
+	return (OK);
+}
+
+
+/* SCANMIN -- Get the minimum for a parameter.
+ */
+int 
+scanmin (struct param *pp, struct operand *o)
+{
+	int 	bastype, otype;
+
+	bastype = pp->p_type & OT_BASIC;
+	otype = o->o_type;
+
+	if (pp->p_type & (OT_BOOL|PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET))
+	    return (ERR);
+
+	if (otype == OT_STRING)
+	    if ((bastype == OT_STRING || *(o->o_val.v_s) == PF_INDIRECT)) {
+
+	        /* Filename, enumerated string, or indirect reference.
+	         */
+	        pp->p_mino.o_type = OT_STRING;
+	        pp->p_min.v_s = memneed (btoi(PF_SZMINSTR));
+	        pp->p_min.v_s[PF_SZMINSTR-1] = '\0';
+	        strncpy (pp->p_min.v_s, o->o_val.v_s, PF_SZMINSTR-1);
+	        pp->p_flags &= ~P_UMIN;
+	        return (OK);
+	    }
+
+	pushop (o);
+	opcast (bastype);
+	pp->p_mino = popop();
+
+	pp->p_flags &= ~P_UMIN;
+	return (OK);
+}
+
+
+/* SCANENUM -- Get the legal values for an enumerated string an store in the
+ * min field of the parameter.
+ */
+int 
+scanenum (register struct param *pp, register struct operand *o)
+{
+	register int bastype;
+
+	bastype = pp->p_type & OT_BASIC;
+
+	if (bastype != OT_STRING || o->o_type != OT_STRING)
+	    return (ERR);
+
+	return (scanmin (pp, o));
+}
+
+
+/* SCANMAX -- Get the maximum for a param.
+ */
+int 
+scanmax (struct param *pp, struct operand *o)
+{	
+	int	otype;
+
+	otype = pp->p_type & OT_BASIC;
+
+	if (pp->p_type & (OT_BOOL|PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET))
+	    return (ERR);
+
+	if (otype == OT_STRING && o->o_type == OT_STRING)
+	    if (*o->o_val.v_s == '@') {
+		/* Filename, enumerated string, or indirect reference.
+		 */
+		pp->p_maxo.o_type = OT_STRING;
+		pp->p_max.v_s = memneed (btoi(PF_SZMAXSTR));
+		pp->p_max.v_s[PF_SZMAXSTR-1] = '\0';
+		strncpy (pp->p_max.v_s, o->o_val.v_s, PF_SZMAXSTR-1);
+
+		pp->p_flags &= ~P_UMAX;
+		return (OK);
+	    }
+
+	/* Type is equivalent to a simple non-string wrt mins.
+	 */
+	pushop (o);
+	opcast (otype);
+	pp->p_maxo = popop();
+	pp->p_flags &= ~P_UMAX;
+	return (OK);
+}
+
+
+/* PROC_PARAMS -- Check that all of the parameters in the procedure statement
+ * are now defined.  If the mode for these parameters is not declared
+ * set it to AUTO mode.  Also rearrange the parameters so they
+ * agree with order of definition in the procedure statement.
+ */
+void 
+proc_params (int npar)
+{
+	struct	operand	*o;
+	struct	param	*pp, *fp, *lp, *op, *tp;
+
+	if (npar <= 0)
+	    goto setmodes_;
+
+	fp = lp = NULL;
+
+	while (npar--) {
+	    memel p = pop();
+	    o = (struct operand *) p;
+
+	    if (o->o_type != OT_STRING)
+		cl_error (E_UERR,"Invalid parameter in procedure statement.\n");
+
+	    if (npar >= MAX_PROC_PARAMS)
+		eprintf (
+		    "Too many parameters: `%s' cannot be used positionally.",
+		    o->o_val.v_s);
+
+	    parlist [npar] = o;
+
+	    pp = paramfind (parse_pfile, o->o_val.v_s, 0, YES);
+	    if (pp == NULL)
+		cl_error (E_UERR, "Required parameter `%s' not defined.",
+		    o->o_val.v_s);
+
+	    if (pp->p_mode & M_HIDDEN) {
+		/* This parameter was declared as hidden, but was in the
+		 * procedure statement.  Override it with a mode of auto,
+		 * giving the user a warning.
+		 */
+		eprintf ("Warning: mode for parameter `%s' overridden.\n",
+		   pp->p_name);
+	 	pp->p_mode &= ~M_HIDDEN;
+	        pp->p_mode |=  M_AUTO;
+	    } else if (!pp->p_mode)
+	        pp->p_mode = M_AUTO;
+
+	    tp = parse_pfile->pf_pp;
+	    op = NULL;
+
+	    /* Since we've already found pp, this loop must terminate with a
+	     * break.
+	     */
+	    while (tp != NULL) {
+		if  (tp == pp)
+		    break;
+		else {
+		    op = tp;
+		    tp = tp->p_np;
+		}
+	    }
+
+	    /* Take param out of list and add to properly ordered list.
+	     */
+	    if (op == NULL)
+		parse_pfile->pf_pp = tp->p_np;
+	    else
+		op->p_np = tp->p_np;
+
+	    if (lp == NULL)
+		lp = tp;
+
+	    tp->p_np = fp;
+	    fp = tp;
+	}
+
+	lp->p_np = parse_pfile->pf_pp;
+	parse_pfile->pf_pp = fp;
+
+	while (fp->p_np != NULL)	/* Find last parameter. */
+	    fp = fp->p_np;
+	parse_pfile->pf_lastpp = fp;
+
+setmodes_:
+	/* Insure that all parameters have a mode.  The default in a procedure
+	 * script is hidden.  
+	 */
+	tp = parse_pfile->pf_pp;
+	while (tp != NULL) {
+	    if (!tp->p_mode)
+		tp->p_mode = M_HIDDEN;
+	    tp = tp->p_np;
+	}
+}
+
+
+/* INITPARAM -- Get a new parameter and initialize appropriate fields.
+ */
+struct param *
+initparam (struct operand *op, int isparam, int type, int list)
+{
+	struct	param *pp;
+	extern	char *e_lookparm;
+	int	slen;
+
+	pp = paramfind (parse_pfile, op->o_val.v_s, 0, YES);
+
+	if (pp == NULL) {
+	    pp = newparam (parse_pfile);
+
+	    slen = strlen(op->o_val.v_s) + 1;
+	    pp->p_name = memneed (btoi(slen));
+	    strcpy (pp->p_name, op->o_val.v_s);
+	    pp->p_type = maketype (type, list);
+
+	    /* Do not initialize the mode of a parameter in a procedure 
+	     * script.  They will be initialized in proc_params().
+	     */
+	    if (parse_state != PARSE_PARAMS) {
+	    	if (isparam)
+		    pp->p_mode = M_HIDDEN;
+	        else
+		    pp->p_mode = M_LOCAL;
+	    }
+
+	    pp->p_mino.o_type = 0;
+	    pp->p_maxo.o_type = 0;
+	    pp->p_flags |= (P_UMAX|P_UMIN);
+	    pp->p_prompt = undefval;
+	    pp->p_lenval = SZ_FNAME;
+
+	} else if (pp == (struct param *) ERR) {
+	    cl_error (E_UERR, e_lookparm, op->o_val.v_s);
+
+	} else {
+	    pp = NULL;
+	    eprintf (dup_def, op->o_val.v_s);
+	}
+
+	return (pp);
+}
+
+
+/* PROCSCRIPT -- Is this a procedure script? 
+ */
+int 
+procscript (FILE *fp)
+{
+	char	*p, buf[PF_MAXLIN+1];
+	int	result;
+	long	fpos, curpos;
+
+	result = NO;
+	fpos   = 0L;
+	curpos = ftell (fp);
+
+	currentask->t_scriptln = 0;
+	if (curpos != 0)
+	    fseek (fp, 0L, 0);
+
+	while (fgets (buf, PF_MAXLIN, fp) != NULL) {
+	    if (fpos > 0)
+	        currentask->t_scriptln++;
+
+	    for (p = buf; *p == ' '  ||  *p == '\t'; p++)
+		;
+	    if (strncmp (p, "procedure", 9) == 0) {
+		result = YES;
+		break;
+	    } else if ((*p == '#') || (*p == '\n')) {
+		fpos = ftell (fp);
+		continue;
+	    } else
+		break;
+	}
+
+	/* Rewind the file so that the parser sees the procedure statement.
+	 * If NOT a procedure script, rewind the file entirely, as the lexical
+	 * analyzer needs to see the comments to work properly (because of the
+	 * #{ ... #} lexmodes toggle sequences).
+	 */
+	if (result)
+	    fseek (fp, fpos, 0);
+	else
+	    fseek (fp, 0L, 0);
+
+	return (result);
+}
+
+
+/* SKIP_TO -- Within a file, skip to the statement beginning with the key.
+ */
+int 
+skip_to (FILE *fp, char *key)
+{
+	char	*p, buf[PF_MAXLIN+1];
+	int 	count, len;
+	long	fpos;
+
+	len   = strlen (key);
+	count = currentask->t_scriptln;
+	fpos  = 0L;
+
+	while (fgets (buf, PF_MAXLIN, fp) != NULL) {
+
+	    count++;
+	    for (p = buf; *p == ' '  ||  *p == '\t'; p++)
+		;
+
+	    if (strncmp (p, key, len) == 0) {
+		/* Seek back to beginning of line.
+		 */
+		fseek (fp, fpos, 0L);
+		return (--count);
+	    }
+
+	    fpos = ftell (fp);
+	}
+
+	return (ERR);
+}
+
+
+/* DO_OPTION -- Set parameter attributes which have been explicitly
+ * defined by the user.
+ */
+void 
+do_option (struct param *pp, struct operand *oo, struct operand *o)
+{
+	char	*opt;
+
+	/* Determine the options and take appropriate action.
+	 */
+	opt = oo->o_val.v_s;
+
+	if (!strcmp (opt, "mode")) {
+	    /* (There is a scanmode() in pfiles.c.)
+	     */
+	    if (c_scanmode (pp, o) == ERR)
+		cl_error (E_UERR, badopt, "MODE", pp->p_name);
+
+	} else if (!strcmp (opt, "filetype")) {
+	    if (scanftype (pp, o) == ERR)
+		cl_error (E_UERR, badopt, "FILETYPE", pp->p_name);
+
+	} else if (!strcmp (opt, "min")) {
+	    if (scanmin (pp, o) == ERR) 
+		cl_error (E_UERR, badopt, "MIN", pp->p_name);
+
+	} else if (!strcmp (opt, "max")) {
+	    if (scanmax (pp, o) == ERR)
+		cl_error (E_UERR, badopt, "MAX", pp->p_name);
+
+	} else if (!strcmp (opt, "enum")) {
+	    if (scanenum (pp, o) == ERR)
+		cl_error (E_UERR, badopt, "ENUM", pp->p_name);
+
+	} else if (!strcmp (opt, "len") || !strcmp (opt, "length")) {
+	    if (scanlen (pp, o) == ERR)
+		cl_error (E_UERR, badopt,"LEN", pp->p_name);
+
+	} else if (!strcmp (opt, "prompt")) {
+	    int	   slen;
+
+	    if (o->o_type != OT_STRING)
+		cl_error (E_UERR, badopt, "PROMPT", pp->p_name);
+
+	    slen = btoi (strlen(o->o_val.v_s) + 1);
+	    pp->p_prompt = memneed (slen);
+	    strcpy (pp->p_prompt, o->o_val.v_s);
+
+	} else
+	    cl_error (E_UERR, illegal_opt, pp->p_name);
+}
diff --git a/pkg/vocl/doc/ecl.hlp b/pkg/vocl/doc/ecl.hlp
new file mode 100644
index 00000000..8e3a02c3
--- /dev/null
+++ b/pkg/vocl/doc/ecl.hlp
@@ -0,0 +1,1099 @@
+.nf
+		ECL:  Enhanced CL Release Notes and User's Guide
+		================================================
+
+		           Michael Fitzpatrick
+			     NOAO/IRAF Group
+			        12/12/04
+
+			   Revised: 5/28/05
+								
+
+********************************************************************************
+Release History:
+     02/10/05		** Alpha Release for testing
+     05/06/05		** 2nd Alpha Release for testing
+     06/07/05		** 1st Beta Release for testing
+
+
+********************************************************************************
+
+Table of Contents
+-----------------
+
+    Introduction
+
+    Installation and Use
+  	To Install the CL
+  	Determine CL Version Type
+
+    Error Handling
+  	Introduction and Cautions
+  	    Example Descriptions
+  	Reporting Errors
+	    Traceback
+	Trapping Errors
+	    The 'iferr' Syntax
+	    The 'erract' Environment Variable
+	    Error Handling: Then and Now
+	New CL parameters
+	What Errors Are NOT Trapped
+
+    Command-line History and BackSpace Revisions
+	Input Command Summary
+
+    New Builtin Functions and Variables
+	Error Functions
+	String Functions
+	Trig Functions
+	Utility Functions
+	Bitwise Operations
+
+    Defined Constants
+
+    Post-Release Notes
+
+
+********************************************************************************
+
+============
+Introduction
+============
+
+    The primary goals of the ECL project were to 
+
+	o  add an error-handling capability to the existing IRAF CL, 
+	o  include other functionality which could improve the
+	   scripting environment (e.g. pre-defined language constants
+	   such as 'PI') and add any other features we found lacking
+	   (e.g. missing trig functions and string utilities), and
+	o  add commonly requested features.
+
+Where possible, small enhancements such as a new utility builtin function
+will be implemented in the "old" CL as well, however as scripts begin to
+use the more advanced features scripts will naturally become less backward
+compatible.  Future work will build on the version presented here with
+the hope that users will migrate to the new system over a short time.
+
+	This is a work in progress.  Users are encouraged to experiment with
+features, request future enhancements, and to please report any errors or
+problems to 
+		iraf@noao.edu
+
+New releases will be announced on the IRAF website (http://iraf.noao.edu)
+following the addition of any new features or when critical bugs have been
+fixed.
+
+
+
+====================
+Installation and Use
+====================
+
+	The ECL is being distributed in a self-extracting script file
+rather than the traditional IRAF external package since it is meant to
+overlay an existing IRAF system until the time when it becomes part of
+the core distribution.  Since the script creates a new command link in
+the unix system "local bin directory" and adds files to the IRAF source 
+tree, it MUST be run as the root user (the script will terminate or ask
+if you wish to proceed with a no-op installation otherwise).
+
+The installation script does the following to your system:
+
+    1)  Replaces the existing hlib$cl.csh script with a modified 
+	version after creating a hlib$cl.csh.ORIG backup file
+
+    2)  Creates an "ecl" command link in the same directory as the
+	current "cl" IRAF command link.  Both links point to the same
+	hlib$cl.csh script which checks for how it was called an 
+	invokes the proper binary.
+
+    3)  Moves the "ecl.e" binary to the proper iraf$bin.<arch> directory,
+	changing the ownership to the 'iraf' user and setting the execute
+	permissions on the file.
+
+    4)  Creates a iraf$pkg/ecl directory and moves all ECL sources there.
+
+The install script may be run from any directory on the system, it is
+unpacked in /tmp and cleans up temp files when complete.   A "personal
+installation" option is not implemented at this time but could be considered
+later for users who don't have write permission on their IRAF tree.  Please
+contact iraf@noao.edu for instructions on how to manually setup such a
+system for personal use.
+
+
+To Install the ECL
+------------------
+
+Step 1)	Download the distribution file appropriate for your system.  For
+	example, 
+
+        	% ftp iraf.noao.edu (140.252.1.1)
+        	login: anonymous
+        	password: [your email address]
+        	ftp> cd pub
+        	ftp> binary
+        	ftp> get ecl_install_redhat.csh
+        	ftp> quit
+
+Step 2) Execute the script AS ROOT:
+
+		% su				# become the root user
+		# ./ecl_install_redhat.csh
+
+	The script will prompt you for the local bin directory or any 
+	iraf paths needed, simply accept the default values determined for
+	your system or override them with others.
+
+	Once executed, the ECL source and binaries will be installed in
+	the system as described above.  The file you are reading right
+	now is available as iraf$pkg/ecl/Notes.ecl and will be updated
+	with post-release notes at the end of the file with each new
+	release.
+
+Step 3) Start the ECL from your normal IRAF login directory as either
+
+		% ecl
+	or
+		% cl -ecl
+
+	The second form of the command is needed on systems which mount
+	IRAF from another machine since the CL command links are created
+	at IRAF install time.  One reason for replacing the hlib$cl.csh
+	script is to allow for the "-ecl" argument to override the binary
+	to be used on systems where only the 'cl' command is available and
+	so that the installation isn't required on all machines mounting
+	a common IRAF.
+
+	The default ECL prompt is now "ecl>" in the new version as a visual
+	clue that the new system is being used.  Additionally, package prompts
+	default to using the complete package name rather than the familiar
+	2-character prefix as another clue.  This behavior can be changed
+	by adding the string "nolongprompt" to the CL 'ehinit' parameter,
+	e.g.
+
+	       cl> cl.ehinit = cl.ehinit // " nolongprompt"
+
+
+Except as described below, use of the ECL should be identical to the
+traditional CL for most users.
+
+
+Determining CL Version
+----------------------
+
+	As users begin to make regular use of features found only in the
+ECL, the first error to be checked is that the script is running using the
+proper version of the CL.  This needs to be done using features found in
+both the ECL and traditional CL languages.  The simplest test, for either
+package loading scripts or within tasks, is something like
+
+	if (defpar ("$errno")) {
+	    print ("You are using the ECL")
+	} else {
+	    print ("You are using the old CL")
+	}
+
+
+
+
+==============
+Error Handling
+==============
+
+Introduction and Cautions
+=========================
+    
+    The error-handling enhancements are composed of two elements: 
+
+	o  the reporting of errors within scripts, and
+	o  the ability to trap and recover those errors.  
+
+The first case addresses the long-standing problem in which an error message
+returned by a script gives a line number that has no basis in reality, and
+which gives no useful information about the underlying task that created it.
+In the second case, one often wants scripts to be able to trap errors from
+compiled tasks so that some sort of cleanup can be done in order to allow
+the script to continue, or so that an error status code can be examined
+and some specific action taken (which may simply be to ignore the error).
+
+    In the ECL, messages are now printed with the correct line number and
+with a detailed traceback to the user's command-line showing more precisely
+what was called at the time of the error.  New language constructs are
+available which allow scripts to conditionally check for errors from
+tasks they call and branch to code to deal with those errors.  Finally,
+new ECL environment variables and builtin functions allow for limited
+error-handling control over scripts already in the system which have not
+been retrofitted to specifically trap errors.  Details of each of these
+capabilities and examples of how they may be used by developers and users
+are given below.  It is also worth discussing the types of errors which
+can occur in a script task before getting into details about how they
+might be handled by the user or script programmer.
+
+Error conditions in the CL break down into roughly the following types:
+
+          Error Type	       		Examples
+          ----------			--------
+
+    Compiled Task Errors    1) A call to a compiled task in the system
+			       dies unexpectedly with an exception (e.g.
+			       FPE, segmentation violation, etc)
+			    2) A task aborts due to an error condition the
+			       task has trapped and cannot recover (e.g.
+			       invalid parameters, out of memory, etc).
+
+    CL Internal Errors	    1) Script code performs an illegal operation
+			       causing an exception (e.g. "i = j / k"
+			       where 'k' is zero.
+			    2) Script code triggers a runtime error within
+			       the CL itself (e.g. "log (string_value)")
+
+    CL Error Assertions	    1) Script programmer forces the task to exit
+			       with a call to the CL error() builtin.
+			    2) Script programmer simply prints and error
+			       message indicating a problem and returns
+			       without further processing.
+
+All of these errors can be detected at some level, however not all of
+them can be handled in a way which allows a calling script to recover
+and continue executing, nor would it always make sense to do so.
+Errors such as a floating-point-exception (FPE) may be data-dependent,
+a segmentation violation may indicate a coding error in a compiled task
+or a platform-specific bug, or an error in another script task may be
+beyond the control of the scripter to fix.  Error assertions by a script
+programmer are not meant to be recoverable, and in the second example
+an arbitrary problem message cannot be trapped by the system.
+
+    An error-handling capability in the ECL (or any language) is not a
+panacea for all error conditions one might encounter, the best a script
+programmer can hope to do is to trap an error and take some reasonable
+action at the time.  The ECL offers a way for a script to print a more
+meaningful error message, or at least abort gracefully after cleaning
+itself up.  However, depending on the type of error,  *your* script may
+still never run to completion until somebody else fixes *their* code.
+
+    Lastly, it is also important to note that trapping an error means the
+script finds itself in an unnatural state.  Proper recovery requires
+that the script programmer understand the error condition as well as
+the state of the script at that point of execution.  The error-handling
+code must restore the script to a state where it can continue running
+(if possible) and avoid potential side-effects caused by e.g. forgetting
+to clean up intermediate files or reset counter variables.  New language
+features mean new types of bugs can be introduced into a script, even if
+the irony is that these new features are meant to trap bugs!
+
+
+Example Descriptions
+--------------------
+
+	In the examples to follow we will make use of an ERRTEST package
+distributed with the ECL source and containing the following tasks used
+in the examples to follow:
+
+     nested -- Test various error conditions from layered scripts
+      nest0 -- Dummy layer for nested testing
+    errtype -- Low-level script to test compiled and CL error conditions
+    
+        fpe -- Compiled task producing an arithmetic exception
+     segvio -- Compiled task producing a segmentation violation
+     spperr -- Compiled task invoking the SPP error() function
+    
+
+
+Reporting of Errors
+===================
+    
+Traceback
+---------
+
+    The most obvious change to users will be in the traceback of errors
+reported by the ECL.  As an example, suppose we have a test script
+called NESTED that calls several layers of other scripts until it gets
+to a compiled task called FPE which simply triggers a divide-by-zero
+arithmetic exception.  The calling sequence we use is
+
+	NESTED (type)			# toplevel test task
+	    NEST0 (type)		# hidden script task
+		ERRTYPE (type)		# script task
+		    FPE ()		# compiled task giving the error
+
+(The 'type' argument here is a code used to test various types of system
+errors but its value isn't important to the current discussion.)  In the 
+traditional CL, executing this script results in the following and familiar
+message:
+		cl> nested 1
+		ERROR on line 72: floating point divide by zero
+		    errtype (type=1)
+		    nested (type=1)
+
+There are a number of issues with the error report here we wish to correct:
+
+    1)  The error is reported to be on line 72, but none of the scripts
+        called invoke any task on that line, or even have that many lines,
+        and so it is clearly wrong.
+    2)  Was it the ERRTYPE script that caused an error or something else?
+    3)  There is no mention of the FPE task we know to be the culprit.
+
+These problems are resolved in the ECL where the error report now looks like:
+
+	cl> nested 1
+	ERROR: floating point divide by zero
+	  "fpe ()"
+	     line 15: errtest$errtype.cl
+	     called as: `errtype (type=1)'
+	  "errtype (type)"
+	     line 13: errtest$nest0.cl (hidden task)
+	     called as: `nest0 (type=1)'
+	  "nest0 (type)"
+	     line 11: errtest$nested.cl
+	     called as: `nested (type=1)'
+
+The traceback is more complete and begins with the task which actually
+throws the error.  Checking the line numbers of the ERRTEST package
+scripts we find that indeed FPE is called on line 15 of 'errtype.cl',
+ERRTYPE is called from line 13 of 'nest0.cl', and so on.
+
+    For each task in the calling sequence the format of the traceback is
+
+	<script code fragment executing at the time of error>
+	   LINE <number>: <script file containing line>
+	   CALLED AS: <how this script was called>
+
+The length of the traceback may be controlled with the new 'erract'
+environment variable discussed in more detail below.  In short, 'erract'
+allows the traceback to be suppressed entirely, to print information only
+at the level where the error occurred, or to print a full calling stack
+trace (default).
+
+
+Trapping Errors
+===================
+
+The 'iferr' Syntax
+------------------
+
+    The ECL provides new language constructs to enable error actions, error
+handling and recovery.  This syntax will already be familiar to SPP programmers
+and will quickly become obvious to even novice script programmers.
+
+    Error recovery is implemented using the IFERR and IFNOERR statements
+to "post" an error handler that is called at the end of a block of code and
+which checks for error conditions that may have occurred in that block.
+The syntax for these statements is of the form:
+
+
+    iferr { <statement> } 		ifnoerr { <statement> }
+        <error action statement> 	    <success action statement>
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 	    	    <block of statements>
+    } then 				} then
+        <error action statement> 	    <success action statement>
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 		    <block of statements>
+    } then { 				} then {
+        <block of error stmts> 		    <block of success action stmts>
+    } 					}
+
+
+The IFERR is grammatically equivalent to the IF statement and means "if an
+error occurs during the processing of the enclosed code, execute the error
+action statement to follow".  IFNOERR is the same except that the sense
+of the test is reversed and the action statements are executed only if the
+enclosed code completes without error.  Additionally, these statements take
+an ELSE clause allowing both forms of the test to be combined.  For example,
+
+
+    iferr { 				ifnoerr {
+        <block of statements> 		    <block of statements>
+    } then { 				} then {
+        <error stmts> 		    	    <success stmts>
+    } else { 				} else {
+        <success stmts>	    	    	    <error stmts>
+    } 					}
+
+
+In all cases 
+
+    o  Curly braces around the code to be checked are required,
+    o  Curly braces are required when any action is a compound block 
+    o  The THEN statement is optional if a single statement is executed
+       as part of the action block
+    o  The THEN statement is required for a compound action or when using
+       an ELSE clause
+    o  It is a syntax error for a condition block to itself directly contain
+       an IFERR or IFNOERR statement and action statements, i.e.  IFERR
+       statements may not be nested
+
+
+    To make effective use of these statements a few points need to be
+kept in mind:
+
+    o   The check for errors happens only after ALL statements in the
+	condition block are executed;
+    o   Statements which generate errors did not execute to completion,
+	subsequent code relying on that result cannot be trusted
+    o   Code in the condition block which executes following an initial
+	error may itself trigger errors due to the failure of a previous
+	statement or the resulting side-effects;
+
+This implies that IFERR statements should be used to target only critical
+pieces of code where a particular error condition might be expected, and/or
+where an action block could reasonably react to that error.  As an example
+of how ignoring these points could be problematic consider the code snippet:
+
+	iferr {
+	    task_a ()
+	    task_b () | scan (x)
+	    task_c (x)
+	} then {
+	    error (99, "An error occurred\n")
+	}
+
+All three tasks in the condition block will be executed, however the
+behavior of the code being check depends on which task in the block fails;
+If 'task_a' fails there may be no consequences for the remaining calls,
+however if 'task_b' fails the value of 'x' may never be set and 'task_c'
+may also fail (or at least produce spurious results).  Cascading errors like
+this will also be trapped and the action statement will still execute, but
+the system error message strings will be incomplete (more about that below).
+
+    While it is possible to have a failure from each statement in a condition
+block branch immediately to the action block by checking each statement
+individually, doing so would permit poor programming practices such as
+iteratively testing for the name of the failed task and taking different
+recovery methods in the action block.  If this is actually required for the
+script to recover cleanly, the recommended method is to put an IFERR block
+around smaller pieces of code where the recovery statements relate more
+directly to the code being checked.
+
+Errors trapped by IFERR statements include:
+
+    o  System exceptions (FPE, segfault, etc) thrown by compiled tasks
+    o  SPP error() returns from compiled tasks
+    o  CL script error() assertions
+
+Below we discuss errors which cannot be trapped using the IFERR syntax as
+well as strategies for how to handle those errors which can be detected.
+We'll also see how to determine which task in a condition block failed
+and why.
+
+
+The 'erract' Environment Variable
+----------------------------------
+
+	The ECL has a new 'erract' environment variable used to control the
+different aspects of the error handling.  This is a whitespace-delimited
+string comprised of the following options:
+
+
+    abort	Script task should abort at an error and begin error
+		recovery back to the command-line
+
+    noabort	Task should not abort, but continue execution if possible
+
+    trace	Print a traceback of the calling sequence including all
+		line numbers and calling statements
+
+    notrace	Print only the error message, no linenumbers or calls
+
+    clear	Clear the error params (i.e. $errmsg, $errnum, $errtask)
+		at each new task call.  This reseets the params with each
+		task invocation allowing them to be examined after each
+		call regardless of whether the code is in an IFERR block.
+
+    noclear	Do not clear the CL error params at each new task call,
+		the params are only reset when an error is encountered.
+
+    flpr	Automatically issue a 'flpr' when an error is seen.  This
+		is used to flush any failed task from the process cache to
+		avoid potential future problems caused by a corrupted task.
+
+    noflpr	Do not issue a 'flpr' when an error is seen, tasks remain
+		in the process cache, possibly in an error state.
+
+    full	Print a complete traceback of the calling sequence.
+
+    nofull	Print only the error report for the task causing the error
+		and none of its parents.
+
+
+The default value is set as:
+
+    set erract = "abort trace flpr clear full"
+
+Note that erract is implemented as an environment variable rather than
+as a new CL parameter (similar to the ehinit/epinit params) in order to
+minimize changes in the CL parameter file itself during the transition
+to the ECL.  The difference is that the 'set' (ore 'reset') command must
+be used to define the values, whereas with ehinit/epinit they may be
+assigned directly.  For this variable it is also possible to (re)define
+a single parameter without affecting other options, e.g.
+
+    cl> show erract			# print options
+    abort trace flpr clear full	
+    cl> set erract = "noabort"		# reset one of them
+    cl> show erract			# print options again
+    noabort trace flpr clear full
+
+
+
+Error Handling: Then and Now
+----------------------------
+
+    To better understand the new error detection and recovery behavior
+(and to document this for future reference), let's look at the old error
+mechanisms of the CL language:  Any command called from the CL executes in a
+context defined by the task hierarchy initiating the command, i.e. from the
+command-line CL prompt one has a "first" task context, scripts calling child
+(compiled or script) tasks push a new CL context inheriting the current
+CL environment and who's 'parent' is the context that invoked the task.
+
+    In the traditional CL with an error occurring in a compiled task,
+recovery first takes place in the SPP code who may choose to either handle
+the error itself or may abort completely by doing a long-jump back to the
+IRAF main() procedure (i.e. an EA_FATAL error type).  In this latter case,
+the process binary (running as a detached process from the CL) sends an
+error() command back to the CL telling it the task has terminated abnormally
+(a normal task shutdown leaves the executable simply waiting for more input
+from the CL, e.g. another task to execute).  This returned error() statement
+is the same CL error() command one would use to abort a script task, and its
+effect is to tell the CL to abort the current context and long-jump back
+to the command-line after cleaning up running processes and freeing the
+dictionary space (what the CL uses to catalog tasks/packages, parameters,
+etc).  [NOTE: Whether it is a system exception or a programmer-posted error,
+the error sent back to the CL has always included both the error code and
+message, it is just that the CL has never made use of these until now.]
+Similarly, errors which occur while running script tasks (e.g. 'task not
+found' errors, invalid use of string values, divide-by-zero from local
+script variables, etc) also end up in the same CL error() procedure via
+internal procedure calls made while executing the script.
+
+    Syntax errors are caught when the script is 'compiled' into the opcode
+execution stack and are reported before the script begins to execute.
+A script calling a child script containing a syntax error cannot trap
+that error even though it will not be reported until the child script is
+'compiled' just prior to execution.  We assume that all script tasks are
+well-formed and free of ntax errors.
+
+    ECL error recovery is somewhat simplified by the fact that errors,
+either from external tasks or the execution of scripts, all converge in
+a single procedure in the CL source code.  The trick is to modify the
+runtime behavior of the CL so that once we know we have an error we can
+branch to conditional code instead of simply jumping all the way back to the
+command line.  Since we also wish to improve the error reporting we'd also
+like make better use of information about how the failed code was called.
+
+    The first step is to realize that when executing a script the CL
+language is "compiled" into a series of 'opcode' instructions comprising an
+intermediate runtime language (similar to assembly language).  Scripts are
+run by executing the opcode instruction at the current 'program counter'
+location, pushing task arguments or getting labels for jumps from the
+dictionary, restoring a previous CL context, etc.  The compilation stage
+already has information about the script line being parsed so by adding
+this line-number to the opcode instruction it is now possible to trace a
+fault in any opcode back to the originating line of the script, and from
+there back up to the command line through the calling tree.  This extra
+information makes the runtime size of the script slightly larger so
+extremely large scripts may experience "dictionary full" problems not
+previously seen (various CL buffer sizes were increased to help offset
+this problem).  This relatively minor change is all that is required to
+address the problems mentioned above in error reporting.
+
+    Error trapping and recovery is done in a manner similar to the
+implementation in SPP:  The IFERR statement isn't actually an instruction
+in the runtime script, rather it is used to tell the parser to insert
+code around the block to be checked using traditional IF statements.
+As an example, consider
+
+	iferr { 
+	    task1 (arg1, arg2) 
+	    task2 (arg1)
+	} then {
+	    recovery ()
+	}
+
+When compiled this is the equivalent of writing
+
+
+	_errpsh () 
+	task1 (arg1, arg2) 
+	task2 (arg1)
+	if (_errpop () != 0) {
+	    recovery ()
+	}
+
+The _errpsh() is a hidden builtin function which "pushes" an error
+structure onto the runtime stack, the _errpop() test at the end then
+queries that structure to see whether any statement since the previous
+push set the error flag and filled in the structure with the task name,
+line number and other information.  The push also temporarily deactivates
+the behavior of the error() function so it no longer aborts entirely,
+allowing the script to continue after cleaning up the current error.
+
+	In order to keep the model simple, nested iferr statements within
+the same script are not currently implemented but are a possible future
+enhancement.  Complications arise from examples such as
+
+	iferr { 
+	    task1 (arg1, arg2) 
+	    iferr { task2 (arg1) } then 
+	        recovery2 ()
+	} then {
+	    recovery1 ()
+	}
+
+Consider the case where task1() succeeds and task2() fails and is
+recovered properly with the recovery2() procedure.  As far as the outer
+IFERR block is concerned, did an error occur or not?  If the remainder of
+the script depends on task2() succeeding then the answer is possibly 'no'
+(depending on what the recovery does) and we should additionally call
+the recovery1() procedure (who is responsible for dealing with an error
+condition in that block), if there is no dependency then we may want
+*any* failure to be considered, or perhaps even have a way to "clear"
+error conditions within the block.  Now assume instead it is the first
+task which fails and that triggers the second to fail because we depend
+on the first succeeding, how should we post the error number/message for
+the script?  We simply disallow nested IFERR statements for the moment
+to avoid dealing with these complex interactions
+
+
+New CL parameters
+===================
+
+	On order for script programmers to make use of errors that have
+been trapped by the ECL, one generally needs access to the details of
+that error, e.g. the message, task name, error number, etc.  To this end
+the ECL implements several new pseudo-parameters and builtin functions
+containing this information.  These include
+
+    Param	    Function        Meaning
+    -----	    --------        -------
+    $errno	    errno()	    The system error number
+    $errmsg	    errmsg()	    The system error message string
+    $errtask	    errtask()	    Task which created the error
+
+By default these parameters are re-defined as each task is called, in theory
+allowing a script to trap errors without the IFERR by doing something like
+
+	mytask1 () 
+	if ($errno != 0) <statement>
+	mytask2 () 
+	if ($errno != 0) <statement> 
+	    :
+
+This behavior can be modified by the 'erract' environment variable 'clear'
+or 'noclear' settings so that they only change when an error condition is
+found (i.e. erract set to 'noclear', tasks which complete successfully
+do not modify variables).
+
+	Additionally, a new $err_dzvalue pseudo-parameter is defined to
+be used by the CL interpreter when a divide-by-zero condition is encountered
+in the CL itself.  (This value has no builtin function equivalent.)
+This is an integer and will be cast to floating-point automatically if
+needed, the default value of 1 (one) was chosen to allow the script to
+continue executing but it should be noted that this value is only used
+when an error is found within an IFERR block.  For example,
+
+	ecl> = 1 / 0
+	ERROR: integer divide by zero
+	ecl> = 1. / 0.
+	ERROR: floating divide by zero
+
+However,
+
+	ecl> iferr {
+	>>>     = 1 / 0
+	>>> } then ;;
+	Warning on line 31 of : integer divide by zero - using $err_dzvalue = 1
+	1
+
+Note the warning message indicating the use of the parameter followed by the
+result.
+
+
+
+What Errors Are NOT Trapped
+===========================
+
+	As mentioned above, not all CL errors can or should be trapped
+by the new system.  The (incomplete) list of error conditions which 
+CANNOT be trapped during task execution using the IFERR or other new
+features includes:
+
+    o CL-language syntax errors
+    o CL internal errors, for example
+	- invalid procedure arguments (e.g. "parameter not found")
+	- improper usage of intrinsic procedures (e.g. log(-10) )
+	- operand type mis-matches (e.g. "s1 + x")
+	- parser errors (e.g. newline in string)
+    o CL runtime errors
+	- too many background jobs (e.g. "no available job slots")
+	- insufficient resource messages (e.g. out of memory)
+	- can't read/write/create files (e.g. permissions problem on uparm$)
+	- ambiguous task name
+	- scan/print string exceeds max length
+    o User-defined error messages and returns (i.e. the script writer
+	outputs an error message and returns from the procedure but 
+	does not use something like thea CL error() function to abort.
+	For instance, a script prints "I can't run this on Tuesdays" and
+	returns to the command-line but does not otherwise post an error
+	condition for the calling context.
+
+    
+
+============================================
+Command-line History and BackSpace Revisions
+============================================
+
+	The ECL now implements the common GNU Readline interface for input
+handing meaning that many familiar tcsh-like features such as Up/Down-Arrow
+history, Left/Right cursor-position movement, and tab-filename completion
+are now understood in the IRAF environment.  It follows that many of
+the problems encountered with the DEL/BS key to erase characters when
+entering input on the commandline have also been eliminated on most
+systems since the readline interface internally handles the delete-key
+mappings imposed on most systems.  Tab-completion of task/params names
+was not implemented in this initial release but could be added later.
+
+	It is important to note that this implementation was done so as
+to not interfere with the native IRAF ehist/epar cursor and history
+mechanism.  From the ECL prompt, all commands recognized by readline()
+interface (including user mappings defined in an ".inputrc" file) will
+be honored.  If that command is ehist/epar or one of the recognized
+IRAF history editing meta-characters then these will be processed in the
+traditional IRAF manner.
+
+	Should a problem with readline input be found, it can be disabled
+from the user's session by adding the string "noreadline" to the CL
+'ehinit' parameter, e.g.
+
+	ecl> cl.ehinit = cl.ehinit // " noreadline"
+
+
+
+Input Command Summary
+---------------------
+	
+	The following Control/Meta key sequences are understood by the 
+readline() interface for command input:
+
+  Basic Commands
+
+    Ctrl-b 	    Move cursor back one character. 
+    Ctrl-f 	    Move cursor forward one character. 
+    DEL 	    Delete the character to the left of the cursor. 
+    Backspace 	    Delete the character to the left of the cursor. 
+    Ctrl-d 	    Delete the character underneath the cursor. 
+    Ctrl-_ 	    Undo the last editing command
+    Ctrl-x Ctrl-u   Undo the last editing command
+
+    Up-Arrow 	    Move up through the command-history list
+    Down-Arrow 	    Move down through the command-history list
+    Left-Arrow 	    Move cursor left one character on command line
+    Right-Arrow     Move cursor right one character on command line
+
+  Cursor Movement Commands
+
+    Ctrl-a 	Move to the start of the line. 
+    Ctrl-e 	Move to the end of the line. 
+    Meta-f 	Move forward a word, where a word is composed of letters/digits.
+    Meta-b 	Move backward a word. 
+    Ctrl-l 	Clear the screen, reprinting the current line at the top.
+
+  Text Deletion Commands
+
+    Ctrl-k 	Kill the text from the current cursor position to the end of
+		the line.
+    Meta-d 	Kill from the cursor to the end of the current word, or, if
+		between words, to the end of the next word. Word boundaries
+		are the same as those used by Meta-f.
+    Meta-DEL 	Kill from the cursor the start of the current word, or, if
+		between words, to the start of the previous word. Word
+		boundaries are the same as those used by Meta-b.
+    Ctrl-w 	Kill from the cursor to the previous whitespace. This is
+		different than Meta-DEL because the word boundaries differ.
+
+    To yank (copy the most-recently-killed text from the kill buffer) the text
+    back into the line:
+
+    Ctrl-y 	Yank the most recently killed text back into the buffer at
+		the cursor.
+    Meta-y 	Rotate the kill-ring, and yank the new top. You can only do
+		this if the prior command is Ctrl-y or Meta-y. 
+
+  History Searching Commands
+
+    Ctrl-r	Search backward through the history for a particular string
+    Ctrl-s	Search forward through the history for a particular string
+    ESC		Terminate the search
+    Ctrl-g	Terminate the search and restore original line
+
+	As each character of the search string is typed, Readline displays
+    the next entry from the history matching the string typed so far. An
+    incremental search requires only as many characters as needed to
+    find the desired history entry.  To find other matching entries in
+    the history list, type Ctrl-r or Ctrl-s as appropriate from the current
+    search position.
+
+    NOTE:  In many terminal settings the Ctrl-s key is mapped to the tty
+   	'stop' character and the window will appear to no longer accept 
+	input.  In these cases a Ctrl-q will normally return the terminal
+	to proper function and so the forward search mechanism isn't
+	generally recommended.
+
+
+
+=====================
+New Builtin Functions
+=====================
+
+Error-Handling Functions
+------------------------
+
+	The following builtin functions were added as alternatives to the
+matching CL parameters.  The difference is almost entirely stylistic and
+the rules about the longevity of the values described above apply in either
+case.
+
+      errmsg ()		Return last error message string (i.e. cl.$errmsg)
+      errcode ()	Return last integer error code  (i.e. cl.$errno)
+      errtask ()	Return taskname posting fatal error (i.e. cl.$errtask)
+
+Examples:
+
+	iferr {
+	    sometask (par1, ....)
+	} then {
+	    printf ("Error in '%s': %s\n", errtask(), errmsg())
+	    # or equivalently
+	    printf ("Error in '%s': %s\n", $errtask, $errmsg)
+	}
+
+
+
+String Functions
+----------------
+
+	Beginning with V2.12.2 several new functions were added to the
+CL to improve string handling and the provide complementary functions
+to those which already exist.  Items marked with a '*' first appeared in
+V2.12.2, all others are new to this release.  
+
+New functions include:
+
+    isindef (expr)							(*)
+       	Can be used to check for INDEF values in expressions.  INDEF
+       	values may be tested for equality, however when otherwise used
+       	in a boolean expression the result of the boolean is also
+       	INDEF.  This function can be used to trap this particular
+       	case, or for INDEF strings/variable directly.  Result is a
+       	boolean yes/no.
+
+       	Example:
+	    cl> junk = fscan (threshold, tval)
+	    cl> if (isindef (tval) == yes) 
+	    	error (0, "INDEF 'threshold' parameter value")
+
+    strlwr (str)							(*)
+    strupr (str)							(*)
+       	Convert the string to lower/upper case, returns a string.     
+
+       	Example:
+	    cl> s1 = "test" ; s2 = "TEST"
+	    cl> = strupr (s1) ; = strlwr (s2)
+	    TEST
+	    test
+
+    strstr (str1, str2)							(*)
+       	Search for first occurance of 'str1' in 'str2', returns index
+       	of the start of 'str1' or zero if not found.
+
+       	Example:
+	    cl> = strstr ("imh", "imhead.imh")
+	    1
+	    cl> = strstr ("head", "imhead.imh")
+	    3
+
+    strldx (chars, str)							(*)
+       	Complement to the stridx() which returns the last occurance of
+       	any of 'chars' in 'str'.  Returns index of last char or zero
+       	if not found.
+
+       	Example:
+	    cl> = strldx (".", "junk.fits")
+	    5
+		
+
+    strlstr (str1, str2)						(*)
+       	Search for last occurance of 'str1' in 'str2', returns index
+       	of the start of 'str1' or zero if not found.
+
+       	Example:
+	    cl> = strlstr ("imh", "imhead.imh")
+	    8
+
+       [NOTE: String indices are 1-indexed in the CL]
+
+    trim (str [, trimchars])
+    triml (str [, trimchars])
+    trimr (str [, trimchars])
+	Trim any of the chars in 'trimchars' from the ends of 'str'.
+	The trim() function removes chars from both the front and back
+	of the string, triml() removes only from the left side of the
+	string, and trimr() removes only from the right side.  If the
+	'trimchars' argument is not specified the whitespace chars
+	(tab and space) are assumed.  
+
+			 
+       	Example:
+	    cl> printf ("'%s'\n", trim ("   test   "))
+	    'test'
+	    cl> = trimr ("/iraf/iraf///////", "/")
+	    /iraf/iraf
+
+	    To check for strings containing only whitespace:
+
+	        if (trim (foo) == "")
+	            error (0, "no legal value specified for 'foo'")
+
+
+        The new string functions are particularly useful for dealing with
+pathnames where one needs to find and extension, separate a file from a
+path prefix, trim trailing slashes. and so on.
+
+	Additionally, the existing substr() function has been modified to
+allow a 'last' index greater than a 'first' index, in which case the return
+string is reversed.
+
+
+Trig Functions
+--------------
+
+	The following trigonometric functions have been added as new builtins
+to the CL.  These complement existing functions as well as provide utility
+versions to simplify degree/radian conversion.
+
+      asin (arg)	    Inverse SIN, result in radians
+      acos (arg)	    Inverse COS, result in radians
+
+      rad (rad_arg)	    Convert arg in radians to degrees
+      deg (deg_arg)	    Convert arg in degrees to radians
+
+      dsin (deg_arg)	    Sine function, arg in degrees
+      dcos (deg_arg)	    Cosine function, arg in degrees
+      dtan (deg_arg)	    Tangent function, arg in degrees
+      dasin (arg)	    Inverse sine function, result in degrees
+      dacos (arg)	    Inverse cosine function, result in degrees
+      datan2 (y, x)	    Inverse tangent function, result in degrees
+
+
+Utility Functions
+-----------------
+
+  The following utility functions have been added.
+
+      fp_equal (arg1, arg2) Floating point compare (w/in machine precision)
+      hypot (x, y)	    Euclidean distance (i.e. sqrt (x*x + y*y))
+      sign (arg)	    Sign of argument (-1 or 1)
+
+
+  Examples:
+	cl> = fp_equal (1.2345, 1.234)
+	0
+	cl> = hypot (3, 4)	# may also take real arguments
+	5
+	cl> = sign (-23)	# may also take real arguments
+	-1
+
+
+Bitwise Operations
+------------------
+
+	The following bitwise operands have been added in the V2.12.2b.  
+Note that these are bitwise operands and not logical operands.  While there 
+is presently no direct need for these they are seen as potentially useful
+in e.g. evaluating bit-flags stored in image header keywords and support the
+goal of providing a richer scripting language.
+
+      not (arg1)	    Bitwise boolean NOT of an integer  
+      and (arg1, arg2)	    Bitwise boolean AND of two integers
+      or (arg1, arg2)	    Bitwise boolean OR of two integers
+      xor (arg1, arg2)	    Bitwise exclusive OR of two integers
+
+  Examples:
+      cl> = radix (12, 2)	# print bit pattern of number 12
+      1100
+      cl> = radix (13, 2)	# print bit pattern of number 13
+      1101
+
+      cl> = and (12, 13)	# 1100 & 1101 == 1100
+      12	
+      cl> = or (12, 13)	# 1100 | 1101 == 1101
+      13	
+      cl> = xor (12, 13)	# (1100 & ~1101) | (~1100 & 1101) == 1
+      1	
+
+      cl> = not (12)
+      -13
+      cl> = radix (not(12), 2)
+      11111111111111111111111111110011
+
+
+
+=================
+Defined Constants
+=================
+
+	The ECL also introduces the ability to use common numerical and
+physical constants in scripts as part of the language keyword set.  Constants
+are, by convention, always upper case identifiers and are listed in the table
+below:
+
+  Numerical constants				
+  +---------------------------------------------------------------------+
+  |  Name		| Value			 | Units		|
+  +---------------------------------------------------------------------+
+  |  BASE_E          	| 2.7182818284590452353	 |			|
+  |  FOURPI          	| 12.566370614359172953	 |			|
+  |  GAMMA           	| .57721566490153286061	 |			|
+  |  HALFPI          	| 1.5707963267948966192	 |			|
+  |  LN_10           	| 2.3025850929940456840	 |			|
+  |  LN_2            	| .69314718055994530942	 |			|
+  |  LN_PI           	| 1.1447298858494001741	 |			|
+  |  LOG_E           	| .43429448190325182765	 |			|
+  |  PI              	| 3.1415926535897932385	 |			|
+  |  RADIAN          	| 57.295779513082320877	 |			|
+  |  SQRTOF2         	| 1.4142135623730950488	 |			|
+  |  SQRTOFPI        	| 1.7724538509055160273	 |			|
+  |  TWOPI           	| 6.2831853071795864769	 |			|
+  +---------------------------------------------------------------------+
+
+  Physical constants				
+  +---------------------------------------------------------------------+
+  |  Name		| Value			 | Units		|
+  +---------------------------------------------------------------------+
+  |  AU              	| 1.49597870691e11       |  m            	|
+  |  GRAV_ACCEL      	| 9.80665e0              |  m / sec^2    	|
+  |  GRAV_CONST      	| 6.673e-11              |  m^3 / kg s^2 	|
+  |  LIGHT_YEAR      	| 9.46053620707e15       |  m            	|
+  |  PARSEC          	| 3.08567758135e16       |  m            	|
+  |  SPEED_OF_LIGHT  	| 299792458.0            |  m / sec      	|
+  |  SOLAR_MASS      	| 1.98892e30             |  kg           	|
+  +---------------------------------------------------------------------+
+
+  For example, these may be used in scripts as:
+
+	area = (PI * radius ** 2) 	# Compute area of circle.
+	rad = degrees / RADIAN		# Convert degrees to radians
+
+
+
+===============================================================================
+# Post-Release Notes
+===============================================================================
+
+.fi
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
diff --git a/pkg/vocl/ecl_install.csh b/pkg/vocl/ecl_install.csh
new file mode 100755
index 00000000..db0bbb57
--- /dev/null
+++ b/pkg/vocl/ecl_install.csh
@@ -0,0 +1,414 @@
+#!/bin/csh -f
+#
+#  ECL_INSTALL -- Install the ECL onto an existing IRAF system or for private
+#  use when you don't have write permission on the iraf tree.
+#
+#  Usage:     ecl_install [-n] 
+#
+#  If run with no arguments, ECL_INSTALL will make an informed guess and prompt
+#  with this value; type <return> to accept the value, or enter a new value.
+#
+#  Use "ecl_install -n" to do a dry run to see what the would be done, without
+#  actually modifying the host system and IRAF configuration files.
+#
+#============================================================================
+
+unset   noclobber
+onintr  ecl_cleanup_
+unalias cd cp cmp echo ln mv rm sed set grep ls chmod chown pwd touch sort
+
+set     path  = (/sbin /usr/sbin /bin /usr/bin /usr/ucb /etc /usr/etc $path /usr /local/bin /opt/local/bin /local/bin /home/local/bin )
+
+
+#============================================================================
+# Global Variables.
+#============================================================================
+
+set hilite            	= 1
+set SKIP              	= `cat $0 | grep -n ^START_OF_DATA | cut -c1-3`
+set SKIP		= `expr $SKIP + 1`
+
+# Identify the installation type.
+set INS_TYPE		= DTYPE
+set INS_VERSION		= VERSION_DATE
+
+
+#============================================================================
+# Utility aliases.
+#============================================================================
+alias PUT      "mv -f \!*; chown $user \!$ "           # [MACHDEP]
+alias BOLD_ON  "(if ($hilite) tput bold)"
+alias BOLD_OFF "(if ($hilite) tput sgr0)"
+alias SO_ON    "(if ($hilite) tput smso)"
+alias SO_OFF   "(if ($hilite) tput rmso)"
+
+alias DO_OK    "(echo -n '[ '; BOLD_ON; echo -n ' OK '; BOLD_OFF; echo ' ]')"
+alias DO_WARN  "(echo -n '[ '; BOLD_ON; echo -n 'WARN'; BOLD_OFF; echo ' ]')"
+alias DO_FAIL  "(echo -n '[ ';   SO_ON; echo -n 'FAIL';   SO_OFF; echo ' ]')"
+
+alias MSG      "(echo -n '   ';BOLD_ON;echo -n '***  ';BOLD_OFF; echo \!*)"
+alias MSGN     "(echo -n '   ';BOLD_ON;echo -n '***  ';BOLD_OFF; echo -n \!*)"
+alias MSGB     "(echo -n '   ';BOLD_ON;echo -n '***  ';echo \!*; BOLD_OFF)"
+alias MSGBN    "(echo -n '   ';BOLD_ON;echo -n '***  ';echo -n \!*;BOLD_OFF)"
+alias ERRMSG   "(echo -n '   ';BOLD_ON;echo -n 'ERROR: ';BOLD_OFF; echo \!*)"
+alias WARNING  "(echo -n '   ';BOLD_ON;echo -n 'WARNING: ';BOLD_OFF; echo \!*)"
+alias NEWLINE  "(echo '')"
+
+alias PROMPT   "(BOLD_ON; echo -n \!*; BOLD_OFF; echo -n ' (yes): ')"
+alias PROMPT_N "(BOLD_ON; echo -n \!*; BOLD_OFF; echo -n ' (no): ')"
+
+
+#============================================================================
+# Get the current platform architecture.
+#============================================================================
+
+set UNAME=""
+set UNCOMPRESS="gunzip"
+
+if (-e /usr/bin/uname) then
+    set uname_cmd = /usr/bin/uname
+    set UNAME=`/usr/bin/uname | tr '[A-Z]' '[a-z]'`
+else if (-e /bin/uname) then
+    set uname_cmd = /bin/uname
+    set UNAME=`/bin/uname | tr '[A-Z]' '[a-z]'`
+else
+    set UNAME = "INDEF"
+endif
+
+switch ($UNAME) 
+    case sunos:
+        if (`$uname_cmd -m | cut -c2-` == "86pc") then
+            set arch = "sunos"
+        else
+            setenv OSVERSION `uname -r | cut -c1`
+            if ($OSVERSION == 5) then
+                set arch = "ssun"
+		set UNCOMPRESS="uncompress"
+            else
+                set arch = "sparc"
+		set UNCOMPRESS="uncompress"
+            endif
+        endif
+	breaksw
+    case linux:
+        if (`$uname_cmd -m` == "ppc") then
+            if (-f /etc/redhat-release) then
+	        set arch = "linuxppc"
+	    else
+                set arch = "mklinux"
+	    endif
+	else
+            if (-f /etc/redhat-release) then
+                set arch = "redhat"
+            else if (-f /etc/SuSE-release) then
+                set arch = "suse"
+            else
+                set arch = "linux"
+            endif
+        endif
+	breaksw
+    case darwin: 
+	set arch = "macosx"
+	breaksw
+    case freebsd: 
+	set arch = "freebsd"
+	breaksw
+    case hp-ux:   
+	set arch = "hp700"
+	set UNCOMPRESS="uncompress"
+	breaksw
+    case irix:    
+	set arch = "irix"
+	set UNCOMPRESS="uncompress"
+	breaksw
+    case irix64:  
+	set arch = "irix"
+	set UNCOMPRESS="uncompress"
+	breaksw
+    case aix:  	  
+	set arch = "rs6000"
+	set UNCOMPRESS="uncompress"
+	breaksw
+    case osf1:    
+	set arch = "alpha"
+	set UNCOMPRESS="uncompress"
+	breaksw
+	breaksw
+    default:	  
+        echo "ERROR: No 'uname' command found to determine architecture."
+bad_arch:
+	NEWLINE
+	echo -n "Enter architecture name: "
+	set arch = "$<"
+	if (! -e bin.$arch) then
+	    echo -n "Invalid architecture, try again..."
+	    goto bad_arch
+	endif
+	breaksw
+endsw
+
+
+
+#############################################################################
+# Process command line options.
+#############################################################################
+set  exec	= yes
+set personal 	= no
+
+while ("$1" != "")
+    switch ("$1")
+    case -n:                            # no execute
+        set exec = no
+        breaksw
+    case -p:                            # no execute
+        set personal = yes
+        breaksw
+    case -hl:                           # disable highlighting
+        set hilite = 0
+        alias BOLD_ON   "(if ($hilite) tput bold)"
+        alias BOLD_OFF  "(if ($hilite) tput sgr0)"
+        alias SO_ON     "(if ($hilite) tput smso)"
+        alias SO_OFF    "(if ($hilite) tput rmso)"
+        breaksw
+    case +hl:                           # enable highlighting
+        set hilite = 1
+        alias BOLD_ON   "(if ($hilite) tput bold)"
+        alias BOLD_OFF  "(if ($hilite) tput sgr0)"
+        alias SO_ON     "(if ($hilite) tput smso)"
+        alias SO_OFF    "(if ($hilite) tput rmso)"
+        breaksw
+    case -h:                            # print help summary
+        goto Usage
+    default:
+        echo "install: unknown argument $1"
+        breaksw
+    endsw
+
+    if ("$2" == "") then
+        break
+    else
+        shift
+    endif
+end
+
+    
+#############################################################################
+# Print the banner message.
+#############################################################################
+clear
+NEWLINE
+BOLD_ON
+echo "			   ECL V0.9 Installation"
+echo "			   ====================="
+echo ""
+echo "		 Build Date: " $INS_VERSION
+echo ""
+BOLD_OFF
+NEWLINE
+
+# Print a quick usage summary.
+NEWLINE
+echo -n "  For each prompt: hit "
+BOLD_ON ; echo -n "<CR>"; BOLD_OFF;
+echo -n " to accept the default value, "
+BOLD_ON ; echo -n "'q'" ; BOLD_OFF
+echo ' to quit,'
+
+echo -n "  or "
+BOLD_ON ; echo -n "'help'"; BOLD_OFF
+echo -n " or ";
+BOLD_ON ; echo -n "'?'"; BOLD_OFF
+echo -n " to print an explanation of the prompt."
+NEWLINE
+NEWLINE
+
+
+
+#############################################################################
+# Check that we're running as 'root' so we can write to system bin dirs.
+#############################################################################
+if (-e /usr/bin/whoami) then
+    set WHOAMI = `/usr/bin/whoami`
+else if (-e /usr/ucb/whoami) then
+    set WHOAMI = `/usr/ucb/whoami`
+else if (-e /bin/whoami) then
+    set WHOAMI = `/bin/whoami`
+endif
+
+if ($WHOAMI != "root" && $exec == "yes") then
+  NEWLINE ; NEWLINE
+  BOLD_ON
+  echo "======================================================================"
+  echo -n "WARNING"
+  BOLD_OFF
+  echo ": This script must be run as root for changes to take effect."
+  echo "         If you decide to proceed,  the 'no-op' flag will be enabled"
+  echo "         by default.   No changes will be made to the system  files,"
+  echo "         however you will be able to see what the script does."
+  echo ""
+  echo "	 If you would like to do a personal installation, use the"
+  echo "	 '-p' flag."
+  BOLD_ON
+  echo "======================================================================"
+  BOLD_OFF
+  NEWLINE
+no_op_proc_:
+  PROMPT "Proceed with a no-op installation anyway? "
+  set ans = "$<"
+  if ("$ans" != "") then
+        if ($ans == 'n' || $ans == 'N' || $ans == 'no' || $ans == 'NO') then
+	    exit 0
+      endif
+  endif
+  NEWLINE
+        
+  set exec = no
+endif
+
+
+
+#############################################################################
+# Locate the current 'cl' command directory.
+#############################################################################
+
+set cldir	= ""
+
+set p = `which cl |& grep -i "^\/"`
+if ($status == 0) then
+    set cldir = $p:h
+endif
+
+
+clbin_prompt:
+    BOLD_ON ; echo -n "Local unix commands directory " ; BOLD_OFF
+    echo -n "($cldir): "
+    set clbin = "$<"
+    if ("$clbin" == "") then
+        set clbin = "$cldir"
+    else if ("$clbin" == "quit" || "$clbin" == "q") then
+        exit 0
+    else if ("$clbin" == "help" || "$clbin" == "h" || "$clbin" == "?") then
+        NEWLINE
+            MSG "The local bin directory is the system directory into which the"
+            MSG "iraf commands (e.g. cl, mkiraf, mkpkg, etc) will be installed"
+            MSG "as symlinks to files in the iraf tree. This should be a common"
+            MSG "dir such as /usr/local/bin which will likely be found in every"
+            MSG "user's path."
+        NEWLINE
+        setenv clbin $cldir
+        goto clbin_prompt
+    endif
+
+    # Create the local bin directory if it doesn't exist?
+    if (! (-e $clbin)) then
+        PROMPT "    Sorry, but $clbin does not exist, create it? "
+        set ans = "$<"
+        if ("$ans" == "" || "$ans" == "y" || "$ans" == "yes") then
+            echo "  Creating directory $clbin..."
+            if ($exec == yes) then
+                mkdir $clbin
+            endif
+            if (! (-e $clbin) && $exec == yes) then
+                ERRMSG  "Cannot create $clbin, please retry..."
+                setenv clbin $cldir
+                goto clbin_prompt
+            endif
+        else
+            goto clbin_prompt
+        endif
+        NEWLINE
+    endif
+
+
+#############################################################################
+# Locate the hlib$ directory.
+#############################################################################
+
+set hlib_dir	= ""
+
+if ($?iraf) then
+    set hlib_dir = $iraf/unix/hlib/
+else if (-e /iraf/iraf/unix/hlib) then
+    set hlib_dir = /iraf/iraf/unix/hlib/
+else if (-e /usr/include/iraf.h) then
+    set WS = '[ 	]'
+    set ip = `grep "define$WS*IRAF" /usr/include/iraf.h | sed -e 's/"//g'`
+    set hlib_dir = $ip[3]/unix/hlib/
+
+else
+hlib_prompt:
+    BOLD_ON ; echo -n "IRAF hlib$ directory " ; BOLD_OFF
+    echo -n "($hlib_dir): "
+    set hlib_dir = "$<"
+    if ("$hlib_dir" == "quit" || "$hlib_dir" == "q") then
+        exit 0
+    else if ("$hlib_dir"=="help" || "$hlib_dir"=="h" || "$hlib_dir"=="?") then
+        NEWLINE
+            MSG "The install script could not determine the hlib$ iraf logical"
+            MSG "directory.  This is the $iraf/unix/hlib subdirectory."
+        NEWLINE
+        setenv hlib ""
+        goto hlib_prompt
+    endif
+
+endif
+
+set iraf = $hlib/../../
+
+
+#############################################################################
+# Dump the tarball of files from the end of this script file.
+#############################################################################
+
+set bck = $cwd				# goto a temp directory to work
+mkdir /tmp/_ecl.$$
+tail -n +$SKIP $0 > /tmp/_ecl.$$/_ecl	# unpack the files
+chdir /tmp/_ecl.$$
+uudecode _ecl
+cat ecl_tar.gz | $UNCOMPRESS | tar -xf -
+/bin/rm -f _ecl ecl_tar.gz		# clean up temp files created so far
+
+
+if ($exec == "yes") then
+  if ($WHOAMI == "root" && $exec == "yes") then
+    echo "Updating cl.csh script in hlib directory ...."
+	cp -p $hlib/cl.csh $hlib/cl.csh.ORIG
+	mv cl.csh $hlib/
+
+    echo "Installing 'ecl' unix command ...."
+	if (! -e $cldir/ecl) then
+	    ln -s $hlib/cl.csh $cldir/ecl
+	endif
+
+    echo "Installing ECL binary ...."
+	chown iraf ecl.e
+	chmod 755 ecl.e
+	mv ecl.e $iraf/bin.$arch/
+
+    echo "Installing ECL in IRAF source tree ...."
+	if (! -e $iraf/pkg/ecl) then
+	    mkdir $iraf/pkg/ecl
+	endif
+	cp -rp * $iraf/pkg/ecl
+	chown -R iraf $iraf/pkg/ecl
+  endif
+else
+    echo "Installing ECL binary ...."
+    echo "Installing ECL in IRAF source tree ...."
+    echo "Installing 'ecl' unix command ...."
+    echo "Updating cl.csh script in hlib directory ...."
+endif
+
+
+# Go back from whence we came and 
+chdir $bck				
+
+# Clean up.
+/bin/rm -rf /tmp/_ecl.$$
+
+
+######################################################################
+exit 0
+######################################################################
+START_OF_DATA
+
diff --git a/pkg/vocl/edcap.c b/pkg/vocl/edcap.c
new file mode 100644
index 00000000..b06536af
--- /dev/null
+++ b/pkg/vocl/edcap.c
@@ -0,0 +1,390 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_stdio
+#define	import_libc
+#define	import_ctype
+#define	import_fset
+#define	import_spp
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "eparam.h"
+#include "proto.h"
+
+
+#define	COLWIDTH	40		/* column width for showhelp	*/
+
+
+/*-------------------------------------------------------------------------
+ * EDCAP.C -- Tools to support the edcap utility, used to define the input
+ * language of screen editors.
+ *
+ * External procedures:
+ *    edtinit		initialize the editor database and terminal
+ *    edtexit		terminate edit mode (may send output to terminal)
+ *    host_editor	return host command used to call the named editor
+ *    what_cmd		convert escape sequence into editor command
+ *    show_editorhelp	print a list of editor keystrokes
+ *
+ * Internal procedures:
+ *    get_editor	open and scan the EDCAP file
+ *    cmd_match		search the editor command list for an escape sequence
+ *    map_escapes	map encoded escape sequence from EDCAP file
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static	char ed_editorcmd[SZ_LINE+1];
+static	void map_escapes();
+
+
+/* EDTINIT -- Initialize the editor.
+ */
+void 
+edtinit (void)
+{
+	register int	i;
+	char 	editor[SZ_FNAME];	/* the name of the editor	 */
+
+	/* See if the current editor is the one to use.  If not, get the
+	 * editor.ed definitions.
+	 */
+	if (c_envgets ("editor", editor, SZ_FNAME) > 0)
+	    if (strcmp (editor, command[EDITOR_ID].keystroke) != 0)
+		get_editor (editor);
+
+	/* Count the number of editor commands.
+	 */
+	numcommands = FIRST_CMD;
+	for (i=FIRST_CMD;  command[i].cmd < NOMORE_COMMANDS;  i++)
+	    numcommands++;
+
+	/* Send the initial edit sequence (to enable keypad, if any).
+	 */
+	if (*(command[EDIT_INIT].escape) != '\0')
+	    printf ("%s",command[EDIT_INIT].escape); 
+
+	/* Enable transmission of the screen repaint sequence, to be returned
+	 * by the terminal driver if the process is suspended and later
+	 * resumed while in raw mode.
+	 */
+	for (i=FIRST_CMD;  command[i].cmd < NOMORE_COMMANDS;  i++)
+	    if (command[i].cmd == REPAINT && strlen(command[i].escape)==1)
+		c_fseti ((XINT)STDOUT, F_SETREDRAW, command[i].escape[0]);
+}
+
+
+/* EDTEXIT -- Terminate the editor.  Send an escape sequence to the terminal
+ * if necessary.
+ */
+void 
+edtexit (void)
+{
+	c_fseti ((XINT)STDOUT, F_SETREDRAW, 0);
+	if (*(command[EDIT_TERM].escape) != '\0')
+	    printf ("%s",command[EDIT_TERM].escape); 
+}
+
+
+/* HOST_EDITOR -- Return a pointer to the command string to be sent to the
+ * host system to run an editor, given the user name for the editor.
+ */
+char *
+host_editor (char *editor)
+{
+	get_editor (editor);
+	return (ed_editorcmd);
+}
+
+
+/* GET_EDITOR -- Redefine the editor keystrokes from the editor.ed file.
+ * Search for that file first in the users home directory.  If not found
+ * there, look in the standard device directory.
+ */
+void 
+get_editor (
+    char *editor		/* the name of the editor		*/
+)
+{
+	FILE	*fp;		/* pointer to the editor.ed file	*/
+	char	string[SZ_LINE];/* an edcap string from the .ed file	*/
+	char	label[SZ_LINE];	/* the key-sequence label (keyword)	*/
+	char	escape[SZ_LINE];/* the escape sequence in c octal	*/
+	char	name[SZ_LINE];	/* the keystroke name, for HELP		*/
+	char	fname[SZ_PATHNAME];
+	int	i, num, n;
+
+	/* Search the directories for the edcap file editor.ed.
+	 */
+	sprintf (fname, "home$%s.ed", editor);
+	fp = fopen (fname, "r");
+
+	if (fp == NULL) { 
+	    sprintf (fname, "dev$%s.ed", editor);
+	    fp = fopen (fname, "r");
+
+	    if (fp == NULL) {
+		eprintf ("cannot find edcap file for `%s'\n", editor);
+		eprintf ("editor language defaults to `%s'\n",
+		    command[EDITOR_ID].keystroke);
+		return;
+	    }
+	}
+
+	/* Parse the edcap file and initialize the command list and the host
+	 * editor command string (default `irafvi', `irafemacs', etc.).
+	 */
+	sprintf (ed_editorcmd, "iraf%s", editor);
+	num = 0;
+
+	while (fgets (string, SZ_LINE, fp) != NULL) {
+	    /* Check for the EDITOR_CMD field, the command to be sent to the
+	     * host system to run the editor.  This is a special case since
+	     * the edcap format does not support anything but keystrokes.
+	     * A termcap format file should have been used for this
+	     * database, rather than defining a new format file, then this
+	     * would not have been necessary.
+	     */
+	    if (strncmp (string, "EDITOR_CMD", 10) == 0) {
+		char    *ip, *op;
+		char    delim;
+		int	isformat;
+
+		/* Extract the optionally quoted host command format string.
+		 * This is either the editor command name (prefix), e.g.,
+		 * "irafemacs", or an SPRINTF format string containing a %s
+		 * where the filename(s) are to go.
+		 */
+		for (ip=string+10;  isspace(*ip);  ip++)
+		    ;
+		delim = (*ip == '"' || *ip == '\'') ? *ip++ : 0;
+		for (op=ed_editorcmd, isformat=NO;  (*op = *ip++);  op++) {
+		    if ((delim && *op == delim) || (!delim && isspace(*op)))
+			break;
+		    else if (*op == '%' && *ip == 's')
+			isformat++;
+		}
+
+		/* If the command string did not contain an embedded %s to
+		 * indicate where the file names(s) are to go, add one at
+		 * the end, i.e., "... %s".
+		 */
+		if (!isformat) {
+		    *op++ = ' ';
+		    *op++ = '%';
+		    *op++ = 's';
+		}
+
+		*op = EOS;
+		continue;
+	    }
+
+	    /* Process a normal editor command into the command table.
+	     * Each line must contain three tokens, the internal command
+	     * name, the terminal escape sequence, and the keystroke name.
+	     */
+	    n = sscanf (string, "%s %s %s", label, escape, name);
+
+	    if (n == 3) {
+		/* Determine which legitimate editor command this is.
+		 */
+		for (i=0;  i < NUM_COMMANDS;  i++)
+		    if (strcmp (label, cmdnames[i]) == 0)
+			break;
+
+		/* Stuff the command into the static command buffer.
+		 */
+		if (i < NUM_COMMANDS) {
+		    command[num].cmd = i;
+		    map_escapes (escape, label);
+		    strncpy (command[num].escape, label, SZ_ESCAPE);
+		    strncpy (command[num].keystroke, name, SZ_KEYSTROKE);
+		    num++;
+		}
+	    }
+	}
+
+	/* Make sure the command buffer terminates here.
+	 */
+	command[num].cmd = NOMORE_COMMANDS;
+	strcpy (command[num].escape, "");
+	strcpy (command[num].keystroke, " ");
+
+	strncpy (command[EDITOR_ID].keystroke, editor, SZ_KEYSTROKE);
+	fclose (fp);
+}
+
+
+/* MAP_ESCAPES -- Take an ASCII string which may have escape sequences
+ * encoded as octal (\nnn).  Copy the string to the output, replacing
+ * the encoded values with the binary character value.  The output
+ * string may be the same as the input string.
+ *
+ * Control codes may be represented in the input in any of the following ways:
+ *
+ *	^X		control-X
+ *	\[befnrt]	backspace, escape, formfeed, newline, return, tab
+ *	\nnn		octal constant
+ *	\^		the character ^
+ *	\\		the character \
+ *
+ * Ordinary characters are copied to the output.
+ */
+static void
+map_escapes (
+    char *input,			/* pointer into input string	*/
+    char *output		/* pointer into output string	*/
+)
+{
+	static char	*echars = "befnrt";
+	static char	*ecodes = "\b\033\f\n\r\t";
+	register char	*ip = input;
+	register char	*op = output;
+	register int	n;
+	char	*index();
+
+	while (*ip != '\0') {
+	    if (*ip == '\\') { 
+		switch (*++ip) {
+		case 'b': case 'e': case 'f':
+		case 'n': case 'r': case 't':
+		    *op++ = ecodes[index(echars,*ip++)-echars];
+		    break;
+		default:
+		    if (isdigit (*ip)) {
+			for (n=0;  isdigit(*ip) != 0;  ip++)
+			     n = n * 8 + (*ip - '0');
+			*op++ = n;
+		    } else
+			*op++ = *ip++;
+		}
+	    } else if (*ip == '^') {
+		ip++;
+		*op++ = (*ip++ % 040);
+	    } else
+		*op++ = *ip++;
+	}
+
+	*op = '\0';
+}
+
+
+/* WHAT_CMD -- Determine which editing command has been sent.  Such commands
+ * must begin with a non-printable character.  Return the command number or
+ * zero if unrecognized.  We are called with the first character of the
+ * command (some control code).  Additional keystrokes are read from the
+ * standard input until an editor command is recognized.
+ */
+int 
+what_cmd (
+    int first_char		/* the first unprintable character */
+)
+{
+	register int	nchars, k;
+	char	cmd_string[9];
+	char	*cmd;
+
+	cmd = cmd_string;
+	*cmd = first_char;
+
+	/* Loop until we get an exact match or until we get no match.
+	 * A character is read from the standard input in each pass
+	 * through the loop.
+	 */
+	for (nchars=1;  nchars < 9;  nchars++)
+	    if ((k = cmd_match (cmd_string, nchars)) < 0)
+		return (0);
+	    else if (nchars == strlen (command[k].escape))
+		return (command[k].cmd);
+	    else
+		*(++cmd) = fgetc(stdin);
+
+	return (0);
+}
+
+
+/* CMD_MATCH -- Scan the first nchars of the available commands to see if
+ * any match the command string.  Return -1 if the command string does not
+ * match any editor escape sequence, else return the index of the first
+ * command code matched.
+ */
+int 
+cmd_match (
+    char *cstring,		/* command string	*/
+    int nchars			/* nchars to compare	*/
+)
+{
+	int	k;
+
+	for (k=FIRST_CMD;  k <= numcommands;  k++)
+	    if (strncmp (cstring, command[k].escape, nchars) == 0)
+		return (k);
+
+	return (-1);
+}
+
+
+/* SHOW_EDITORHELP -- Display the edit commands and their keystroke
+ * equivalences.
+ */
+void 
+show_editorhelp (void)
+{
+	char	sbuf[MAX_COMMANDS*COLWIDTH];
+	char	*strp[MAX_COMMANDS];
+	int	center, maxcols, firstcol, lastcol, nstrs, i;
+	int	save_raw;
+
+	maxcols = c_envgeti ("ttyncols");
+	center = maxcols / 2;
+
+	/* Disable raw mode output so that output processing will be enabled,
+	 * e.g., to map newlines into crlfs.
+	 */
+	save_raw = c_fstati ((XINT)STDOUT, F_RAW);
+	c_fseti ((XINT)STDOUT, F_RAW, NO);
+
+	/* Format the help strings for the individual keystrokes.
+	 */
+	for (i=FIRST_CMD, nstrs=0;  i <= numcommands;  i++)
+	    if (*(command[i].escape) != '\0') {
+		strp[nstrs] = &sbuf[nstrs*COLWIDTH];
+		sprintf (strp[nstrs], "%8w%-10.10s = %-11.11s%2w",
+		    cmdnames[command[i].cmd], command[i].keystroke);
+		nstrs++;
+	    }
+
+	e_clear();
+	e_goto (center - 7, 1);
+	e_putline ("EDIT COMMANDS (");
+	e_putline (command[EDITOR_ID].keystroke);
+	e_putline (")\n\n");
+
+	/* Sort and output the string table.
+	 */
+	if (nstrs) {
+	    strsort (strp, nstrs);
+	    i = strlen (strp[0]);
+	    firstcol = center - i - 2;
+	    lastcol  = center + i + 2;
+	    strtable (stdout, strp, nstrs, firstcol, lastcol, COLWIDTH, 2);
+	}
+
+	e_putline ("\n");
+	e_ctrl ("so");
+	e_putline ("[hit any key to continue]");
+	e_ctrl ("se");
+
+	/* Restore raw mode.
+	 */
+	c_fseti ((XINT)STDOUT, F_RAW, save_raw);
+
+	fflush (stdout);
+
+	/* Pause. */
+	fgetc (stdin);
+}
diff --git a/pkg/vocl/eparam.c b/pkg/vocl/eparam.c
new file mode 100644
index 00000000..942b1a21
--- /dev/null
+++ b/pkg/vocl/eparam.c
@@ -0,0 +1,2156 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_stdio
+#define	import_libc
+#define	import_error
+#define	import_ctype
+#define	import_ttset
+#define	import_fset
+#define	import_spp
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "errs.h"
+#include "param.h"
+#include "grammar.h"
+#include "task.h"
+#include "eparam.h"
+
+/*
+ * EPARAM -- Screen editor for parameter files.
+ *
+ *	 epset (pset)				# edit any pset by name
+ *	eparam (cx, &update, &cmd, &newpset)	# edit incore pfile struct
+ *
+ * EHIST  -- Screen editor for the history list.
+ *
+ *	edit_history_directive (raw_cmd, new_cmd)
+ *
+ * Both of these primary functions use the following internal editing
+ * functions (and many more).  These use EDCAP to describe the editor 
+ * language to be used, and TERMCAP to describe the terminal to be driven.
+ *
+ *	e_ttyinit		enter edit mode
+ *	e_ttyexit		exit edit mode
+ *
+ *	editstring		screen editor for a string
+ *
+ *	e_clear			clear the screen
+ *	e_clrline		clear the current line
+ *	e_ctrl			send control sequence to the terminal
+ *	e_display		display text at addressed coordinates
+ *	e_goto			move cursor
+ *	e_putline		put a line to terminal with escape translation
+ *
+ * E_TTYINIT must be called to initialize the editor database and put the
+ * terminal into edit mode before calling any of these functions.
+ */
+
+extern  int 	cldebug;
+static  char  	dbg[SZ_LINE];	   		   /* for formatting msgs */
+#define	E_DEBUG(str)	e_display(str,cmdline,1)   /* debug msg on last line */
+
+struct	param *parmlist[G_MAXPARAM];	/* assoc. keyword with param          */
+static	struct pfile *pfilep;
+static	int keylines[G_MAXPARAM];	/* starting linenos of each keyword   */
+static	int firstelement[G_MAXPARAM];	/* first element on row for array     */
+static	int topkeys[G_MAXPAGES];	/* array of topkeys for each page     */
+
+static	int maxpage;			/* maximum page number                */
+static	int cmdline;			/* last line on screen		      */
+static	int maxcol;			/* last column on screen	      */
+static	int line, topline, botline;	/* current, top, bottom lines	      */
+static	int col, startcol, nextcol;	/* current, first, last columns	      */
+static	XINT tty_fd, tty;		/* define the terminal globally       */
+static	int botkeyline, nextline,	/* various global variables for       */
+	    keyid, numkeys, topkey,	/*   keeping track of lines and keys  */
+	    botkey, nextkey;
+static	int error_displayed = 0;	/* flag for error messages 	      */
+
+static  int standout;			/* flag for turning standout mode off */
+static	int e_ucasein=NO,e_ucaseout=NO;	/* tt case flags for raw mode i/o     */
+static	int ep_status = OK;		/* OK=normal exit, ERR=ctrl/c exit    */
+static	int ep_filemode = NO;		/* editing a file not a task	      */
+static	int ep_nextcmd;			/* next eparam command upon exit      */
+static	int ep_update;			/* update pfile upon exit	      */
+static	char e_nextpset[SZ_FNAME+1];	/* next pset to be edited	      */
+static	struct ep_context *e_cx;	/* current context		      */
+
+/* These global variables are reset by parse_clmodes() in modes.c whenever the
+ * appropriate CL parameter is changed.
+ */
+int	ep_standout 	= YES;		/* eparam default for standout 	      */
+int	ep_showall  	= NO;		/* display all params, incl. hiddens  */
+int	eh_standout 	= YES;		/* ehist default for standout         */
+int	eh_bol      	= NO;		/* start ehist at beginning of line   */
+int	eh_verify   	= NO;		/* use ehist with history meta-chars  */
+#ifdef NO_READLINE
+int	eh_readline 	= NO;		/* no readline() available here       */
+#else
+int	eh_readline 	= YES;		/* use readline() for terminal input  */
+#endif
+int	eh_longprompt 	= YES;		/* print full package name as prompt  */
+
+char	*e_tonextword(), *e_toprevword(), *index();
+
+char	epar_cmdbuf[SZ_LINE];
+
+
+
+/* EPSET -- Edit a parameter set.  Once in the parameter set editor, editor
+ * colon commands may be used to edit any other parameter set, to save psets
+ * in pfiles, load psets from pfiles, and so on.  ERR is returned if the user
+ * wants to quit altogether, e.g., when epset is called in a loop.
+ */
+int 
+epset (
+    char *pset			/* ltaskname or pfilename */
+)
+{
+	struct  ep_context context[20], *cx;
+	char    newpset[SZ_FNAME+1];
+	char	runcmd[SZ_LINE+1];
+	int     update, cmd;
+
+	cx = context;
+	cx->e_mpfp = NULL;
+	strcpy (cx->e_pset, pset);
+
+	while (cx >= context) {
+	    /* Open the pfile to be edited. */
+	    if (cx->e_mpfp == NULL) {
+		cx->e_topd = topd;
+		cx->e_mpfp = pfilesrch (cx->e_pset);
+		cx->e_cpfp = pfilecopy (cx->e_mpfp);
+		cx->e_init = YES;
+	    }
+
+	    /* Edit pset.  If ERR is returned exit immediately without
+	     * updating any pfiles, returning ERR to our caller.
+	     */
+	    if (eparam (cx, &update, &cmd, newpset) == ERR) {
+		for (;  cx >= context;  --cx) {
+		    pfileunlink (cx->e_cpfp);
+		    if (dereference (cx->e_mpfp) >= cx->e_topd)
+			pfileunlink (cx->e_mpfp);
+		    topd = cx->e_topd;
+		}
+		return (ERR);
+	    }
+
+	    /* If we are done with this pfile (not descending into a pset)
+	     * update the pfile on disk and free memory.
+	     */
+	    if (cmd != EP_DESCEND) {
+		if (update) {
+		    pfcopyback (cx->e_cpfp);
+		    pfileupdate (cx->e_mpfp);
+		} else
+		    pfileunlink (cx->e_cpfp);
+
+		if (dereference (cx->e_mpfp) >= cx->e_topd)
+		    pfileunlink (cx->e_mpfp);
+		cx->e_mpfp = NULL;
+		cx->e_cpfp = NULL;
+		topd = cx->e_topd;
+	    }
+
+	    /* Decide what to do next. */
+	    switch (cmd) {
+	    case EP_EOF:			/* pop context */
+		--cx;
+		break;
+	    case EP_EDIT:			/* edit a new pfile */
+		strcpy (cx->e_pset, newpset);
+		break;
+	    case EP_DESCEND:			/* push context & edit */
+		cx++;
+		cx->e_mpfp = NULL;
+		strcpy (cx->e_pset, newpset);
+		break;
+	    case EP_RUN:			/* run the task */
+		sprintf (runcmd, "%s (mode='h')\n", newpset);
+		if (eh_readline == NO)
+		    c_ungetline (fileno (prevtask->t_in), runcmd);
+		else
+		    strcpy (epar_cmdbuf, runcmd);
+		return (OK);
+	    default:
+		eprintf ("eparam: unrecognized command\n");
+		--cx;
+		break;
+	    }
+	}
+
+	return (OK);
+}
+
+
+/* EPARAM -- Edit a parameter set which has already been loaded into a
+ * pfile structure.  Most editor colon commands will cause an exit,
+ * returning the user command to the caller, e.g., to edit a new pset or
+ * quit.  The context of the editor is saved upon exit in the context
+ * structure, allowing the editor to be reentered at the same point
+ * on the old pset.
+ */
+int 
+eparam (
+    struct ep_context *cx,		/* eparam editor context	*/
+    int *update,		/* update pset upon exit	*/
+    int *nextcmd,		/* receives next command	*/
+    char *nextpset		/* receives next pset name	*/
+)
+{
+	char	string[G_MAXSTRING];
+
+	pfilep = cx->e_cpfp;		/* save in global variables     */
+	e_cx = cx;
+
+	standout = ep_standout;		/* set standout value 		*/
+	e_ttyinit();			/* initialize the terminal      */
+	edtinit();			/* and initialize the editor	*/
+
+	/* When we are called to edit a file, the ltask ptr is NULL.
+	 */
+	if (ep_filemode = (pfilep->pf_ltp == NULL))
+	    topline--;			/* room for one more param line */
+
+	numkeys = e_makelist (pfilep);	/* initialize parameter list	*/
+	if (numkeys < 1)		/* nothing to edit		*/
+	    goto exit;
+
+	ep_status = OK;
+	ep_nextcmd = EP_EOF;		/* default if no :cmd		*/
+	ep_update  = YES;		/* default unless cleared	*/
+
+	if (cx->e_init) {
+	    /* New pfile: start at the top. */
+	    topkey    = 1;
+	    line      = topline;
+	    col       = startcol;
+	    nextkey   = topkey;
+	    nextline  = topline;
+	} else {
+	    /* Reentering an old pfile: start where we left off. */
+	    topkey    = cx->e_topkey;
+	    line      = cx->e_line;
+	    col       = cx->e_col;
+	    nextkey   = cx->e_nextkey;
+	    nextline  = cx->e_nextline;
+	}
+
+	if (parmlist[topkey]->p_type & PT_ARRAY) 	/* add line for array */
+	    line++, nextline++;
+
+	e_repaint();
+
+	/* Main EPARAM loop.
+	 */
+	while (nextline != cmdline) {
+	    keyid = nextkey;
+	    line  = nextline;
+	    col   = startcol;
+
+	    e_goto (col, line);
+	    fflush (stdout);
+
+	    /* Encode value string and call the string editor to give the
+	     * user a chance to edit it.
+	     */
+	    e_encode_vstring (parmlist[keyid], string);
+
+	    if (editstring (string, YES) > 0)
+	        e_check_vals (string);
+
+	    e_scrollit();
+	}
+exit:
+	/* Save our context in case we reenter this pfile. */
+	cx->e_topkey = topkey;
+	cx->e_line = line;
+	cx->e_col = col;
+	cx->e_nextkey = keyid;
+	cx->e_nextline = line;
+	cx->e_init = 0;
+
+	e_goto (1, cmdline);
+	e_clrline();
+
+	edtexit();
+	e_ttyexit();
+
+	*update = ep_update;
+	*nextcmd = ep_nextcmd;
+	strcpy (nextpset, e_nextpset);
+
+	return (ep_status);
+}
+
+
+/* E_MAKELIST -- Make a list of pointers to each parameter structure to aid
+ * speedy access.  Return the number of parameters in the list.  For a
+ * multiline prompt environment, we need a table of pointers to the firstline
+ * of each keyword.
+ */
+int 
+e_makelist (struct pfile *pfileptr)
+{
+	register struct param *pp;
+	register char c, *p;
+	int	numnew;			/* number of newlines 		*/
+	int	totlines;		/* count of current total lines */
+
+	topkeys[0] = 1;
+	totlines = 0;
+	maxpage  = 0;
+
+	/* Scan the parameter list, adding each parameter to the EPARAM
+	 * list.  Hidden parameters are skipped if ep_showall=no (in epinit).
+	 */
+	for (pp = pfileptr->pf_pp, numkeys = 0;  pp != NULL;  pp = pp->p_np) {
+
+	    if ((pp->p_mode & M_HIDDEN) && (ep_showall == NO))
+		continue;
+
+	    numkeys++;
+	    parmlist[numkeys] = pp;
+
+	    /* Count the number of newlines in the prompt, add to keylines.
+	     */
+	    numnew = 0;
+	    p = pp->p_prompt;
+
+	    while ((c = *p) != '\0') {
+		if (c == '\n')
+		    numnew++;
+		p++;
+	    }
+
+	    totlines += numnew + 1;
+	    keylines[numkeys] = numnew + 1;
+	    firstelement[numkeys] = 1;
+
+	    if (pp->p_type & PT_ARRAY) {
+		int	numonrow, nextelement;
+		int	dim, d, alines;
+		short 	*plen, len, flen;
+
+		keylines[numkeys]++;		/* 1 extra line for arrays */
+		totlines++;
+		totlines = e_testtop (totlines, numnew+1+1);
+	
+		dim    = pp->p_val.v_a->a_dim;
+		plen   = &(pp->p_val.v_a->a_len);
+		flen   = *plen;				/* first length */
+		alines = (flen - 1) / MAX_ON_ROW + 1;
+		numonrow = (flen > MAX_ON_ROW) ? MAX_ON_ROW : flen;
+
+		for (d=1;  d < dim;  d++) {
+		    len = *(plen + 2*d);
+		    alines *= len;
+		}
+
+		nextelement = 1;
+		for (d=1, numkeys++;  d < alines;  d++, numkeys++) {
+		    parmlist[numkeys] = pp;
+		    keylines[numkeys] = 1;
+
+		    nextelement += numonrow;
+		    firstelement[numkeys] = nextelement;
+		    
+		    totlines++;
+		    totlines = e_testtop (totlines, numnew+1+1+d);
+		}
+
+		--numkeys;
+
+	    } else {
+		totlines = e_testtop (totlines, numnew+1);
+	    }
+	}
+
+	if (cldebug) {
+	    int	i;
+	    for (i=1;  i <= numkeys;  i++) {
+	        sprintf (dbg, "parmlist: %d %d %d  ", 
+			parmlist[i], keylines[i], firstelement[i]);
+		E_DEBUG (dbg);
+	    }
+            sprintf (dbg, " maxpage = %d  ", maxpage);
+	    E_DEBUG (dbg);
+	    for (i=1;  i<= maxpage;  i++) {
+		sprintf (dbg, "topkeys : %d  ", topkeys[i]);
+	        E_DEBUG (dbg);
+	    }
+	    sprintf (dbg, "numkeys = %d  ", numkeys);
+	    E_DEBUG (dbg);
+	}    
+
+	return (numkeys);
+}
+
+
+/* E_TESTTOP -- Check to see if we have filled up a screen and if so,
+ * start a new page.
+ */
+int 
+e_testtop (
+    int cur,			/* current line count on screen */
+    int new			/* new count, returned if new page */
+)
+{
+	if (cur > (botline - topline + 1)) {
+	    topkeys[++maxpage] = numkeys;
+	    return (new);
+	} else
+	    return (cur);
+}
+
+
+/* E_REPAINT -- Repaint the current screen.
+ */
+int 
+e_repaint (void)
+{
+	static	char *static_prompt = "--------- parameter array ---------";
+	char	promptbuf[MAXPROMPT];
+	char	outbuf[MAXPROMPT];
+	int	i, keylin, ll, cc;
+	char	*p;
+
+	/* More keys than can fit on the screen?
+	 */
+	keylin = topline;
+	for (i=topkey; i <= numkeys && (keylin+keylines[i] <= (botline+1)); ) {
+	    botkeyline = keylin;
+	    keylin += keylines[i++];
+	}
+
+	botkey = i - 1;
+	if (parmlist[botkey]->p_type & PT_ARRAY)
+	    botkeyline += keylines[botkey] - 1;
+
+	e_pheader (pfilep, cmdline, maxcol);
+
+	ll   = line;
+	cc   = col;
+	line = topline;
+	col  = startcol;
+
+	for (keyid=topkey;  keyid <= botkey;  keyid++) {
+
+	    if ((parmlist[keyid]->p_type & PT_ARRAY) &&
+		(firstelement[keyid] == 1)) {
+
+		/* Print the array parameter name.  If hidden, enclose it in ()
+		 * as in lparam.
+		 */
+		if (parmlist[keyid]->p_mode & M_HIDDEN)
+		    sprintf (outbuf, "(%-7.7s) ", parmlist[keyid]->p_name);
+		else
+		    sprintf (outbuf, "%-8.8s  ", parmlist[keyid]->p_name);
+		e_display (outbuf, line, 1);
+
+		/* Display the prompt over the values, to allow user to
+		 * label columns (if desired).
+		 */
+		p = parmlist[keyid]->p_prompt;
+		if (p == NULL || *p == NULL)
+		    p = static_prompt;
+
+		/* e_indent_prompt (p, promptbuf, startcol); */
+		e_display (p, line, startcol);
+
+	   	line += keylines[keyid] - 1;
+		e_drawkey();
+	    	line++;
+
+	    } else {
+		e_drawkey();
+	    	line += keylines[keyid];
+	    }
+
+	    fflush (stdout);
+	}
+
+	e_moreflag (topkey);
+
+	keyid = topkey;
+	e_goto (cc, ll);
+	line = ll;
+	col  = cc;
+}
+
+
+/* E_PHEADER -- Print the EPARAM form header.
+ */
+int 
+e_pheader (
+    struct pfile *pfp,		/* pfile pointer		*/
+    int cmdline,		/* terminal command line number	*/
+    int maxcol			/* max cols on a line		*/
+)
+{
+	static	char	*logo = "  I R A F  ";
+	static  char	*title= "Image Reduction and Analysis Facility";
+	char	string[SZ_LINE+1];
+	int	i, col;
+
+	e_clear();
+
+	/* Print logo and title lines.
+	 */
+	col = (maxcol - strlen(logo)) / 2;
+	e_ctrl ("so");
+	e_goto (col, 1);
+	e_putline (logo);
+
+	col = (maxcol - strlen(title)) / 2;
+	e_ctrl ("se");
+	e_ctrl ("us");
+	e_goto (col, 2);
+	e_putline (title);
+
+	/* Identify object being edited.
+	 */
+	e_goto (1, 3);
+	e_ctrl ("ue");
+	if (ep_filemode) {
+	    sprintf (string, "PARFILE = %s\r\n", pfp->pf_pfilename);
+	    e_putline (string);
+	} else {
+	    struct  ltask *ltp = pfp->pf_ltp;
+	    sprintf (string, "PACKAGE = %s\r\n", ltp->lt_pkp->pk_name);
+	    e_putline (string);
+	    sprintf (string, "   TASK = %s\r\n", ltp->lt_lname);
+	    e_putline (string);
+	}
+
+	for (col=0;  col < maxcol;  col++)
+	    string[col] = ' ';
+        string[maxcol] = '\0';
+	e_ctrl ("us");
+	e_goto (1, cmdline-1);		/* draw line across bottom of screen */
+	e_putline (string);
+
+	e_ctrl ("ue");
+	e_ctrl ("so");
+	e_goto (maxcol - 18, cmdline);
+
+	for (i=FIRST_CMD; (i<=numcommands) && (command[i].cmd != GET_HELP); i++)
+	    ;
+	e_putline (command[i].keystroke);	/* show the help command */
+	e_ctrl ("se");
+	e_putline (" for HELP");
+
+	fflush (stdout);
+}
+
+
+/* E_DRAWKEY -- Format and display the keyline.  It is assumed that for
+ * arrays, the prompt occurs above the first array line.  This enables the
+ * user to label his columns.  We must handle multiline prompts as well.  
+ * For maximum drawing speed output is optimized using line clears and screen 
+ * gotos rather than blanks to erase and position text.
+ */
+int 
+e_drawkey (void)
+{
+	char	valuebuf[MAXPROMPT];
+	char	tempbuf[MAXPROMPT];
+	int	offset, nchars;
+	char	*p;
+
+	e_encode_vstring (parmlist[keyid], valuebuf);
+	e_goto (1, line);
+	e_clrline();
+
+	if (parmlist[keyid]->p_type & PT_ARRAY) {
+	    e_putline ("\t=   ");
+	    e_putline (valuebuf);
+	} else {
+	    int  hidden;
+
+	    hidden = (parmlist[keyid]->p_mode & M_HIDDEN);
+
+	    /* Print parameter name.  Enclose hidden parameters in (), as in
+	     * lparam.  We lose a character in the name, but at least we know
+	     * when a parameter is hidden.
+	     */
+	    if (hidden)
+		sprintf (tempbuf, "(%-7.7s=", parmlist[keyid]->p_name);
+	    else
+	        sprintf (tempbuf, "%-8.8s=", parmlist[keyid]->p_name);
+	    e_putline (tempbuf);
+
+	    /* Print the value string right justified in the value field.
+	     */
+	    nchars = strlen (valuebuf);
+	    offset = PROMPTOFFSET - nchars - 1;
+	    offset = (VALUEOFFSET > offset) ? VALUEOFFSET : offset;
+	    e_goto (offset, line);
+
+	    if (hidden)			/* closing ) for hidden parameters */
+		strcat (valuebuf, ")");
+	    e_putline (valuebuf);
+
+	    /* Print the (possibly multiline) prompt string.  Do not write over
+	     * the value string if it's a long one.
+	     */
+	    offset += (nchars + 1);		/* offset of prompt string */
+	    if (offset < PROMPTOFFSET)
+		offset = PROMPTOFFSET;
+
+	    /* Add one to the offset (for ')' in hidden parameters) and display
+	     * the prompt.  Continuation lines start at the standard prompt
+	     * offset.
+	     */
+	    e_displayml (parmlist[keyid]->p_prompt, line, ++offset,
+		PROMPTOFFSET + 1);
+	}
+}
+
+
+/* E_INDENT_PROMPT -- Must handle multiline prompts, i.e. prompt string may
+ * have imbedded newlines.  Convert newline into newline plus the number of
+ * spaces to indent.
+e_indent_prompt (p, bp, indent)
+char	*p;
+char	*bp;
+int	indent;
+{
+	register int	i;
+	register char	c;
+
+	while ((*bp++ = c = *p++) != '\0')
+	    if (c == '\n')
+		for (i=0;  i < indent;  i++)
+		    *bp++ = ' ';
+}
+ */
+
+
+/* E_ENCODE_VSTRING -- Get the value as a string for editing.  If it's an array,
+ * get several of the values.  If it is an array, make sure the undefined values
+ * get a '***', without calling spparval (which would bomb).
+ */
+int 
+e_encode_vstring (struct param *pp, char *outbuf)
+{
+	char valuebuf[G_MAXSTRING];
+	char colbuf[16];
+
+	*outbuf = '\0';
+
+	if (pp->p_type & PT_ARRAY) {
+	    int	   first, i, nn, numonrow;
+	    struct operand o;
+	    short  len;			/* the length of the first dim */
+
+	    len = pp->p_val.v_a->a_len;
+	    first = firstelement[keyid];
+
+	    nn = len - ((first-1) % len);
+	    numonrow = (nn > MAX_ON_ROW) ? MAX_ON_ROW : nn;
+
+	    for (i=first;  i < first+numonrow;  i++) {
+		/* First determine if the value is undefined or not.
+		 */
+		poffset (i-1);
+		paramget (pp, FN_VALUE);
+		o = popop();
+
+		if (opundef (&o))
+		    sprintf (colbuf,"       ***");
+		else {
+	            if ((pp->p_type & OT_BASIC) == OT_REAL) {
+			/* For real numbers, do not use spparval since we may
+			 * lose exponents in the formatting.  Limit output but
+			 * use the %g format directly.
+			 */
+			sprintf (colbuf, "%10g ", o.o_val.v_r);
+		        if (index (colbuf, '.') == NULL)
+			    strcat (colbuf, ".");
+		    } else {
+			poffset (i-1);
+		        spparval (valuebuf, pp);
+		    	sprintf (colbuf, "%10.10s ", valuebuf);
+		    }
+		}
+
+		strcat (outbuf, colbuf);
+	    }
+
+	} else {
+	    /* Do not use a high level routine such as paramget() to fetch
+	     * the parameter value, as we do not want to deal with parameter
+	     * indirection here.  Just print the immediate value of the
+	     * parameter as a string.
+	     */
+	    if (opundef (&pp->p_valo))
+		*outbuf = EOS;
+	    else
+		sprop (outbuf, &pp->p_valo);
+	}
+}
+
+
+/* E_CHECK_VALS -- Perform range checking and reset the default if the string
+ * contains a partial array (yea, even a whole array).  Parse each element of
+ * the array and check it.  Also check whether there are enough elements in the
+ * array.  In any case, if gquery returns an error, report that to the user.
+ */
+int 
+e_check_vals (char *string)
+{
+	char *gquery();		/* declare gquery as returning a pointer  */
+	char *errstr;		/* pointer to the error string (or 0)     */
+	char message[SZ_LINE+1];/* error message string			  */
+	int  badnews;		/* a flag if an array element is in error */
+	int  isarray;		/* a flag to indicate if this is an array */
+	int  numonrow;		/* the number of elements on a row	  */
+
+	isarray = parmlist[keyid]->p_type & PT_ARRAY;
+	badnews = 0;
+
+	if (cldebug) {
+	    sprintf (dbg, "string = |%s|  ", string);
+	    E_DEBUG (dbg);
+	}
+
+	if (isarray) {
+	    char    outstring[G_MAXSTRING];
+	    char    *in, *out, *e_getfield();
+	    int	    first, nelem, flen;
+	    
+	    /* Get the length of the first dimension, and the starting point.
+	     */
+	    flen = parmlist[keyid]->p_val.v_a->a_len;
+	    first = firstelement[keyid];
+
+	    /* Determine how many elements SHOULD be on the row.
+	     */
+	    nelem = flen - (first-1) % flen;
+	    numonrow = (nelem > MAX_ON_ROW) ? MAX_ON_ROW : nelem;
+
+	    in = string;
+	    badnews = 0;
+	    nelem = 0;
+
+	    /* Parse each element of the string.
+	     */
+	    while (!badnews) {
+		in = e_getfield (in, outstring, G_MAXSTRING);
+		if (outstring[0] == '\0')
+		    break;
+		else
+		    nelem++;
+	    
+		if (e_undef (outstring))
+		    errstr = "OK";
+		else {
+		    poffset (first+nelem-2);	/* push absolute index  */
+		    errstr = gquery (parmlist[keyid], outstring);
+	        }
+
+		if (strcmp (errstr, "OK") != 0) { 
+		    sprintf (message, "%s [%s]?", errstr, outstring);
+		    badnews++;
+		}
+	    }
+
+	    if ((nelem != numonrow) && !(badnews)) {
+		sprintf (message, "Expected %d elements on this line",numonrow);
+		badnews++;
+	    }
+
+	} else {
+	    /* Not an array.
+	     */
+	    errstr = gquery (parmlist[keyid], string);
+	    if (strcmp (errstr, "OK") != 0) {
+		strcpy (message, errstr);
+		badnews++;
+	    }
+	}
+
+	/* Report any errors. */
+	if (badnews)
+	    e_rpterror (message);
+
+	/* Reprint the line. */
+	e_drawkey();
+	e_goto (startcol, line);
+	fflush (stdout);
+}
+
+
+/* E_UNDEF -- Recognize the undefined string of 3 asterisks.
+ */
+int 
+e_undef (register char *s)
+{
+	register int	n = 0;
+
+	for (;  (*s != '*') && (*s != '\0');  s++)
+	    ;
+	for (;  (*s == '*') && (*s != '\0');  s++)
+	    n++;
+
+	return (n == 3);
+}
+
+
+static	char	message[SZ_LINE];	/* used by e_rpterror and e_clrerror */
+
+/* E_RPTERROR -- Report the error for the eparam user.
+ */
+int 
+e_rpterror (char *errstr)
+{
+	char	*range;		/* pointer to the range error string	*/
+
+	if (parmlist[keyid]->p_type == OT_BOOL) {
+	    sprintf (message, "%s must be `yes' or `no'", errstr);
+	} else if ((parmlist[keyid]->p_type == OT_STRING) 
+	    && !(parmlist[keyid]->p_flags & P_UMIN)) {
+	    range = enumin (parmlist[keyid]);
+	    sprintf (message, "What?  %s", range);
+	} else {
+	    range = minmax (parmlist[keyid]);
+	    sprintf (message, "%s %s", errstr, range);
+	}
+
+	/* Display at most one line of error message to avoid having to redraw
+	 * the screen.
+	 */
+	message[maxcol-1] = '\0';
+	e_display (message, cmdline, 1);
+	e_putline ("\007");
+	error_displayed = 1;
+
+	/* Edit the same keyline over again.
+	 */
+	nextline = line;
+	nextkey  = keyid;
+	fflush (stdout);
+}
+
+
+/* E_CLRERROR -- Clear the error line, i.e. the last error message.
+ */
+int 
+e_clrerror (void)
+{
+	register int	i, len;
+
+	len = strlen (message);
+
+	for (i=0; i < len; i++)
+	    message[i] = ' ';
+	message[len] = '\0';
+		
+	e_display (message, cmdline, 1);
+	error_displayed = 0;
+
+	/* Edit the same keyline over again.
+	 */
+	nextline = line;
+	nextkey  = keyid;
+	e_goto (startcol, line);
+	fflush (stdout);
+}
+
+
+/* E_GETFIELD -- Extract the next newline or comma delimited token from
+ * a string.  Returns as the function value a pointer to the first char
+ * after the token.
+ */
+char *
+e_getfield (
+    register char *ip,		/* pointer into input string	*/
+    char *outstr,		/* receives token		*/
+    int maxch			/* max chars out		*/
+)
+{
+	register char	*op, *otop;
+
+	while (*ip == ' ' || *ip == ',')
+	    ip++;
+	otop = &outstr[maxch];
+	for (op=outstr;  *ip != '\0' && *ip != ' ' && *ip != ',';  ) {
+	    *op++ = *ip++;
+	    if (op >= otop)
+		break;
+	}
+	*op = '\0';
+
+	return (ip);
+}
+
+
+/* E_MOREFLAG -- Signal that there are more parameters above or below the
+ * window.
+ */
+int 
+e_moreflag (register int topkey)
+{
+	if ((numkeys == botkey) && (topkey == 1))
+	    return 0;
+
+	if (botkey < numkeys) {
+	    e_ctrl ("so");
+	    e_ctrl ("us");
+	    e_display ("More", botline+1, 1);
+	} else {
+	    e_ctrl ("us");
+	    e_display ("    ", botline+1, 1);
+	}
+
+	if (topkey != 1) {
+	    e_ctrl ("so");
+	    e_display ("More", topline-1, 1);
+	} else {
+	    e_ctrl ("se");
+	    e_ctrl ("ue");
+	    e_display ("    ", topline-1, 1);
+	}
+
+	e_ctrl ("se");
+	e_ctrl ("ue");
+	fflush (stdout);
+}
+
+
+/* E_SCROLLIT -- Scroll the window if possible.
+ */
+int 
+e_scrollit (void)
+{
+	register int i;
+
+	if (nextline == cmdline) {
+	    ;
+
+	} else if (nextline > botline) {
+	    topkey = nextkey;
+	    nextline = topline;
+	    if (parmlist[topkey]->p_type & PT_ARRAY)
+		nextline += keylines[topkey] - 1;
+	    e_repaint();
+
+	} else if (nextline < topline) {
+	    for (i=0;  topkeys[i] <= nextkey && topkeys[i] > 0;  i++)
+		;
+	    topkey = topkeys[i-1];
+	    e_repaint();
+	    nextline = botkeyline;		/* set in e_repaint */
+
+	} else if (nextline != topline) {
+	    for (i=0;  i <= maxpage;  i++) {
+		if (topkeys[i] == nextkey && nextkey != topkey) { 
+		    topkey = nextkey;
+		    nextline = topline;
+		    if (parmlist[topkey]->p_type & PT_ARRAY)
+			nextline += keylines[topkey] - 1;
+		    e_repaint();
+		}
+	    }
+	}
+}
+
+
+/* EDIT_HISTORY_DIRECTIVE -- Main entry point of EHIST, an interactive history
+ * editor.
+ *
+ * EHIST is similar to the IRAF history commands to fetch a previous command,
+ * except that it allows the user to edit it interactively.  The command is
+ * highlighted (optionally) and the user's line editor is invoked.
+ *
+ * This command is invoked by:
+ *
+ *	ehist		(== ^)   edit the previous command
+ *	ehist 3 	(== ^3)  edit command number 3
+ *	ehist a* 	(== ^a*) edit the previous command beginning with 'a'
+ *
+ * A 'return' or EXIT_UPDATE will execute the edited command.
+ * An EXIT_NOUPDATE will not execute the edited command.
+ */
+int 
+edit_history_directive (
+    char *args,			/* ehistory argument list */
+    char *new_cmd		/* the command to be executed after editing */
+)
+{
+	static	char *firstchr[MAX_COMMANDS]; /*array of character pointers */
+	static	char string[G_MAXSTRING];
+	char	arglist[SZ_LINE+1];
+	int	execute, nchars, ochars, i;
+	int	ice;		/* flag for interactive command editor */
+	int	record;		/* record number of the history record */
+	int	numchar;	/* number of characters in the new command */
+	char	*lc, *sc;
+
+	/* Convert the ehist command into the form "^histcmd", fetch the
+	 * command from the history, and start EHIST up.
+	 */
+	arglist[0] = '^';
+	strcpy (&arglist[1], args);
+	execute = process_history_directive (arglist, new_cmd);
+
+	standout = eh_standout;		/* set standout value		*/
+	e_ttyinit();			/* initialize the terminal	*/
+	edtinit();			/* and initialize the editor	*/
+        ice = YES;
+
+	while (ice) {
+	    /* Count the number of keylines and setup the first character
+	     * pointers.
+	     */
+	    firstchr[1] = new_cmd;
+	    for (numkeys=1, sc=new_cmd;  *sc != '\0';  sc++)
+		if (*sc == '\n') {
+		    numkeys++;
+		    firstchr[numkeys] = sc + 1;
+		    keylines[numkeys] = 1;
+		}
+
+	    numkeys--;
+	    firstchr[numkeys+1] = sc;
+
+	    topline  = cmdline - numkeys;
+	    botline  = cmdline - 1;
+	    startcol = 1;
+	    
+	    numchar = strlen(new_cmd) - 1;
+	    line = topline;
+	    if (eh_bol)
+		nextcol = startcol;
+	    else
+		nextcol = startcol + numchar;
+
+	    e_ctrl ("so");
+	    e_display (new_cmd, cmdline, 1);
+	    e_ctrl ("se");
+	    fflush (stdout);
+
+	    *(new_cmd+numchar) = '\0';	/* get rid of the newline at the end. */
+	    nextkey = 1;
+
+	    /* Main EHIST loop.
+	     */
+	    while (nextkey > 0) {
+		/* Copy the next command.
+		 */
+		sc = string, lc = firstchr[nextkey];
+		while ((*lc != '\n') && (*lc != '\0')) {
+		    /* KLUDGE fix for tabs for the moment. */
+		    if ((*sc = *lc) == '\t')
+			*sc = ' ';
+		    lc++, sc++;
+		}
+		*sc = '\0';
+
+		keyid = nextkey;
+		/* line  = topline + keyid - 1; 24Feb87 */
+		line  = topline + keyid;
+		col   = nextcol;
+	    
+		e_goto (col, line);
+		fflush (stdout);
+		ochars = strlen (string);	    
+		nchars = editstring (string, NO);
+
+		/* Shift commands to the right of this one.
+		 */
+		if (nchars > ochars) {
+		    lc = firstchr[numkeys+1] + nchars - ochars;
+		    while (lc >= firstchr[keyid+1] - 1) {
+			*lc = *(lc - nchars + ochars);
+			--lc;
+		    }
+		}
+
+		/* Insert the revised string inplace.
+		 */
+		for (sc=string, lc=firstchr[keyid];  *sc != '\0';  sc++, lc++)
+		    *lc = *sc;
+		*lc = '\n';
+
+		/* Move the following commands if necessary.
+		 */
+		if (nchars < ochars)
+		    for (lc=firstchr[keyid+1];  *lc !='\0';  lc++)
+			*(lc+nchars-ochars) = *lc;
+
+		/* Revise the firstchr pointers.
+		 */
+		for (i = keyid+1;  i <= numkeys;  i++)
+		    firstchr[i] = firstchr[i] + nchars-ochars;
+
+		numchar += nchars - ochars;
+		keyid   += nextline - line;
+
+	    } /* end of while (nextkey) */
+
+	    *(new_cmd+numchar)   = '\n';
+	    *(new_cmd+numchar+1) = '\0';
+
+	    execute = (nextkey < 0) ? 0 : 1;
+
+	    if (nextline < topline) {
+		record = what_record() + 1;
+		if (get_history (record, new_cmd, SZ_CMDBLK) == ERR)
+		    ice = NO;
+	    } else if (nextline > botline) {
+		record = what_record() - 1;
+		if (get_history (record, new_cmd, SZ_CMDBLK) == ERR)
+		    ice = NO;
+	    } else
+		ice = NO;
+
+	} /* end of ice loop */
+	
+	edtexit();
+	e_ttyexit();
+	printf ("\n");
+	fflush (stdout);
+
+	return (execute);
+}
+
+
+/* EDITSTRING -- A very limited string editor for interactive input.  The number
+ * of characters in the edited string is returned as the function value.
+ */
+int 
+editstring (
+    char *string,
+    int eparam				/* flag to indicate eparam or ehis  */
+)
+{
+	char	oldchar;		/* save old character after delete  */
+	char    oldword[G_MAXSTRING];   /* save the deleted word            */
+	char    oldline[G_MAXSTRING];	/* save the deleted line            */
+	char	tempstr[G_MAXSTRING];
+	char	*chn;
+	char	*cp;			/* pointer to char within string    */
+	char	*lc;			/* pointer to last char		    */
+	int	oldnum = 0;		/* for DEL_WORD and UNDEL_WORD	    */
+	int	numchar;		/* number of characters in string   */
+	int	cmd;			/* the command identifier	    */
+	int	direction;		/* the cursor direction		    */
+	int	gotstring, i, numdel, ch;
+
+    	gotstring = NO;			/* dont have anything yet	    */
+
+	if (eparam) {
+	    /* Start out with an empty string, saving the old value of
+	     * the parameter in "oldline".
+	     */
+	    strcpy (oldline, string);
+	    numchar = 0;
+	    cp  = string;
+	    *cp = '\0';
+	} else {
+	    /* Edit history.  Start at either EOL or BOL depending upon
+	     * value of switch set by user.
+	     */
+    	    numchar = strlen (string);
+	    if (eh_bol)
+		cp = string;
+	    else
+		cp = string + numchar;
+	}
+
+    	direction = FWD;
+    	col = startcol + (cp - string);
+
+	while (!gotstring) {
+
+	    /* Fetch the next keystroke.
+	     */
+	    ch = fgetc (stdin);
+	    if (error_displayed)
+		e_clrerror();
+
+	    /* Map to lower case if ucasein switch is set.  The ^ shift escape
+	     * sequence is not currently supported.
+	     */
+	    if (e_ucasein && isupper(ch))
+		ch = tolower (ch);
+
+	    if (ch == EOF) {
+		/* EOF returned; should not happen, so return.
+		 */
+		gotstring = YES;
+		nextline  = cmdline;
+		continue;
+
+	    } else if (eparam && ch == ':' && col == startcol) {
+		/* Colon escape.
+		 */
+		if (e_colon() == EP_EOF) {
+		    gotstring = YES;
+		    nextline  = cmdline;
+		} else {
+		    e_goto (col, line);
+		    fflush (stdout);
+		}
+		continue;
+	    
+	    } else if (ch == ' ' || ch == '\t' || isprint(ch)) {
+		/* Normal character.
+		 */
+
+		/* KLUDGE fix for tabs for the moment. */
+		ch = (ch == '\t') ? ' ' : ch;
+
+		/* Copy what's to the right. */
+		for (lc = string + numchar +1;  lc > cp;  --lc)
+		    *lc = *(lc-1);
+		*cp = ch;			/* substitute the new char   */
+
+		if (cp >= (string + G_MAXSTRING))
+		    continue;
+		lc = cp;  numchar++;  col++;  cp++;
+		e_ctrl ("so");
+		e_putline (lc); 
+		e_ctrl ("se");
+		e_goto (col, line);
+		fflush (stdout);
+		continue;
+
+	    } else if (ch == '\r') {
+		/* Carriage return.
+		 */
+		if (eparam)
+		    gotstring = e_movedown (eparam);
+		else {
+		    nextkey = 0;
+		    nextline  = botline;
+		    gotstring = YES;
+		}
+		continue;
+
+	    } else {
+		/* Find out if it is a legitimate edit command.
+		 */
+		cmd = what_cmd (ch);
+	    }
+
+	    /* Perform the editing function.
+	     */
+	    switch (cmd) {
+
+	    case MOVE_UP:
+		gotstring = e_moveup (eparam);
+		break;
+
+	    case MOVE_DOWN:
+		gotstring = e_movedown (eparam);
+		break;
+
+	    case MOVE_RIGHT:
+		if (cp < (string+numchar))	/* dont move beyond string */
+		    if (col < maxcol)		/* dont move beyond screen */
+			cp++; 
+		break;
+
+	    case MOVE_LEFT:
+		if (cp > string)	 	/* dont move too far */
+		    --cp;
+		break;
+
+	    case NEXT_WORD:
+		if (direction != AFT) {
+		    if (cp != (string+numchar))
+			cp = e_tonextword (cp);
+		    else
+			gotstring = e_movedown (eparam);
+		    break;
+		}
+		/* fall through to the PREV_WORD case (no break) */
+
+	    case PREV_WORD:
+		if (cp != string)
+		    cp  = e_toprevword (cp, string);
+		else
+		    gotstring = e_moveup (eparam);
+		break;
+
+	    case MOVE_EOL:
+		/* Move to the end of the current line.
+		 */
+		if (cp < (string+numchar)) {
+		    cp = string + numchar;
+		    break;
+		}
+
+		if (direction == AFT)
+		    gotstring = e_moveup (eparam);
+		else
+		    gotstring = e_movedown (eparam);
+		break;
+
+	    case MOVE_BOL:
+		/* Move to the beginning of the current line.
+		 */
+		cp = string;
+		break;
+
+	    case NEXT_LINE:
+		if (direction == AFT)
+		    gotstring = e_moveup (eparam);
+		else
+		    gotstring = e_movedown (eparam);
+	   	break;
+
+	    case NEXT_PAGE:
+		if (eparam) {
+		    if (botkey != numkeys) {
+			nextline = botline + 1;
+			nextkey  = botkey + 1;
+		    } else {
+			nextline = botkeyline;
+			nextkey  = botkey;
+		    }
+		    gotstring = YES;
+		}
+		break;
+
+	    case PREV_PAGE:
+		if (eparam) {
+		    if (topkey != 1) {
+			nextline = topline - 1;
+			nextkey  = topkey - 1;
+		    } else {
+			nextline = topline;
+			nextkey  = topkey;
+		    }
+		    gotstring = YES;
+		}
+		break;
+
+	    case MOVE_START:
+		if (eparam) {
+		    if (topkey == 1) {
+			nextline = topline;
+			nextkey  = topkey;
+		    } else {
+			nextline = botline + 1;
+			nextkey  = 1;
+		    }
+		    gotstring = YES;
+		}
+		break;
+
+	    case MOVE_END:
+		if (eparam) {
+		    if (botkey == numkeys) {
+			nextline = botkeyline;
+			nextkey  = botkey;
+		    } else {
+			nextline = topline - 1;
+			nextkey  = numkeys;
+		    }
+		    gotstring = YES;
+		}
+		break;
+
+	    case SET_FWD:
+		direction = FWD;
+		break;
+
+	    case SET_AFT:
+		direction = AFT;
+		break;
+
+	    case TOGGLE_DIR:
+		if (direction == AFT)
+		    direction = FWD;
+		else
+		    direction = AFT;
+		break;
+
+	    case DEL_LEFT:
+		chn = cp - 1;
+		if (numchar > 0) {
+		    oldchar = *chn;
+		    strcpy (chn, chn+1);
+		    if (cp > string)
+			--cp;
+		    --numchar;
+
+		    e_display (string, line, startcol);
+
+		    e_goto (startcol + numchar, line);
+		    e_putline (" ");
+		    fflush (stdout);
+		}
+		break;
+
+	    case DEL_CHAR:	
+		/* Delete the character under the cursor.
+		 */
+		chn = cp;
+		if ((numchar > 0) && (cp < (string+numchar))) {
+		    oldchar = *chn;
+		    strcpy (chn, chn+1);
+		    --numchar;
+
+		    e_display (string, line, startcol);
+
+		    e_goto (startcol + numchar, line);
+		    e_putline (" ");
+		    fflush (stdout);
+		}
+		break;
+
+	    case UNDEL_CHAR:
+		/* Undelete the last character deleted.
+		 */
+		for (lc=string+numchar+1;  lc >= cp;  --lc)
+		    *lc = *(lc-1);
+		*cp = oldchar;
+		numchar++;
+		e_display (string, line, startcol);
+		break;
+
+	    case DEL_WORD:
+		if (cp >= (string + numchar))		/* end of line */
+			break;
+
+		chn = e_tonextword (cp);
+
+		if ((numchar > 0) && (chn != cp)) {
+		    numdel = chn - cp;
+		    strncpy (oldword, cp, numdel);
+		    oldnum = numdel;
+		    strcpy (cp, chn);
+		    numchar -= numdel;
+
+		    e_display (string, line, startcol);
+
+		    e_goto (startcol + numchar, line);
+		    for (i=0;  i < numdel;  i++)
+			e_putline (" ");
+		    fflush (stdout);
+		}
+		break;
+
+	    case UNDEL_WORD:
+		if (oldnum > 0) {
+		    strcpy (tempstr, cp);	/* save the end */
+		    strncpy (cp, oldword, oldnum);
+		    strcpy (cp+oldnum, tempstr);
+		    numchar = numchar + oldnum;
+		    e_display (string, line, startcol);
+		}
+		break;
+
+	    case DEL_LINE:
+		strcpy (oldline, cp);
+		*cp= '\0';
+		chn     = string + numchar;
+		numdel  = chn - cp;
+		numchar = cp - string;
+
+		e_display (string, line, startcol);
+
+		e_goto (startcol + numchar, line);
+		for (i=0;  i < numdel;  i++)
+		    e_putline (" ");
+		fflush (stdout);
+		break;
+
+	    case UNDEL_LINE:
+		/* Erase current value totally; don't want extraneous
+		 * characters floating around.
+		 */
+		e_goto (startcol, line);
+		numchar = PROMPTOFFSET - startcol;
+		for (i=0;  i < numchar;  i++)
+		    e_putline (" ");
+
+		/* Now, get the old line and display it.
+		 */
+		strcpy (cp, oldline);
+		numchar = strlen (string);
+		cp = string + numchar;
+		e_display (string, line, startcol);
+		break;
+	
+	    case GET_HELP:
+		show_editorhelp();
+
+		/* fall through */
+
+	    case REPAINT:
+		if (eparam) {
+		    nextkey = keyid;
+		    e_repaint();
+		    keyid = nextkey;
+		}
+		e_ctrl ("so");
+		e_display (string, line, startcol);
+		e_ctrl ("se");
+		break;
+
+	    case EXIT_NOUPDATE:
+		if (eparam) {
+		    nextline = cmdline;
+		    ep_status = ERR;
+		} else {
+		    nextkey = -1;
+		    nextline= botline;
+		}	
+		gotstring = YES;
+		break;
+
+	    case EXIT_UPDATE:
+		if (eparam) {
+		    nextline = cmdline;
+		    if (numchar > 0)
+			e_check_vals (string);
+		} else
+		    nextline = botline;
+
+		nextkey  = 0;
+		gotstring = YES;
+		break;
+
+	    default:
+		e_putline ("\007");
+		break;
+	    }
+
+	    col = startcol + cp - string;
+	    e_goto (col, line);
+	    fflush (stdout);
+	}
+
+	return (numchar);
+}
+
+
+/* E_TTYINIT -- Initialize the terminal, i.e., set raw mode and standout mode
+ * (if enabled).  Get dimensions of terminal screen.
+ */
+int 
+e_ttyinit (void)
+{
+	/* Open the tty (termcap) descriptor for the terminal.
+	 */
+	if ((tty = c_ttyodes ("terminal")) == ERR)
+	    c_erract (EA_ERROR);
+
+	/* Set raw mode on the standard input.
+	 */
+	c_fseti (fileno(stdin), F_RAW, YES);
+
+	/* The following is to support monocase (upper case only) terminals,
+	 * or normal dualcase terminals in shift lock mode.  Normally the
+	 * terminal driver handles this, but since this is a raw mode
+	 * interface case mapping is disabled.  Determine if ucasein and
+	 * ucaseout have been selected, e.g., with `stty ucasein ucaseout'.
+	 */
+	e_ucasein  = c_ttstati ((XINT)STDIN,  TT_UCASEIN);
+	e_ucaseout = c_ttstati ((XINT)STDOUT, TT_UCASEOUT);
+
+	/* Get the dimensions of the terminal screen from the environment.
+	 * These need not agree with the physical screen dimensions given
+	 * in the termcap descriptor.
+	 */
+	c_xttysize (&maxcol, &cmdline);
+	startcol = G_STARTCOL;
+	topline  = G_TOPLINE;
+	botline  = cmdline - (G_CMDLINE - G_BOTLINE);
+
+	tty_fd = fileno(stdout);
+}
+
+
+/* E_COLON -- Process a colon escape.  Prompt with a : on the status line,
+ * get the command from the user, and either execute the command or return
+ * the command to the procedure which called eparam.  As far as possible,
+ * all error checking should be performed before exiting, so that eparam
+ * does not exit when an invalid colon escape is entered.  EP_EOF is returned
+ * as the function value if eparam is to exit.
+ */
+int 
+e_colon (void)
+{
+	register char	*ip, *op;
+	register int	ch;
+	char	buf[SZ_LINE+1], *pset;
+	struct	param *pp;
+	int	ucasein_set;
+	int	force, n;
+
+	ucasein_set = c_ttstati ((XINT)STDIN, TT_UCASEIN);
+
+	/* Go to the command line, clear it and read the string value.
+	 * The read is performed in raw mode to avoid a line feed and scroll
+	 * when the CR is typed.
+	 */
+again_:
+	c_ttygoto (tty_fd, tty, 1, cmdline);
+	c_ttyclearln (tty_fd, tty);
+	c_ttyctrl (tty_fd, tty, "se", 1);
+	c_ttyputline (tty_fd, tty, "\r:", NO);
+	c_flush (tty_fd);
+
+	for (op=buf;  (ch = fgetc (stdin)) != EOF;  ) {
+	    if (ch == '\177' || ch == '\010') {			/* delete */
+		if (op > buf) {
+		    *--op = EOS;
+		    c_ttyclearln (tty_fd, tty);
+		    c_ttyputline (tty_fd, tty, "\r:", NO);
+		    c_ttyputline (tty_fd, tty, buf, NO);
+		    c_flush (tty_fd);
+		} else {
+		    /* A delete at bol gets us out of colon mode.  */
+		    break;
+		}
+	    } else if (ch == '\003' || ch == '\025') {		/* ^C, ^U */
+		c_ttyclearln (tty_fd, tty);
+		goto again_;
+	    } else if (ch == '\n' || ch == '\r' || (op - buf) >= SZ_LINE) {
+		break;
+	    } else {
+		fputc (ch, stdout);
+		c_flush (tty_fd);
+		if (ucasein_set && isupper (ch))
+		    *op++ = tolower (ch);
+		else
+		    *op++ = ch;
+	    }
+	}
+	*op = EOS;
+
+	/* Parse the colon directive.
+	 */
+	for (ip=buf;  isspace (*ip);  ip++)
+	    ;
+	if (*ip == EOS) {
+	    c_ttyclearln (tty_fd, tty);
+	    return (OK);		/* null command */
+	}
+
+	ch = *ip++;
+	if (ch == 'g' && *ip == 'o')
+	    ip++;
+	if (force = (*ip == '!'))
+	    ip++;
+	for (;  isspace (*ip);  ip++)
+	    ;
+	pset = ip;
+
+	/* Process the colon directive.
+	 */
+	switch (ch) {
+	case 'q':
+	    /* Exit.  The pfile is automatically updated unless :q! is used.
+	     */
+	    if (force)
+		ep_update = NO;
+	    return (EP_EOF);
+
+	case 'w':
+	    /* Update the pfile currently being edited if no arg, else
+	     * write the named pfile.
+	     */
+	    if (*pset == EOS)
+		n = pfilewrite (pfilep, pfilep->pf_pfilename);
+	    else if (strcmp (pset, "q") == 0)		/* ":wq" */
+		return (EP_EOF);
+	    else {
+		if (force || c_access (pset, 0,0) == NO)
+		    n = pfilewrite (pfilep, pset);
+		else {
+		    sprintf (buf,
+			"File exists - use `w! %s' to overwrite", pset);
+		    e_puterr (buf);
+		    return (ERR);
+		}
+	    }
+
+	    sprintf (buf, " - %d parameters written to %s", n,
+		(*pset == EOS) ? pfilep->pf_pfilename : pset);
+	    e_putline (buf);
+	    fflush (stdout);
+	    return (OK);
+
+	case 'r':
+	    /* Load a new set of parameter values into the parameter set
+	     * currently being edited.  If no argument is given the main
+	     * task pset is reloaded.
+	     */
+	    if (*pset == EOS) {
+		if (force) {
+		    strcpy (e_nextpset, e_cx->e_pset);
+		    ep_nextcmd = EP_EDIT;
+		    ep_update = NO;
+		    return (EP_EOF);
+		} else {
+		    e_puterr ("Use `r!' to reload current pset");
+		    return (ERR);
+		}
+	    } else {
+		if (e_psetok (pset)) {
+		    pfilemerge (e_cx->e_cpfp, pset);
+
+                    /* If we're forcing the new parameters, update
+                     * the pfile on disk so we can execute it immediately.
+                     */
+                    if (force) 
+                        n = pfilewrite (pfilep, pfilep->pf_pfilename);
+
+		    e_repaint();
+		    return (OK);
+		} else
+		    return (ERR);
+	    }
+
+	case 'e':
+	    /* Edit the pset whose name is given by the string value of the
+	     * current parameter.
+	     */
+	    if (*pset != EOS) {
+		/* Edit a new pset, discarding current context.
+		 */
+		if (e_psetok (pset)) {
+		    strcpy (e_nextpset, pset);
+		    ep_nextcmd = EP_EDIT;
+		    return (EP_EOF);
+		} else
+		    return (ERR);
+
+	    } else {
+		/* Edit the pset pointed to by the pset parameter currently
+		 * under the cursor (only works for pset parameters).
+		 */
+		pp = parmlist[keyid];
+		if (!(pp->p_type & PT_PSET)) {
+		    sprintf (buf, "parameter `%s' is not a pset parameter",
+			pp->p_name);
+		    e_puterr (buf);
+		    return (ERR);
+		}
+
+		/* Get the pset name.  This is the string value of the pset
+		 * parameter, else the name of the parameter itself.
+		 */
+		e_encode_vstring (pp, buf);
+		if (*buf == EOS)
+		    pset = pp->p_name;
+		else
+		    pset = buf;
+
+		if (e_psetok (pset)) {
+		    strcpy (e_nextpset, pset);
+		    ep_nextcmd = EP_DESCEND;
+		    return (EP_EOF);
+		} else
+		    return (ERR);
+	    }
+	    
+	case 'g':
+	    /* Exit and run the task.
+	     */
+	    if (force)
+		ep_update = NO;
+	    if (*pset == EOS)
+		pset = e_cx->e_pset;
+
+	    if (is_pfilename (pset)) {
+		e_puterr ("cannot execute a pfile");
+		return (ERR);
+	    } else {
+		strcpy (e_nextpset, pset);
+		ep_nextcmd = EP_RUN;
+		return (EP_EOF);
+	    }
+
+	default:
+	    e_puterr ("Invalid colon escape directive");
+	    return (ERR);
+	}
+}
+
+
+/* E_PSETOK -- Verify that the named pfile exists and can be read.  Report
+ * any problems to the user.
+ */
+int 
+e_psetok (char *pset)
+{
+	register struct pfile *pfp;
+	char	errmsg[SZ_LINE+1], *errfmt, *errarg;
+	XINT	save_topd;
+
+	save_topd = topd;
+	errarg = pset;
+	pfp = NULL;
+
+	if (is_pfilename (pset)) {
+	    /* Verify valid file pset.
+	     */
+	    if (c_access (pset, 0,0) == NO) {
+		errfmt = "pfile `%s' does not exist";
+		goto error_;
+	    } else if ((pfp = pfileread (NULL, pset, 0)) == NULL) {
+		errfmt = e_badpfile;
+		goto error_;
+	    }
+
+	} else {
+	    /* Verify valid ltask pset.
+	     */
+	    char    *x1, *pk, *lt, *x2;
+	    struct  package *pkp;
+	    struct  ltask *ltp;
+
+	    breakout (pset, &x1, &pk, &lt, &x2);
+	    ltp = _ltasksrch (pk, lt, &pkp);
+
+	    if (pkp == NULL) {
+		errfmt = e_pcknonexist;
+		errarg = pk;
+		goto error_;
+	    } else if ((XINT)pkp == ERR) {
+		errfmt = e_pckambig;
+		errarg = pk;
+		goto error_;
+	    } else if (ltp == NULL) {
+		errfmt = e_tnonexist;
+		errarg = lt;
+		goto error_;
+	    } else if ((XINT)ltp == ERR) {
+		errfmt = e_tambig;
+		errarg = lt;
+		goto error_;
+	    }
+
+	    if (!(ltp->lt_flags & LT_PFILE)) {
+		errfmt = e_nopfile;
+		goto error_;
+	    } else if ((pfp = pfileload (ltp)) == NULL) {
+		errfmt = e_badpfile;
+		goto error_;
+	    }
+	}
+
+	/* If we get here we presumably have a valid pset.  Return memory
+	 * and return YES to the caller, indicating that the pset is valid.
+	 */
+	if (pfp)
+	    pfileunlink (pfp);
+	topd = save_topd;
+	return (YES);
+
+error_:
+	sprintf (errmsg, errfmt, errarg);
+	e_puterr (errmsg);
+	return (NO);
+}
+
+
+/* E_PUTERR -- Put an error message on the command line.
+ */
+int 
+e_puterr (char *errmsg)
+{
+	c_ttygoto (tty_fd, tty, 1, cmdline);
+	c_ttyclearln (tty_fd, tty);
+	e_putline (errmsg);
+}
+
+
+/* E_TTYEXIT -- Turn off raw mode and standout mode and close the termcap
+ * descriptor, leaving everything as we found it.
+ */
+int 
+e_ttyexit (void)
+{
+	c_fseti (fileno(stdin), F_RAW, NO);	/* unset raw mode */
+
+	c_ttygoto (tty_fd, tty, 1, cmdline);
+	c_ttyctrl (tty_fd, tty, "se", 1);
+	c_ttycdes (tty);
+
+	fflush (stdout);
+}
+
+
+/* E_MOVEUP -- Move the cursor up one line.
+ */
+int 
+e_moveup (int eparam)
+{
+	if (keyid != 1) {
+	    /* Can go up further.
+	     */
+	    nextkey = keyid - 1;
+	    if (line == topline)	/* over the top */
+		nextline = topline - 1;
+	    else {
+		nextline = line - keylines[nextkey];
+		if (eparam) {
+		    if ((parmlist[nextkey]->p_type & PT_ARRAY))
+			if (firstelement[nextkey] == 1)
+			    nextline = line - 1;
+
+		    if ((parmlist[keyid]->p_type & PT_ARRAY))
+			if (firstelement[keyid] == 1)
+			    nextline = nextline - keylines[keyid] + 1;
+		}
+		if (nextline < topline)
+		    nextline = topline - 1;
+	    }
+
+	} else if (!eparam) {
+	    nextline = topline - 1;
+	    nextkey = -1;
+	}
+
+	return (YES);
+}
+
+
+/* E_MOVEDOWN -- Move the cursor down one line.
+ */
+int 
+e_movedown (int eparam)
+{
+	if (keyid != numkeys) { 
+	    /* get downnnnn!! 
+	     */
+	    nextkey = keyid+1;
+	    if (line == botline)
+		nextline = botline+1;
+	    else {
+		nextline = line + keylines[keyid];
+		if (eparam) {
+		   if ((parmlist[keyid]->p_type & PT_ARRAY))
+		       if (firstelement[keyid] == 1)  
+			    nextline = line + 1;
+
+		   /* Make room for prompt */
+		   if ((parmlist[nextkey]->p_type & PT_ARRAY))
+			if (firstelement[nextkey] == 1)
+			    nextline = nextline + keylines[nextkey] - 1;
+		}
+		if (nextline > botline)
+		    nextline = botline + 1;
+	    }
+
+	} else if (!eparam) {
+	    nextline = botline+1;
+	    nextkey  = -1;
+	}
+
+	if (cldebug) {
+	    sprintf (dbg, "nextline=%d, nextkey=%d line=%d keys=%d", 
+		nextline, nextkey, line, keylines[nextkey]);
+	    E_DEBUG(dbg);
+	}
+
+	return (YES);
+}
+
+
+/* E_TONEXTWORD -- Skip forward to the beginning of the next word.
+ */
+char *
+e_tonextword (register char *ip)
+{
+	ip++;
+
+	/* Pass over leading characters. */
+	while (*ip && !isspace (*ip))
+	    ip++;
+	
+	/* Find the next character. */
+	while (*ip && isspace(*ip))
+	    ip++;
+
+	return (ip);
+}
+
+
+/* E_TOPREVWORD -- Find the beginning of the previous word.
+ */
+char *
+e_toprevword (char *ip, char *string)
+{
+	--ip;
+
+	/* Pass over leading blanks. */
+	if (*ip == ' ')
+	    for (;  (*ip == ' ') && (ip != string);  --ip)
+		;
+		
+	/* Find the preceding blank. */
+	for (;  (*ip != ' ') && (ip != string);  --ip)
+	    ;
+	if ((*ip != ' ') && (ip == string))
+	    ;
+	else
+	    ip++;
+
+	return (ip);
+}	
+
+
+/* E_CTRL -- Send a control sequence to the terminal.
+ */
+int 
+e_ctrl (char *cap)
+{
+	/* Check for start standout or start underline mode.
+	 */
+	if (strcmp(cap,"so") == 0 || strcmp(cap,"us") == 0)
+	    if (standout == NO)
+		return 0;
+
+	c_ttyctrl (tty_fd, tty, cap, 1);
+}
+
+
+/* E_GOTO -- High level edcap version of ttygoto (cursor addressing).
+ */
+int 
+e_goto (int col, int line)
+{
+	c_ttygoto (tty_fd, tty, col, line);
+}
+
+
+/* E_PUTLINE -- Put a line of text to the terminal.  Do not map any embedded
+ * control codes (bell will get lost).
+ */
+int 
+e_putline (char *stwing)
+{
+	register char	*ip, *op;
+	register int	ch, n;
+	char	obuf[512];
+	int	map_cc=0;
+
+	/* Map output to upper case if `stty ucaseout' mode is set (we have
+	 * to do this here because of the raw i/o).
+	 */
+	if (e_ucaseout) {
+	    for (ip=stwing, op=obuf, n=512;  --n >= 0 && (ch = *ip++) != EOS;  )
+		*op++ = islower(ch) ? toupper(ch) : ch;
+	    *op = EOS;
+	    ip = obuf;
+	} else
+	    ip = stwing;
+	    
+	/* The flush calls are required to avoid mixing text and control
+	 * sequences when doing raw i/o to monocase terminals.
+	 */
+	if (e_ucaseout)
+	    c_flush (tty_fd);
+	c_ttyputline (tty_fd, tty, ip, map_cc);
+	if (e_ucaseout)
+	    c_flush (tty_fd);
+}
+
+
+/* E_CLEAR -- Clear the screen (disables standout mode as a side effect).
+ */
+int 
+e_clear (void)
+{
+	c_ttyctrl (tty_fd, tty, "se", 1);
+	c_ttyctrl (tty_fd, tty, "ue", 1);
+	c_ttyclear (tty_fd, tty);
+}
+
+
+/* E_CLRLINE -- Clear the current line.
+ */
+int 
+e_clrline (void)
+{
+	c_ttyclearln (tty_fd, tty);
+}
+
+
+/* E_DISPLAY -- Output a possibly multiline string at the given screen
+ * coordinates.  Each line is written starting at the same column on the
+ * screen.
+ */
+int 
+e_display (
+    char *string,		/* string to be printed		*/
+    int sline,
+    int scol		/* starting line and column	*/
+)
+{
+	e_displayml (string, sline, scol, scol);
+}
+
+
+/* E_DISPLAYML -- Display a possibly multiline prompt, with the first line
+ * starting a different column than the continuation lines.  If a continuation
+ * line begins with \r (CR) it will be displayed starting at column 1, rather
+ * than starting at column scol.
+ */
+int 
+e_displayml (
+    char *string,		/* string to be printed			*/
+    int sline,
+    int scol,		/* starting line and column		*/
+    int ccol			/* start col of continuation lines	*/
+)
+{
+	register char	*ip, *op;
+	char	lbuf[512], *line;
+	int	ocol;
+
+	/* Display a series of newline delimited lines.
+	 */
+	for (ip=string, op=lbuf;  *ip != EOS;  )
+	    for (op=lbuf;  (*op = *ip) != EOS;  op++, ip++)
+		if (*op == '\n') {
+		    *op = EOS;
+		    /* Truncate line at right margin.  If first char is \r,
+		     * starting column is column 1 rather than scol.
+		     */
+		    ocol = scol; line = lbuf;
+		    while (*line == '\r') {
+			ocol = 1;
+			line++;
+		    }
+		    line[maxcol-ocol+1] = EOS;
+
+		    /* Display the line. */
+		    e_goto (ocol, sline++);
+		    e_ctrl ("ce");
+		    e_putline (line);
+		    op = lbuf - 1;
+		    scol = ccol;
+		}
+
+	/* Display any remaining, nonnewline-delimited line segment.
+	 */
+	if (op > lbuf) {
+	    *op = EOS;
+	    ocol = scol; line = lbuf;
+	    while (*line == '\r') {
+		ocol = 1;
+		line++;
+	    }
+	    line[maxcol-ocol+1] = EOS;
+	    e_goto (ocol, sline++);
+	    e_putline (line);
+	}
+}
diff --git a/pkg/vocl/eparam.h b/pkg/vocl/eparam.h
new file mode 100644
index 00000000..72ef1ab2
--- /dev/null
+++ b/pkg/vocl/eparam.h
@@ -0,0 +1,108 @@
+/*
+ * EPARAM.H -- Definition of the string editing capabilities.  The mapping
+ * of the commands is defined by the *.ed files in DEV.
+ */
+
+#define FIRST_CMD	3	/* first command escape sequence	*/
+#define	NUM_COMMANDS	35	/* number of recognized commands	*/
+#define	MAX_COMMANDS	50	/* max commands recognized by edcap	*/
+#define	SZ_ESCAPE	10	/* terminal escape sequence		*/
+#define	SZ_KEYSTROKE	12	/* keystroke command name		*/
+
+#define	G_TOPLINE	6	/* top of eparam scrolling region	*/
+#define	G_BOTLINE	22	/* bottom of eparam scrolling region	*/
+#define	G_STARTCOL	11	/* start of eparam edit area		*/
+#define	G_CMDLINE	24	/* command line for messages & exit	*/
+
+#define	G_MAXPARAM	100	/* maximum number of parameters		*/
+#define	G_MAXPAGES	12	/* maximum number of pages		*/
+#define	G_MAXSTRING      80	/* maximum size of the edit string	*/
+#define	G_BIGSIZE	2048	/* sum of sizes of value fields		*/
+#define	MAXPROMPT	2048	/* maximum characters in multiline pr.	*/
+#define	PROMPTOFFSET	32	/* where the prompt starts		*/
+#define	VALUEOFFSET	11	/* where the value field starts		*/
+#define	MAX_ON_ROW	6	/* the number of %10.10s fields		*/
+
+#define	FWD		1
+#define	AFT		0
+
+/* eparam() context structure.
+ */
+struct ep_context {
+	int	e_init;			/* set on first call		*/
+	XINT	e_topd;			/* save top of dictionary	*/
+	int	e_topkey;		/* saved context variables	*/
+	int	e_line;			/* 		"		*/
+	int	e_col;			/* 		"		*/
+	int	e_nextkey;		/* 		"		*/
+	int	e_nextline;		/* 		"		*/
+	struct	pfile *e_mpfp;		/* master pfile descriptor	*/
+	struct	pfile *e_cpfp;		/* pfilecopy descriptor		*/
+	char	e_pset[SZ_FNAME+1];	/* pset name (task or file)	*/
+};
+
+/* eparam() colon commands and exit status codes.
+ */
+#define	EP_EOF		1		/* update pfile and pop context	*/
+#define	EP_EDIT		2		/* discard context and edit	*/
+#define	EP_DESCEND	3		/* push context and edit pfile	*/
+#define	EP_RUN		4		/* exit and run task		*/
+
+/* Editor initialization and termination sequences (these have to be first
+ * in case a 'define key' capability is added).
+ */
+#define EDITOR_ID	0	/* editor's name		 	*/
+#define EDIT_INIT	1	/* editor initialization sequence	*/
+#define EDIT_TERM	2	/* editor termination sequence		*/
+
+/* edit commands	*/
+
+#define	MOVE_UP		3	/* move the cursor up one line */
+#define MOVE_DOWN	4	/* move the cursor down one line */
+#define MOVE_RIGHT	5	/* move the cursor one char to the right */
+#define MOVE_LEFT	6	/* move the cursor one char to the left */
+#define NEXT_WORD	7	/* move the cursor one word to the right */
+#define PREV_WORD	8	/* move the cursor one word to the left */
+#define MOVE_EOL	9	/* move the cursor to the end of line */
+#define MOVE_BOL	10	/* move the cursor to the beginning */
+#define NEXT_PAGE	11	/* move to the next page */
+#define PREV_PAGE	12	/* move to the previous page */
+#define MOVE_START	13	/* move to the start of the text */
+#define MOVE_END	14	/* move to the end of the text */
+
+/* these commands are for EDT type editors */
+#define SET_FWD		15	/* set the direction forwards */
+#define SET_AFT		16	/* set the direction aftwards */
+#define TOGGLE_DIR	17	/* change the direction */
+
+#define DEL_LEFT	18	/* delete the character to the left */
+#define DEL_CHAR	19	/* delete the character under the cursor */
+#define DEL_WORD	20	/* delete up to and including next delimiter */
+#define DEL_LINE	21	/* delete up to the end of line */
+#define UNDEL_CHAR	22	/* undelete the character */
+#define UNDEL_WORD	23	/* undelete the word */
+#define UNDEL_LINE	24	/* undelete the line */
+
+#define FIND_FWD	25	/* find forward	*/
+#define FIND_AFT	26	/* find aftward	*/
+#define FIND_NEXT	27	/* find next */
+#define GET_HELP	28	/* display help information */
+#define REPAINT		29	/* clear and repaint the screen */
+#define EXIT_UPDATE	30	/* exit the editor */
+#define EXIT_NOUPDATE	31	/* exit the editor with no update */
+
+#define NEXT_LINE	32	/* move to the next line */
+#define NOMORE_COMMANDS 99	/* last command terminator */
+
+struct edit_commands {
+	int  cmd;
+	char escape[SZ_ESCAPE+1];
+	char keystroke[SZ_KEYSTROKE+1];
+};
+
+extern struct edit_commands command[MAX_COMMANDS];
+extern char *cmdnames[MAX_COMMANDS];
+extern int numcommands;
+
+char	*enumin(), *minmax();
+char	*host_editor();
diff --git a/pkg/vocl/errs.c b/pkg/vocl/errs.c
new file mode 100644
index 00000000..52ff0d3d
--- /dev/null
+++ b/pkg/vocl/errs.c
@@ -0,0 +1,401 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define import_libc
+#define	import_fset
+#define	import_stdio
+#define import_setjmp
+#define import_knames
+#define	import_xnames
+#define	import_stdarg
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "mem.h"
+#include "errs.h"
+#include "grammar.h"
+#include "construct.h"
+#include "proto.h"
+
+
+/*
+ * ERRS -- When a runtime operation detects an error, it calls error with an
+ *   error type, a diagnostic string and some additional arguments. the type
+ *   determines the severity and prefix for the diagnostic. the diagnositic
+ *   and its args are written as an error message with doprnt.
+ * After the error message has been printed to our t_stderr, tasks are killed
+ *   until an interactive cl is found. the longjmp forces the last
+ *   setjmp (errenv) in main() to return and start the parser again.
+ *   thus, a call to error() never returns but forces a reset back to an
+ *   interactive state.
+ *
+ * Some frequently used diagnostic strings are defined here to avoid
+ *   repetition. The list may be expanded or ignored as desired when new
+ *   errors are added.
+ */
+extern	int cltrace;		/* trace execution			*/
+extern	int errlev;		/* for detecting error recursion	*/
+extern	int bkgno;		/* bkg task number, if batch job	*/
+extern	int validerrenv;	/* set in main once get past login()	*/
+extern	int loggingout;		/* set while reading from logout file	*/
+extern	int gologout;		/* set when getting ready to " " "	*/
+extern	int currentline;	/* current script line being executed 	*/
+extern	int errorline;		/* error script line being recovered 	*/
+extern	jmp_buf errenv;		/* setjmp() is in main().		*/
+
+char	*e_appopen 	= "can not open `%s' for appending";
+char	*e_badstrop 	= "illegal operation on string '%0.20s'";
+char	*e_badsw 	= "bad switch case, %d, in `%s'";
+char	*e_geonearg 	= "`%s' requires at least one argument";
+char	*e_indexunf 	= "no indices on stack for array reference";
+char 	*e_nominmax 	= "structs, strings, cursors and bools have no ranges";
+char	*e_nopfile 	= "task `%s' has no param file";
+char	*e_badpfile 	= "cannot read parameter file `%s'";
+char	*e_nostrcnv 	= "may not convert string to other types";
+char	*e_onearg 	= "`%s' expects one argument";
+char	*e_pambig 	= "ambiguous parameter `%s' within `%s'";
+char	*e_pckambig 	= "ambiguous package `%s'";
+char	*e_pcknonexist	= "package `%s' not found";
+char	*e_posargs 	= "too many positional arguments for `%s'";
+char	*e_pnonexist 	= "parameter `%s' not found";
+char	*e_ropen 	= "cannot open `%s' for reading";
+char	*e_simplep 	= "use simple parameter name only for `%s'";
+char	*e_strplusreal	= "attempt to add operand of type real to string `%s'";
+char	*e_soverflow 	= "stack overflow (cs:%d,os:%d)";
+char	*e_sunderflow 	= "stack underflow";
+char	*e_tambig 	= "ambiguous task `%s'";
+char	*e_twoargs 	= "`%s' expects two arguments";
+char	*e_tnonexist 	= "task `%s' not found";
+char	*e_uopcode 	= "undefined opcode %d";
+char	*e_wopen 	= "cannot open `%s' for writing";
+char	*e_lookparm 	= "error searching for parameter `%s'.";
+char	*e_invaldef	= "conflicting attributes in definition of `%s'.";
+char	*e_fdivzero 	= "floating divide by zero";
+char	*e_idivzero 	= "integer divide by zero";
+char	*e_fdzvalue 	= "floating divide by zero - using $err_dzvalue";
+char	*e_idzvalue 	= "integer divide by zero - using $err_dzvalue";
+
+/* 
+char	*e_edom 	= "function argument outside valid range: %g";
+char	*e_erange 	= "%g caused arithmetic overflow";
+char	*e_fpe 		= "floating point exception";
+char	*e_unlink 	= "cannot remove file `%s'";
+char	*e_notbool 	= "parameter `%s' is not boolean";
+*/
+
+/* The 'errlog' variable is used to avoid duplicate error logging by the
+ * builtin clerror() and the error function cl_error() below.  When a script
+ * or executable tasks calls the CL language 'error' function, the builtin
+ * clerror() logs the error message.  Otherwise, we'll log it here.
+ */
+int	errlog    = NO;
+
+/* These variables are the various 'erract' options.
+ */
+int	err_abort      = YES;	/* abort on error		*/
+int	err_beep       = YES;	/* beep on error		*/
+int	err_trace      = YES;	/* print calling traceback	*/
+int	err_flpr       = YES;	/* flush process cache		*/
+int	err_clear      = YES;	/* clear CL status params	*/
+int	err_full       = YES;	/* print full traceback?	*/
+ErrCom	errcom;
+
+extern	int in_iferr, do_error;
+extern  char *onerr_handler;
+
+
+
+/* CL_ERROR -- print error info according to errtype on our t_stderr, pop back
+ * to an interactive task and do a longjmp back to setjmp (errenv) in
+ * main(); thus, whomever calls error() should not expect it to return.
+ *  
+ * If errtype is or'd with E_P, also call perror() for more info.
+ * If we are a background task, print the task ordinal to tell the user
+ * which task aborted.
+ */
+
+void
+cl_error (int errtype, char *diagstr, ...)
+{
+	va_list	args;
+	register struct task *tp;
+	static	int nfatal = 0;
+	static	int break_locks = 1;
+
+	va_start (args, diagstr);
+
+        /* (Re)-initialize the error action.
+         */
+        erract_init();
+
+	/* Safety measure, in the event of error recursion.
+	 */
+	if (err_abort) {
+	    if (nfatal)
+	        clexit();
+
+	    if (errlev++ > 2) {
+	        nfatal++;
+	        eprintf ("Error recursion.  Cl dies.\n");
+	        clexit();
+	    }
+	}
+
+	/* The first setjmp(errenv) is not done until we start the main loop.
+ 	 * Set validerrenv when start the first interactive cl to indicate that
+	 * we may safely longjmp back to main's loop on an error.  ERRENV is
+	 * not set for bkg jobs since error restart is not permitted.
+	 */
+	    
+	if (!validerrenv && !(firstask->t_flags & T_BATCH)) {
+	    nfatal++;
+            u_doprnt (diagstr, &args, currentask->t_stderr);
+	    if (errtype & E_P)
+	        perror ("\nOS errmsg");
+	    else
+		eprintf ("\n");
+	    eprintf ("Fatal startup error.  CL dies.\n");
+	    clexit();
+	}
+
+	/* Any error occurring during logout is fatal.
+	 */
+	if (loggingout || gologout) {
+	    nfatal++;
+            u_doprnt (diagstr, &args, currentask->t_stderr);
+	    if (errtype & E_P)
+	        perror ("\nOS errmsg");
+	    else
+		eprintf ("\n");
+	    eprintf ("Fatal logout error.  CL dies.\n");
+	    clexit();
+	}
+
+	/* Perform any ONERROR error recovery in the vos first.  Initialize
+	 * the error recovery mechanism (necessary since the iraf main is not
+	 * being allowed to do error recovery).
+	 */
+	c_xonerr (1);
+	XER_RESET();	/* TODO: move into LIBC interface */
+
+	/* Clear terminal raw mode if still set. */
+	c_fseti ((XINT)STDIN, F_RAW, NO);
+
+	if (firstask->t_flags & T_BATCH)
+	    eprintf ("\n[%d] ", bkgno);
+	if (errtype & E_IERR)
+	    eprintf ("INTERNAL ");
+	if (errtype & E_FERR)
+	    eprintf ("FATAL ");
+
+	/* Disable error tracing if requested.
+	 */
+	if (err_trace == YES || (errtype & E_UERR)) {
+	    if (currentask->t_flags & T_SCRIPT &&
+	        currentask->t_flags & T_INTERACTIVE)
+		    eprintf ("ERROR on line %d: ", errorline);
+	    else
+	        eprintf ("ERROR: ");
+
+	    u_doprnt (diagstr, &args, currentask->t_stderr);
+	    if (errtype & E_P)
+	        perror ("\nOS errmsg");
+	    else
+	        eprintf ("\n");
+	}
+
+	/* Log the error message if from a script or an executable.
+	 */
+	if (!errlog && keeplog() && log_errors()) {
+	    if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) {
+	    	PKCHAR  buf[SZ_LINE+1];
+		FILE	*fp;
+		int     fd;
+
+		fd = c_stropen (buf, SZ_LINE, NEW_FILE);
+		fp = fdopen (fd, "w");
+
+		fprintf (fp, "ERROR on line %d: ", errorline);
+		u_doprnt (diagstr, &args, fp);
+
+		fclose (fp);
+		c_close (fd);
+	    	putlog (currentask, c_strpak (buf, (char *)buf, SZ_LINE));
+	    }
+	}
+	errlog = 0;
+
+	/* Initialize the current command block but do not log the command
+	 * which aborted.  If we're only trapping errors and not fully 
+  	 * recovering, don't reset the command block so we have the option
+	 * to continue execution.
+	 */
+	if ((err_abort == YES && do_error == NO) || 
+	    (do_error == YES || (errtype & E_UERR))) 
+		yy_startblock (NOLOG);
+
+	/* Delete all pipefiles.  Call iofinish() first as some OS's may
+	 * require that the files be closed before they can be deleted.
+	 */
+	for (tp=currentask; !(tp->t_flags & T_INTERACTIVE); tp=next_task(tp)) {
+	    iofinish (tp);
+	    if (tp == firstask)
+		break;
+	}
+	delpipes (0);
+
+	/* Do not go on if this is a fatal error or we are unattended.
+	 */
+	if (errtype & E_FERR) {
+	    nfatal++;
+	    pr_dumpcache (0, break_locks);
+	    clexit();
+	} else if (firstask->t_flags & T_BATCH)
+	    clshutdown();
+
+	/* Reset state variables. */
+	/* Most of these probably needn't be reset, but we'll play
+	 * it safe.
+	 */
+	nestlevel = 0;			/* set nesting to 0 		*/
+	offsetmode (0);			/* offset mode to index 	*/
+	ncaseval = 0;			/* number of case values 	*/
+	n_indexes = 0;
+	imloopset = 0;			/* in an implicit loop 		*/
+	n_oarr = 0;			/* implicit loop indicators 	*/
+	i_oarr = 0;
+	maybeindex = 0;			/* sexagesimal/index range	*/
+	parse_state = PARSE_FREE;
+	if (last_parm) {		/* have we tried to add a param	*/
+	    last_parm->p_np = NULL;
+	    currentask->t_pfp->pf_lastpp = last_parm;
+	    last_parm = NULL;
+	}
+
+
+	/* Set the error flag.  */
+	errcom.errflag++;
+	errcom.nhandlers++;
+
+	/* Get back to an interactive state.  We simply return if we're
+	 * trapping errors except when processing a E_UERR.  These type
+	 * messages come from the CL itself and require user attention to
+	 * correct (e.g. task not found, parameter type/syntax errors, etc).
+	 * The calling procedure is not expecting us to return, so we cannot
+	 * properly trap without rewriting the calling code.
+	 */
+	if (cltrace) {
+	    eprintf ("cl_error: abort=%d  beep=%d  trace=%d  flpr=%d\n", 
+	        err_abort, err_beep, err_trace, err_flpr);
+	    eprintf ("cl_error: code=%d do_err=%d errtype=%d/%d task='%s'\n", 
+	        errcom.errcode, do_error, errtype, errtype&E_UERR, 
+	        currentask->t_ltp->lt_lname);
+	}
+	if ((err_abort == YES && do_error == NO) || 
+	    (do_error == YES || (errtype & E_UERR))) {
+	        extern ErrCom errcom;
+	        register struct param *pp;
+
+	    	if (!errcom.errcode && (errtype & E_UERR)) {
+
+                    errcom.errcode = errtype;
+                    strcpy (errcom.errmsg, diagstr);
+                    strcpy (errcom.task, currentask->t_ltp->lt_lname);
+
+                    pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
+                    pp->p_val.v_i = errcom.errcode;
+                    pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
+                    pp->p_val.v_s = errcom.errmsg;
+                    pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
+                    pp->p_val.v_s = errcom.task;
+	    	}
+	    	taskunwind();
+
+	    	/* If an abort occurs while interrupts are disabled they will 
+	    	 * never get reenabled unless we do so here.
+	    	 */
+	    	intr_reset();
+
+	    	/* Go back to main loop in main().
+	    	 */
+	    	va_end (args);
+	    	longjmp (errenv, 1);
+
+	} else {
+	    va_end (args);
+	    return;
+	}
+}
+
+
+/*  ERRACT_INIT -- Initialize the error recovery option string 'erract'.
+ *  To be consistent this should really be a CL parameter similar to 
+ *  'ehinit' but for the moment we don't want to change the CL pset so
+ *  we implement it as an environment variable.  Also, unlike the params
+ *  we allow the value to reset individual options and build the final
+ *  value string at the end and put it back in the environment.
+ */
+
+#define NEXT_TOKEN  while (*act == ' ' || *act == '\t' || *act == '\n') act++;\
+                    if (!*act) break;
+#define NEXT_WHITE  while (*act != ' ' && *act != '\t' && *act != '\0') act++;
+
+void 
+erract_init (void)
+{
+	char *act, *envget();
+	char opt[SZ_LINE];
+
+	/* Parse the erract string to pick up new options.
+	 */
+	if ((act = envget ("erract"))) {
+            while (*act) {
+                NEXT_TOKEN;
+
+                if      (strncmp (act, "abort", 3) == 0)
+                    err_abort = YES;
+                else if (strncmp (act, "noabort", 3) == 0)
+                    err_abort = NO;
+                else if (strncmp (act, "beep", 3) == 0)
+                    err_beep = YES;
+                else if (strncmp (act, "nobeep", 3) == 0)
+                    err_beep = NO;
+                else if (strncmp (act, "trace", 3) == 0)
+                    err_trace = YES;
+                else if (strncmp (act, "notrace", 3) == 0)
+                    err_trace = NO;
+                else if (strncmp (act, "flpr", 3) == 0)
+                    err_flpr = YES;
+                else if (strncmp (act, "noflpr", 4) == 0)
+                    err_flpr = NO;
+                else if (strncmp (act, "clear", 3) == 0)
+                    err_clear = YES;
+                else if (strncmp (act, "noclear", 3) == 0)
+                    err_clear = NO;
+                else if (strncmp (act, "full", 3) == 0)
+                    err_full = YES;
+                else if (strncmp (act, "nofull", 4) == 0)
+                    err_full = NO;
+                else if (*act != '\0')
+                    eprintf ("unrecognized erract set-option `%s'\n", act);
+
+                NEXT_WHITE;
+            }
+	}
+
+	/* Now restore the environment variable to define all the options.
+	 */
+	sprintf (opt, "%s %s %s %s %s",
+	    (err_abort      ? "abort"      : "noabort"),
+	    (err_beep       ? "beep"      : "nobeep"),
+	    (err_trace      ? "trace"      : "notrace"),
+	    (err_flpr       ? "flpr"       : "noflpr"),
+	    (err_clear      ? "clear"      : "noclear"),
+	    (err_full       ? "full"       : "nofull") );
+	c_envreset ("erract", opt);
+}
diff --git a/pkg/vocl/errs.h b/pkg/vocl/errs.h
new file mode 100644
index 00000000..4d7bcaec
--- /dev/null
+++ b/pkg/vocl/errs.h
@@ -0,0 +1,72 @@
+/*
+ * ERRS.H -- Type codes for first arg to error(). see errs.c.
+ * Just use bits for easy testing. if the type is or'd with E_P,
+ *   then the systems own error info will also be printed by error().
+ * Also declare the external diagnostic strings.
+ *
+ * E_UERR is a normal user diagnostic.
+ * E_IERR is an internal consistency check failure or system error.
+ * E_FERR is a fatal internal error. it causes error() to call shutdown().
+ * E_P or-ed in causes call to perror() to print system error message.
+ */
+
+#define	E_UERR		001
+#define	E_IERR		002
+#define	E_FERR		004
+#define	E_P		01000
+
+
+#ifndef ERRCOM_DEF
+typedef struct {
+    int  errflag;               /* set when error is posted             */
+    int  errcode;               /* error code                           */
+    int  nhandlers;             /* handler nesting level                */
+    int  err_restart;           /* YES during estart, NO otherwise      */
+
+    char errmsg[SZ_LINE+1];     /* error message string                 */
+    char task[SZ_FNAME+1];      /* task posting the error               */
+    char script[SZ_FNAME+1];    /* script calling task			*/
+    int  linenum;           	/* lineno where error occurred		*/
+} ErrCom, *ErrComPtr;
+
+#define	ERRSIZ		btoi (sizeof (ErrCom))
+#endif
+#define ERRCOM_DEF
+
+
+/* The diagnostic strings. defined in errs.c.
+ */
+extern char *e_appopen;
+extern char *e_badstrop;
+extern char *e_badsw;
+extern char *e_edom;
+extern char *e_erange;
+extern char *e_fpe;
+extern char *e_geonearg;
+extern char *e_indexunf;
+extern char *e_nominmax;
+extern char *e_nopfile;
+extern char *e_badpfile;
+extern char *e_nostrcnv;
+extern char *e_notbool;
+extern char *e_onearg;
+extern char *e_pambig;
+extern char *e_pckambig;
+extern char *e_pcknonexist;
+extern char *e_posargs;
+extern char *e_pnonexist;
+extern char *e_ropen;
+extern char *e_simplep;
+extern char *e_strplusreal;
+extern char *e_soverflow;
+extern char *e_sunderflow;
+extern char *e_tambig;
+extern char *e_tnonexist;
+extern char *e_twoargs;
+extern char *e_unlink;
+extern char *e_uopcode;
+extern char *e_wopen;
+extern char *e_fdivzero;
+extern char *e_idivzero;
+extern char *e_fdzvalue;
+extern char *e_idzvalue;
diff --git a/pkg/vocl/errtest/errif.cl b/pkg/vocl/errtest/errif.cl
new file mode 100644
index 00000000..6328fab6
--- /dev/null
+++ b/pkg/vocl/errtest/errif.cl
@@ -0,0 +1,24 @@
+#{  ERRIF -- Test error types.
+
+procedure errif (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	int 	code
+
+	# get local script variable of param
+	code = type
+
+	if (code == 1) {			# FPE test
+	    fpe ()
+	} else if (code == 2) {			# SEGVIO test
+	    segvio ()
+	} else if (code == 3) {			# SPP error() call test
+	    spperr ()
+	} else if (code == 4) {			# non-existant task test
+	    foo ()
+	} else if (code == 5) {			# CL error() command
+	    error (code, "cl error() command")
+	}
+end
diff --git a/pkg/vocl/errtest/errtest.cl b/pkg/vocl/errtest/errtest.cl
new file mode 100644
index 00000000..9fea81e4
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.cl
@@ -0,0 +1,25 @@
+#{ ERRTEST.CL -- Package declaration for the CLERR recovery/test suite.
+
+package errtest
+
+task	$fpe,
+	$segvio,
+	$spperr		= "errtest$spperrs.e"
+
+task	errif		= "errtest$errif.cl"
+task	errtype		= "errtest$errtype.cl"
+task	$sfpe		= "errtest$sfpe.cl"
+task	nested		= "errtest$nested.cl"
+task	recursion	= "errtest$recursion.cl"
+
+task	$zztest		= "errtest$zztest.cl"
+task	$printvals	= "errtest$printvals.cl"
+
+task	nest0		= "errtest$nest0.cl"
+task	recur0		= "errtest$recur0.cl"
+
+task	test_iferr	= "errtest$test_iferr.cl"
+
+hidetask nest0, recur0
+
+clbye()
diff --git a/pkg/vocl/errtest/errtest.hd b/pkg/vocl/errtest/errtest.hd
new file mode 100644
index 00000000..8f9c33a2
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.hd
@@ -0,0 +1,9 @@
+# Help directory for the CLERR (CL error recovery test) package.
+
+$clerr		= "./"
+
+# Define help files for the packages.
+
+clerr		men = clerr$clerr.men,
+		pkg = clerr$clerr.hd,
+		src = clerr$clerr.cl
diff --git a/pkg/vocl/errtest/errtest.men b/pkg/vocl/errtest/errtest.men
new file mode 100644
index 00000000..e523a64f
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.men
@@ -0,0 +1,14 @@
+
+     		CL Script Test Tasks
+     		--------------------------
+     errtype -- Script to call task of particular error type
+       errif -- Errtype using 'if' instead of 'switch'
+      nested -- Nested calls of error scripts
+        sfpe -- Simple wrapper of 'fpe' task
+
+
+     		SPP Error Generating Tasks
+     		--------------------------
+         fpe -- Generate a floating point error
+      segvio -- Generate a segmentation fault
+      spperr -- SPP error() function call
diff --git a/pkg/vocl/errtest/errtest.par b/pkg/vocl/errtest/errtest.par
new file mode 100644
index 00000000..1b950a60
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.par
@@ -0,0 +1,3 @@
+# Package parameters for the CLERR package.
+
+version,s,h,"Apr 01, 2004"
diff --git a/pkg/vocl/errtest/errtype.cl b/pkg/vocl/errtest/errtype.cl
new file mode 100644
index 00000000..58df9623
--- /dev/null
+++ b/pkg/vocl/errtest/errtype.cl
@@ -0,0 +1,74 @@
+#{  ERRTYPE -- Test error types.
+
+procedure errtype (type)
+
+int	type			{ prompt = "Error test type: " 	}
+
+begin
+	if (type == 0) 							#  8
+	    goto usage_							#  9
+									# 10
+	switch (type) {							# 11
+									# 12
+	# SPP task errors.						# 13
+	case 1: 			# FPE test			# 14
+	    	fpe ()							# 15
+	case 2: 			# SEGVIO test			# 16
+	    	segvio ()						# 17
+	case 3: 			# SPP error() call test		# 18
+	    	spperr ()						# 19
+									# 20
+									# 21
+	# CL-generated errors.						# 22
+	case 4: 			# non-existant task test 	# 23
+	    	nonexist ()						# 24
+	case 5: 			# CL error command		# 25
+	    	error (type, "cl error() command")			# 26
+	case 6: 			# CL div by zero		# 27
+		i = 1.0 / 0.0						# 28
+	case 7: 			# function error		# 29
+		s1 = envget (1)						# 30
+	case 8: 			# legal return from script	# 31
+	    {								# 32
+		print ("simple CL return")				# 33
+	    	return							# 34
+	    }								# 35
+									# 36
+	# Grammar tests.						# 37
+	case 9: fpe() 			# FPE test w/ no newline	# 38
+	case 10:  			# FPE test w/in compound block	# 39
+		{ i = 0; fpe(); i = 1;					# 40
+		}							# 41
+									# 42
+	# Pipe tests.							# 43
+	case 11:							# 44
+		{ print ("fpe") | cl()	# FPE from a piped command	# 45
+		}							# 46
+	case 12:							# 47
+		{ print ("foo") | cl()	# invalid command in a pipe	# 48
+		}							# 49
+									# 50
+	# New features tests.						# 51
+#	case -1: 			# Test negative case constant	# 52
+#		print ("negative code")					# 53
+									# 54
+	default:							# 55
+		print ("default case reached")				# 56
+	}								# 57
+
+	return
+
+usage_:
+	print ("1:	fpe				recoverable")
+	print ("2	segvio				recoverable")
+	print ("3:	spperr				recoverable")
+	print ("4:	nonexistant task		recoverable")
+	print ("5:	CL error command		recoverable")
+	print ("6	CL div by zero			recoverable")
+	print ("7:	intrinsic function error	non-recoverable")
+	print ("8	CL return			non-error")
+	print ("9	FPE test w/ no newline		recoverable - grammar")
+	print ("10	FPE test w/in compound block	recoverable - grammar")
+	print ("11	FPE from piped command		recoverable")
+	print ("12	invalid command in a pipe	internal error")
+end									# 74
diff --git a/pkg/vocl/errtest/mkpkg b/pkg/vocl/errtest/mkpkg
new file mode 100644
index 00000000..ae7ddb80
--- /dev/null
+++ b/pkg/vocl/errtest/mkpkg
@@ -0,0 +1,9 @@
+
+$call	relink
+$exit
+
+
+relink:
+	$omake	spperrs.x
+	$link	spperrs.o
+	;
diff --git a/pkg/vocl/errtest/nest0.cl b/pkg/vocl/errtest/nest0.cl
new file mode 100644
index 00000000..0cbb533b
--- /dev/null
+++ b/pkg/vocl/errtest/nest0.cl
@@ -0,0 +1,14 @@
+#{  NEST0 -- Test error types from nested scripts.
+
+procedure nest0 (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	# dummy space
+	# dummy space
+	# dummy space
+	# dummy space
+
+	errtype (type)
+end
diff --git a/pkg/vocl/errtest/nested.cl b/pkg/vocl/errtest/nested.cl
new file mode 100644
index 00000000..ff452eaa
--- /dev/null
+++ b/pkg/vocl/errtest/nested.cl
@@ -0,0 +1,12 @@
+#{  NESTED -- Test error types from nested scripts.
+
+procedure nested (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	# dummy space
+	# dummy space
+
+	nest0 (type)
+end
diff --git a/pkg/vocl/errtest/printvals.cl b/pkg/vocl/errtest/printvals.cl
new file mode 100644
index 00000000..d7e1a30d
--- /dev/null
+++ b/pkg/vocl/errtest/printvals.cl
@@ -0,0 +1,20 @@
+procedure printvals ()
+
+begin
+
+time
+return
+	printf ("PRINTVALS:\n");
+	printf ("\t$errno = %d\n", $errno)
+	printf ("\t$errmsg = %d\n", $errmsg)
+	printf ("\t$errtask = %d\n", $errtask)
+
+	i  =  cl.$errno
+	s1 =  cl.$errmsg
+	s2 =  cl.$errtask
+
+	=i
+	=s1
+	=s2
+	keep
+end
diff --git a/pkg/vocl/errtest/recur0.cl b/pkg/vocl/errtest/recur0.cl
new file mode 100644
index 00000000..35266292
--- /dev/null
+++ b/pkg/vocl/errtest/recur0.cl
@@ -0,0 +1,13 @@
+#{ RECURS0.CL -- Test CL calling recursion.
+
+procedure recurs0 (level)
+
+int	level
+
+begin
+	j = level + 1
+	if (level == 0)
+	    recursion (j)
+	else
+	    sfpe ()
+end
diff --git a/pkg/vocl/errtest/recursion.cl b/pkg/vocl/errtest/recursion.cl
new file mode 100644
index 00000000..2b66c27f
--- /dev/null
+++ b/pkg/vocl/errtest/recursion.cl
@@ -0,0 +1,13 @@
+#{ RECURSION.CL -- Test CL calling recursion.
+
+procedure recursion (level)
+
+int	level
+
+begin
+	if (level == 0)
+	    i = 0
+	else
+	    i = level
+	recur0 (i)
+end
diff --git a/pkg/vocl/errtest/sfpe.cl b/pkg/vocl/errtest/sfpe.cl
new file mode 100644
index 00000000..75e89e2f
--- /dev/null
+++ b/pkg/vocl/errtest/sfpe.cl
@@ -0,0 +1,6 @@
+#{ sfpe -- Simple FPE error test.
+
+procedure sfpe ()
+begin
+	fpe ()
+end
diff --git a/pkg/vocl/errtest/spperrs.x b/pkg/vocl/errtest/spperrs.x
new file mode 100644
index 00000000..0715393b
--- /dev/null
+++ b/pkg/vocl/errtest/spperrs.x
@@ -0,0 +1,25 @@
+task fpe 	= t_fpe,
+     segvio 	= t_segvio,
+     spperr	= t_spperr
+
+procedure t_fpe ()
+real	x, y, z
+begin
+	x = 1.0
+	y = 0.0
+	z = x / y
+end
+
+
+procedure t_segvio ()
+pointer	ip
+begin
+	ip = 0
+	Memc[ip] = 'x'
+end
+
+
+procedure t_spperr ()
+begin
+	call error (123, "test spp error()")
+end
diff --git a/pkg/vocl/errtest/test_iferr.cl b/pkg/vocl/errtest/test_iferr.cl
new file mode 100644
index 00000000..5cf40d6c
--- /dev/null
+++ b/pkg/vocl/errtest/test_iferr.cl
@@ -0,0 +1,33 @@
+#{  TEST_IFERR -- Test various iferr constructs.
+
+procedure test_iferr (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	printf ("Testing iferr....\n\t")
+	for (i=1; i <= 5; i=i+1) {
+	    iferr { errif (i) } then {
+	        print ("    error from test #"//i)
+	    } else {
+	        print ("    NO error from test #"//i)
+	    }
+	}
+
+	printf ("\n\n")
+	printf ("Testing divzero error....\n\t")
+	iferr { i = 1 / 0 } then {
+	    print ("    error from divzero test")
+	} else {
+	    print ("    NO error from divzero test")
+	}
+	;
+
+	printf ("\n\n")
+	printf ("Testing fdivzero error....\n\t")
+	iferr { x = 1.0 / 0.0 } then {
+	    print ("    error from fdivzero test")
+	} else {
+	    print ("    NO error from fdivzero test")
+	}
+end
diff --git a/pkg/vocl/errtest/zztest.cl b/pkg/vocl/errtest/zztest.cl
new file mode 100644
index 00000000..d63151f1
--- /dev/null
+++ b/pkg/vocl/errtest/zztest.cl
@@ -0,0 +1,24 @@
+#{  ZZTEST -- Test various iferr constructs.
+
+procedure zztest ()
+
+begin
+	int	nerrs
+
+	onerror ("flpr")
+
+	printf ("Testing iferr....\n")
+	nerrs = 0
+
+	for (i=1; i <= 5; i=i+1) {
+	    iferr { fpe () } then {
+	        print ("    error from test #"//i)
+		nerrs = nerrs + 1
+	    } else {
+	        print ("    NO error from test #"//i)
+	    }
+	}
+
+	if (nerrs > 0) 
+	    error (999, "errors found in script")
+end
diff --git a/pkg/vocl/exec.c b/pkg/vocl/exec.c
new file mode 100644
index 00000000..322a3cef
--- /dev/null
+++ b/pkg/vocl/exec.c
@@ -0,0 +1,1400 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_xwhen
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "mem.h"
+#include "opcodes.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "grammar.h"
+#include "proto.h"
+
+
+/*
+ * EXEC -- Functions that prepare tasks for running, the actual runtime
+ * interpreter, and functions involved in wrapping up when a task dies.
+ */
+
+extern int cldebug;
+extern int cltrace;
+
+#define	SZ_STARTUPMSG	4000	/* cmd sent to subprocess to run task	*/
+#define	BINDIR		"bin$"	/* where installed executables go	*/	
+
+extern	FILE *yyin;		/* yyparse's input			*/
+extern	int alldone;		/* set when oneof pops firstask		*/
+extern	int yeof;		/* parser saw EOF			*/
+extern	int gologout;		/* user typed logout()			*/
+extern	int loggingout;		/* in the process of logging out	*/
+extern	int currentline;	/* current script line being executed	*/
+extern	int in_iferr;		/* currently in an iferr block		*/
+		    
+extern  ErrCom errcom;		/* execution error recovery struct	*/
+
+	
+long int run_level 	= 0;
+int 	do_error  	= YES;
+char	*onerr_handler  = NULL;
+
+char	*findexe();
+
+
+
+/* RUN -- Run the code beginning at pc until we run an EXEC instruction of
+ *   something other than a builtin command or END instruction.
+ *   The EXEC instruction means that a new task is being started and we should
+ *   return to the parser in the main "parse/run" loop in main.  If, however,
+ *   the exec was for a builtin (or procedure, someday) then no parsing is to
+ *   be done and we just continue on with the current code.
+ * Note that execing the bye builtin is not a special case since it does a
+ *   restor() which resets the pc to the instruction immediately following the
+ *   exec IN THE PARENT task and we continue on with it.
+ * Increment pc after each "fetch" cycle and before the "exec" cycle.
+ *   If any if the instructions fail, they will call error(). this will do
+ *   a longjmp(errenv,1), causing setjmp to return (in main) and an
+ *   immediate retreat to the most recent terminaltask with unwind().
+ */
+void 
+run (void)
+{
+	register struct codeentry *cp;
+	register int opcode;
+	char *task;
+
+	if (cltrace) {
+	    cp = coderef(pc);
+            currentline = cp->c_scriptln;
+	    eprintf ("\t----- task %s - line %d (%s) -----\n",
+		currentask->t_ltp->lt_lname, 
+		currentline, op2str(cp->c_opcode));
+	}
+	if (cltrace > 1) eprintf ("start of run()\t\t\n");
+
+	do {
+	    cp = coderef (pc);
+	    opcode = cp->c_opcode;
+
+  	    if (currentask->t_flags &  T_SCRIPT)
+	        currentline = cp->c_scriptln;
+
+	    currentask->t_callln = currentline;
+
+	    if (cltrace)
+		d_instr (stderr, "\t", pc);
+	    if (cldebug)
+		eprintf("run: pc=%d, op=%s\n", pc, op2str(opcode), currentline);
+
+	    if (coderef(pc)->c_opcode == CALL) {
+		task = (char *)&(coderef(pc)->c_args);
+
+	        if (cltrace && run_level > 0)
+		    eprintf ("%d: CALL %s\n", run_level, task);
+
+		if (strncmp ("error", task, 5) != 0)
+	            errcom.linenum = currentline;
+
+		run_level++;
+
+	    } else if (coderef(pc)->c_opcode == END)
+		run_level--;
+
+	    pc += cp->c_length;
+	    (*opcodetbl[opcode]) (&cp->c_args);
+
+	} until ((opcode == EXEC && !(newtask->t_flags & T_BUILTIN)) ||
+		  opcode == END || alldone);
+
+	if (cltrace > 1) eprintf ("end of run()\t\t\n");
+}
+
+
+/* CALLNEWTASK -- Called from CALL instruction to push and setup a new task
+ *   structure.  If find a known ltask with given name create a new task on
+ *   control stack, set up newtask and defaults for the pseudofiles.
+ *   Pseudofiles may be effected by other instructions before it gets to exec.
+ * Make sure we have a pfile list; either try to read it if task is 
+ *   supposed to have a real one or manufacture the beginnings of one if it
+ *   isn't and set PF_FAKE.  New task runs with a copy of the pfile if it
+ *   wasn't fake.  Guard against making more than one copy.  Also, don't dup
+ *   the cl's params to maintain the meaning of "firstask".  Things like mode,
+ *   logfile and abbreviations should be global and permanent.
+ * Special case for package names essentially runs a cl but with a new curpack,
+ *   the only real semantic intent of "running" a package.
+ *   This lets a package name given as a command appear to change the current
+ *   package and yet remain interactive.  Since it really is a new task, state
+ *   saving and restoring on error will work right and we also achieve an
+ *   ability to have multiple package defn's in a script ltask.
+ *   Any parameter references will refer to the cl's also.
+ */
+void 
+callnewtask (char *name)
+{
+	/* x1 and x2 are just place holders to call breakout().
+	 */
+	char	*x1, *pk, *t, *x2;	
+	struct	ltask *ltp;
+	int	flags, ltflags;
+
+	if (cldebug)
+	    eprintf ("callnewtask: name=%s, currentask=%x\n", name, currentask);
+
+	currentline = coderef(pc)->c_scriptln;
+
+	/* Save current dictionary and stack pointers.  They get restored when
+	 * the new task dies normally and the current task is to continue.
+	 * Save pc when get to the EXEC instruction so it continues from there.
+	 */
+	currentask->t_topos = topos;	/* save these two just in case 	*/
+	currentask->t_basos = basos;	/* something is left on the stk	*/
+	currentask->t_topcs = topcs;	/* save before adding newtask	*/
+	currentask->t_topd  = topd;	/* save before adding pfile	*/
+	currentask->t_curpack = curpack;/* save in case changing to a new one*/
+	c_envmark (&currentask->t_envp);/* save env stack pointer	*/
+	currentask->t_pno = 0;		/* set only if task defines pkg	*/
+	currentask->t_callln = currentline;
+
+	newtask = pushtask();
+	flags = 0;
+
+	/* Search for the command to run.  A leading '$' signifies that
+	 * execution is to be time but is not part of the name.  Set ltp
+	 * and newtask->t_pfp depending on whether we are running a task or
+	 * a package.
+	 */
+	if (*name == '$') {
+	    flags |= T_TIMEIT;
+	    name++;
+	}
+
+	breakout (name, &x1, &pk, &t, &x2);
+	ltp = cmdsrch (pk, t);
+
+	if (ltp->lt_flags & LT_CL) {
+	    /* Change curpack if LT_PACCL. (cmdsrch() set lt_pkp).  Just
+	     * changing packages; use cl's ltask and pfile.  Push a new cl()
+	     * on the control stack, with the T_PKGCL and T_CL flags set.
+	     */
+	    if (ltp->lt_flags & LT_PACCL) {
+		flags |= T_PKGCL;
+		curpack = ltp->lt_pkp;
+	    } else if (ltp->lt_flags & LT_CLEOF)
+		flags |= T_CLEOF;
+
+	    ltp = firstask->t_ltp;
+	    newtask->t_pfp = firstask->t_pfp;
+
+	    /* Initialize the lexical analyzer (necessary to recognize BOL).
+	     */
+	    lexinit();
+
+	} else {
+	    if (ltp->lt_flags & LT_PFILE) {
+		register struct pfile *pfp;
+
+		/* This task has a real pfile. read in if not already in
+		 * core.  Copy if not already one and not just cl.
+		 */
+		newtask->t_pfp = NULL;
+		if ((pfp = pfilefind (ltp)) == NULL)
+		    pfp = pfileload (ltp);
+		if (!(pfp->pf_flags & PF_COPY) && ltp != firstask->t_ltp)
+		    pfp = pfilecopy (pfp);
+		newtask->t_pfp = pfp;
+
+		/* Also load any pset files associated with the main pfile.
+		 * These are linked into a list with the main pfile at the
+		 * head of the list, pointed to by the task descriptor.
+		 */
+		if (pfp->pf_flags & PF_PSETREF) {
+		    register struct param *pp;
+		    struct  operand o;
+		    char    *pset;
+
+		    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+			if (!(pp->p_type & PT_PSET))
+			    continue;
+			o = pp->p_valo;
+			if (opundef(&o) || *(pset = o.o_val.v_s) == EOS)
+			    pset = pp->p_name;
+			pfp = pfp->pf_npset = pfilecopy (pfilesrch (pset));
+			pfp->pf_psetp = pp;
+		    }
+		}
+
+	    } else {
+		/* This task does not have a real pfile so start a fake one.
+		 */
+		newtask->t_pfp = newpfile (ltp);
+		newtask->t_pfp->pf_flags = PF_FAKE;
+	    }
+	}
+
+	newtask->t_pfp->pf_n = 0;	/* init number of command line args */
+	newtask->t_ltp = ltp;
+	newtask->t_pid = -1;		/* gets set if do a real exec	*/
+	newtask->t_stdin = currentask->t_stdin;	/* inherit files	*/
+	newtask->t_stdout = currentask->t_stdout;
+	newtask->t_stderr = currentask->t_stderr;
+	newtask->t_stdgraph = currentask->t_stdgraph;
+	newtask->t_stdimage = currentask->t_stdimage;
+	newtask->t_stdplot = currentask->t_stdplot;
+
+	/* Init i/o redirection for a foreign task.
+	 */
+	newtask->ft_in = newtask->ft_out = newtask->ft_err = NULL;
+
+	/* Set up flags describing the kind of task we are about to run. the
+	 * absence of any of these flags will imply a genuine executable task.
+	 * the flags in t_flags are more of a convenience than anything since
+	 * later tests could use the same tests used here.
+	 */
+	ltflags = ltp->lt_flags;
+
+	if (ltflags & LT_PSET) {
+	    flags = (T_SCRIPT|T_PSET);
+	} else if (ltflags & LT_SCRIPT) {
+	    newtask->t_scriptln = 0;
+	    flags = T_SCRIPT;
+	} else if (ltflags & LT_FOREIGN) {
+	    flags = T_BUILTIN | T_FOREIGN;	/* a type of builtin */
+	} else if (ltflags & LT_BUILTIN) {
+	    flags = T_BUILTIN;
+	} else if (ltflags & LT_CL) {
+	    /* Or, not assign: preserve T_PKGCL and T_CLEOF flags if set. */
+	    flags |= T_CL;
+	}
+
+	if (ltflags & LT_STDINB)
+	    flags |= T_STDINB;
+	if (ltflags & LT_STDOUTB)
+	    flags |= T_STDOUTB;
+
+	newtask->t_flags = flags;
+}
+
+
+/* EXECNEWTASK -- Called from the EXEC instruction after all param and stdio
+ * processing for the new task is complete.  Here we actually run the new task,
+ * either directly in the case of a builtin function, or as a new case for
+ * main()'s loop.  Do not set newtask to NULL so that run() can tell what it
+ * exec'd.
+ */
+void 
+execnewtask (void)
+{
+	/* VMS C V2.1 cannot handle this (see below).
+	 * register struct pfile *pfp;
+	 */
+        struct  codeentry *cep;
+	static	struct pfile *pfp;
+
+	struct	param *pp;
+	FILE	*fopen();
+
+	if (newtask == NULL)
+	    /* if this ever happens, i don't want to know about it. */
+	    return;
+
+	currentask->t_pc = pc;		/* instruction after EXEC	*/
+        cep = coderef (pc);
+        currentline = cep->c_scriptln;
+
+
+	if (cldebug)
+	    eprintf ("execnewtask: pc = %d  (line %d)\n", pc, currentline);
+
+	if (newtask->t_flags & T_BUILTIN) {
+	    /* set yyin in case a builtin reads someday; none do now.
+	     * unlink newtask's fake param file and reset top of dictionary
+	     *   to what it was before the fake param file was added; it is
+	     *   still there, however, for the builtin to use. this is done
+	     *   since some builtins (eg task) want to add things that are
+	     *   to stay on the dictionary and the tools all start at topd.
+	     * the return is back to run(); it will continue since it will
+	     *   see that newtask was just a builtin.
+	     * note that we do not reset pf_n, as with other fake pfiles,
+	     *   as this is the way builtins get their number of arguments
+	     *   (it's faster than building them a $nargs).
+	     */
+	    yyin = newtask->t_in = currentask->t_in;	/* inherit pipe */
+	    newtask->t_out = currentask->t_out;
+	    newtask->t_modep = currentask->t_modep;	/* inherit mode */
+
+	    /* VMS C 2.1 Optimizer cannot handle this.
+	     * parhead = dereference (reference (pfile, parhead)->pf_npf);
+	     */
+	    pfp = reference (pfile, parhead);
+	    parhead = dereference (pfp->pf_npf);
+
+	    topd = currentask->t_topd;
+	    currentask = newtask;
+	    newtask->t_flags |= T_RUNNING;
+
+	    if (cldebug)
+		eprintf ("execnewtask: calling new task@@%x\n", newtask);
+	    if (cltrace)
+		eprintf ("\t----- exec %s %s : line %d -----\n",
+		    (newtask->t_flags & T_FOREIGN) ? "foreign" : "builtin",
+		    newtask->t_ltp->lt_lname, coderef(pc)->c_scriptln);
+
+	    (*newtask->t_ltp->lt_f)();
+	    oneof();		/* proceed as though this task saw eof	  */
+	    return;
+	}
+
+	pfp = newtask->t_pfp;
+
+	/* If the new task is a cl, we are not running in background and
+	 * its t_in is stdin, it is interactive.  Note that when a package
+	 * is loaded by a script task rather than interactively by the user,
+	 * the t_in of the cl() in the package script task will be reading
+	 * from the calling script task rather than from the original stdin
+	 * (the user terminal), hence is not interactive.  If this task is
+	 * flagged interactive, taskunwind() may elect to restart it on an
+	 * error so save present state for restor().
+	 */
+	if (newtask->t_flags & T_CL) {
+	    if (cldebug)
+		eprintf ("execnewtask: new task is the CL\n");
+	    if (cltrace)
+		eprintf ("\t----- exec cl -----\n");
+
+	    /* Call set_clio to set the command input and output streams
+	     * t_in and t_out for a cl() or package_name() command.
+	     */
+	    set_clio (newtask);
+
+	    /* This code is a temporary patch to allow packages to be 
+	     * loaded from within scripts regardless of whether there 
+	     * are enclosing brackets.  If a CL statement is executed
+	     * within a script which is itself called within another
+	     * script, then we will do an implicit keep before the CL.
+	     */
+	    if (topcs + 2*TASKSIZ <= STACKSIZ)
+		if ((strcmp (newtask->t_ltp->lt_lname, "cl") == 0) ||
+ 		    (strcmp (newtask->t_ltp->lt_lname, "clbye") == 0))
+		    if ((currentask->t_flags &  T_SCRIPT) &&
+		        (prevtask->t_flags & T_SCRIPT))
+			keep(prevtask);
+
+	    /* If newtask is cleof(), close the input stream of the current
+	     * task (the task whose input contained the cleof), and reopen
+	     * as the null file.
+	     */
+	    if (newtask->t_flags & T_CLEOF) {
+		if (currentask->t_in != stdin)
+		    fclose (currentask->t_in);
+		if (currentask != firstask)
+		    currentask->t_in = fopen ("dev$null", "r");
+	    }
+
+	    if (!(firstask->t_flags & T_BATCH) &&
+		 (newtask->t_in == stdin) && (newtask->t_out == stdout)) {
+		newtask->t_flags |= T_INTERACTIVE;
+		newtask->t_topd = topd;
+		newtask->t_topos = topos;
+		newtask->t_topcs = topcs;
+		newtask->t_curpack = curpack;
+	    }
+	}
+
+	/* Standardize the pfile.
+	 * Set (or create if necessary) `$nargs', number of command line args,
+	 *   based on pf_n which is set for each command line argument by
+	 *   posargset, et al.
+	 * If this ltask had no paramfile and we built one up from the
+	 *   command line, then we need to add a `mode' param.  If it did have
+	 *   a paramfile, then pfileload has already added it for us.
+	 *   Point t_modep to the mode param for newtask.
+	 */
+	pp = paramfind (pfp, "$nargs", 0, YES);
+	if (pp == NULL || (XINT)pp == ERR) {
+	    char nabuf[FAKEPARAMLEN];
+	    sprintf (nabuf, "$nargs,i,h,%d\n", pfp->pf_n);
+	    pp = addparam (pfp, nabuf, NULL);
+	    pp->p_mode |= M_FAKE;		/* never flush out $nargs */
+	} else
+	    pp->p_val.v_i = pfp->pf_n;
+
+	if (pfp->pf_flags & PF_FAKE) {
+	    newtask->t_modep = addparam (pfp, "mode,s,h,q\n", NULL);
+	    /* pf_n will be used by paramsrch() to count positional arg
+	     * matches; see it and param.h.
+	     */
+	    pfp->pf_n = 0;
+	} else {
+	    newtask->t_modep = paramfind (pfp, "mode", 0, YES);
+	}
+
+	if (newtask->t_modep == NULL)
+	    cl_error (E_IERR, "no mode param for task `%s'",
+		newtask->t_ltp->lt_lname);
+
+	/* If task is being run in menu mode, call up eparam so that the user
+	 * can edit/inspect the parameters.  If eparam is exited with ctrl/c
+	 * do not run the task or update the pfile.  The parameter editor
+	 * will make a copy of the task's pfile(s), edit it, and if necessary
+	 * update the incore version created earlier by callnewtask().
+	 */
+	if ((taskmode(newtask) & M_MENU) || (newtask->t_flags & T_PSET)) {
+	    if (epset (newtask->t_ltp->lt_lname) == ERR) {
+		if (newtask->t_flags & T_PSET)
+		    cl_error (E_UERR, "parameter file not updated");
+		else
+		    cl_error (E_UERR, "menu mode task execution aborted");
+	    }
+	}
+
+	/* Set up bascode so new task has a good place to start building
+	 * code.  See how the pc is set up before each call to the parser in
+	 * main() loop.
+	 */
+	newtask->t_bascode = topos + 1;
+
+	/* Set up io paths.  If the new task is cl(), it's command input
+	 * and output streams are connected to those of the task which
+	 * called currentask.  If the currentask is the firstask, there
+	 * was no caller (no prevtask), so we must watch out for that.
+	 * In the case of a script, commands are read from the script.
+	 * In the case of a process, commands are read from the process.
+	 */
+	if (newtask->t_flags & T_PSET) {
+	    newtask->t_in = fopen ("dev$null", "r");
+	    newtask->t_out = newtask->t_stdout;
+
+	} else if (newtask->t_flags & T_SCRIPT) {
+	    if (cltrace)
+		eprintf ("\t----- exec script %s (%s) - line %d -----\n",
+		    newtask->t_ltp->lt_lname, newtask->t_ltp->lt_pname,
+		    coderef(pc)->c_scriptln);
+
+	    newtask->t_in = fopen (newtask->t_ltp->lt_pname, "r");
+	    if (newtask->t_in == NULL)
+		cl_error (E_UERR|E_P, "can not open script file `%s'",
+		    newtask->t_ltp->lt_pname);
+	    newtask->t_out = newtask->t_stdout;
+
+	} else if (newtask->t_flags & T_CL) {
+	    /* The command streams t_in and t_out have already been
+	     * set up above by set_clio() in the test for T_INTERACTIVE.
+	     */
+	    /* Do nothing */
+
+	} else {
+	    char    startup_msg[SZ_STARTUPMSG+1];
+	    int     timeit;
+
+	    /* Connect to an executable process.
+	     */
+	    mk_startupmsg (newtask, startup_msg, SZ_STARTUPMSG);
+	    timeit = (newtask->t_flags & T_TIMEIT) != 0;
+	    if (cltrace)
+		eprintf ("\t----- exec external task %s - line %d -----\n",
+		    newtask->t_ltp->lt_lname, coderef(pc)->c_scriptln);
+	    newtask->t_pid = pr_connect (
+		findexe (newtask->t_ltp->lt_pkp, newtask->t_ltp->lt_pname),
+		startup_msg,
+		&newtask->t_in, &newtask->t_out,
+		newtask->t_stdin, newtask->t_stdout, newtask->t_stderr,
+		newtask->t_stdgraph, newtask->t_stdimage, newtask->t_stdplot,
+		timeit);
+	}
+
+	yyin = newtask->t_in;	/* set the input for the parser	*/
+
+	/* Tell parser what to expect.
+	 */
+	parse_state = PARSE_FREE;
+	if (newtask->t_flags & T_SCRIPT) {
+	    proc_script = (newtask->t_flags & T_PSET) ? NO : procscript(yyin);
+
+	    if (proc_script) {
+		parse_state = PARSE_BODY;
+		/* Skip to the BEGIN statement */
+		newtask->t_scriptln = skip_to (yyin, "begin");
+		if (newtask->t_scriptln == ERR)
+		    cl_error (E_UERR, "No BEGIN statement in procedure script");
+
+		/* Reset pointer here.
+		 */
+		proc_script = NO;
+	    }
+	}
+
+	/* Log a start message for script and executable tasks.
+	 */
+	if (keeplog() && log_trace())
+	    if (newtask->t_flags & T_SCRIPT || newtask->t_pid != -1) {
+	    	char  logmsg[SZ_LINE];
+	    	sprintf (logmsg, "Start (%s)", newtask->t_ltp->lt_pname);
+	    	putlog (newtask, logmsg);
+	    }
+
+	newtask->t_flags |= T_RUNNING;
+	currentask = newtask;	/* continue as new the new task; at last. */
+
+	if (cldebug)
+	    eprintf ("Returning from execnewtask.yyin, ct_in, nt_in:%d %d %d\n",
+		yyin, currentask->t_in, newtask->t_in);
+}
+
+
+/* MK_STARTUPMSG -- Format the command to be sent to the interpreter in the
+ * IRAF Main in the child to execute the indicated logical task.  The format
+ * of this command is
+ *
+ *	taskname redir_args paramset_args
+ *
+ * where "redir_args" are used to either inform the task that a stream has
+ * been redirected by the CL (file "$") or to actually redirect a stream,
+ * and where "paramset_args" are assignments of the form "param=value".
+ * For example, "4 > $" tells the task that its standard output (4 = integer
+ * value of STDOUT) has been redirected.  Only parameters with static values,
+ * i.e., with predefined values that are not expected to change during task
+ * execution (no queries) may be passed on the command line.
+ */
+void 
+mk_startupmsg (
+    struct task *tp,			/* task being executed		*/
+    char *cmd,				/* receives formatted command	*/
+    int maxch				/* max chars out		*/
+)
+{
+	register char	*ip, *op, *cp;
+	struct	pfile *pfp;
+	struct	operand o;
+	struct	param *pp;
+	char	redir[20];
+
+	/* Start with the task name.
+	 * Task names which begin with an underscore are used to implement
+	 * "invisible" commands which are not intended to be part of the
+	 * user interface.  The distinction between these and regular
+	 * commands is restricted to the CL, hence the leading underscore
+	 * is stripped from the task name sent to the process.
+	 */
+	ip = tp->t_ltp->lt_lname;
+	while (*ip == CH_INVIS)
+	    ip++;
+	strcpy (cmd, ip);
+
+	/* Add redirection information.  We can omit the pseudofile stream
+	 * codes for the standard input and output as the iraf main will
+	 * assume those streams if no stream code is given, though we must
+	 * be explicit for stderr and the graphics streams.
+	 */
+	if (tp->t_flags & (T_MYIN|T_MYOUT|T_MYERR)) {
+	    if (tp->t_flags & T_MYIN)
+		strcat (cmd, " < $");
+	    if (tp->t_flags & T_MYOUT)
+		strcat (cmd, " > $");
+	    if (tp->t_flags & T_MYERR) {
+		sprintf (redir, " %d> $", STDERR);
+		strcat (cmd, redir);
+	    }
+	}
+	if (tp->t_flags & (T_MYSTDGRAPH|T_MYSTDIMAGE|T_MYSTDPLOT)) {
+	    if (tp->t_flags & T_MYSTDGRAPH) {
+		sprintf (redir, " %d> $", STDGRAPH);
+		strcat (cmd, redir);
+	    }
+	    if (tp->t_flags & T_MYSTDIMAGE) {
+		sprintf (redir, " %d> $", STDIMAGE);
+		strcat (cmd, redir);
+	    }
+	    if (tp->t_flags & T_MYSTDPLOT) {
+		sprintf (redir, " %d> $", STDPLOT);
+		strcat (cmd, redir);
+	    }
+	}
+
+	for (cp=cmd;  *cp;  cp++)
+	    --maxch;
+
+	/* Add parameter assignments for all non list-structured parameters
+	 * whose access would not cause a query, i.e., those parameters which
+	 * already have a legal value and which are either hidden or were set
+	 * on the command line.  Passing the values of these parameters on the
+	 * command line speeds task startup by reducing the number of parameter
+	 * requests that must be processed by handshaking over the IPC.
+	 */
+	for (pfp = tp->t_pfp;  pfp;  pfp = pfp->pf_npset) {
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		o = pp->p_valo;
+
+		/* Do not cache parameters which have an undefined value or
+		 * for which the value is indirect to another parameter.
+		 * Also, array parameters can not be cached currently.
+		 */
+		if (o.o_type & OT_UNDEF)
+		    continue;
+		if ((o.o_type & OT_BASIC) == OT_STRING &&
+		    (o.o_val.v_s[0] == PF_INDIRECT))
+		    continue;
+
+		if (pp->p_type & PT_ARRAY)
+		    continue;
+
+		if (!(pp->p_type & PT_LIST) && !(effmode(pp) & M_QUERY)) {
+		    char   buf[SZ_LINE+1];
+		    char   val[SZ_LINE+1];
+
+		    /* First format the param=value string in buf.
+		     */
+
+		    /* Start with "param=" if main pfile, or "pset.param=" if
+		     * pset-param pfile.
+		     */
+		    if (pfp->pf_psetp != NULL) {
+			ip = pfp->pf_psetp->p_name;
+			for (op=buf;  (*op = *ip++);  op++)
+			    ;
+			*op++ = '.';
+		    } else
+			op = buf;
+
+		    for (ip=pp->p_name;  (*op = *ip++);  op++)
+			;
+		    *op++ = '=';
+
+		    /* Add "value".  If the parameter is string valued enclose
+		     * the string in quotes and convert any newlines into \n.
+		     */
+		    sprop (val, &pp->p_valo);
+		    if ((pp->p_type & OT_BASIC) == OT_STRING)
+			*op++ = '"';
+
+		    for (ip=val;  (*op = *ip++);  op++)
+			if (*op == '\n') {
+			    *op++ = '\\';
+			    *op = 'n';
+			} else if (*op == '"') {
+			    *op++ = '\\';
+			    *op = '"';
+			}
+
+		    if ((pp->p_type & OT_BASIC) == OT_STRING)
+			*op++ = '"';
+
+		    *op = EOS;
+
+		    /* Now check to see if there is room in the output buffer.
+		     * If not we can just quit, as the task will automatically
+		     * query for any parameters not set on the command line.
+		     * If there is room break the current line by appending \\n
+		     * (an escaped newline) and append the new line.
+		     */
+		    maxch -= (strlen(buf) + 2);
+		    if (maxch <= 0)
+			break;
+
+		    *cp++ = '\\';
+		    *cp++ = '\n';
+
+		    for (ip=buf;  (*cp = *ip++);  cp++)
+			;
+		}
+	    }
+	}
+
+	/* Terminate the command line by appending an unescaped newline.
+	 */
+	*cp++ = '\n';
+	*cp = EOS;
+
+	if (cldebug)
+	    eprintf ("CALL %s", cmd);
+}
+
+
+/* FINDEXE -- Search a set of standard places for an executable file to be
+ * run.  Currently, we check first in the logical directory BIN for the
+ * "installed" version of the executable, and if that is not found, use
+ * the pathname given, which is the pathname specified in the TASK declaration.
+ */
+char *
+findexe (
+    struct package *pkg,	/* package in which task resides */
+    char *pkg_path	/* pathname of exe file given in TASK statement	*/
+)	
+{
+	static	char bin_path[SZ_PATHNAME+1], loc_path[SZ_PATHNAME+1];
+	char	root[SZ_FNAME+1], root_path[SZ_PATHNAME+1];
+	char	bindir[SZ_FNAME+1], *ip = NULL, *arch = NULL;
+	char	bin_root[SZ_PATHNAME+1];
+	char   *envget();
+
+
+	memset (root, 0, SZ_FNAME);
+	memset (bindir, 0, SZ_FNAME);
+	memset (bin_path, 0, SZ_PATHNAME);
+	memset (loc_path, 0, SZ_PATHNAME);
+	memset (bin_root, 0, SZ_PATHNAME);
+	memset (root_path, 0, SZ_PATHNAME);
+
+	c_fnroot (pkg_path, root, SZ_FNAME);
+	c_fpathname ((pkg ? pkg->pk_bin : BINDIR), root_path, SZ_PATHNAME);
+	sprintf (bin_path, "%s%s.e", pkg ? pkg->pk_bin : BINDIR, root);
+	sprintf (loc_path, "./%s.e", root);
+	arch = envget ("arch");
+
+
+	if (c_access (bin_path, 0, 0) == YES) {
+	    return (bin_path);
+	} else {
+	    /*  The binary wasn't found in the expected bin directory, but
+	     *  on certain platforms look for alternate binaries that may
+	     *  work.  This supports backward compatability with older
+	     *  packages that may not have been upgraded to architecture
+	     *  conventions in this release but which may contain usable
+	     *  binaries (e.g. 32-bit 'linux' binaries on 64-bit systems
+	     *  or older 'redhat' binaries where the core arch is 'linux').
+	     */
+	    memset (bin_root, 0, SZ_PATHNAME);
+	    strcpy (bin_root, root_path);
+	    if ((ip = strstr (bin_root, arch)))
+		*ip = '\0';
+	    else {
+		int len = strlen (bin_root);
+		if (bin_root[len-1] == '/')
+		    bin_root[len-1] = '\0';
+	    }
+
+	    if (strcmp (arch, ".linux64") == 0) {
+		/*  On 64-bit Linux systems we can use either of the
+		 *  available 32-bit binaries if needed.  In v2.15 and
+		 *  later, 'linux' is the preferred arch but look for
+		 *  'redhat' in case it's a package that hasn't been
+		 *  updated.
+		 */
+		sprintf (bin_path, "%s.linux/%s.e", bin_root, root);
+		if (c_access (bin_path, 0, 0) == YES)
+	    	    return (bin_path);
+
+		sprintf (bin_path, "%s.redhat/%s.e", bin_root, root);
+		if (c_access (bin_path, 0, 0) == YES)
+	    	    return (bin_path);
+
+	    } else if (strcmp (arch, ".linux") == 0) {
+		/*  On 32-bit Linux systems, check for older 'redhat' binaries.
+		 */
+		sprintf (bin_path, "%s.redhat/%s.e", bin_root, root);
+		if (c_access (bin_path, 0, 0) == YES)
+	    	    return (bin_path);
+
+	    } else if (strcmp (arch, ".macintel") == 0) {
+		/*  On 64-bit Mac systems, check for older 32-bin binaries.
+		 */
+		sprintf (bin_path, "%s.macosx/%s.e", bin_root, root);
+		if (c_access (bin_path, 0, 0) == YES)
+	    	    return (bin_path);
+
+	    } else if (strcmp (arch, ".macosx") == 0) {
+		/*  On 32-bit Mac systems, check for older 'macintel' binaries.
+		 */
+		sprintf (bin_path, "%s.macintel/%s.e", bin_root, root);
+		if (c_access (bin_path, 0, 0) == YES)
+	    	    return (bin_path);
+	    }
+	}
+
+	if (c_access (pkg_path, 0, 0) == YES)
+	    return (pkg_path);
+	else
+	    return (loc_path);
+}
+
+
+/* SET_CLIO -- Set the command input and output for the new cl().  If the
+ * standard input or output has been redirected, use that, otherwise inherit
+ * the t_in, t_out of the task preceeding the most recent non-CL task that has
+ * the same t_in as the current task (this is not obvious, but permits packages
+ * to be called or loaded within scripts).  In the case of a cl() type task
+ * used to change packages, change the current package and push a cl() on the
+ * control stack but continue reading from the current command stream.
+ */
+void 
+set_clio (register struct task *newtask)
+{
+	register struct task *tp;
+
+	if ((newtask->t_stdin == currentask->t_stdin) &&
+	    (currentask->t_in != stdin)) {
+	    newtask->t_in = NULL;
+
+	    if (newtask->t_flags & T_PKGCL) {		/* package()	*/
+		newtask->t_in = currentask->t_in;
+		tp = currentask;
+	    } else {					/* cl()		*/
+		for (tp=currentask;  tp != firstask; tp = next_task(tp))
+		    if (!(tp->t_flags & T_CL) &&
+			 (tp->t_in == currentask->t_in)) {
+			tp = next_task(tp);
+			newtask->t_in = tp->t_in;
+			break;
+		    }
+	    }
+	    if (newtask->t_in == NULL)
+		cl_error (E_IERR, "Cannot find t_in for cl()");
+
+	} else {					/* pk|cl <	*/
+	    tp = NULL;
+	    newtask->t_in = newtask->t_stdin;
+	}
+
+	if ((newtask->t_stdout == stdout) && (tp != NULL))
+	    newtask->t_out = tp->t_out;
+	else
+	    newtask->t_out = newtask->t_stdout;		/* pk|cl >	*/
+}
+
+
+/* PPFIND -- Search the list of loaded psets for a task for the named
+ * parameter.  If a taskname is given, search only the pset with that
+ * taskname, else search all the psets associated with the running task.
+ * This is called by the routines in opcodes.c to perform command line
+ * assignments to parameters.
+ */
+struct param *
+ppfind (
+    struct pfile *pfp,		/* first pfile in chain		*/
+    char *tn,			/* psetname (taskname) or null	*/
+    char *pn,			/* parameter name		*/
+    int pos,			/* for paramfind		*/
+    int abbrev			/* for paramfind		*/
+)
+{
+	struct	param *pp, *m_pp;
+	struct	pfile *m_pfp = (struct pfile *) NULL;
+	int	nchars;
+
+	if (tn != NULL && *tn != EOS) {
+	    /* Locate the named pset and search it. */
+	    for (nchars=strlen(tn), m_pp=NULL;  pfp;  pfp = pfp->pf_npset)
+		if ( (pp = pfp->pf_psetp) )
+		    if (strncmp (pp->p_name, tn, nchars) == 0) {
+			if (strlen (pp->p_name) == nchars)
+			    return (paramfind (pfp, pn, pos, abbrev));
+			else if (m_pp)
+			    return ((struct param *)ERR);
+			else {
+			    m_pp = pp;
+			    m_pfp = pfp;
+			}
+		    }
+
+	    /* Unique abbreviation for pset was given. */
+	    if (m_pp)
+		return (paramfind (m_pfp, pn, pos, abbrev));
+	    else
+		return (NULL);
+
+	} else {
+	    /* Search all psets. */
+	    for (;  pfp;  pfp = pfp->pf_npset)
+		if ((pp = paramfind (pfp, pn, pos, abbrev)) != NULL)
+		    return (pp);
+	    return (NULL);
+	}
+}
+
+
+/* PSETRELOAD -- Called when a pset parameter is assigned into by a command
+ * line argument.  The previous value of the pset param will already have
+ * been used by callnewtask() to load a pset.  We must replace the old pset
+ * by the new one.
+ */
+void 
+psetreload (
+    struct pfile *main_pfp,		/* main task pfile	*/
+    struct param *psetp			/* pset param		*/
+)
+{
+	struct	pfile *o_pfp, *n_pfp, *prev_pfp;
+	struct	pfile *next_pfp = (struct pfile *) NULL;
+
+	if (cldebug)
+	    eprintf ("psetreload, pset %s\n", psetp->p_name);
+
+	/* Locate the old pfile in the list of psets off the main task pfile.
+	 */
+	prev_pfp = main_pfp;
+	for (o_pfp=prev_pfp->pf_npset;  o_pfp;  o_pfp = o_pfp->pf_npset)
+	    if (o_pfp->pf_psetp == psetp)
+		break;
+	    else
+		prev_pfp = o_pfp;
+	
+	if (o_pfp == NULL)
+	    cl_error (E_IERR, "in psetreload: cannot find npset");
+	else
+	    next_pfp = o_pfp->pf_npset;
+
+	/* Unlink the old pfile and its copy.  This must be done before loading
+	 * the new pfile, else pfilesrch will simply reference the old pfile.
+	 */
+	pfileunlink (o_pfp->pf_oldpfp);
+	pfileunlink (o_pfp);
+
+	/* Load the new pfile.  */
+	n_pfp = pfilecopy (pfilesrch (psetp->p_name));
+
+	/* Link it into the pset list */
+	prev_pfp->pf_npset = n_pfp;
+	n_pfp->pf_npset = next_pfp;
+	n_pfp->pf_psetp = o_pfp->pf_psetp;
+}
+
+
+/* IOFINISH -- Flush out and wrap up all pending io for given task.
+ *   Called when the task is dying and it wants to close all files it opened.
+ *   This includes a pipe if it used one, a file if it was a script and io
+ *   redirections as indicated by the T_MYXXX flags.  The T_MYXXX flags are
+ *   set only when the redirections were done for this task, ie, they were
+ *   not simply inherited.
+ * Just as a fail-safe measure, always check that a real stdio file is
+ *   not being closed.
+ * Don't call error() because in trying to restor to an interactive task
+ *   it might call us again and cause an inf. loop.
+ */
+void 
+iofinish (register struct task *tp)
+{
+	register FILE *fp;
+	int	flags;
+
+	flags = tp->t_flags;
+
+	/* Make sure we do not close files more than once.
+	 */
+	if (flags & T_RUNNING)
+	    tp->t_flags &= ~T_RUNNING;
+	else
+	    return;
+
+	if (cldebug)
+	    eprintf ("flushing io for task `%s'\n", tp->t_ltp->lt_lname);
+
+	if (flags & T_MYIN) {
+	    fp = tp->t_stdin;
+	    if (fp != stdin)
+		fclose (fp);
+	}
+	if (flags & T_MYOUT) {
+	    fflush (fp = tp->t_stdout);
+	    if (fp != stdout)
+		fclose (fp);
+	}
+	if (flags & T_MYERR) {
+	    fflush (fp = tp->t_stderr);
+	    if (fp != stderr)
+		fclose (fp);
+	}
+
+	/* Close any redirected graphics output streams.
+	 */
+	if (flags & (T_MYSTDGRAPH|T_MYSTDIMAGE|T_MYSTDPLOT)) {
+	    if (flags & T_MYSTDGRAPH)
+		if (tp->t_stdgraph != tp->t_stdimage &&
+		    tp->t_stdgraph != tp->t_stdplot)
+		    fclose (tp->t_stdgraph);
+	    if (flags & T_MYSTDIMAGE)
+		if (tp->t_stdimage != tp->t_stdplot)
+		    fclose (tp->t_stdimage);
+	    if (flags & T_MYSTDPLOT)
+		fclose (tp->t_stdplot);
+	}
+
+	/* If task i/o is redirected to a subprocess send the done message.
+	 */
+	if (flags & T_IPCIO)
+	    fputs (IPCDONEMSG, tp->t_out);
+	fflush (tp->t_out);
+
+	/* Close files only for script task, not for a cl, a builtin, or
+	 * a process.  Do call disconnect if the task lives in a process.
+	 */
+	if (flags & T_SCRIPT) {
+	    fp = tp->t_in;
+	    if (fp != stdin)
+		fclose (fp);
+	} else if (flags & (T_CL|T_BUILTIN)) {
+	    ;
+	} else if (tp->t_pid != -1)
+	    pr_disconnect (tp->t_pid);
+
+	/* Log a stop message for script and executable tasks.
+	 */
+	if (keeplog() && log_trace())
+	    if (tp->t_flags & T_SCRIPT || tp->t_pid != -1)
+	    	putlog (tp, "Stop");
+}
+
+
+/* RESTOR -- Restor all global variables for the given task and insure the
+ *   integrity of the dictionary and control stack.
+ * Go through the dictionary and properly disgard any packages, ltasks,
+ *   pfiles, environments and params that may be above the new topd.
+ * Write out any pfiles that are not just working copies that have been
+ *   updated before discarding them.
+ * Don't call error() because in trying to restor to an interactive task
+ *   it might call us again and cause an inf. loop.  Instead, issue fatal error
+ *   which will kill the cl for good.  This seems reasonable since we might
+ *   as well die if we can't  restor back to an interactive state.
+ * N.B. we assume that a pfile's params will either all lie above or all
+ *   below tp->t_topd.  If this can ever happen, must add a further check
+ *   of each pfile below topd and lob off any params above topd.
+ *   The way posargset, et al, and call/execnewtask are now, we are safe.
+ */
+void 
+restor (struct task *tp)
+{
+	memel *topdp;
+	register struct ltask *ltp;
+	register struct package *pkp;
+	register struct param *pp;
+	register struct pfile *pfp;
+	struct	param *last_pp;
+	int	n;
+
+	if (cldebug) {
+	    eprintf ("restoring task `%s', tp: %d\n", tp->t_ltp->lt_lname,tp);
+	    eprintf ("  topd %d/%d\n", topd, tp->t_topd);
+	}
+
+	topd = tp->t_topd;
+	pc = tp->t_pc;
+	topos = tp->t_topos;
+	basos = tp->t_basos;
+	topcs = tp->t_topcs;
+	curpack = tp->t_curpack;
+
+	yyin = tp->t_in;
+	parse_state = PARSE_FREE;
+
+	topdp = daddr (topd);
+
+	/* Set pachead to first package below new topd.  Then lob off any ltasks
+	 *   all remaining packages might have above topd.  It is sufficient to 
+	 *   stop the ltask checks for a given package once find an ltask
+	 *   below topd since the dictionary always grows upward.
+ 	 *   (Recall that since new ltasks are always added at the top of the
+	 *   dictionary, and pkp->pk_ltp always points to the most recently
+	 *   added ltask, then the thread moves to lower and lower addrs.)
+	 *   Thus, work downward and throw out all ltasks until find one below
+	 *   the new topd.
+	 */
+	for (pkp = reference (package, pachead);  pkp;  pkp = pkp->pk_npk)
+	    if ((memel)pkp < (memel)topdp) {
+		pachead = dereference (pkp);
+		break;
+	    }
+	if (pkp == NULL)
+	    cl_error (E_FERR, "package list broken");
+
+	for (;  pkp;  pkp = pkp->pk_npk) {
+	    for (ltp = pkp->pk_ltp; ltp; ltp = ltp->lt_nlt)
+		if ((memel)ltp < (memel)topdp) {
+		    pkp->pk_ltp = ltp;
+		    break;
+		}
+	    if ((memel)pkp->pk_ltp >= (memel)topdp)
+		/* All ltasks in this package were above topd */
+		pkp->pk_ltp = NULL;
+	}
+
+	/* Similarly for pfiles and their params; however, since new params
+	 *   are always added at the top of the dictionary and linked in at the
+	 *   END of the list (at pfp->pf_lastpp), the thread off pfp->pf_pp
+	 *   moves to higher and higher addrs.  Thus, we work our way up and
+	 *   throw out all params above the new topd.  Also, close off any open
+	 *   list files from discarded params along the way, if any.
+	 * Also, see if any of the params were P_SET and set PF_UPDATE.
+	 *   This avoids having to set PF_UPDATE for each assignment when the
+	 *   is not always easily found.
+	 * N.B. hope mode param that some t_modep is using is never disgarded..
+	 * Also, guard against writing out pfiles in background.
+	 */
+	for (pfp = reference (pfile, parhead);  pfp;  pfp = pfp->pf_npf) {
+	    /* Lob off any pfiles above new topd.  Go through their
+	     * params, updating if necessary and closing any lists.
+	     */
+	    if ((memel)pfp < (memel)topdp) {
+		parhead = dereference (pfp);
+		break;
+	    }
+
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		/* Close if list file and enable flushing if P_SET.
+		 */
+		if (pp->p_type & PT_LIST)
+		    closelist (pp);
+		if (pp->p_flags & P_SET)
+		    pfp->pf_flags |= PF_UPDATE;
+	    }
+	    if (((pfp->pf_flags & (PF_UPDATE|PF_COPY)) == PF_UPDATE) &&
+		!(firstask->t_flags & T_BATCH))
+		    pfileupdate (pfp);
+	}
+
+	/* Discard any recently added parameters above topd, where the pfile
+	 * itself is below topd.  This happens when a new parameter is added
+	 * to an existing incore pfile, e.g., in a declaration.
+	 */
+	for (;  pfp;  pfp = pfp->pf_npf) {
+	    if ((memel)(pfp->pf_lastpp) < (memel)topdp)
+		continue;		/* quick check */
+	    last_pp = NULL;
+	    n = 0;
+
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		if ((memel)pp >= (memel)topdp) {
+		    if (cldebug)
+			fprintf (stderr, "chop pfile for task %s at param %s\n",
+			    pfp->pf_ltp->lt_lname, last_pp->p_name);
+		    if (last_pp)
+			last_pp->p_np = NULL;
+		    pfp->pf_lastpp = last_pp;
+		    pfp->pf_n = n;
+		    break;
+		} else {
+		    last_pp = pp;
+		    n++;
+		}
+	    }
+	}
+
+	/* Delete any SET environment statements processed since this task
+	 * was spawned.  If any redefs are uncovered the original values are
+	 * reset in all connected subprocesses.
+	 */
+	if (tp->t_envp)
+	    c_prenvfree (0, tp->t_envp);
+
+	/* If the task being restored defined a package, dump all processes
+	 * in the process cache spawned since the package was loaded.
+	 */
+	if (tp->t_pno)
+	    pr_prunecache (tp->t_pno);
+}
+
+
+/* ONEOF -- "on eof" (not "one of"):
+ * The current task has issued eof, either directly or via the "bye" command.
+ *   Flush out all pending io, copy working pfile back to original if have one,
+ *   pop a state back to the previous state and restore its environment.
+ *   Avoid calling effecmode() if called from a builtin task since builtins
+ *   do not have the "mode" parameter.
+ *
+ * If currentask is the first cl or we are batch, then we are truely done.
+ *   Return true to the caller (EXECUTE), causing a return to the main.
+ */
+void 
+oneof (void)
+{
+	register struct pfile *pfp;
+	register struct package *pkp;
+	register struct param *pp;
+	static	int	nerrs = 0;
+	int	flags;
+	extern  ErrCom	errcom;
+	extern  int 	err_clear;
+
+	    
+	if (cldebug)
+	    eprintf ("received `%s' from `%s'\n", yeof ? "eof" : "bye",
+		currentask == firstask ? "root" : currentask->t_ltp->lt_lname);
+	    
+	if (!(firstask->t_flags & T_BATCH))
+	    if (currentask == firstask && !gologout && !loggingout &&
+		isatty (fileno (stdin)) && nerrs++ < 8)
+		cl_error (E_UERR, "use `logout' to log out of the CL");
+
+	flags = currentask->t_flags;
+
+	/* Clear the error struct to indicate a successful run().  If 
+	 * the err_clear flag is not set ....
+	 */
+	if (err_clear) {
+	    if ((do_error == YES || (do_error == NO && !errcom.errflag))) {
+		errcom.errcode = OK;
+		strcpy (errcom.errmsg, "");
+		strcpy (errcom.task, currentask->t_ltp->lt_lname);
+		/*strcpy (errcom.task, "");*/
+
+        	pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
+        	pp->p_val.v_i = errcom.errcode;
+        	pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
+        	pp->p_val.v_s = errcom.errmsg;
+        	pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
+        	pp->p_val.v_s = errcom.task;
+	    }
+	}
+
+
+	if (!(flags & (T_BUILTIN|T_CL|T_SCRIPT|T_BATCH)))
+	    fflush (currentask->t_out);
+	iofinish (currentask);
+
+	/* Copy back the main pfile and any pset-param files.  If the task
+	 * which has terminated is a package script task, fix up the pfile
+	 * pointer in the package descriptor to point to the updated pset.
+	 */
+	if (currentask->t_ltp->lt_flags & LT_PFILE) {
+	    pfcopyback (pfp = currentask->t_pfp);
+	    if (currentask->t_ltp->lt_flags & LT_DEFPCK)
+		if ( (pkp = pacfind(currentask->t_ltp->lt_lname)) )
+		    if (pkp->pk_pfp == pfp)
+			pkp->pk_pfp = pfp->pf_oldpfp;
+	    for (pfp = pfp->pf_npset;  pfp != NULL;  pfp = pfp->pf_npset)
+		pfcopyback (pfp);
+	}
+
+	if (currentask == firstask)
+	    alldone = 1;
+	else {
+	    currentask = poptask();
+	    if (currentask->t_flags & T_BATCH)
+		alldone = 1;
+	}
+
+	restor (currentask);		/* restore environment 		*/
+}
+
+
+/* PRINTCALL -- Print the calling sequence for a task.  Called by killtask()
+ * to print stack trace.
+ */
+void 
+printcall (FILE *fp, struct task *tp)
+{
+	register struct param *pp;
+	int	 notfirst = 0;
+	extern   int unwind_level;
+
+
+	/*  See whether we print a stack trace at all, and if so, whether
+	 *  we want the full trace. 
+	 */
+	if (err_trace == NO || (err_full == NO && unwind_level > 0))
+	    return;
+
+	/* Print the offending line.
+	 */
+ 	print_call_line (fp, tp->t_callln, tp->t_ltp->lt_pname,
+	    tp->t_ltp->lt_flags);
+
+	fprintf (fp, "     called as: `%s (", tp->t_ltp->lt_lname);
+
+	for (pp = tp->t_pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+	    if (pp->p_flags & P_CLSET) {
+		if (notfirst)
+		    fprintf (fp, ", ");
+		notfirst++;
+		if (!(tp->t_pfp->pf_flags & PF_FAKE) && !(pp->p_mode & M_FAKE))
+		    fprintf (fp, "%s=", pp->p_name);
+
+		/* Use only low level routines to print the parameter value to
+		 * avoid error recursion.  In particular, parameter indirection
+		 * is not resolved.
+		 */
+		if (!(pp->p_valo.o_type & OT_UNDEF))
+		    fprop (fp, &pp->p_valo);
+		else
+		    fprintf (fp, "UNDEF");
+	    }
+	}
+
+	fprintf (fp, ")'\n");
+}
+
+
+/* PRINT_CALL_LINE -- Print the line of the file being called.
+ */
+void 
+print_call_line (FILE *out, int line, char *fname, int flags)
+{
+    	register int i, len;
+	register FILE *fp;
+	char 	buf[SZ_LINE+1];
+	extern  int unwind_level;
+
+
+	len = strlen (fname);
+	if (strncmp (".cl", &fname[len-3], 3) == 0) {
+
+	    fp = fopen (fname, "r");		/* open the script 	*/
+	    for (i=0; i < line; i++) {		/* skip to line		*/
+	        if (fgets (buf, SZ_LINE, fp) == (char *)NULL) {
+	    	    fclose (fp);
+		    return;
+		}
+	    }
+
+	    /* Skip leading whitespace and string trailing newline. */
+	    len = strlen (buf);
+	    buf[len-1] = '\0';
+	    for (i=0; buf[i] == ' ' || buf[i] == '\t'; i++) 
+	        ;
+
+	    fprintf (out, "  \"%.68s", &buf[i]);
+	    if (strlen (&buf[i]) > 68)
+	        fprintf (out, " ...");
+
+	    if (flags & LT_INVIS)
+	        fprintf (out, "\"\n     line %d: %s (hidden task)\n",
+		    line, fname);
+	    else
+	        fprintf (out, "\"\n     line %d: %s\n", line, fname);
+
+	    fclose (fp);
+	}
+
+	unwind_level++;
+}
+
+
+/* KILLTASK -- Abort the currently executing task.  Only call this when a task
+ *  is to be killed spontaneously, as from interrupt, not when it is just dying
+ *   due to a "bye" or eof.
+ * Close all pipes and pseudofiles, being careful not to close any that
+ *   are real stdio files.
+ * Note that our function is to kill an external task, not the process in which
+ *   it resides.  The process is left running in the cache in case it is needed
+ *   again.
+ */
+void 
+killtask (register struct task *tp)
+{
+	char	buf[128];
+
+	/* Print stack trace, with arguments.
+	if (!(tp->t_ltp->lt_flags&LT_INVIS) && !(firstask->t_flags&T_BATCH) &&
+	    !(strcmp (tp->t_ltp->lt_lname, "error") == 0))
+	 */
+	if (!(firstask->t_flags&T_BATCH))
+	    printcall (currentask->t_stderr, tp);
+
+	/* If task is running in a subprocess, interrupt it and read the ERROR
+	 * message.  Not certain there isn't some case where this could cause
+	 * deadlock, but it does not seem so.  Interrupts are disabled during
+	 * process startup.  If task issues ERROR then it is popped before
+	 * we are called, without issuing the signal.
+	 */
+	if (tp->t_pid != -1) {
+	    fflush (tp->t_out);
+	    c_prsignal (tp->t_pid, X_INT);
+	    fgets (buf, 128, tp->t_in);
+	}
+
+	iofinish (tp);
+}
diff --git a/pkg/vocl/globals.c b/pkg/vocl/globals.c
new file mode 100644
index 00000000..62d7f9d0
--- /dev/null
+++ b/pkg/vocl/globals.c
@@ -0,0 +1,117 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "operand.h"
+#include "construct.h"
+#include "param.h"
+#include "task.h"
+#include "eparam.h"
+
+int	parse_state;		/* What are we parsing?			*/
+int	proc_script;		/* In a procedure script?		*/
+struct	pfile *parse_pfile;	/* Where parsed params are added.	*/
+
+int	nextdest[MAX_LOOP];	/* Destinations for NEXT's 		*/
+int	brkdest[MAX_LOOP];	/* Destinations for BREAK's 		*/
+
+int	nestlevel = 0;		/* Loop nesting level			*/
+int	ncaseval;		/* Number of cases in switch		*/
+
+int	n_oarr;			/* Number of open array indices		*/
+int	i_oarr;			/* Current open array index		*/
+
+int	oarr_beg[N_OPEN_ARR];	/* Open index limits.			*/
+int	oarr_end[N_OPEN_ARR];
+int	oarr_curr[N_OPEN_ARR];	/* Current value for index.		*/
+int	imloopset = 0;		/* Loop inited at run time?		*/
+int	n_indexes = 0;		/* Number of indexes on stack.		*/
+
+int	maybeindex;		/* Could last constant be index		*/
+				/* range?				*/
+
+struct	label	*label1 = NULL; /* Pointer to first top of label list.	*/
+int	igoto1 = -1;		/* Head of list of indirect GOTO's	*/
+
+struct	operand	*parlist[MAX_PROC_PARAMS];
+struct	param *last_parm;	/* Last parameter before compilation.	*/
+int	n_procpar;		/* Number of params in proc stmt.	*/
+
+/* Default initialization of the EDCAP editor command set.
+ * Note: these are expected to be reset be the edcap facility at runtime.
+ * The source of most of these defaults is the EMACS editor
+ */
+int	numcommands;		/* number of defined commands		*/
+
+struct edit_commands command[MAX_COMMANDS] = {
+	{ EDITOR_ID	,"\0"		,""		},
+	{ EDIT_INIT	,"\0"		,"enable"	},
+	{ EDIT_TERM	,"\0"		,"disable"	},
+
+	{ MOVE_UP	,"\020"		,"^P"		},
+	{ MOVE_DOWN	,"\016"		,"^N"		},
+	{ MOVE_RIGHT	,"\006"		,"^F"		},
+	{ MOVE_LEFT	,"\002"		,"^B"		},
+
+	{ MOVE_UP	,"\033\133\101" ,"UP ARROW"	},
+	{ MOVE_DOWN	,"\033\133\102" ,"DOWN ARROW"	},
+	{ MOVE_RIGHT    ,"\033\133\103" ,"RIGHT ARROW"	},
+	{ MOVE_LEFT	,"\033\133\104" ,"LEFT ARROW"	},
+
+	{ NEXT_WORD	,"\033\106"	,"ESC-F"	},
+	{ NEXT_WORD	,"\033\146"	,"ESC-f"	},
+	{ PREV_WORD	,"\033\102"	,"ESC-B"	},
+	{ PREV_WORD	,"\033\142"	,"ESC-b"	},
+	{ MOVE_EOL	,"\005"		,"^E"		},
+	{ MOVE_BOL	,"\001"		,"^A"		},
+	{ NEXT_PAGE	,"\026"		,"^V"		},
+	{ PREV_PAGE	,"\033\126"	,"ESC-V"	},
+	{ PREV_PAGE	,"\033\166"	,"ESC-v"	},
+	{ MOVE_START	,"\033\074"	,"ESC-<"	},
+	{ MOVE_END	,"\033\076"	,"ESC->"	},
+
+	{ SET_FWD	,"\000"		,"undefined"	},
+	{ SET_AFT	,"\000"		,"undefined"	},
+	{ TOGGLE_DIR	,"\000"		,"undefined"	},
+
+	{ DEL_LEFT	,"\177"		,"DEL"		},
+	{ DEL_LEFT	,"\010"		,"^H or BS"	},
+	{ DEL_CHAR	,"\004"		,"^D"		},
+	{ DEL_WORD	,"\033\104"	,"ESC-D"	},
+	{ DEL_WORD	,"\033\144"	,"ESC-d"	},
+	{ DEL_LINE	,"\013"		,"^K"		},
+	{ UNDEL_CHAR	,"\033\004"	,"ESC-^D"	},
+	{ UNDEL_WORD	,"\033\027"	,"ESC-^W"	},
+	{ UNDEL_LINE	,"\033\013"	,"ESC-^K"	},
+
+	{ FIND_FWD	,"\033\123"	,"ESC-S"	},
+	{ FIND_FWD	,"\033\163"	,"ESC-s"	},
+	{ FIND_AFT	,"\033\122"	,"ESC-R"	},
+	{ FIND_AFT	,"\033\162"	,"ESC-r"	},
+	{ FIND_NEXT	,"\000"		,"undefined"	},
+
+	{ GET_HELP	,"\033\077"	,"ESC-?"	},
+	{ REPAINT	,"\014"		,"^L"		},
+	{ EXIT_UPDATE	,"\032"		,"^Z"		},
+	{ EXIT_NOUPDATE ,"\003"		,"^C"		},
+
+	{ NEXT_LINE     ,"\000"		,"undefined"	},
+	{ NOMORE_COMMANDS ,"\0"		,""		}
+};
+
+/* Names of the editor commands, used for edcap interpretation and showhelp.
+ */
+char	*cmdnames[MAX_COMMANDS] = {
+	"EDITOR_ID", "EDIT_INIT", "EDIT_TERM",
+	"MOVE_UP", "MOVE_DOWN", "MOVE_RIGHT", "MOVE_LEFT", "NEXT_WORD",
+	"PREV_WORD", "MOVE_EOL", "MOVE_BOL", "NEXT_PAGE", "PREV_PAGE",
+	"MOVE_START", "MOVE_END", "SET_FWD", "SET_AFT", "TOGGLE_DIR",
+	"DEL_LEFT", "DEL_CHAR", "DEL_WORD", "DEL_LINE", "UNDEL_CHAR",
+	"UNDEL_WORD", "UNDEL_LINE", "FIND_FWD", "FIND_AFT", "FIND_NEXT",
+	"GET_HELP", "REPAINT", "EXIT_UPDATE", "EXIT_NOUPDATE",
+	"NEXT_LINE", "NOMORE_COMMANDS"
+};
diff --git a/pkg/vocl/gquery.c b/pkg/vocl/gquery.c
new file mode 100644
index 00000000..1ddea0e4
--- /dev/null
+++ b/pkg/vocl/gquery.c
@@ -0,0 +1,200 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "task.h"
+#include "clmodes.h"
+#include "proto.h"
+
+
+/* Contains modified portions of modes.c for range checking etc. for use
+ * by EPARAM.  The problem with modes.c is that it not only checks ranges, 
+ * but does direct i/o to the terminal.
+ */
+
+extern	int cldebug;
+static  char *e1 = "Not in batch";
+static  char *e2 = "Parameter value is out of range";
+
+
+/* GQUERY -- Determine if the value of a parameter given by the user is OK.
+ * Also, store the new value in the parameter; in the case of a list
+ * structured parameter, the new value is the name of a new list file.
+ * This routine is called by EPARAM to verify that the new parameter value
+ * is inrange and set the new value if so.
+ */
+char *
+gquery (struct param *pp, char *string)
+{
+	register char *ip;
+	char	buf[SZ_LINE];
+	char	*query_status, *nlp, *errmsg;
+	int	arrflag=0, offset=0, bastype=0, batch=0;
+	struct	operand o;
+	char	*strcpy(), *index();
+
+	bastype = pp->p_type & OT_BASIC;
+	batch   = firstask->t_flags & T_BATCH;
+	arrflag = pp->p_type & PT_ARRAY;
+
+	if (arrflag)
+	    offset = getoffset(pp);
+
+	if (batch) {
+	    errmsg = e1;
+	    return (errmsg);
+	} else
+	    query_status = strcpy (buf, string);
+
+	ip = buf;
+
+	/* Set o to the current value of the parameter.  Beware that some
+	 * of the logical branches which follow assume that struct o has
+	 * been initialized to the current value of the parameter.
+	 */
+	if (pp->p_type & PT_LIST) {
+	    setopundef (&o);
+	} else if (arrflag) {
+	    poffset (offset);
+	    paramget (pp, FN_VALUE);
+	    o = popop ();
+	} else
+	    o = pp->p_valo;
+
+	/* Handle eof, a null-length line (lone carriage return),
+	 * and line with more than SZ_LINE chars.  Ignore leading whitespace
+	 * if basic type is not string.
+	 */
+	if (query_status == NULL)
+	    goto testval;
+
+	/* Ignore leading whitespace if it is not significant for this
+	 * datatype.  Do this before testing for empty line, so that a
+	 * return such as " \n" is equivalent to "\n".  I.e., do not
+	 * penalize the user if they type the space bar by accident before
+	 * typing return to accept the default value.
+	 */
+	if (bastype != OT_STRING || (pp->p_type & PT_LIST))
+	    while (*ip == ' ' || *ip == '\t')
+		ip++;
+
+	if (*ip == '\n') {
+	    /* Blank lines usually just accept the current value
+	     * but if the param in a string and is undefined,
+	     * it sets the string to a (defined) nullstring.
+	     */
+	    if (bastype == OT_STRING && opundef (&o)) {
+		*ip = '\0';
+		o = makeop (ip, bastype);
+	    } else
+		goto testval;
+	}
+
+	/* Cancel the newline. */
+	if ((nlp = index (ip, '\n')) != NULL)
+	    *nlp = '\0';
+
+	/* Finally, we have handled the pathological cases.
+	 */
+	if (pp->p_type & PT_LIST)
+	    o = makeop (string, OT_STRING);
+	else
+	    o = makeop (ip, bastype);
+
+testval:   
+	if (*string == '@')
+	    errmsg = "OK";
+	else if (pp->p_type & PT_LIST)
+	    errmsg = "OK";
+	else if (inrange (pp, &o))
+	    errmsg = "OK";
+	else {
+	    errmsg = e2;
+	    return (errmsg);
+	}
+
+	if (cldebug) {
+	    eprintf ("changing `%s.p_val' to ", pp->p_name);
+	    fprop (stderr, &o);
+	    eprintf ("\n");
+	}
+
+	/* Update param with new value.
+	 */
+	pushop (&o);
+	if (arrflag)
+	    poffset (offset);
+
+	paramset (pp, FN_VALUE);
+	pp->p_flags |= P_SET;
+
+	return ("OK");
+}
+
+
+/* MINMAX -- Format the minimum and maximum values of a parameter, if any.
+ */
+char *
+minmax (register struct param *pp)
+{
+	static char  message[SZ_LINE];
+
+	/* Show the ranges if they are defined and this is a parameter
+	 * type that has ranges.
+	 */
+	if (range_check (pp)) {
+	    char   str[SZ_LINE];
+	    struct operand o;
+
+	    o.o_type = pp->p_type & OT_BASIC;
+
+	    sprintf (message, " (minimum=");
+	    if (!(pp->p_flags & (P_IMIN|P_UMIN))) {
+		o.o_val = pp->p_min;
+		sprop (str, &o);
+		strcat (message, str);
+	    }
+	    strcat (message, ": maximum=");
+	    if (!(pp->p_flags & (P_IMAX|P_UMAX))) {
+		o.o_val = pp->p_max;
+		sprop (str, &o);
+		strcat(message, str);
+	    }
+	    strcat (message, ")");
+	} else
+	    message[0] = EOS;
+
+	return (message);
+}
+
+
+/* ENUMIN -- Format the enumeration string for a parameter.
+ */
+char *
+enumin (register struct param *pp)
+{
+	static char  message[SZ_LINE];
+
+	if (!(pp->p_flags & (P_IMIN|P_UMIN))) {
+	    char    str[SZ_LINE];
+	    struct  operand o;
+
+	    sprintf (message, " choose: ");
+
+	    o.o_type = pp->p_type & OT_BASIC;
+	    o.o_val  = pp->p_min;
+	    sprop (str, &o);
+	    strcat (message, str);
+	} else
+	    message[0] = EOS;
+
+	return (message);
+}
diff --git a/pkg/vocl/gram.c b/pkg/vocl/gram.c
new file mode 100644
index 00000000..84d470da
--- /dev/null
+++ b/pkg/vocl/gram.c
@@ -0,0 +1,1443 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "construct.h"
+#include "ytab.h"		/* pick up yacc token #defines		*/
+#include "proto.h"
+
+
+/*
+ * GRAM -- These routines are used by the parser and lex files grammar.y and
+ *   grammar.l.  Also we handle other things that are very visible to the user
+ *   here too, such as cracking and running the intrinsic functions.
+ *
+ * We define our own yywrap() here to set yeof.
+ * TODO: clean up having to keep some of the strings upper, some lower case.
+ */
+
+#define SZ_PIPEFILENAME		(6+4+5)		/* uparm$ // pipe // XXXXX */
+#define	MAX_PIPECODE		30000		/* modulus for pipecodes   */
+
+#define	TRIM_LEFT	1
+#define	TRIM_RIGHT	2
+
+
+int	yeof;			/* set by yywrap when it sees eof.	*/
+extern	int yylval;		/* declared in y.tab.c			*/
+extern	int cldebug;
+
+extern	int inarglist;		/* set by parser when in argument list	*/
+extern	int parenlevel;		/* nesting level of parens		*/
+extern	int get_nscanval();
+extern	int do_error;		/* runtime error handling		*/
+int	pipetable[MAXPIPES];	/* for maintaining pipe temp files	*/
+int	nextpipe = 0;
+
+char	*truestr    = "yes";	/* true constant as it appears in ASCII	*/
+char	*falsestr   = "no";	/* false                "		*/
+char	*nullstr    = "";
+char	*undefval   = "";	/* used in nextfield(), pvaldefined()	*/
+char	*indefstr   = "INDEF";	/* input or output for indef operands	*/
+char	*indeflc    = "indef";	/*   lower case version.		*/
+char	*eofstr     = "EOF";	/* list file EOF or input		*/
+char	*eoflc      = "eof";	/*   lower case version			*/
+char	*errorstr   = "error";	/* the error statement			*/
+char	*err_cmdblk;		/* Pointer where error detected		*/
+
+/* Numerical constants.
+ */
+#define  BASE_E          2.7182818284590452353
+#define  FOURPI          12.566370614359172953
+#define  GAMMA           .57721566490153286061
+#define  HALFPI          1.5707963267948966192
+#define  LN_10           2.3025850929940456840
+#define  LN_2            .69314718055994530942
+#define  LN_PI           1.1447298858494001741
+#define  LOG_E           .43429448190325182765
+#define  PI              3.1415926535897932385
+#define  RADIAN          57.295779513082320877
+#define  SQRTOF2         1.4142135623730950488
+#define  SQRTOFPI        1.7724538509055160273
+#define  TWOPI           6.2831853071795864769
+
+/* Physical constants.
+ */
+#define  AU 		 1.49597870691e11 		/* m 		*/
+#define  GRAV_ACCEL 	 9.80665e0		 	/* m / sec^2 	*/
+#define  GRAV_CONST      6.673e-11		 	/* m^3 / kg s^2 */
+#define  LIGHT_YEAR 	 9.46053620707e15		/* m 		*/
+#define  PARSEC 	 3.08567758135e16		/* m 		*/
+#define  SPEED_OF_LIGHT  299792458.0			/* m / sec	*/
+#define  SOLAR_MASS 	 1.98892e30 			/* kg 		*/
+
+
+
+char	*epsilonstr = "epsilon";/* a small value; see hlib$mach.h	*/
+char	*epsilonuc  = "EPSILON";/* a small value; see hlib$mach.h	*/
+char	*pistr      = "PI";     /* pi 					*/
+char	*twopistr   = "TWOPI";  /* 2 * pi 				*/
+char	*fourpistr  = "FOURPI"; /* 4 * pi 				*/
+char	*halfpistr  = "HALFPI"; /* pi / 2 				*/
+char	*sqrtpistr  = "SQRTPI"; /* sqrt (pi) 				*/
+char	*sqrttwostr = "SQRT2";  /* sqrt (2) 				*/
+char	*baseestr   = "BASE_E"; /* e					*/
+char	*ln2str     = "LN_2";   /* ln (2)				*/
+char	*ln10str    = "LN_10";  /* ln (10)				*/
+char	*lnpistr    = "LN_PI";  /* ln (pi) 				*/
+char	*logestr    = "LOG_E";  /* log (e) 				*/
+char	*gammastr   = "GAMMA";  /* Euler's constant			*/
+char	*radianstr  = "RADIAN"; /* Radian conversion factor		*/
+
+char	*austr      = "AU"; 	    	/* Astronomical Unit		*/
+char	*gaccelstr  = "GRAV_ACCEL"; 	/* Gravitational Acceleration	*/
+char	*gconststr  = "GRAV_CONST"; 	/* Gravitational Constant	*/
+char	*lystr      = "LIGHT_YEAR"; 	/* Light Year (meters)		*/
+char	*parsecstr  = "PARSEC";     	/* Parsec (meters)		*/
+char	*lightstr   = "SPEED_OF_LIGHT"; /* Speed of light in vacuum	*/
+char	*solmassstr = "SOLAR_MASS"; 	/* Solar Mass (kg)		*/
+
+
+extern  char  cmdblk[SZ_CMDBLK+1]; /* current command block (in history.c) */
+extern	ErrCom	errcom;
+
+
+char *ifnames[] = {
+    "abs",                  "access",           	"atan2",
+    "cos",                  "defpac",           	"defpar",
+    "deftask",              "envget",           	"exp",
+    "frac",                 "int",              	"log",
+    "log10",                "nscan",            	"max",
+    "min",                  "mod",              	"nint",
+    "osfn",                 "radix",            	"real",
+    "sin",                  "sqrt",             	"str",
+    "substr",               "tan",              	"mktemp",
+    "stridx",               "strlen",           	"imaccess",
+    "defvar",               "strldx",           	"strstr",
+    "strlwr",               "strupr",           	"isindef",
+    "strlstr",              "not",              	"or",
+    "xor",                  "and",              	"_errpop",
+    "_errpeek",             "errmsg",           	"errcode",
+    "errtask",              "asin",             	"acos",
+    "hypot",                "rad",              	"deg",
+    "sign",                 "dsin",             	"dcos",
+    "dtan",                 "dasin",            	"dacos",
+    "trim",                 "triml",            	"trimr",
+    "fp_equal",             "datan2",    	    	"strdic",
+    "strsub",
+    "initVOClient",         "closeVOClient",    	"restartVOClient",
+    "dalConeSvc",           "dalSiapSvc",       	"dalRecordCount",
+    "dalGetRecord",         "dalGetData",       	"dalGetStr",
+    "dalGetInt",            "dalGetDbl",        	"dalAttrCount",
+    "dalAttrName",          "dalIntAttr",       	"dalFloatAttr",
+    "dalStrAttr",           "getDataset",       	"dalAttrScan",
+    "regSearch",            "regSvcSearch",     	"regResCount",
+    "regSetWaveband",       "regSetService",       	"regSetContent",
+    "regValue",             "regResolver",      	"nresolved",
+    "validObj",             "vocReady",			
+    "samp",
+    "sampLoadImage", 	    "sampLoadVOTable", 		"sampLoadFITS",
+    "sampLoadSpec", 	    "sampLoadBibcode", 		"sampLoadResource",
+    "sampShowRow", 	    "sampSelectRows", 	        "sampPointAt", 		
+    "sampCmdExec", 	    "sampEnvGet", 	    	"sampEnvSet",
+    "sampParamGet", 	    "sampParamSet", 	    	"sampHandler",
+    "sampHubAccess", 	    "sampAccess", 	    	"sampStatus",
+    "sampMeta", 	    "sampName",
+    NULL
+};
+
+
+int optbl[] = {
+      UNOP|OP_ABS,      UNOP|OP_ACCESS,   BINOP|OP_ATAN2,    UNOP|OP_COS,
+      UNOP|OP_DEFPAC,   UNOP|OP_DEFPAR,    UNOP|OP_DEFTASK,  UNOP|OP_ENVGET,
+      UNOP|OP_EXP,      UNOP|OP_FRAC,      UNOP|OP_INT,      UNOP|OP_LOG,
+      UNOP|OP_LOG10,  MULTOP|OP_NSCAN,   MULTOP|OP_MAX,    MULTOP|OP_MIN,
+     BINOP|OP_MOD,      UNOP|OP_NINT,      UNOP|OP_OSFN,    BINOP|OP_RADIX,
+      UNOP|OP_REAL,     UNOP|OP_SIN,       UNOP|OP_SQRT,     UNOP|OP_STR,
+    MULTOP|OP_SUBSTR,   UNOP|OP_TAN,       UNOP|OP_MKTEMP,  BINOP|OP_STRIDX,
+      UNOP|OP_STRLEN,   UNOP|OP_IMACCESS,  UNOP|OP_DEFVAR,  BINOP|OP_STRLDX,
+     BINOP|OP_STRSTR,   UNOP|OP_STRLWR,    UNOP|OP_STRUPR,   UNOP|OP_ISINDEF,
+     BINOP|OP_STRLSTR,  UNOP|OP_BNOT,     BINOP|OP_BOR,     BINOP|OP_BXOR,
+     BINOP|OP_BAND,   MULTOP|OP_ERRPOP,  MULTOP|OP_ERRPEEK,MULTOP|OP_ERRMSG,
+    MULTOP|OP_ERRCODE,MULTOP|OP_ERRTASK,   UNOP|OP_ASIN,     UNOP|OP_ACOS,
+     BINOP|OP_HYPOT,    UNOP|OP_RAD,       UNOP|OP_DEG,      UNOP|OP_SIGN,
+      UNOP|OP_DSIN,     UNOP|OP_DCOS,      UNOP|OP_DTAN,     UNOP|OP_DASIN,
+      UNOP|OP_DACOS,  MULTOP|OP_TRIM,    MULTOP|OP_TRIML,  MULTOP|OP_TRIMR,
+     BINOP|OP_FPEQUAL, BINOP|OP_DATAN2,   BINOP|OP_STRDIC, MULTOP|OP_STRSUB,
+     VOCOP|OP_INITVOC,
+     VOCOP|OP_CLOSEVOC,     VOCOP|OP_RESTARTVOC,    VOCOP|OP_CONESVC,
+     VOCOP|OP_SIAPSVC,      VOCOP|OP_RECCNT,        VOCOP|OP_GETREC,
+     VOCOP|OP_GETDATA,      VOCOP|OP_GETSTR,        VOCOP|OP_GETINT,
+     VOCOP|OP_GETDBL,       VOCOP|OP_ATTRCNT,       VOCOP|OP_ATTRNAME,
+     VOCOP|OP_INTATTR,      VOCOP|OP_FLOATATTR,     VOCOP|OP_STRATTR,
+     VOCOP|OP_DATASET,      VOCOP|OP_ATTRSCAN,      VOCOP|OP_REGSEARCH,
+     VOCOP|OP_REGSVCSEARCH, VOCOP|OP_REGCOUNT,      VOCOP|OP_REGBPASS,
+     VOCOP|OP_REGSVC,       VOCOP|OP_REGCONTENT,    VOCOP|OP_REGVALUE,
+     VOCOP|OP_REGRESOLVER,  VOCOP|OP_NRESOLVED,     VOCOP|OP_VALIDOBJ,
+     VOCOP|OP_VOCREADY,          
+
+     SAMPOP|OP_SAMP,          		/* SAMP master command		*/
+
+     SAMPOP|OP_SAMPIMLOAD,          	/* image.load.fits		*/
+     SAMPOP|OP_SAMPTBLVOT,          	/* table.load.votable		*/
+     SAMPOP|OP_SAMPTBLFITS,          	/* table.load.fits		*/
+     SAMPOP|OP_SAMPSPECLOAD,          	/* spectrum.load.ssa-generic	*/
+     SAMPOP|OP_SAMPBIBLOAD,          	/* bibcode.load			*/
+     SAMPOP|OP_SAMPRESLOAD,          	/* voresource.loadlist		*/
+
+     SAMPOP|OP_SAMPTBLROW,          	/* table.highlight.row		*/
+     SAMPOP|OP_SAMPSELRLIST,          	/* table.select.rowList		*/
+     SAMPOP|OP_SAMPPOINTAT,          	/* coord.pointAt.sky		*/
+
+     SAMPOP|OP_SAMPCMDEXEC,          	/* client.cmd.exec		*/
+     SAMPOP|OP_SAMPENVGET,          	/* client.env.get		*/
+     SAMPOP|OP_SAMPENVSET,          	/* client.env.set		*/
+     SAMPOP|OP_SAMPPARAMGET,          	/* client.param.get		*/
+     SAMPOP|OP_SAMPPARAMSET,          	/* client.param.set		*/
+
+     SAMPOP|OP_SAMPHANDLER,          	/* add a user defined handler	*/
+     SAMPOP|OP_SAMPHUBACC,          	/* check on a running hub       */
+     SAMPOP|OP_SAMPACCESS,          	/* check on an external app     */
+     SAMPOP|OP_SAMPSTATUS,          	/* check interface status	*/
+     SAMPOP|OP_SAMPMETA,          	/* declare metadata		*/
+     SAMPOP|OP_SAMPNAME,          	/* set/print app name		*/
+         NULL
+};
+
+
+/* Usually the following routine is provided by the yacc library but we need
+ * our own here to signal the parser that an eof has been read.
+ */
+int 
+yywrap (void)
+{
+	yeof = 1;
+	return (1);
+}
+
+/* Yacc calls this when it gets a general error.  We are doing all our own
+ * error handling so just provide an entry point and store where the
+ * error occurred in the input stream.
+ */
+/* ARGSUSED */
+void 
+yyerror (char *s)
+{
+	extern	char	*ip_cmdblk;
+
+	if (cldebug)
+	   eprintf ("yyerror: %s, ip_cmdblk=%d %s\n", s, ip_cmdblk, ip_cmdblk);
+	err_cmdblk = ip_cmdblk;	
+}
+
+
+/* Used by the . command: repeat whatever was last compiled.
+ * All we need to do is advance the pc up to what it would be if the
+ * command were typed in again.  See grammar.y '.' rule.
+ */
+void 
+rerun (void)
+{
+	register struct codeentry *cp;
+
+	do {
+	    cp = coderef (pc);
+	    pc += cp->c_length;
+	} while (cp->c_opcode != END);
+}
+
+
+/* CRACKIDENT -- Check given string s against keyword, set yylval, and return
+ *   token.  Used from grammar when see an identifier or from "?" and "??" lex
+ *   rules.  Make these look like identifiers for the special help commands.
+ * A few that need more complicated processing are checked separately.
+ * This is much more core efficient than putting the keywords in the
+ *   lex spec and also makes the grammer very stable.
+ * TODO: sort keyword list and do binary search if things get slow.
+ *   (better yet use a hashed symbol table - this list is getting huge)
+ */
+
+#define const_str(val)	(kch == *(val) && !strcmp (s, (val)))
+#define retconst(val)	{ sprintf (sb, "%g", val); \
+			  yylval = addconst (sb, OT_REAL); \
+			  return (Y_CONSTANT); \
+			}
+
+int 
+crackident (char *s)
+{
+	struct keywords {
+		char *k_name;		/* the keyword string itself.	*/
+		short k_token;		/* yacc %token for the keyword	*/
+		short k_yylval;		/* the value associated with token.*/
+	};
+
+	static struct keywords kw[] = {
+
+	    /* Control flow keywords.
+	     */
+	    { "while",  Y_WHILE,  0 },	{ "if",        Y_IF,        0 },
+	    { "else",   Y_ELSE,   0 },	{ "switch",    Y_SWITCH,    0 },
+	    { "case",   Y_CASE,   0 },	{ "default",   Y_DEFAULT,   0 },
+	    { "break",  Y_BREAK,  0 },	{ "next",      Y_NEXT,      0 }, 
+	    { "return", Y_RETURN, 0 },	{ "goto",      Y_GOTO,      0 },
+	    { "for",    Y_FOR,    0 },	{ "procedure", Y_PROCEDURE, 0 },
+	    { "begin",  Y_BEGIN,  0 },	{ "end",       Y_END,       0 },
+	    { "iferr",  Y_IFERR,  0 },	{ "ifnoerr",   Y_IFNOERR,   0 },
+	    { "then",   Y_THEN,   0 },
+
+	    /* Parameter and variable types.
+	     */
+	    { "int",    Y_INT,    0 },	{ "char",      Y_STRING,    0 },
+	    { "real",   Y_REAL,   0 },	{ "string",    Y_STRING,    0 },
+	    { "file",   Y_FILE,   0 },	{ "gcur",      Y_GCUR,      0 },
+	    { "imcur",  Y_IMCUR,  0 },	{ "ukey",      Y_UKEY,      0 },
+	    { "pset",   Y_PSET,   0 },	{ "bool",      Y_BOOL,      0 },
+	    { "struct", Y_STRUCT, 0 },
+
+	    /* debugging commands.
+	     */
+	    { "d_d",    D_D,      0 },
+	    { "d_peek", D_PEEK,   0 },
+
+	    { "", 0, 0 } 		/* sentinel; leave it here... */
+	};
+
+	static struct keywords kf[] = {
+	    /* Keywords of intrinsic functions that get built into
+	     * the grammar.  Most intrinsics handled by intrinsic().
+	     */
+	    { "scan",   Y_SCAN,   0 },
+	    { "scanf",  Y_SCANF,  0 },
+	    { "fscan",  Y_FSCAN,  0 },
+	    { "fscanf", Y_FSCANF, 0 },
+
+	    /* sentinel; leave it here... */
+	    { "", 0, 0 } 
+	};
+
+	register struct keywords *kp;
+	XINT	oldtopd;
+	static	char sch, kch;		/* static storage is faster here   */
+	char	*scopy;			/* non-makelower'd copy		   */
+	char    sb[REALWIDTH];
+
+
+	oldtopd = topd;			/* save topd			   */
+	scopy = comdstr(s);		/* make a copy in the dictionary   */
+	makelower (scopy);		/* make it lower case for compares */
+	topd = oldtopd;			/*restore topd but scopy still there!*/
+
+	/* Put the first character of the identifier we are searching for
+	 * in local storage to permit fast rejection of keywords without all
+	 * the overhead involved in a call to strcmp.  This is an easy way
+	 * to speed things up several times w/o coding fancy data structures.
+	 */
+	sch = *scopy;
+	kch = *s;	/* save original string */
+
+	/* Check for and handle special-case keywords first.
+	 */
+	if (sch == *truestr && !strcmp (scopy, truestr)) {
+	    yylval = addconst (truestr, OT_BOOL);
+	    return (Y_CONSTANT);
+	} else if (sch == *falsestr && !strcmp (scopy, falsestr)) {
+	    yylval = addconst (falsestr, OT_BOOL);
+	    return (Y_CONSTANT);
+	} else if (sch == *indeflc && !strcmp (scopy, indeflc)) {
+	    yylval = addconst (scopy, OT_INT);
+	    return (Y_CONSTANT);
+	} else if (sch == *eoflc && !strcmp (scopy, eoflc)) {
+	    yylval = addconst (CL_EOFSTR, OT_INT);
+	    return (Y_CONSTANT);
+	} else if (sch == *errorstr && !strcmp (scopy, errorstr)) {
+	    yylval = addconst (errorstr, OT_STRING);
+	    return (Y_IDENT);
+
+	/* Check for defined numerical constants.  For backwards compatability
+	 * we match 'epsilon', however this particular value is deprecated by
+	 * the fp_equal() builtin and we assume CL constants will be upper
+	 * case strings.
+	 */
+	} else if ((sch == *epsilonstr && !strcmp (scopy, epsilonstr)) ||
+		   (kch == *epsilonuc && !strcmp (s, epsilonuc))) {
+	    sprintf (sb, "%e", EPSILON);
+	    yylval = addconst (sb, OT_REAL);
+	    return (Y_CONSTANT);
+
+	} else if (const_str (pistr)) { 	retconst (PI);
+	} else if (const_str (twopistr)) { 	retconst (TWOPI);
+	} else if (const_str (fourpistr)) { 	retconst (FOURPI);
+	} else if (const_str (halfpistr)) { 	retconst (HALFPI);
+	} else if (const_str (sqrtpistr)) { 	retconst (SQRTOFPI);
+	} else if (const_str (sqrttwostr)) { 	retconst (SQRTOF2);
+	} else if (const_str (baseestr)) { 	retconst (BASE_E);
+	} else if (const_str (ln2str)) { 	retconst (LN_2);
+	} else if (const_str (ln10str)) { 	retconst (LN_10);
+	} else if (const_str (lnpistr)) { 	retconst (LN_PI);
+	} else if (const_str (logestr)) { 	retconst (LOG_E);
+	} else if (const_str (gammastr)) { 	retconst (GAMMA);
+	} else if (const_str (radianstr)) { 	retconst (RADIAN);
+
+	} else if (const_str (austr)) { 	retconst (AU);
+	} else if (const_str (gaccelstr)) { 	retconst (GRAV_ACCEL);
+	} else if (const_str (gconststr)) { 	retconst (GRAV_CONST);
+	} else if (const_str (lystr)) { 	retconst (LIGHT_YEAR);
+	} else if (const_str (parsecstr)) { 	retconst (PARSEC);
+	} else if (const_str (lightstr)) { 	retconst (SPEED_OF_LIGHT);
+	} else if (const_str (solmassstr)) { 	retconst (SOLAR_MASS);
+
+
+	} else if (!inarglist && parenlevel == 0) {
+	    /* Search the keyword list; kewords are not recognized in argument
+	     * lists and expressions, else unquoted strings like "for" and
+	     * "file" will cause syntax errors.
+	     */
+	    for (kp=kw;  (kch = *kp->k_name);  kp++)
+		if (kch == sch)
+		    if (strcmp (scopy, kp->k_name) == 0) {
+			yylval = kp->k_yylval;
+			return (kp->k_token);
+		    }
+
+	} else {
+	    /* Search the list of intrinsic functions.
+	     */
+	    for (kp=kf;  (kch = *kp->k_name);  kp++)
+		if (kch == sch)
+		    if (strcmp (scopy, kp->k_name) == 0) {
+			yylval = kp->k_yylval;
+			return (kp->k_token);
+		    }
+	}
+
+	/* S not a keyword, so it's just an identifier.
+	 */
+	yylval = addconst (s, OT_STRING);	/* use original */
+	return (Y_IDENT);
+}
+
+
+/* ADDCONST -- Called during parsing to convert string s into operand of
+ *   type t and push it as an operand onto the dictionary (NOT the operand
+ *   stack).
+ * Use dictionary because this routine is called at compile time and the 
+ *   operand stack is being filled with compiled code; use dictionary as
+ *   a quiet workspace.
+ * Convert as per makeop().
+ * Return dictionary index of new operand entry so that it may be used as
+ *   ((struct operand *)&dictionary[$1])->o_... in yacc specs.
+ */
+XINT 
+addconst (char *s, int t)
+{
+	register struct operand *op;
+	XINT	lasttopd;
+
+	lasttopd = topd;		/* could just derefenece op	*/
+	op = (struct operand *) memneed (OPSIZ);
+	
+	if (t == OT_STRING) {
+	    /* makeop with an OT_STRING type will reuse the
+	     * string pointer but we want to compile into the dictionary.
+	     * fortunately, it's easy because lex has already removed any
+	     * surrounding quotes.
+	     */
+	    op->o_type = t;
+	    op->o_val.v_s = comdstr (s);
+	} else
+	    *op = makeop (s, t);
+
+	return (lasttopd);
+}
+
+
+/* LISTPARAMS -- Go through the given pfile and list out its parameters on
+ * t_stdout.  Give all non-hidden ones first, then all hidden ones in
+ * parentheses.
+ */
+void 
+listparams (struct pfile *pfp)
+{
+	register struct param *pp;
+
+	for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+	    if (!(pp->p_mode & M_HIDDEN))
+		pretty_param (pp, currentask->t_stdout);
+
+	for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+	    if (pp->p_mode & M_HIDDEN)
+		pretty_param (pp, currentask->t_stdout);
+}
+
+
+/* PRETTY_PARAM -- Pretty print the name, value, and prompt string of
+ * a parameter on the output file.  Put parens around the name=value string
+ * if a hidden parameter.
+ */
+void 
+pretty_param (struct param *pp, FILE *fp)
+{
+	register char	ch, *p;
+	char	buf[SZ_LINE];
+	int	nchars, maxch;
+
+	/* Get terminal dimensions from the environment.
+	 */
+	maxch = c_envgeti ("ttyncols") - 1;
+
+	p = buf;					/* name =	*/
+	if (pp->p_mode & M_HIDDEN)
+	    *p++ = '(';
+	sprintf (p, "%0.12s = ", pp->p_name);
+	nchars = strlen (buf);
+	while (nchars < 16) {
+	    fputc (' ', fp);
+	    nchars++;
+	}
+	fputs (buf, fp);
+
+	/* For arrays print the index list. 
+	 */
+	if (pp->p_type & PT_ARRAY) {
+	    int    dim, d, amin, amax;
+	    short  *len, *off;
+	    char   ibuf[15]; /* Maximum length of an index range should
+			      * be 13 e.g. -DDDDD:-DDDDD, plus one for the
+			      * terminator, and one for good luck.
+			      */
+	    buf[0]= '[';
+	    buf[1] = '\0';
+
+	    dim = pp->p_val.v_a->a_dim;
+	    len = &(pp->p_val.v_a->a_len);
+	    off = &(pp->p_val.v_a->a_off);
+
+	    for (d=0; d<dim; d++) {
+		amin = *(off + 2*d);
+		amax = amin + *(len + 2*d) - 1;
+
+		if (amin != 1)
+		    sprintf (ibuf, "%d:%d", amin, amax);
+		else
+		    sprintf (ibuf, "%d", amax);
+	
+		strcat (buf, ibuf);
+		if (d+1<dim)
+		    strcat (buf, ",");
+
+		if (strlen (buf) > SZ_LINE-14)
+		    break;
+	    }
+	    strcat (buf, "]");
+	    fputs (buf, fp);
+	    nchars += strlen (buf);
+
+	} else if (!(pp->p_valo.o_type & OT_UNDEF)) {
+	    /* For scalars print the value if available.
+	     */
+	    sprop (buf, &pp->p_valo);
+	    if ((pp->p_type & OT_BASIC) == OT_STRING && *buf != PF_INDIRECT) {
+		fputc ('"', fp);
+		nchars++;
+	    }
+	    fputs (buf, fp);
+	    nchars += strlen (buf);
+	    if ((pp->p_type & OT_BASIC) == OT_STRING && *buf != PF_INDIRECT) {
+		fputc ('"', fp);
+		nchars++;
+	    }
+	}
+
+	if (pp->p_mode & M_HIDDEN) {
+	    fputc (')', fp);
+	    nchars++;
+	}
+	fputc (' ', fp);
+	nchars++;
+
+	/* Advance to next field. */
+	while (nchars < 32) {
+	    fputc (' ', fp);
+	    nchars++;
+	}
+							/* prompt	*/
+	for (p=pp->p_prompt;  (ch = *p++) != '\0' && nchars < maxch;  nchars++)
+	    switch (ch) {
+	    case '\t':
+		fputs ("\\t", fp);
+		nchars++;
+		break;
+	    case '\n':
+		fputs ("\\n", fp);
+		nchars++;
+		break;
+	    case '\r':
+		fputs ("\\r", fp);
+		nchars++;
+		break;
+	    case '\f':
+		fputs ("\\f", fp);
+		nchars++;
+		break;
+	    default:
+		fputc (ch, fp);
+	    }
+	fputc ('\n', fp);
+}
+
+
+/* DUMPPARAMS -- Go through the given pfile and list out its parameters on
+ * t_stdout in the form `task.param=value'.
+ */
+void 
+dumpparams (struct pfile *pfp)
+{
+	register struct param *pp;
+	register FILE	*fp = currentask->t_stdout;
+
+	for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+	    if (!(pp->p_mode & M_HIDDEN))
+		show_param (pfp->pf_ltp, pp, fp);
+
+	for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+	    if (pp->p_mode & M_HIDDEN)
+		show_param (pfp->pf_ltp, pp, fp);
+	
+	fputs ("# EOF\n", fp);
+}
+
+
+/* SHOW_PARAM -- Print the name and value of a parameter on the output file
+ * in the format `task.param = value'.
+ */
+void 
+show_param (struct ltask *ltp, struct param *pp, FILE *fp)
+{
+	char	buf[SZ_LINE+1];
+	int	isstr;
+
+	if (ltp)
+	    fprintf (fp, "%s.%s", ltp->lt_lname, pp->p_name);
+	else
+	    fputs (pp->p_name, fp);
+
+	fputs (" = ", fp);
+
+	if (!(pp->p_valo.o_type & OT_UNDEF)) {
+	    sprop (buf, &pp->p_valo);
+	    isstr = ((pp->p_type & OT_BASIC) == OT_STRING &&
+		*buf != PF_INDIRECT);
+	    if (isstr)
+		fputc ('"', fp);
+	    fputs (buf, fp);
+	    if (isstr)
+		fputc ('"', fp);
+	}
+
+	fputc ('\n', fp);
+}
+
+
+/* LISTHELP -- List all the (visible) ltasks in the given package in the form
+ * of a sorted table.  Used to give menus in response to ? and ?? directives.
+ */
+void 
+listhelp (struct package *pkp, int show_invis)
+{
+	static	int first_col=7, maxch=20, ncol=0;
+	register struct ltask *ltp;
+	register char	*ip, *op;
+
+	char	buf[4096], *list[MAXMENU];
+	int	nltask, last_col;
+	FILE	*fp;
+
+	nltask = 0;
+	last_col = c_envgeti ("ttyncols") - 1;
+
+	fp = currentask->t_stdout;
+	op = buf;
+
+	for (ltp = pkp->pk_ltp;  ltp != NULL;  ltp = ltp->lt_nlt) {
+	    if (ltp->lt_flags & LT_INVIS && show_invis == NO)
+		continue;
+	    if (nltask >= MAXMENU)
+		cl_error (E_UERR, "too many ltasks in menu");
+
+	    /* Get task name. */
+	    list[nltask++] = op;
+	    for (ip=ltp->lt_lname;  (*op = *ip++);  op++)
+		;
+
+	    /* If special task, add character defining task type. */
+	    if (showtype()) {
+		if (ltp->lt_flags & LT_DEFPCK)
+		    *op++ = '.';
+		else if (ltp->lt_flags & LT_PSET)
+		    *op++ = '@';
+	    }
+
+	    *op++ = EOS;
+	}
+
+	/* Sort the list and output the table. */
+	if (nltask) {
+	    strsort (list, nltask);
+	    strtable (fp, list, nltask, first_col, last_col, maxch, ncol);
+	}
+}
+
+
+/* LISTALLHELP -- Starting at curpack, list out all packages and their tasks
+ * in a circular fashion until get back to curpack. this is like the search
+ * path works.  Label the current package in some way.  Serves ?? directive.
+ * TODO: this should be optimized once a nice form is settled on.
+ */
+void 
+listallhelp (int show_invis)
+{
+	register struct package *pkp;
+
+	pkp = curpack;
+	do {
+		oprintf ("    %s:\n", pkp->pk_name);
+		listhelp (pkp, show_invis);
+		if ((pkp = pkp->pk_npk) == NULL)
+			pkp = reference (package, pachead);
+	} until (pkp == curpack);
+}
+
+
+/* Break a param spec of the form [[pack.]task.]param[.field] into its
+ *   component parts.  Full is a pointer to the full name.  The others are the 
+ *   addresses of char pointers in the calling routine that are to be set to
+ *   point to the starting address, within full, of their respective components.
+ *   All dots are set to \0 and serve as eos's for each component.
+ *   If any of the parts are absent, the respective pointer is made to point at
+ *   the trailing null of full.
+ * The last part, field, is handled by fieldcvt(). it overwrites the first
+ *   char of the field component with the proper FN_XXX character; it is not
+ *   made into a string by adding an additional \0.
+ * Call error() and do not return if something goes wrong.
+ * Also used to break apart the components of full task names, [pack.]task.  In
+ *   this case, the task name will be found at p and the package name at t.
+ *   Fair enough; just keep them straight when calling.
+ * Modified 3/26/84 by TAM to use a static buffer, rather than mutilating
+ *   the input string.  This caused problems when programs looped and
+ *   executed the same PUSHPARAM (or similar) more than once, e.g.
+ *   	while (i<10) {= task.param; i += 1; }.
+ * This bug is particularly manifest when accessing arrays in specified tasks,
+ *   e.g. = task.array[*]
+ */
+void 
+breakout (char *full, char **pk, char **t, char **p, char **f)
+{
+	register char *cp;
+	register int npts, n;
+	char	*pts[3];
+	static	char	buffer[SZ_LINE+1];
+
+	strncpy (buffer, full, SZ_LINE);
+	buffer[SZ_LINE] = '\0';
+
+	for (npts=0, cp=buffer;  *cp;  cp++) {
+	    if (*cp == '.') {
+		if (*(cp+1) == EOS) {
+		    *cp = EOS;		/* chop dot if last character	*/
+		    break;
+		} else {
+		    if (npts > 3)
+			cl_error (E_UERR, "too many dots in param name `%s'",
+			    full);
+		    pts[npts++] = cp;
+		}
+	    }
+	}
+
+	for (n=0;  n < npts;  n++)
+	    *(pts[n]++) = '\0';		/* null over and skip dots	*/
+
+	switch (npts) {
+	case 0:	/* just a simple param name without dots */
+	    *p = buffer;
+	    *pk = *t = *f = cp;
+	    break;
+
+	case 1: /* p.f or t.p depending on f */
+	    if (fieldcvt (pts[0])) {
+		/* p.f */
+		*pk = *t = cp; *p = buffer; *f = pts[0];
+	    } else {
+		/* t.p */
+		*pk = *f = cp; *t = buffer; *p = pts[0];
+	    }
+	    break;
+
+	case 2: /* t.p.f or pk.t.p depending on f */
+	    if (fieldcvt (pts[1])) {
+		/* t.p.f */
+		*pk = cp; *t = buffer; *p = pts[0]; *f = pts[1];
+	    } else {
+		/* pk.t.p */
+		*pk = buffer; *t = pts[0]; *p = pts[1]; *f = cp;
+	    }
+	    break;
+
+	case 3: /* full spec */
+	    *pk = buffer; *t = pts[0]; *p = pts[1]; *f = pts[2];
+	    fieldcvt (*f);
+	    break;
+	}
+}
+
+
+/* If f is a valid parameter field spec, such as p_val, then overwrite *f
+ *   with the proper FN_XXX character and return YES, else return NO.
+ * Let the p_value field also be called p_filename, p_length and p_default.
+ * Call error() if f starts with p_ but is not found or if ambiguous
+ *   (and abbrevs are enabled).
+ */
+int 
+fieldcvt (register char *f)
+{
+	/* Field name and corresponding code tables.
+	 */
+	static char *fntbl[] = {
+	    "p_name", "p_type", "p_mode", "p_value", "p_minimum",
+	    "p_maximum", "p_prompt", "p_filename", "p_length", "p_default",
+	    "p_xtype", NULL
+	};
+	static char fctbl[] = {
+	    FN_NAME, FN_TYPE, FN_MODE, FN_VALUE, FN_MIN,
+	    FN_MAX, FN_PROMPT, FN_VALUE, FN_LENGTH, FN_VALUE,
+	    FN_XTYPE, NULL
+	};
+
+	int kentry;
+
+	/* Do a quick screening first. returning NO just means that f does
+	 * not even look like a field name.
+	 */
+	if (strncmp (f, "p_", 2))
+	    return (NO);
+
+	kentry = keyword (fntbl, f);
+	if (kentry == KWBAD)
+	    cl_error (E_UERR, "bad param field `%s'", f);
+	else if (kentry == KWAMBIG)
+	    cl_error (E_UERR, "ambiguous param field `%s'", f);
+
+	*f = fctbl[kentry];
+	return (YES);
+}
+
+
+/* Search though string table, tbl, for string s. last pointer in table
+ * should be NULL, ie, tbl[last] == NULL (not *tbl[last] == '\0').
+ * Settle for an abbreviation if they are enabled.  Return KWBAD if s
+ * simply not in tbl at all, KWAMBIG if abbreviations are enabled and more
+ * than one entry in tbl would match s, else the ordinal (index) into tbl
+ * at which s matched.
+ */
+int 
+keyword (register char *tbl[], register char *s)
+{
+	register int i;
+	register char *kentry;
+	int	cand, len;
+
+	i = 0;
+	cand = KWBAD;
+	len = strlen (s);
+
+	if (abbrev()) {
+	    for (kentry = tbl[0]; kentry; kentry = tbl[++i])
+		if (!strncmp (s, kentry, len)) {
+		    if (kentry[len] == '\0')
+			return (i); 		/* exact hit */
+		    if (cand == KWBAD)
+			cand = i;
+		    else
+			cand = KWAMBIG; 	/* might still hit exact */
+		}
+
+	} else for (kentry = tbl[0]; kentry; kentry = tbl[++i])
+	    if (!strcmp (s, kentry))
+		return (i);
+
+	return (cand);
+}
+
+
+/* Given a, possibly abbreviated, function name to run, look it up and
+ * run it if found. it gets nargs arguments from the operand stack.
+ */
+void 
+intrfunc (char *fname, int nargs)
+{
+	int	op_index, op;
+	int	i, n, subi[2];
+	int	trim_side = TRIM_LEFT|TRIM_RIGHT;
+	char	*trim = " \t";
+	char	sbuf[SZ_LINE+1];
+	struct	operand o;
+
+
+	op_index = keyword (ifnames, fname);
+	if (op_index == KWBAD)
+	    cl_error (E_UERR, "unknown function `%s'", fname);
+	if (op_index == KWAMBIG)
+	    cl_error (E_UERR, "ambiguous function `%s'", fname);
+
+	op = optbl[op_index];
+
+	/* if do this by shifting the cases and op to the right OP_BITS, this
+	 * will compile as a jump table. not worth it until it gets larger.
+	 */
+	switch (op & ~OP_MASK) {
+	case UNOP:
+	    if (nargs != 1)
+		cl_error (E_UERR, e_onearg, ifnames[op_index]);
+	    unop (op & OP_MASK);
+	    break;
+
+	case BINOP:
+	    if (nargs != 2)
+		cl_error (E_UERR, e_twoargs, ifnames[op_index]);
+	    binop (op & OP_MASK);
+	    break;
+
+	case MULTOP:
+            multop (op & OP_MASK, op_index, nargs);
+	    break;
+
+        case VOCOP:
+            vocop (op & OP_MASK, op_index, nargs);
+            break;
+
+        case SAMPOP:
+            sampop (op & OP_MASK, op_index, nargs);
+            break;
+
+	default:
+err:	    cl_error (E_IERR, e_badsw, op, "intrfunc()");
+	}
+}
+
+
+/* Convert string s to sexagesimal operand, of type OT_REAL.  Set opundef()
+ * if conversion is bad somehow.  Allow both h:m and h:m:s forms.
+ */
+struct operand 
+sexa (char *s)
+{
+	struct operand o;
+	int	n, sign;
+	int	hr, minutes;
+	float	sec;
+	extern double atof();
+
+	o.o_type = OT_REAL;
+	sign = (*s == '-') ? (s++, -1) : 1;
+
+	minutes = 0;
+	sec = 0.;
+	n = sscanf (s, "%d:%d:%hf", &hr, &minutes, &sec);
+	if (n < 1 || minutes < 0 || sec < 0)
+	    setopundef (&o);
+	else
+	    o.o_val.v_r = sign * (atof (s));
+	    /*  Old evaluation producing roundoff errors.
+	    o.o_val.v_r = sign*(hr + ((float)minutes)/60. + sec/3600.);
+	    */
+
+	return (o);
+}
+
+/* Convert a sexagesimal real back to an index range.
+ */
+void 
+sexa_to_index (double r, int *i1, int *i2)
+{
+	int	sgn;
+
+	if (r < 0) {
+	    sgn = -1;
+	    r = -r;
+	} else
+	    sgn = 1;
+
+	*i1 = (int) r;				/* add a little for round-off*/
+	*i2 = (int) (60.0e0 * (r - *i1) + .001);
+	*i1 =  sgn * *i1;
+}
+
+
+/* ADDPIPE -- Generate a new pipe file name and push it onto the pipe stack.
+ *   The strategy is to generate a unique pipefile name of the form "pipeXXX",
+ *   where XXX is an integer of 5 digits or less which is what is saved on the
+ *   pipe stack.  Return a pointer to the name of the new pipefile.
+ */
+char *
+addpipe (void)
+{
+	static	int pipecode = 0;
+	char	*pipefile();
+
+	if (pipecode == 0)
+	    pipecode = c_getpid();
+
+	/* Get unique pipefile name described by a simple integer.
+	 */
+	do {
+	   /*
+	    * There seems to be a problem with this code in the VMS compiler.
+	    * It has been changed to a form which will work for UNIX and VMS.
+	    *
+	    *	    pipecode = (pipecode++ % MAX_PIPECODE);
+	    */
+	    pipecode %= MAX_PIPECODE;
+
+	   /* There can be applications where multiple CL are spawned in
+	    * relatively short order so that the PIDs are close.  Incrementing
+	    * the least significant digits can result in duplications.  So
+	    * instead we use the lower digits as the "unique" part and
+	    * increment the higer digits.
+	    *
+	    *  pipecode++;
+	    */
+	    pipecode += 1000;
+
+	} while (c_access (pipefile(pipecode),0,0) == YES);
+
+	pipetable[nextpipe++] = pipecode;
+	if (nextpipe >= MAXPIPES)
+	    cl_error (E_UERR, "Too many pipes");
+
+	return (pipefile (pipecode));
+}
+
+
+/* GETPIPE -- Get the name of the last pipefile.
+ */
+char *
+getpipe (void)
+{
+	char	*pipefile();
+
+	if (nextpipe == 0)
+	    cl_error (E_IERR, "Pipestack underflow");
+	return (pipefile (pipetable[nextpipe-1]));
+}
+
+
+/* DELPIPES -- Delete N pipefiles (the actual file may not have been created
+ * yet), and pop N pipes off the pipe stack.  If N is zero, all pipefiles are
+ * deleted and the pipestack is cleared (i.e., during error recovery).
+ */
+void 
+delpipes (register int npipes)
+{
+	register int pipe;
+	char	*pipefile();
+
+	if (npipes == 0) {
+	    while (nextpipe > 0)
+		c_delete (pipefile (pipetable[--nextpipe]));
+	} else {
+	    while (npipes-- > 0) {
+		if ((pipe = --nextpipe) < 0)
+		    cl_error (E_IERR, "Pipestack underflow");
+		c_delete (pipefile (pipetable[pipe]));
+	    }
+	}
+}
+
+
+/* PIPEFILE -- Given the pipecode, format a pipefile name in static internal
+ * buffer and return pointer to pipefile name to caller.
+ */
+char *
+pipefile (int pipecode)
+{
+	static	char fname[SZ_PIPEFILENAME+1];
+	char	*dir;
+	char	*envget();
+
+	/* Put pipefiles in 'pipes' or 'uparm' if defined, else use tmp.  Do
+	 * not put pipe files in current directory or pipe commands will fail
+	 * when used in someone elses directory.
+	 */
+	if (envget ("pipes") != NULL)
+	    dir = "pipes$";
+	else if (envget ("uparm") != NULL)
+	    dir = "uparm$";
+	else
+	    dir = "tmp$";
+	sprintf (fname, "%spipe%d", dir, pipecode);
+
+	return (fname);
+}
+
+
+/* LOOPINCR -- increments the loop counter and stores the destination
+ * address for NEXT statements.  It should be called just before the
+ * destination is compiled.
+ */
+void 
+loopincr (void)
+{
+	if (nestlevel >= MAX_LOOP)
+	    cl_error (E_UERR, "Nesting too deeply.");
+
+	brkdest[nestlevel] = 0;
+	nextdest[nestlevel] = pc;
+	nestlevel++;
+}
+
+
+/* LOOPDECR -- decrements the loop counter, and if the break destination
+ * has been set it resolves the GOTO statement which has been made
+ * the target of BREAK's.
+ */
+void 
+loopdecr (void)
+{
+	int	p_goto;
+
+	p_goto = brkdest[--nestlevel];
+	if (p_goto != 0)
+	    coderef(p_goto)->c_args = pc - p_goto - SZ_CE;
+}
+
+
+/* SETSWITCH -- creates the jumptable which will be used in the SWITCH.
+ * On entry to setswitch the stack contains a pointer to the SWITCH
+ * operand, and pointers to the first and last operands of each
+ * CASE and DEFAULT block, i.e. the CASE and DEFAULT operands and the
+ * GOTO operands which terminate each block.
+ * The jumptable is created at the location of the current pc.
+ */
+void 
+setswitch (void)
+{
+	int	code, jmp, njump, assgn, oper, delta;
+
+	/* First get the size of the jump table by reading 
+	 * backwards on the stack until we find the switch
+	 * statement.
+	 */
+	oper = topcs;
+	code = coderef(stack[oper])->c_opcode;
+	njump = 2;
+
+	while (code != SWITCH) {
+	    if (code == CASE)
+		njump++;
+	    else if (code != GOTO  &&  code != DEFAULT)
+		cl_error (E_UERR, "Corrupt stack in SWITCH analysis.");
+
+	    oper++;
+	    code = coderef(stack[oper])->c_opcode;
+	}
+
+	assgn = stack[oper];
+
+	/* To create the jump table we read the control stack
+	 * to get the addresses of each of the case statements
+	 * and the default statement.  The values associated with
+	 * each case statement are stored in that operand.  The
+	 * addresses are popped and transferred to the jump table.
+	 * The first location in the jump table is reserved for
+	 * the DEFAULT statement and is 0 if this is not defined.
+	 * We know the size of the jump table, so as we pop off
+	 * the goto statements at the end of the CASE blocks
+	 * we can fill in the addresses.
+	 */
+	jmp = pc + 1;
+	oper = pop();
+	code = coderef(oper)->c_opcode;
+	stack[pc] = 0;
+
+	while (code != SWITCH) {
+
+	    switch (code) {
+	    case DEFAULT:
+		stack[pc] = oper-assgn;
+		break;
+
+	    case CASE:
+		stack[jmp++] = oper-assgn;
+		break;
+
+	    case GOTO:
+		delta = pc + njump - oper - SZ_CE;
+		coderef(oper)->c_args = delta;
+		break;
+
+	    default:
+		cl_error (E_UERR, "Corrupt stack in SWITCH analysis.");
+	    }
+
+	    oper = pop();
+	    code = coderef(oper)->c_opcode;
+	}
+
+	stack[jmp] = 0;			/* Fill in terminator. */
+
+	/* Put address of jump table in ASSIGN operand. 
+	 */
+	coderef(oper)->c_args = pc - oper;
+	pc += njump;
+
+	/* Fill in address of GOTO following ASSIGN. 
+	 */
+	oper += SZ_CE;
+	coderef(oper)->c_args = pc - oper - SZ_CE;
+}
+
+
+/* IN_SWITCH -- determines whether a CASE or DEFAULT block is
+ * legal at the current location.
+ */
+int 
+in_switch (void)
+{
+	int 	oper, code, oper2, code2, status;
+
+	oper = pop();
+	code = coderef(oper)->c_opcode;
+	status = 1;
+
+	switch (code) {
+	    case SWITCH:
+		push (oper);
+		break;
+
+	    case GOTO:
+		/* Previous operand must be DEFAULT or CASE.
+		 */
+		oper2 = pop();
+		code2 = coderef(oper2)->c_opcode;
+		if (code2 != CASE  &&  code2 != DEFAULT)
+		    status = 0;
+		push (oper2);
+		push (oper);
+		break;
+
+	    default:
+		status = 0;
+	    }
+
+	return (status);
+}
+
+
+/* CASESET -- Fill in the values for which the current case block is to be
+ * executed.
+ */
+void 
+caseset (memel *parg, int ncaseval)
+{
+	struct	operand	*o;
+	static	char *badcase = "Invalid case constant.";
+	int	ival;
+
+	for (ival = 0; ival < ncaseval; ival++) {
+	    memel p = pop();
+	    o = (struct operand *) p;
+
+	    if (o->o_type == OT_STRING) {
+		/* Only chars, not full strings.
+		 */
+		if (*o->o_val.v_s == 0)
+		    cl_error (E_UERR, badcase);
+		if (*(o->o_val.v_s + 1) != 0)
+		    cl_error (E_UERR, badcase);
+
+		*parg++ = (int) *o->o_val.v_s;
+
+	    } else if (o->o_type == OT_INT) {
+	        *parg++ = o->o_val.v_i;
+
+	    } else
+		cl_error (E_UERR, badcase);
+	}
+}
+
+
+/* SETLABEL -- called when a label is first seen. It allocates
+ * space for the label on the dictionary and also copies the
+ * label name onto the dictionary.  The label is placed at the
+ * top of a linked list.
+ */
+struct label *
+setlabel (struct operand *name)
+{
+	struct	label	*p;
+
+	p = (struct label *) memneed (sizeof(struct label));
+	p->l_name = comdstr (name->o_val.v_s);
+
+	if (label1 == NULL)
+	    p->l_next = NULL;
+	else
+	    p->l_next = label1;
+
+	label1 = p;
+	return (p);
+}
+
+
+/* GETLABEL -- returns the label struct corresponding to the string
+ * name, or NULL if the label has not been defined.
+ */
+struct label *
+getlabel (struct operand *name)
+{
+	struct	label	*l;
+
+	l = label1;
+	while (l != NULL) {
+	    if (!strcmp (name->o_val.v_s, l->l_name))
+		return (l);
+	    l = l->l_next;
+	}
+
+	return (NULL);
+}
+
+
+/* SETIGOTO -- maintains the list of indirect goto's.
+ * Note that an indirect GOTO is identical in format to a
+ * normal GOTO.  The argument, instead of pointing to the destination
+ * is used as the list pointer.  When the destination is defined,
+ * the GOTO is taken out of the indirect list.
+ */
+void 
+setigoto (int loc)
+{
+	if (igoto1 < 0)
+	    coderef(loc)->c_args = -1;
+	else
+	    coderef(loc)->c_args = igoto1;
+
+	igoto1 = loc;
+}
+
+
+/* UNSETIGOTO -- takes a GOTO out of the indirect list so that
+ * the target may be put in the argument.
+ */
+void 
+unsetigoto (int loc)
+{
+	int 	last, curr;
+
+	last = NULL;
+	curr = igoto1;
+
+	while (curr != loc) {
+	    last = curr;
+	    curr = coderef(curr)->c_args;
+	}
+
+	if (last == NULL)
+	    igoto1 = coderef(curr)->c_args;
+	else
+	    coderef(last)->c_args = coderef(curr)->c_args;
+}
+
+
+/* MAKE_IMLOOP -- compiles the meta-code for the indexing of arrays in
+ * implicit array loops e.g. a[*,5].
+ */
+int 
+make_imloop (int i1, int i2)
+{
+	int 	mode;
+
+	if (n_oarr) {
+	    /* Array limits already defined, check for agreement. 
+	     */
+	    if (i1 != oarr_beg[i_oarr] || i2 != oarr_end[i_oarr])
+		cl_error (E_UERR, "Inconsistent open refs.\n");
+	    mode = -1;
+	} else {
+	    oarr_beg[i_oarr] = i1;
+	    oarr_end[i_oarr] = i2;
+	    if (i_oarr)
+		mode = -1;
+	    else
+		/* This is the PUSHINDEX which will
+		 * initialize the loop variables.
+		 */
+		mode = 0;
+	}
+	i_oarr++;
+
+	return (mode);
+}
+
+
+/* Y_TYPEDEF -- Convert a type specifier keyword into a datatype code.
+ */
+int 
+y_typedef (char *key)
+{
+	if (strcmp (key, "string") == 0 || strcmp (key, "char") == 0)
+	    return (V_STRING);
+	else if (strcmp (key, "int") == 0)
+	    return (V_INT);
+	else if (strcmp (key, "real") == 0)
+	    return (V_REAL);
+	else if (strcmp (key, "bool") == 0)
+	    return (V_BOOL);
+	else if (strcmp (key, "file") == 0)
+	    return (V_FILE);
+	else if (strcmp (key, "gcur") == 0)
+	    return (V_GCUR);
+	else if (strcmp (key, "imcur") == 0)
+	    return (V_IMCUR);
+	else if (strcmp (key, "ukey") == 0)
+	    return (V_UKEY);
+	else if (strcmp (key, "pset") == 0)
+	    return (V_PSET);
+	else if (strcmp (key, "struct") == 0)
+	    return (V_STRUCT);
+	else
+	    cl_error (E_UERR, "illegal type specifier `%s'", key);
+	/*NOTREACHED*/
+	return (0);
+}
+
+
+/* P_POSITION -- Called when we get a syntax error in the parser.  Print
+ * the current cmdblk and point to the offending token.
+ */
+void 
+p_position (void)
+{
+	register int i;
+
+	eprintf ("**: %s    ", cmdblk);		/* '\n' in cmdblk */
+
+	for (i=0; i < err_cmdblk-cmdblk; i++)
+	    eprintf ("%c", ((cmdblk[i] == '\t') ? '\t' : ' ') );
+
+	eprintf ("^\n");
+}
diff --git a/pkg/vocl/grammar.h b/pkg/vocl/grammar.h
new file mode 100644
index 00000000..21d15e08
--- /dev/null
+++ b/pkg/vocl/grammar.h
@@ -0,0 +1,61 @@
+/*
+ * GRAMMAR.H -- Include stuff for parser and other grammar-related routines.
+ */
+
+/* fieldcvt() takes the p_xxx parameter field spec and replaces it with 
+ *   one of these field_name letters. this makes testing and using fields much
+ *   faster for paramget(), paramset(), etc.
+ * the letter is the first letter of the field, or the second if ambiguous.
+ * FN_NULL is to test when field came back from fieldcvt() unspecified.
+ *   or when calling paramset() or paramget() and you want the "worth" field.
+ * The aliases for p_value all use FN_VALUE. see fieldcvt() in gram.c.
+ */
+
+#define	FN_NAME		'N'
+#define	FN_TYPE		'T'
+#define	FN_MODE		'O'
+#define	FN_VALUE	'V'
+#define	FN_LENGTH	'L'
+#define	FN_MIN		'I'
+#define	FN_MAX		'A'
+#define	FN_PROMPT	'P'
+#define FN_XTYPE	'X'		/* Extended type (list, gcur, etc) */
+#define	FN_NULL		'\0'
+
+/* possible return values from keyword(), in gram.c. 
+ */
+#define	KWBAD		(-1)	/* keyword not found			*/
+#define	KWAMBIG		(-2)	/* keyword ambiguous			*/
+
+/* magic constants.
+ */
+#define	CL_EOF		(-2)	/* integer value of EOF in language	*/
+#define	CL_EOFSTR	"-2"	/* string equivalent of the above	*/
+#define	PBRACE		1000	/* start brace level in procedure	*/
+
+#define	NOLOG		0	/* do not save command block in logfile	*/
+#define	LOG		1	/* save command block in logfile	*/
+
+/* Constants determining how the parser is being called.		*/
+#define PARSE_PARAMS	0	/* Parsing parameters at beginning.	*/
+#define PARSE_BODY	1	/* Parsing body of script.		*/
+#define PARSE_FREE	2	/* Not a procedure script.		*/
+
+/* Command/compute mode status package.  The lexical mode may be set
+ * explicitly for a particular command input stream.  While in command
+ * mode (the default), the sequence #{ at the beginning of a line causes
+ * compute mode to be permanently set for that stream (e.g., in a comment
+ * at the head of a script file).  We use an otherwise unused bit in the
+ * stdio file descriptor flag word to record whether or not compute mode
+ * is set on a stream.
+ */
+#define	_LEXBIT			0100000
+#define	lex_setcpumode(fp)	((fp)->_fflags |= _LEXBIT)
+#define	lex_clrcpumode(fp)	((fp)->_fflags &= ~_LEXBIT)
+#define	lex_cpumodeset(fp)	((fp)->_fflags & _LEXBIT)
+
+extern int parse_state;			/* What are we parsing?	*/
+extern int proc_script;			/* In a procedure script? */
+extern struct pfile *parse_pfile;	/* Where parsed params are added. */
+
+char *today();				/* returns pointer to todays date */
diff --git a/pkg/vocl/grammar.l b/pkg/vocl/grammar.l
new file mode 100644
index 00000000..7a5f6adf
--- /dev/null
+++ b/pkg/vocl/grammar.l
@@ -0,0 +1,198 @@
+comment		"#"
+
+D		[0-9]
+H		[0-9a-fA-F]
+A		[a-zA-Z]
+
+%%
+
+[ \t]+		/* groups of blanks and tabs, while significant as delimiters,
+		 * are otherwise ignored.
+		 */ ;
+
+","[ \t]*\n	{	/* trailing ',' implies continuation */
+			return (',');
+		}
+
+"\\"[ \t]*\n	{	/* trailing '\' completely absorbed */
+		}
+^[ \t]*"!".*	{
+			/* Host os command escape.  Remove everything up through
+			 * '!'.  Let clsystem decide what to do with null cmd.
+			 * Must precede the "!" YOP_NOT spec in this file.
+			 */
+			register char *cp;
+			for (cp = yytext;  *cp++ != '!';  )
+			    ;
+			yylval = addconst (cp, OT_STRING);
+			return (Y_OSESC);
+		}
+
+
+"|&"		return (Y_ALLPIPE);	/* pipe all, even stderr	   */
+">>"		return (Y_APPEND);	/* append all but stderr	   */
+">>&"		return (Y_ALLAPPEND);	/* append all, even stderr	   */
+">&"		return (Y_ALLREDIR);	/* redirect all, even stderr	   */
+(">"|">>")("G"|"I"|"P")+ {
+			yylval = addconst (yytext, OT_STRING);
+			return (Y_GSREDIR);
+		}
+
+"<="		return (YOP_LE);	/* operators...			   */
+">="		return (YOP_GE);
+"=="		return (YOP_EQ);
+"!="		return (YOP_NE);
+"**"		return (YOP_POW);
+"||"		return (YOP_OR);
+"&&"		return (YOP_AND);
+"!"		return (YOP_NOT);
+"+="		return (YOP_AOADD);
+"-="		return (YOP_AOSUB);
+"*="		return (YOP_AOMUL);
+"/="		return (YOP_AODIV);
+"//="		return (YOP_AOCAT);
+"//"		return (YOP_CONCAT);
+
+"}"		{ if (dobrace) {
+			dobrace = NO;
+			return (*yytext);
+		  } else {
+			dobrace = YES;
+			unput (*yytext);
+			return (';');
+		  }
+		}
+
+
+"^"		return (*yytext);	/* debug: print stack		     */
+"/"		return (*yytext);	/* debug: single step		     */
+
+"?"		return (crackident (yytext));	/* current package help	     */
+"??"		return (crackident (yytext));	/* all tasks help	     */
+
+"&"		{	extern bracelevel;
+			if (bracelevel) {
+	    eprintf ("ERROR: background not allowed within statement block\n");
+			    return ('#');
+			} else {
+			    yyleng = 0;
+			    while ((yytext[yyleng]=input()) != '\n')
+				yyleng++;
+			    yytext[yyleng] = '\0';
+			    bkg_init (yytext);
+			    return (Y_NEWLINE);
+			}
+		}
+
+({A}|"$"|"_")({A}|"$"|{D}|"_"|".")*	{
+			/* crackident() sets yylval and returns token value.
+			 */
+			return (crackident (yytext));
+		}
+
+{D}+(([bB])|({H}*[xX]))?	{
+			/* must precede OT_REAL as integers also match there */
+			yylval = addconst (yytext, OT_INT);
+			return (Y_CONSTANT);
+		}
+(({D}+)|(({D}*"."{D}+)|({D}+"."{D}*)))([eEdD][+-]?{D}+)? {
+			yylval = addconst (yytext, OT_REAL);
+		 	return (Y_CONSTANT);
+		}
+
+{D}+":"{D}+(":"{D}*("."{D}*)?)? {
+			/* sexagesimal format */
+			yylval = addconst (yytext, OT_REAL);
+			return (Y_CONSTANT);
+		}
+
+(\")|(\')	{	/* Quoted string.  call traverse() to read the
+			 * string into yytext.
+			 */
+			traverse (*yytext);
+			yylval = addconst (yytext, OT_STRING);
+			return (Y_CONSTANT);
+		}
+
+\n		return (Y_NEWLINE);
+
+{comment}	{	/* Ignore a comment. */
+			while (input() != '\n')
+			    ;
+			unput ('\n');
+		}
+
+.		return (*yytext);
+
+%%
+
+#include "errs.h"
+
+/* See gram.c for the various support functions, such as addconst()
+ * and crackident().  Traverse is included here since it directly
+ * references input, unput, yytext, etc.
+ */
+
+/* TRAVERSE -- Called by the lexical analyzer when a quoted string has
+ * been recognized.  Characters are input and deposited in yytext (the
+ * lexical analyzer token buffer) until the trailing quote is seen.
+ * Strings may not span lines unless the newline is delimited.  The
+ * recognized escape sequences are converted upon input; all others are
+ * left alone, presumably to later be converted by other code.
+ * Quotes may be included in the string by escaping them, or by means of
+ * the double quote convention.
+ */
+traverse (delim)
+char	delim;
+{
+	register char *op, *cp, ch;
+	static	char *esc_ch  = "ntfr\\\"'";
+	static	char *esc_val = "\n\t\f\r\\\"\'";
+	char	*index();
+
+	for (op=yytext;  (*op = input()) != EOF;  op++) {
+	    if (*op == delim) {
+		if ((*op = input()) == EOF)
+		    break;
+		if (*op == delim)
+		    continue;	/* double quote convention; keep one */
+		else {
+		    unput (*op);
+		    break;			/* normal exit	*/
+		}
+
+	    } else if (*op == '\n') {		/* error recovery exit	*/
+		*op = '\0';
+		cl_error (E_UERR, "Newline while processing string");
+		break;
+
+	    } else if (*op == '\\') {
+		if ((*op = input()) == EOF) {
+		    break;
+		} else if (*op == '\n') {
+		    --op;			/* explicit continuation */
+		    while ((ch = input()) && isspace(ch) || ch == '#') {
+			if (ch == '#')
+			    while ((ch = input()) && ch != '\n')
+				;
+		    }
+		    unput (ch);
+		    continue;
+		} else if ((cp = index (esc_ch, *op)) != NULL) {
+		    *op = esc_val[cp-esc_ch];
+		} else if (isdigit (*op)) {	/* '\0DD' octal constant   */
+		    *op -= '0';
+		    while (isdigit (ch = input()))
+			*op = (*op * 8) + (ch - '0');
+		    unput (ch);
+		} else {
+		    ch = *op;			/* unknown escape sequence, */
+		    *op++ = '\\';		/* leave it alone.	    */
+		    *op = ch;
+		}
+	    }
+	}
+
+	*op = '\0';
+	yyleng = (op - yytext);
+}
diff --git a/pkg/vocl/grammar.y b/pkg/vocl/grammar.y
new file mode 100644
index 00000000..b6c56656
--- /dev/null
+++ b/pkg/vocl/grammar.y
@@ -0,0 +1,2108 @@
+%{
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "clmodes.h"
+#include "task.h"
+#include "construct.h"
+#include "errs.h"
+
+
+/* CL parser, written as a yacc grammar:
+ *   build up an (rpn) instruction sequence begining at the base of the
+ *   operand stack as the grammar is recognized.
+ *
+ * The parser may be called during parameter initialization (initiated by
+ * the CALL meta-code instruction), and to parse the executable portion
+ * (from the EXEC instruction).
+ *
+ * CONSTANT's are put on the dictionary by addconst() rather than the operand
+ *   stack to avoid conflict with the code being created.  They are accessed
+ *   by using the yylval of IDENT and CONSTANT as dictionary indices that
+ *   point to struct operands.  This is facilitated with the stkop() macro.
+ *   Make sure that topd and topcs are restored on return to discard these
+ *   temporaries.
+ * When building offsets for branches, such as BIFF and GOTO, allow
+ *   for the advancement of the pc by the size of the instruction (in ints).
+ *   See opcodes.c for the code executed by the branch instructions.
+ */
+
+extern	int cldebug;
+#define	lint			/* turns off sccsid in Yacc parser	*/
+
+/* shorthand way to get at operands in dictionary. x will be values returned
+ * from addconst() by way of $n's from CONSTANT and IDENT tokens; see gram.c
+ * and its uses in grammar.l. also see pushop() for a description of the stack.
+ */
+#define	stkop(x)	(reference (operand, (x)))
+
+int	dobkg 		= 0;	/* set when want to do code in bkground	*/
+int	npipes 		= 0;	/* number of pipes in a command		*/
+XINT	pipe_pc		= 0;	/* pc of last ADDPIPE instruction	*/
+int	posit 		= 0;	/* positional argument count		*/
+int	inarglist 	= 0;	/* set when in argument list		*/
+int	parenlevel 	= 0;	/* level of paren nesting in command	*/
+int 	in_iferr 	= 0;	/* in an iferr block			*/
+int	cl_level	= 0;	/* CL calling level			*/
+
+int	index_cnt;		/* Index counter in array ref's		*/
+char	curr_param[SZ_FNAME];	/* Parameter name of ref's		*/
+char	curr_task[SZ_FNAME];	/* ltaskname of command 		*/
+XINT	stmt_pc;		/* PC at beginning of current statement */
+int	varlist;		/* Declaration is list directed.	*/
+int	vartype;		/* Type of declaration.			*/
+int	do_params;		/* Are param definitions legal here?	*/
+int	errcnt;			/* Syntax error count.			*/
+int	inited;			/* Was variable already initialized.	*/
+struct	param *pp;		/* Pointer to param being compiled.	*/
+int	n_aval;			/* Number of array init values.		*/
+int	lastref;		/* Was last ref an array?		*/
+int	for_expr;		/* Was there an expression in FOR?	*/
+char	*ifseen;		/* Have we just processed an IF?	*/
+char	*errmsg;		/* Syntax error message.		*/
+
+/* context-sensitive switches. technique is ok, but beware of nesting!
+ */
+static	int absmode 	= 0;	/* set by first absolute mode arg in cmd*/
+static	int newstdout 	= 0;	/* set if stdout redirected in arg	*/
+static	int bracelevel 	= 0;	/* set while in s_list to inhibit &	*/
+static	int tbrace 	= 0;	/* fake braces for declarations		*/
+static	int dobrace 	= 0;	/* handling braces.			*/
+static	int sawnl 	= 0;	/* set when EOST was \n, else 0		*/
+static	int printstmt 	= 0;	/* set when parsing FPRINT statement	*/
+static	int scanstmt 	= 0;	/* set when parsing SCAN statement	*/
+static	int iferr_tok 	= 0;	/* iferr/ifnoerr token type seen	*/
+
+/* printf-format error messages.
+ */
+char *arrdeferr   = "Error in array initialization for `%s'.";
+char *badparm     = "Parameter definition of `%s' is illegal here.";
+char *inval_arr   = "Invalid array type for `%s'.";
+char *inv_index   = "Invalid index definition for `%s'.";
+char *twoinits    = "Two initializations for parameter `%s'.";
+
+char *exlimits    = "Explicit range required for loop in external param.";
+char *illegalvar  = "Illegal variable declarations.";
+char *locallist   = "Local list variables are not permitted.";
+char *nestediferr = "Nested iferr not allowed in test or handler block.";
+char *posfirst    = "All positional arguments must be first";
+
+
+extern	char	cmdblk[SZ_CMDBLK+1];	/* Command buffer in history.c */
+extern	char	*ip_cmdblk;		/* Pointer to current char in command.*/
+extern	char	*err_cmdblk;		/* ip_cmdblk when error detected. */
+
+char	*index();
+struct	param *initparam();
+struct	label *getlabel(), *setlabel();
+
+/* arbitrary large number for bracelevel in a procedure script 
+ */
+#define MAX_ERR    10
+#define EYYERROR  { err_cmdblk = ip_cmdblk; YYERROR; }
+
+%}
+
+%token	Y_SCAN Y_SCANF Y_FSCAN Y_FSCANF Y_OSESC 
+%token	Y_APPEND Y_ALLAPPEND Y_ALLREDIR Y_GSREDIR Y_ALLPIPE
+%token	D_D D_PEEK
+%token	Y_NEWLINE Y_CONSTANT Y_IDENT
+%token	Y_WHILE Y_IF Y_ELSE
+%token  Y_FOR Y_BREAK Y_NEXT
+%token  Y_SWITCH Y_CASE Y_DEFAULT
+%token	Y_RETURN Y_GOTO
+%token	Y_PROCEDURE Y_BEGIN Y_END 
+%token	Y_BOOL Y_INT Y_REAL Y_STRING Y_FILE Y_STRUCT
+%token	Y_GCUR Y_IMCUR Y_UKEY Y_PSET
+%token	Y_IFERR Y_IFNOERR Y_THEN
+
+%right	'=' YOP_AOADD YOP_AOSUB YOP_AOMUL YOP_AODIV YOP_AOCAT
+%left	YOP_OR
+%left	YOP_AND
+%left	YOP_EQ YOP_NE 
+%left	'<' '>' YOP_LE YOP_GE
+%left	YOP_CONCAT
+%left	'+' '-'
+%left	'*' '/' '%'
+%left	YOP_NOT UMINUS		/* supplies precedence for unary minus	*/
+%left	YOP_POW
+
+%start	block
+
+%%
+
+block	:	/* empty */ {
+		    /* Done once on entry but after at least one call to
+		     * yylex().  Good for initing parser flags.
+		     * Note: this does not get called in procedure scripts.
+		     */
+		    if (cldebug)
+			eprintf ("parse init (block)...\n");
+
+		    errcnt     = 0;
+		    err_cmdblk = 0;
+		    dobkg      = 0;
+		    inarglist  = 0;
+		    parenlevel = 0;
+		    bracelevel = 0;
+		    tbrace     = 0;
+		    dobrace    = 0;
+		    in_iferr   = 0;
+		    do_params  = YES;
+		    last_parm  = NULL;
+		    ifseen     = NULL;
+		    label1     = NULL;
+		    errmsg     = NULL;
+		    parse_pfile= currentask->t_pfp;
+		}
+
+	|	'.' NL {
+		    /* Prepare to rerun whatever was compiled last.
+		     * Does not work for the debug commands builtin here.
+		     */
+		    if (parse_state != PARSE_FREE) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		    rerun();
+		    YYACCEPT;
+		}
+
+	|	block {
+		    if (parse_state == PARSE_PARAMS) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		}
+		debug xstmt {
+		    if (sawnl && bracelevel == 0) {
+			if (!errcnt)
+			    compile (END);
+			if (ifseen) {
+			    /* Simulate an unput of what has been read
+			     * from the current line.
+			     */
+			    ip_cmdblk = ifseen;
+			}
+			YYACCEPT;
+		    }
+		}
+
+	|	script_params {
+		    /* Parse the parameters in a script file.  This will
+		     * normally be done on a call by pfileread().
+		     */
+		    if (parse_state != PARSE_PARAMS) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    YYACCEPT;
+		}
+
+	|	script_body {
+		    /* Parse the executable statements in a script.
+		     */
+		    if (parse_state != PARSE_BODY) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    if (!errcnt)
+			compile (END);
+		    YYACCEPT;
+		}
+
+	|	error NL {
+		    /* This catches errors that the two other error lines
+		     * can't get, e.g. a missing `}' at the end of a script, 
+		     * or errors occuring in interactive input.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.
+		     */
+		    p_position();
+		    if (currentask->t_flags & T_SCRIPT) 
+			cl_error (E_UERR, "syntax error, line %d",
+			    currentask->t_scriptln);
+		    else
+			cl_error (E_UERR, "syntax error");
+
+		    YYACCEPT;
+		}
+	;
+
+debug	:	/* empty */
+	|	D_XXX EOST {
+		    /* debug are those debugging functions that
+		     * should be run directly and not through a
+		     * builtin task due to stack or other changes,
+		     * ie, don't change what we are trying to show.
+		     */
+		    printf ("\n");
+		} debug
+	;
+
+D_XXX	:	D_D {
+		    d_d(); /* show dictionary/stack pointers */
+		}
+	|	D_PEEK Y_CONSTANT { /* show a dictionary location	*/
+		    if (stkop($2)->o_type & OT_INT) {
+			int	idx;
+			idx = stkop($2)->o_val.v_i;
+			eprintf ("%d:\t%d (0%o)\n", idx, stack[idx],
+				stack[idx]);
+		    } else
+			eprintf ("usage: D_PEEK <d. index>\n");
+		}
+	|	'~' {
+		    d_stack (pc, 0, 0);		/* show compiled code	*/
+		}
+	;
+
+script_params :	proc_stmt
+		var_decls
+		begin_stmt { 
+			/* Check for required params.
+			 */
+			if (!errcnt)
+			    proc_params(n_procpar);
+		}
+	;
+
+script_body:	begin_stmt {
+			/* Initialize parser for procedure body.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (script_body)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+		        in_iferr   = 0;
+			dobrace    = 0;
+			bracelevel = PBRACE; /* disable lexmodes; force "end" */
+			tbrace     = 0;
+ 			do_params  = NO;
+			last_parm  = NULL;
+			ifseen     = NULL;
+			label1     = NULL;
+			parse_pfile= currentask->t_pfp;
+		}
+		s_list
+		opnl
+		end_stmt
+	;
+
+proc_stmt:	Y_PROCEDURE {  
+			/* Initialize parser for procedure parameters.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (proc_stmt)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+			bracelevel = PBRACE;
+			tbrace     = 0;
+		        dobrace    = 0;
+		        in_iferr   = 0;
+			do_params  = YES;
+		        last_parm  = NULL;
+			label1     = NULL;
+		}
+		param bparam_list EOST
+	;
+
+bparam_list:	/* Nothing at all, not even parens. */
+		{
+		    n_procpar = 0;
+		}
+	|	LP param_list RP
+	;
+
+/* The definition of the parameter list excludes lists of the 
+ * form  a,,b
+ */
+param_list:	/* empty */ {
+		    n_procpar = 0;
+		}
+	|	xparam_list
+	;
+
+xparam_list:	param { 
+		    n_procpar = 1;
+		    if (!errcnt)
+			push (stkop($1));
+		}
+	|	xparam_list DELIM param {
+		    n_procpar++;
+		    if (!errcnt)
+			push (stkop($3));
+		}
+	;
+
+var_decls:	/* No params. */
+	|	var_decl_block
+	;
+
+var_decl_block:	var_decl_line
+	|	var_decl_block var_decl_line
+	;
+
+var_decl_line:	EOST	/* Blank. */
+	|	var_decl_stmt
+	|	error NL {
+		    /* This catches errors in the parameter declarations
+		     * of a procedure script.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.  We know
+		     * we're parsing a procedure script, so print the line
+		     * number too.
+		     */
+		    p_position();
+		    cl_error (E_UERR, "syntax error, line %d", 
+			currentask->t_scriptln);
+		}
+	;
+
+var_decl_stmt:	typedefs {
+	 	        /* For in-line definitions we don't want
+			 * to freeze stuff on the dictionary, so
+			 * only allow additions if the dictionary
+			 * is the same as at the beginning of the task.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				if (currentask->t_topd != topd)
+				    cl_error (E_UERR, illegalvar);
+				last_parm = currentask->t_pfp->pf_lastpp;
+			    }
+			}
+
+		        /* Increment bracelevel temporarily to defeat command
+			 * mode, in case this is an in-line declaration and
+			 * lexmodes=yes.
+			 */
+			bracelevel += PBRACE;
+			tbrace++;
+
+		} var_decl_list EOST {
+		      	/* Update dictionary to include these definitions.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				currentask->t_topd = topd;
+				last_parm = 0;
+			    }
+			}
+
+			/* Restore command mode */
+			bracelevel -= PBRACE;
+			tbrace--;
+		}
+	;
+
+typedefs:	Y_BOOL		{ vartype = V_BOOL; }
+	|	Y_STRING	{ vartype = V_STRING; }
+	|	Y_REAL		{ vartype = V_REAL; }
+	|	Y_FILE		{ vartype = V_FILE; }
+	|	Y_GCUR		{ vartype = V_GCUR; }
+	|	Y_IMCUR		{ vartype = V_IMCUR; }
+	|	Y_UKEY		{ vartype = V_UKEY; }
+	|	Y_PSET		{ vartype = V_PSET; }
+	|	Y_INT		{ vartype = V_INT; }
+	|	Y_STRUCT	{ vartype = V_STRUCT; }
+	;
+
+var_decl_list:	var_decl_plus
+	|	var_decl_plus DELIM var_decl_list
+	;
+
+var_decl_plus:	var_decl {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, inited);
+			    }
+			}
+		}
+
+		/* Semi-colon in following rule is not input by user, but
+		 * rather by lexical analyzer to help close compound
+		 * statements.
+		 */
+	|	var_decl '{' options_list ';' '}'  {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (!do_params)
+				    cl_error (E_UERR, badparm, pp->p_name);
+
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, n_aval);
+			    }
+			}
+		}
+	;
+
+var_decl:	var_def {
+			inited = NO;
+			n_aval = 0;
+		}
+	|	var_def '=' {
+			n_aval = 0;
+		}
+		init_list {
+			inited = YES;
+		}
+	;
+
+var_def	:	var_name {
+		    index_cnt = 0;
+		    if (!errcnt)
+			pp = initparam (stkop($1), do_params, vartype, varlist);
+		}
+	|	var_name {
+		    int  itemp;
+
+		    if (!errcnt) {
+			pp = initparam (stkop($1), do_params, vartype, varlist);
+
+			if (pp != NULL) {
+			    itemp = (pp->p_type & OT_BASIC) == pp->p_type;
+			    itemp = itemp && !varlist;
+			    if (itemp)
+				pp->p_type |= PT_ARRAY;
+			    else
+				cl_error (E_UERR, inval_arr, pp->p_name);
+			}
+		    }
+		}
+		'[' init_index_list ']'
+	;
+
+var_name:	param {
+			varlist = NO;
+			index_cnt = 0;
+		}
+	|	'*' param {
+			if (!do_params) {
+			    errmsg = locallist;
+			    EYYERROR;
+			}
+			varlist = YES;
+			index_cnt = 0;
+			$$ = $2;
+		}
+	;
+
+init_index_list:
+		/* A null index list means get the length of the array 
+		 * from the initializer.
+		 */
+	|	init_index_range
+	|	init_index_list DELIM init_index_range
+	;
+
+init_index_range:
+		const {
+		    if (!errcnt) {
+			if (pp != NULL) {
+			    if (stkop($1)->o_type == OT_INT) {
+				push (stkop($1)->o_val.v_i);
+				push (1);
+			    } else if (maybeindex) {
+				/* Confusion between sexagesimal and index
+				 * range.  Maybeindex is set only when operand
+				 * is real.
+			 	 */
+				int  i1,i2;
+				sexa_to_index (stkop($1)->o_val.v_r, &i1, &i2);
+				push (i2-i1+1);
+				push (i1);
+			    } else {
+				eprintf (inv_index, pp->p_name);
+				EYYERROR;
+			    }
+			    index_cnt++;
+			}
+		    }
+		}
+	|	const ':' const {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (stkop($1)->o_type != OT_INT  ||
+				    stkop($3)->o_type != OT_INT)
+				    cl_error (E_UERR, inv_index, pp->p_name);
+				else {
+				    push (stkop($3)->o_val.v_i -
+				          stkop($1)->o_val.v_i + 1);
+				    push (stkop($1)->o_val.v_i);
+			        }
+			        index_cnt++;
+			    }
+			}
+		}
+	;
+
+init_list:	init_elem
+	|	init_list DELIM	init_elem
+	;
+
+init_elem:	const {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				push (stkop($1) );
+				n_aval++;
+			    }
+			}
+		}
+	|	Y_CONSTANT LP const RP  /* PL/I notation. */
+		{
+			int   cnt;
+			
+			if (!errcnt)
+			    if (pp != NULL) {
+			    	if (stkop($1)->o_type != OT_INT)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        cnt = stkop($1)->o_val.v_i;
+			        if (cnt <= 0)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        while (cnt-- > 0) {
+				    push (stkop($3));
+				    n_aval++;
+			        }
+			    }
+		}
+	;
+
+const	:	Y_CONSTANT
+	|	number
+	;
+
+/* The parser and lexical analyzer don't see negative numbers as an
+ * entity.  So we must join signs to their constants.
+ */
+number	:	sign Y_CONSTANT {
+		      	if (stkop($2)->o_type == OT_INT) {
+			    stkop($2)->o_val.v_i *= $1;
+			    $$ = $2;
+			} else if (stkop($2)->o_type == OT_REAL) {
+			    stkop($2)->o_val.v_r *= $1;
+			    $$ = $2;
+			} else {
+			    errmsg = "Invalid constant in declaration.";
+			    EYYERROR;
+			}
+		}
+	;
+
+sign	:	'+'	{ $$ =  1; }
+	|	'-'	{ $$ = -1; }
+
+options_list:	init_list DELIM options {
+			/* Check if we already had an initialization. 
+			 */
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+				eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+	|	init_list {
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+			        eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+	|	options
+	;
+
+options	:	option
+	|	options DELIM option
+	;
+
+option	:	Y_IDENT '=' const {
+			if (!errcnt)
+			    if (pp != NULL)
+			    	do_option (pp, stkop($1), stkop($3));
+		}
+	;
+
+begin_stmt:	Y_BEGIN NL
+	;
+
+/* In normal expressions, a param means the name of a parameter, but in
+ * command line arguments, it may be a string constant.  Pull out param
+ * from expr to let the arg rule deal with it specially.
+ */
+
+expr	:	expr0
+	|	ref {
+		    if (!errcnt)
+		        compile (PUSHPARAM, stkop($1)->o_val.v_s);
+		}
+	;
+
+/* EXPR0 is everything but a simple parameter.  This is needed for argument
+ * lists so that a simple parameter may be treated as a special case of a
+ * string constant.  EXPR1 also excludes constants.  This is needed
+ * to eliminate ambiguities in the grammar which would arise from
+ * the handling of the lexical ambiguity of sexagesimal constants
+ * and array index ranges.
+ */
+expr0	:	expr1
+	|	Y_CONSTANT {
+		    if  (!errcnt)
+		        compile (PUSHCONST, stkop($1));
+		}
+	|	Y_GCUR {
+		    /* "gcur" is both a keyword and a CL global parameter,
+		     * and must be built into the grammar here to permit
+		     * reference of the parameter in expressions.
+		     */
+		    if (!errcnt)
+			compile (PUSHPARAM, "gcur");
+		}
+	|	Y_IMCUR {
+		    if (!errcnt)
+			compile (PUSHPARAM, "imcur");
+		}
+	|	Y_UKEY {
+		    if (!errcnt)
+			compile (PUSHPARAM, "ukey");
+		}
+	|	Y_PSET {
+		    if (!errcnt)
+			compile (PUSHPARAM, "pset");
+		}
+	;
+
+expr1	:	LP expr RP
+
+	|	expr '+' opnl expr {
+		    if (!errcnt)
+			compile (ADD);
+		}
+	|	expr '-' opnl expr {
+		    if (!errcnt)
+			compile (SUB);
+		}
+	|	expr '*' opnl expr {
+		    if (!errcnt)
+			compile (MUL);
+		}
+	|	expr '/' opnl expr {
+		    if (!errcnt)
+			compile (DIV);
+		}
+	|	expr YOP_POW opnl expr {
+		    if (!errcnt)
+			compile (POW);
+		}
+	|	expr '%' opnl expr {
+		    struct	operand o;
+		    if (!errcnt) {
+			o.o_type = OT_INT;
+			o.o_val.v_i = 2;
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, "mod");
+		    }
+		}
+	|	expr YOP_CONCAT opnl expr {
+		    if (!errcnt)
+			compile (CONCAT);
+		}
+	|	expr '<' opnl expr {
+		    if (!errcnt)
+			compile (LT);
+		}
+	|	expr '>' opnl expr {
+		    if (!errcnt)
+			compile (GT);
+		}
+	|	expr YOP_LE opnl expr {
+		    if (!errcnt)
+			compile (LE);
+		}
+	|	expr YOP_GE opnl expr {
+		    if (!errcnt)
+			compile (GE);
+		}
+	|	expr YOP_EQ opnl expr {
+		    if (!errcnt)
+			compile (EQ);
+		}
+	|	expr YOP_NE opnl expr {
+		    if (!errcnt)
+			compile (NE);
+		}
+	|	expr YOP_OR opnl expr {
+		    if (!errcnt)
+			compile (OR);
+		}
+	|	expr YOP_AND opnl expr {
+		    if (!errcnt)
+			compile (AND);
+		}
+	|	YOP_NOT expr {
+		    if (!errcnt)
+			compile (NOT);
+		}
+	|	'-' expr %prec UMINUS {
+		    if (!errcnt)
+			compile (CHSIGN);
+		}
+
+	|	Y_SCAN LP {
+		    /* Free format scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (SCAN);
+		    }
+		}
+	|	Y_SCANF LP {
+		    /* Formatted scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanfmt DELIM scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (SCANF);
+		    }
+		}
+
+	|	Y_FSCAN LP {
+		    /* Free format scan from a parameter.  */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (FSCAN);
+		    }
+		}
+
+	|	Y_FSCANF LP Y_IDENT DELIM {
+		    /* Formatted scan from a parameter.
+		     * fscanf (param, format, arg1, ...)
+		     */
+		    if (!errcnt) {
+			compile (PUSHCONST, stkop ($3));
+		        push (1);	/* use control stack to count args */
+		    }
+		} scanfmt DELIM scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (FSCANF);
+		    }
+		}
+
+	|	intrinsx LP {
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} intrarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, stkop($1)->o_val.v_s);
+		    }
+		}
+	;
+
+/* Variable types are keywords, so any types which are also intrinsic
+ * functions are added here.
+ */
+intrinsx:	intrins
+	|	Y_INT {
+			/* The YACC value of this must match normal intrinsics
+			 * so we must generate an operand with the proper
+			 * string. 
+			 */
+			if (!errcnt)
+			    $$ = addconst ("int", OT_STRING);
+		}
+	|	Y_REAL {
+			if (!errcnt)
+			    $$ = addconst ("real", OT_STRING);
+		}
+	;
+
+scanfmt	:	expr {
+		    if (!errcnt) {
+		        push (pop() + 1);		/* inc num args	*/
+		    }
+		}
+	;
+
+scanarg	:	/* empty.  This is bad for scan but we don't want to
+		 * generate a cryptic syntax error.  See also intrarg.
+		 * This rule reduces the strings from right to left.
+		 * Note the lexical analyzer strips optional newlines
+		 * after comma delimiters, so we don't need an opnl here.
+		 */
+	|	Y_IDENT {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ($1));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+	|	Y_IDENT DELIM scanarg {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ($1));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+	;
+
+intrarg	:	/* empty. this is to allow () but it also allows
+		 * (x,,x). may want to prune this out.
+		 */
+	|	expr {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+	|	intrarg DELIM expr {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+	;
+
+
+/* Statements. */
+
+stmt	:	c_stmt
+	|	assign	EOST
+	|	cmdlist EOST
+	|	immed	EOST
+	|	inspect	EOST
+	|	osesc	EOST
+	|	popstk	EOST
+	|	if
+	|	ifelse
+	|	iferr
+	|	iferr_else
+	|	while
+	|	for
+	|	switch
+	|	case
+	|	default
+	|	next	EOST
+	|	break	EOST
+	|	goto	EOST
+	|	return	EOST
+	|	label_stmt
+	|	nullstmt
+	;
+
+		/* A compound statement may be followed by zero or one 
+		 * newlines.
+		 */
+c_stmt	:	c_blk
+	|	c_blk NL
+	;
+
+c_blk	:	'{' {
+		    bracelevel++;
+		} s_list opnl {
+		    --bracelevel;
+		} '}'
+	;
+
+s_list	:	/* empty */
+	|	s_list opnl xstmt
+	;
+
+/* Put "implicit" parentheses around right hand side of assignments to
+ * permit easy arithmetic even with lexmodes=yes.
+ */
+assign	:	ref equals expr0 {
+			--parenlevel;
+ 			if (!errcnt)
+		      	    compile (ASSIGN, stkop($1)->o_val.v_s);
+		}
+	|	ref equals ref {
+			/* Old code pushed a constant rather than a param
+			 * when not within braces.  This doesn't seem
+			 * to be what most people want.
+			 */
+			--parenlevel;
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop($3)->o_val.v_s);
+		            compile (ASSIGN, stkop($1)->o_val.v_s);
+		    	}
+		}
+	|	ref {
+			parenlevel++;
+		}
+		assign_oper expr {
+		      	--parenlevel;
+			if (!errcnt)
+		  	    compile ($3, stkop($1)->o_val.v_s);
+		}
+	;
+
+	/* Breaking out the '=' avoids grammar ambiguities.
+	 */
+equals	:	'=' {
+			parenlevel++;
+		}
+	;
+
+assign_oper:	YOP_AOADD 	{ $$ = ADDASSIGN; }
+	|	YOP_AOSUB 	{ $$ = SUBASSIGN; }
+	|	YOP_AOMUL 	{ $$ = MULASSIGN; }
+	|	YOP_AODIV 	{ $$ = DIVASSIGN; }	
+	|	YOP_AOCAT 	{ $$ = CATASSIGN; }	
+	;
+
+cmdlist	:	command {
+		    npipes = 0;
+		} cmdpipe {
+		    if (!errcnt) {
+			compile (EXEC);
+			if (npipes > 0)
+			    compile (RMPIPES, npipes);
+		    }
+		}
+	;
+
+cmdpipe	:	/* empty */
+	|	cmdpipe pipe {
+		    /* Pipefiles must be allocated at run time using a stack
+		     * to permit pipe commands within loops, and to permit
+		     * scripts called in a pipe to themselves contain pipe
+		     * commands.  ADDPIPE allocates a new pipefile on the
+		     * pipe stack and pushes its name on the operand stack.
+		     * GETPIPE pushes the pipefile at the top of the pipe
+		     * stack onto the operand stack.  RMPIPES removes N pipes
+		     * from the pipe stack, and deletes the physical pipefiles.
+		     */
+
+		    if (!newstdout) {
+			/* When the runtime code creates the pipe it needs to
+			 * know the identity of the two tasks sharing the pipe
+			 * to determine what type of pipe to create (text or
+			 * binary).  Save the pc of the ADDPIPE instruction
+			 * so that we can backpatch it below with a pointer to
+			 * the name of the second task in the pipe (ADDPIPE
+			 * will be called during startup of the first task
+			 * hence will know its name).
+			 */
+			pipe_pc = compile (ADDPIPE, NULL);
+
+			if ($2 == 1)
+			    compile (REDIR);
+			else
+			    compile (ALLREDIR);
+			compile (EXEC);
+
+		    } else {
+			eprintf ("multiple redirection\n");
+			YYERROR;
+		    }
+
+		} command {
+		    /* Compile the GETPIPE instruction with the name of the
+		     * second task in the current pipe, and backpatch the
+		     * matching ADDPIPE instruction with the PC of the GETPIPE.
+		     */
+		    (coderef(pipe_pc))->c_args = compile (GETPIPE, curr_task);
+		    compile (REDIRIN);
+		    npipes++;		/* Overflow checking is in ADDPIPE */
+		}
+	;
+
+pipe	:	'|' opnl {
+		    $$ = 1;
+		}
+	|	Y_ALLPIPE opnl {
+		    $$ = 2;
+		}
+	;
+
+command	:	tasknam {
+		    char    *ltname;
+
+		    ltname = stkop($1)->o_val.v_s;
+		    compile (CALL, ltname);
+		    strcpy (curr_task, ltname);
+
+		    /* The FPRINT task is special; the first arg
+		     * is the destination and must be compiled as
+		     * a string constant no matter what.  Set flag
+		     * so that 'arg' compiles PUSHCONST.
+		     */
+		    printstmt = (strcmp (ltname, "fprint") == 0);
+
+		    /* Ditto with SCAN; all the arguments are call by
+		     * reference and must be compiled as string constants.
+		     */
+		    scanstmt = (strcmp (ltname, "scan") == 0 ||
+				strcmp (ltname, "scanf") == 0);
+
+		    absmode = 0;
+		    posit = 0;
+		    newstdout = 0;
+		    parenlevel = 0;
+		} BARG {
+		    inarglist = 1;
+		} args EARG {
+		    extern char *onerr_handler;
+
+		    inarglist = 0;
+		    parenlevel = 0;
+		    scanstmt = 0;
+		}
+	;
+
+args	:	DELIM {
+		    /* (,x) equates to nargs == 2.  Call posargset with
+		     * negative dummy argument to bump nargs.
+		     */
+		    if (!errcnt) {
+			compile (POSARGSET, -1);
+			posit++;
+			printstmt = 0;
+			scanstmt = 0;
+		    }
+		} arglist	
+	|	arglist
+	;
+
+arglist	:	arg 
+	|	arglist DELIM arg
+	;
+
+arg	:	/* nothing - compile a null posargset to bump nargs */
+		{
+		    if (!errcnt) {
+			if (posit > 0) {		/* not first time */
+			    compile (POSARGSET, -posit);
+			    printstmt = 0;
+			    scanstmt = 0;
+			}
+			posit++;
+		    }
+		}
+	|	expr0 {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else
+			if (!errcnt)
+			    compile (POSARGSET, posit++);
+		}
+	|	ref {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else if (!errcnt) {
+			if (scanstmt) {
+			    char    pname[SZ_FNAME];
+			    char    *pk, *t, *p, *f;
+			    struct  pfile *pfp;
+			    struct  operand o;
+
+			    /* If no task name specified check the pfile for
+			     * the task containing the scan statement for the
+			     * named parameter.
+			     */
+			    breakout (stkop($1)->o_val.v_s, &pk, &t, &p, &f);
+			    pfp = currentask->t_pfp;
+			    if (*pk == NULL && *t == NULL &&
+				pfp && paramfind(pfp,p,0,1)) {
+
+				sprintf (pname, "%s.%s",
+				    currentask->t_ltp->lt_lname, p);
+				if (*f) {
+				    strcat (pname, ".");
+				    strcat (pname, f);
+				}
+			    } else
+				strcpy (pname, stkop($1)->o_val.v_s);
+
+			    o = *(stkop($1));
+			    o.o_val.v_s = pname;
+			    compile (PUSHCONST, &o);
+			    compile (INDIRPOSSET, posit++);
+
+			} else if (parenlevel == 0 || printstmt) {
+			    compile (PUSHCONST, stkop($1));
+			    compile (INDIRPOSSET, posit++);
+			    /* only first arg of fprint stmt is special. */
+			    printstmt = 0;
+
+			} else {
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			    compile (POSARGSET, posit++);
+			}
+		    }
+		}
+	|	ref '=' expr0 {
+		    absmode++;
+		    if (!errcnt)
+			compile (ABSARGSET, stkop($1)->o_val.v_s); 
+		}
+	|	ref '=' ref {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0) {
+			    compile (PUSHCONST, stkop($3));
+			    compile (INDIRABSSET, stkop($1)->o_val.v_s); 
+			} else {
+			    compile (PUSHPARAM, stkop($3)->o_val.v_s);
+			    compile (ABSARGSET, stkop($1)->o_val.v_s);
+			}
+		    }
+		}
+	|	param '+' {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWON, stkop($1)->o_val.v_s);
+		}
+	|	param '-' {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWOFF, stkop($1)->o_val.v_s);
+		}
+	|	'<' file {
+		    if (!errcnt)
+			compile (REDIRIN);
+		}
+	|	'>' file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (REDIR);
+		}
+	|	Y_ALLREDIR file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLREDIR);
+		}
+	|	Y_APPEND file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (APPENDOUT);
+		}
+	|	Y_ALLAPPEND file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLAPPEND);
+		}
+	|	Y_GSREDIR file {
+		    if (!errcnt)
+			compile (GSREDIR, stkop($1)->o_val.v_s);
+		}
+	;
+
+file	:	expr0 {
+		    absmode++;
+		    /* constant already pushed by expr0.
+		     */
+		}
+	|	param {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0)
+			    compile (PUSHCONST, stkop($1));
+			else
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			}
+		}
+	;
+
+immed	:	equals expr0 {
+			--parenlevel;
+			if (!errcnt)
+			    compile (IMMED);
+		}
+	|	equals ref {
+		      	--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop($2)->o_val.v_s);
+		}
+	;
+
+inspect	:	ref equals {
+			--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop($1)->o_val.v_s);
+		}
+	;
+
+osesc	:	Y_OSESC {
+		    if (!errcnt)
+			compile (OSESC, stkop($1)->o_val.v_s);
+		}
+	;
+
+popstk	:	equals {
+		    --parenlevel;
+		    if (!errcnt)
+			compile (IMMED);
+		}
+	;
+
+/* IFERR checking code.
+ */
+
+iferr: 		iferr_stat {
+		    /* pop BIFF addr and set branch to just after statement */
+		    if (!errcnt) {
+		        XINT   biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		    in_iferr = 0;
+		}
+	;
+
+iferr_stat:	iferr_tok {
+		    if (++in_iferr > 1) { 
+			errmsg = nestediferr; 
+			EYYERROR; 
+		    } 
+		    compile (CALL, "_errpsh");
+		    compile (EXEC);
+
+		} c_blk {
+		    if (!errcnt) {
+			struct	operand o;
+
+			o.o_type = OT_INT;
+			o.o_val.v_i = 0;
+			compile (PUSHCONST, &o);       /* if (_errpop() != 0) */
+			compile (INTRINSIC, "_errpop");
+			compile (PUSHCONST, &o);
+			compile (((iferr_tok == 0) ? NE : EQ));
+			push (compile (BIFF, 0));
+		    }
+		} op_then opnl xstmt {
+		    in_iferr--;
+		} 
+	;
+
+iferr_else : 	iferr_stat Y_ELSE {
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			XINT  biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+
+		} opnl xstmt {
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+		    	XINT  gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+	;
+
+iferr_tok:	Y_IFERR   { iferr_tok = 0; }
+	|	Y_IFNOERR { iferr_tok = 1; }
+	;
+
+op_then:	/* empty */
+	|	Y_THEN
+	;
+
+/* END IFERR checking rules.
+ */
+
+
+if	:	if_stat {
+		    /* pop BIFF addr and set branch to just after statement
+		     */
+		    XINT   biffaddr;
+		    if (!errcnt) {
+			biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		} 
+	;
+
+if_stat	:	Y_IF LP expr RP {
+			/* save BIFF addr so branch can be filled in 
+			 */
+			if (!errcnt)
+			    push (compile (BIFF, 0));
+		} opnl xstmt {
+			/* The shift/reduce conflict in the IF-IF/ELSE
+			 * construct can cause errors in compilation
+			 * because the IF statement can also be a
+			 * terminal symbol, i.e. it may be all that
+			 * is parsed in one call to the parser.
+			 * The parser must look ahead one token
+			 * to find if there is an else statement
+			 * following.  If there is no following
+			 * token an EOF may be detected prematurely.
+			 * When the IF statement is being parsed not
+			 * inside any braces, then when the next token
+			 * is not an ELSE care must be taken that this
+			 * token is seen on a subsequent invocation
+			 * of the parser.  The `ifseen' flag is
+			 * used within the support for the lexical
+			 * analyzer located in `history.c'.
+			 */
+			if (cldebug) 
+			    eprintf ("ytab: setting ifseen=yes\n");
+
+			if (currentask->t_flags & T_INTERACTIVE)
+			    ifseen = ip_cmdblk;
+			else
+			    ifseen = cmdblk;
+		}
+	;
+
+ifelse	:	if_stat Y_ELSE {
+		    XINT  biffaddr;
+
+		    ifseen = NULL;
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		} opnl xstmt {
+		    XINT  gotoaddr;
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+			gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+	;
+
+while	:	Y_WHILE LP {
+		    /* Save starting addr of while expression.
+		     */
+		    if (!errcnt) {
+			push (pc);
+			loopincr();
+		    }
+		} expr RP {
+		    /* Save BIFF addr so branch can be filled in.
+		     */
+		    if (!errcnt)
+			push (compile (BIFF, 0));
+		} opnl xstmt {
+		    XINT  biffaddr;
+
+		    if (!errcnt) {
+			/* Pop and save addr of BIFF instruction.	   */
+			biffaddr = pop();
+			/* Pop addr of expression and build a goto there.  */
+			compile (GOTO, pop() - pc - SZ_CE);
+			/* Now can set BIFF branch to just after statement.*/
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+			loopdecr();
+		    }
+		}
+	;
+
+	/* The line of code:
+	 *
+	 *	for (e1, e2, e3) stmt
+	 *
+	 * is compiled into:
+	 *
+	 *		e1
+	 *   loop1: 	if (!e2) goto end
+	 *		goto loop3
+	 *   loop2: 	e3
+	 *		goto loop1
+	 *   loop3: 	stmt
+	 *		goto loop2
+	 *     end:
+	 *
+	 * Note that e1 and e3 are assignments while e2 is an expression.
+	 */
+
+for	:	Y_FOR LP opnl xassign ';' opnl {
+			if (!errcnt)
+			    push(pc);				/* Loop1: */
+		} 
+		xexpr ';' opnl {
+			if (!errcnt) {
+			    if (for_expr)
+				ppush (compile(BIFF, 0));	/* if (!e2) */
+
+			    /* Add SZ_CE to skip following GOTO. 
+			     */
+			    ppush (pc+SZ_CE);			/* Loop2: */
+			    ppush (compile(GOTO,0));		/* goto Loop3 */
+
+			    /* Save current location as the destination
+			     * for NEXT statements.
+			     */
+			    loopincr();
+			}
+		}
+		xassign RP opnl {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); 	/* Goto loop1 */
+			    stmtaddr = pop();
+			    coderef(stmtaddr)->c_args = pc - stmtaddr - SZ_CE;
+			}
+		}
+		stmt {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); /* goto loop2 */
+
+			    if (for_expr) {
+				stmtaddr = pop();
+				coderef(stmtaddr)->c_args = pc-stmtaddr-SZ_CE;
+			    }
+			    loopdecr();
+			}
+		}
+	;
+
+/* The following allow skipping of fields in the FOR statement.
+ */
+
+xassign	:	assign
+	|	/* empty */
+	;
+
+xexpr	:	expr {
+			for_expr = YES;
+		}
+	|	/* empty */ {
+			for_expr = NO;
+		}
+	;
+
+	/* The compiled code for the switch statement
+	 * consists of a SWITCH, followed by a series of
+	 * CASE and DEFAULT blocks, followed by a jump table.
+	 * The first operand in each CASE and DEFAULT block
+	 * is a CASE or DEFAULT operand which is never
+	 * executed, but is used to store the values which
+	 * will enter this block.  Executable statements
+	 * follow.
+	 *
+	 * The jump table consists of the addresses of the
+	 * CASE and DEFAULT blocks.  The DEFAULT block
+	 * comes first, and is 0 if no default has
+	 * been given.  The list of addresses is terminated
+	 * by a 0 address.
+	 *
+	 * The last statement of each CASE and DEFAULT
+	 * statement is a branch back to a GOTO following
+	 * the SWITCH.  This GOTO points to after the jumptable.
+	 */
+
+switch	:	Y_SWITCH opnl LP opnl expr opnl RP opnl
+		{
+			if (!errcnt) {
+			    push (compile(SWITCH));
+
+			    /* Compile GOTO which will branch past end of
+			     * switch.  This is needed if there is no DEFAULT.
+			     */
+			    compile (GOTO, 0);
+			}
+		} xstmt {
+			/* Set up jumptable and pop space on stack.
+			 */
+			if (!errcnt)
+			    setswitch();
+		}
+	;
+
+case	:	Y_CASE {
+			if (!errcnt) {
+			    ncaseval = 0;
+			    if (!in_switch()) {
+				errmsg = "Improper CASE statement.";
+				EYYERROR;
+			    }
+			}
+		} const_expr_list ':' opnl {
+			XINT  pcase;
+
+			if (!errcnt) {
+			    pcase = compile (CASE, ncaseval);
+
+			    /* Fill in argument list. 
+			     */
+			    caseset (&(coderef(pcase)->c_args), ncaseval);
+			    push (pcase);
+			}
+		} xstmt {
+			/* Branch to end of switch block 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+	;
+
+default	:	Y_DEFAULT ':' opnl {
+		      	/* Compile an operand to store the current PC.
+			 */
+			if (!errcnt) {
+			    if (!in_switch()) {
+				errmsg = "Improper DEFAULT statement.";
+				EYYERROR;
+			    }
+			    push (compile(DEFAULT));
+			}
+		} xstmt {
+		      	/* Branch past jump table. 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+	;	
+
+next	:	Y_NEXT {
+			/* All NEXT statements are backward references,
+			 * so we simply store the addresses in an array.
+			 */
+			if (!errcnt) {
+			    if (nestlevel)
+				compile (GOTO, nextdest[nestlevel-1]-pc-SZ_CE);
+			    else {
+				errmsg = "NEXT outside of loop.";
+				EYYERROR;
+			    }
+			}
+		}
+	;
+
+break	:	Y_BREAK {
+			/* Each BREAK is a forward reference.  For the
+			 * first BREAK in each loop we compile a
+			 * GOTO statement which will be the object of
+			 * all BREAK statements within the loop.  When
+			 * the loop is terminated the target of this
+			 * GOTO will be set.
+			 */
+			int  dest;
+
+			if (!errcnt) {
+			    if (!nestlevel) {
+				errmsg = "Break outside of loop.";
+				EYYERROR;
+			    } else if ((dest = brkdest[nestlevel-1]) != 0)
+		    		compile (GOTO, dest-pc-SZ_CE);
+			    else {
+				brkdest[nestlevel-1] = pc;
+				compile (GOTO, 0);
+			    }
+			}
+		}
+	;
+
+return	:	Y_RETURN {
+			if (!errcnt)
+			    compile (END);
+		}
+	|	Y_RETURN expr {
+			/* Return values currently not implemented.
+			 */
+			eprintf ("Warning: return value ignored.\n");
+			if (!errcnt)
+			    compile (END);
+		}
+	;
+
+	/* Require end to terminate with a new-line, because
+	 * it should be at the end of the file.
+	 */
+end_stmt:	Y_END NL {
+			bracelevel -= PBRACE;
+			if (bracelevel < 0) {
+			    errmsg = "Too few left braces.";
+			    EYYERROR;
+			} else if (bracelevel > 0) {
+			    errmsg = "Too few right braces.";
+			    EYYERROR;
+			}
+		}
+	;
+
+label_stmt:	Y_IDENT ':' opnl {
+			/* Put symbol in table in dictionary and
+			 * process indirect references if present.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop($1));
+
+			    if (l == NULL) {
+				l = setlabel (stkop($1));
+				l->l_loc = pc;
+			    } else if (l->l_defined) {
+			        errmsg = "Identical labels.";
+				EYYERROR;
+			    } else {
+				/* Get this GOTO out of the
+				 * indirect list so we can use
+				 * the argument as the destination
+				 */
+				XINT  gotopc;
+				gotopc = l->l_loc;
+				unsetigoto (gotopc);
+
+				/* Fix the indirect reference. 
+				 */
+				coderef(gotopc)->c_args = pc - gotopc - SZ_CE;
+			    }
+			    (l->l_defined)++;
+			}
+		}
+		xstmt
+	;
+
+goto	:	Y_GOTO Y_IDENT {
+			/* Get the address corresponding to the label.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop($2));
+
+			    if (l != NULL)
+				compile (GOTO, l->l_loc - pc - SZ_CE);
+			    else {
+				/* Ready for indirect GOTO 
+				 */
+				l = setlabel (stkop($2));
+				l->l_loc = pc;
+				setigoto (compile(GOTO, 0));
+				l->l_defined = 0;
+			    }
+			}
+		}
+	;
+
+nullstmt:	';'
+	|	';' NL
+	;
+
+/* xstmt is defined so that to handle implicit do loops created by
+ *  open array references e.g. a[*,3]=a[3,*].
+ */
+
+xstmt	:	/* empty */ { 
+			/* Save pc before compiling statement for loop back
+			 */
+			stmt_pc = pc;
+			n_oarr = 0;
+			i_oarr = 0;
+			ifseen = NULL;
+		}
+		stmt {
+		      	/* If there was an open reference compile the
+			 * loop increment and goback.
+			 */
+			XINT push_pc;
+
+			if (!errcnt) {
+			    if (n_oarr) {
+				compile (INDXINCR, stmt_pc-pc-4, 2*n_oarr+1);
+
+				/* We are going to store initialization
+				 * info for the implicit loop here.
+				 * It is loopincr's responsibility to 
+				 * branch around it.  This data is what
+				 * should be pointed to by the special
+				 * PUSHINDEX compiled at the first open
+				 * array reference.
+				 */
+				push_pc = pop();  /* Location of PUSHINDEX */
+				coderef(push_pc)->c_args = pc - push_pc - SZ_CE;
+
+				stack[pc++] = n_oarr;
+				for (i_oarr=0; i_oarr<n_oarr; i_oarr++) {
+				    stack[pc++] = oarr_beg[i_oarr];
+				    stack[pc++] = oarr_end[i_oarr];
+				}
+
+				/* Clear n_oarr.  This must be done here
+				 * because we may have the end of a compound
+				 * statement following on the heels of the
+				 * end of the simple statement with the
+				 * implicit loop.
+				 */
+				n_oarr = 0;
+				i_oarr = 0;
+			    }
+			}
+		}
+	|	var_decl_stmt
+	|	error NL {
+		    /* This should get most errors in executable statements
+		     * or in the local variable declarations in a script.
+		     */
+		    yyerrok;
+
+		    /* Get rid of any fake braces.
+		     */
+		    bracelevel -= tbrace;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+ 		    }
+
+		    /* Tell user about the syntax error, printing the 
+		     * offending line and position if possible.
+		     */
+		    if (currentask->t_flags & T_SCRIPT) {
+		        if (errmsg != NULL) {
+			    eprintf ("** Syntax error, line %d: %s\n",
+			        currentask->t_scriptln, errmsg);
+			} else {
+			    eprintf ("** Syntax error, line %d\n",
+			        currentask->t_scriptln);
+			}
+		    } else
+			eprintf ("** Syntax error\n");
+		    p_position();
+
+		    if (!(currentask->t_flags & T_SCRIPT)) {
+			/* If interactive, we're finished if not within braces.
+			 */
+			if (!bracelevel)
+			    YYACCEPT;
+		    }
+
+		    /* Note that we do not call cl_error() here to abort, but
+		     * continue on parsing the script for more syntax errors.
+		     */
+		    if (++errcnt > MAX_ERR)
+			cl_error (E_UERR, "Too many syntax errors.");
+		}
+	;
+
+const_expr_list	:	const_expr
+		|	const_expr DELIM const_expr_list
+		;
+
+const_expr	:	const {
+				if (!errcnt) {
+				    push(stkop($1)) ; 
+				    ncaseval++;
+				}
+			}
+		;
+
+	/* Use opnl when blank lines are permitted,
+	 * or where a statement may be broken into more
+	 * than one line.  The lexical analyzer (actually
+	 * get_command in history.c) ensures that all blank
+	 * lines are deleted.  So we don't have to use
+	 * a recursive definition here.
+	 */
+
+opnl	:	/* empty */
+	|	NL
+	;
+
+ref	:	param {
+			int  dim, d, i1, i2, mode;
+
+			/*  In command arguments, when not in parentheses
+			 *  we just pass the param as a string constant.
+			 */
+			if (!errcnt) {
+			    lastref = NO;
+			    if (!inarglist || parenlevel) {
+				i_oarr = 0;
+				index_cnt = 0;
+
+				strncpy (curr_param, stkop($1)->o_val.v_s, 
+					SZ_FNAME);
+
+				/* If a '.' is found in the name we have a 
+				 * reference to an external task, or to a 
+				 * specific field.  In these cases we don't 
+				 * want implicit looping.
+				 */
+				if (index (curr_param, '.') == NULL) {
+				    if ((dim = get_dim (curr_param)) > 0) {
+					lastref = YES;
+			        	for (d = 0; d < dim; d++) {
+					    getlimits (curr_param, d, &i1, &i2);
+					    mode = make_imloop (i1, i2);
+					    if (mode)
+						compile (PUSHINDEX, -1);
+					    else
+						push (compile(PUSHINDEX, 0));	
+					}
+			    		n_oarr = dim;
+				    }
+				}
+			    }
+			}
+		}
+	|	param {
+		    if (!errcnt) {
+			strncpy (curr_param, stkop($1)->o_val.v_s, SZ_FNAME);
+			index_cnt = 0;
+		    }
+		}
+		'[' index_list ']' 
+		{
+		    if (i_oarr > 0  &&  n_oarr == 0)
+			n_oarr = i_oarr;
+		    i_oarr = 0;
+		    lastref = YES;
+		}
+	;
+
+index_list:	index {
+			index_cnt = 1;
+		}
+	|	index {
+			index_cnt++;
+		}
+		DELIM index_list
+	;
+
+index	:	expr1 {
+			if (!errcnt)
+			    compile (PUSHINDEX, 0);
+		}
+	|	ref  /* This isn't included in expr1 */
+		{ 
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			    compile (PUSHINDEX, 0);
+			}
+		}
+	|	'*' {
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (index(curr_param, '.') != NULL) {
+				errmsg = exlimits;
+				EYYERROR;
+			    }
+			    if (getlimits (curr_param, index_cnt, &i1, &i2) 
+				== ERR) {
+				eprintf ("Implicit index error for %s.\n",
+					curr_param);
+				EYYERROR;
+			    }
+			    mode = make_imloop (i1, i2);
+			    if (mode)
+				compile (PUSHINDEX, mode);
+			    else
+				push (compile (PUSHINDEX, mode));
+			}
+		}
+	|	Y_CONSTANT {
+			/*  There is an ambiguity in the grammar between
+			 *  sexagesimal constants, and array range references.
+			 *  Since the sexagesimal constants are recognized
+			 *  in the lexical analyzer we can't just change the
+			 *  grammar.  The kludge around this is to have
+			 *  makeop set a flag telling us that the last
+			 *  constant it compiled COULD have been an index
+			 *  range.  We check the flag here and if it is
+			 *  set we convert back and compile an implicit loop
+			 *  otherwise we just push the constant.
+			 */
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (maybeindex) {
+				sexa_to_index (stkop($1)->o_val.v_r, &i1, &i2);
+				mode = make_imloop (i1, i2);
+				if (mode)
+				    compile (PUSHINDEX, mode);
+				else
+				    push (compile (PUSHINDEX, mode));
+			    } else {
+				compile (PUSHCONST, stkop($1));
+				compile (PUSHINDEX, 0);
+			    }
+			}
+		}
+	;
+
+/* these are just to make the grammar a bit easier to read.
+ * can yank them out to shrink parser a bit...
+ */
+
+intrins	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+param	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+tasknam	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+EOST	:	NL
+	|	';' {
+		    /* If statements are delimited by ';'s, do not execute
+		     * until next newline EOST is received.
+		     */
+		    sawnl = 0;
+		}
+	;
+	
+DELIM	:	','
+	;
+
+BARG	:	/* empty */
+	|	LP
+	;
+
+EARG	:	/* empty */
+	|	RP
+	;
+
+/* These eliminate several interior actions.
+ */
+
+LP	:	'('	{ parenlevel++; }
+	;
+
+RP	:	')'	{ --parenlevel; }
+	;
+
+NL	:	Y_NEWLINE  { sawnl = 1; }
+	;
+
+%%
+
+#include "lexyy.c"
+#include "lexicon.c"
diff --git a/pkg/vocl/history.c b/pkg/vocl/history.c
new file mode 100644
index 00000000..b2a4462f
--- /dev/null
+++ b/pkg/vocl/history.c
@@ -0,0 +1,1279 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <sys/types.h>
+#include <sys/select.h>
+#include <sys/errno.h>
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_fset
+#define import_ctype
+#define import_fpoll
+#include <iraf.h>
+
+#include "config.h"
+#include "errs.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "clmodes.h"
+#include "grammar.h"
+#include "proto.h"
+
+
+/*
+ * HISTORY.C -- Routines for character input to the parser (actually,
+ * the lexical analyser).  Includes the history mechanism, the logfile,
+ * and prompting.
+ */
+
+extern	int cldebug;
+
+#define	HISTCHAR	'^'	/* primary history metacharacter	*/
+#define	FIRSTARG	'^'	/* first argument macro ("^^")		*/
+#define	LASTARG		'$'	/* last argument macro ("^$")		*/
+#define	ALLARGS		'*'	/* all arguments macro ("^*")		*/
+#define	ARGCHARS	"$^*"	/* argument substitution chars		*/
+#define	MATCH_ANYWHERE	'?'	/* match string anywhere in cmd		*/
+#define	MATCH_ALL	'g'	/* match all occurrences		*/
+#define	NO_EXECUTE	":p"	/* print but do not execute command	*/
+#define	MAXCOL		80	/* form width for formatting output	*/
+#define	SZ_LOGBUF	1024	/* putlog buffer size			*/
+
+#define	EOS		'\0'
+#define	NOCLOSURE	">>"	/* parser needs more input (pprompt)	*/
+#define	MAX_SHOWHIST	800	/* maximum history cmds to show		*/
+
+/* History, command block, yy_getc, logfile database.
+ */
+char	raw_cmdblk[SZ_CMDBLK+1];/* saves raw command for history (for scripts)*/
+char	cmdblk[SZ_CMDBLK+1];	/* command block buffer			*/
+char	prompt[SZ_CMDBLK+1];	/* command prompt			*/
+char	*op_cmdblk=cmdblk;	/* next output line in cmdblk		*/
+char	*ip_cmdblk=cmdblk;	/* next input char in cmdblk		*/
+int	cmdblk_line=0;		/* line number within cmd block		*/
+int	cmdblk_save=0;		/* set if cmdblk filled interactively	*/
+
+char	histbuf[SZ_HISTBUF+1];	/* history buffer			*/
+char	*op_hist=histbuf;	/* next location in history buffer	*/
+int	histbuf_full=0;		/* set when buffer wraps around		*/
+int	share_logfile=SHARELOG;	/* share logfile with other processes?	*/
+
+FILE	*logfp=NULL;		/* file pointer for command logfile	*/
+int	histnum = 0;		/* history command block number		*/
+int	history_number;		/* the current history record		*/
+
+
+
+/*  Input polling structure.
+ */
+typedef struct {
+    XINT fds;                           /* polling file descriptor set  */
+    int nfds;                           /* top of pollfd stack          */
+    int timeout;                        /* polling timeout              */
+} PollFd;
+
+PollFd  *poll_fd	= (PollFd *) NULL;
+
+
+extern	int _lexmodes;			/* enable lexical mode switching  */
+extern	char *ifseen;			/* Processing an IF statement?	  */
+extern	int do_error;			/* Are we processing errors?	  */
+
+extern  char samp_cmd[];		/* samp command buffer		  */
+extern  pthread_mutex_t samp_mutex;
+
+extern  XINT  c_poll_open (void);
+
+
+extern	void *memset();
+char   *freadline (char *prompt);
+int     add_history (char *buf);
+
+
+
+/* YY_GETC -- Called by the modified yylex() "input" macro in the lexical
+ * analysis stage of the parser to get the next character from the input
+ * stream.  When EOF is reached on the stream, add the "bye" command to
+ * the logfile.
+ */
+int 
+yy_getc (FILE *fp)
+{
+	register char ch;
+
+	while ((ch = *ip_cmdblk++) == EOS)
+	    if (get_command (fp) == EOF) {
+		if (currentask->t_flags & T_INTERACTIVE)
+		    if (log_commands())
+		        put_logfile ("bye\n");
+		return (EOF);
+	    }
+
+	return ((int) ch);
+}
+
+
+/* YY_STARTBLOCK -- Terminate the last command block and start a new one.
+ * Save old command block in history (if interactive) and in logfile (if
+ * interactive, logging is enabled, and logflag argument is true).  Even
+ * if logging is enabled, a command will not be logged which aborts or is
+ * interrupted.
+ */
+void 
+yy_startblock (int logflag)
+{
+	register char *ip;
+
+	if (cldebug)
+	    eprintf ("startblock (%d)\n", logflag);
+
+	/* Log cmdblk only if it was filled by an interactive task.  We must
+	 * make the test when the new block is initialized since the write is
+	 * delayed.
+	 */
+	if (cmdblk_save) { 
+	    /* Do not record commands which consist only of whitespace.
+	     */
+	    for (ip=cmdblk;  isspace (*ip);  ip++)
+		;
+	    if (*ip != EOS) {
+		/* Use the raw_cmdblk, saved in get_command().
+		 */
+		put_history (raw_cmdblk);
+		if (logflag && log_commands())
+		    put_logfile (raw_cmdblk);
+	    }
+	}
+
+	if (cldebug) eprintf ("startblock: ifseen=%d\n", ifseen);
+
+	if (!ifseen) {
+	    ip_cmdblk = op_cmdblk = cmdblk;
+	    *ip_cmdblk = EOS;
+	}
+	cmdblk_line = 0;
+	cmdblk_save = (currentask->t_flags & T_INTERACTIVE);
+
+	/* Mode switching of the lexical analyzer is enabled by this call
+	 * if the CL parameter lexmodes is set.  Called between blocks
+	 * entered interactively and also during error recovery.
+	 */
+	lexinit();
+}
+
+
+/* CURCMD -- Return a pointer to the command block currently being interpreted.
+ */
+char *
+curcmd (void)
+{
+	return (cmdblk);
+}
+
+
+/* GET_COMMAND -- Get command line from the input stream.  If not interactive,
+ *   all we do is read the line into the cmdblk buffer.  If called when parsing
+ *   command input to an interactive task, we must output a prompt before
+ *   reading in the command line.  The prompt changes depending on whether or
+ *   not the command is the first in a command block (whether or not we have
+ *   closure).  After reading the command, we check if it is a history directive
+ *   and process it if so.  Otherwise we must still process it to expand any
+ *   history macros.  Ignore all blank or comment lines.  These are
+ *   any line in which the first non-blank character is a newline or a
+ *   '#'.  This will make some things a bit more efficient, but is
+ *   actually to allow the if/else parsing to work properly.
+ *
+ * N.B.: We must directly or indirectly set ip_cmdblk so that yy_getc takes
+ *   the next character from the right place.  This is either done directly
+ *   or by a call to yy_startblock.
+ */
+
+
+int 
+get_command (FILE *fp)
+{
+	register char *ip, *op;
+	char	raw_cmd[SZ_LINE+1];	/* buffer for raw command line	*/
+	char	new_cmd[SZ_CMDBLK+1];	/* temporary for processed cmd	*/
+	int	execute=1, temp, status, n;
+
+	if (!(currentask->t_flags & T_INTERACTIVE)  ||
+	    parse_state == PARSE_PARAMS) {
+
+	    /* Ensure that searches through string terminate. */
+	    cmdblk[SZ_LINE] = '\0';
+	    ip_cmdblk = cmdblk;
+
+	    while (YES) {
+ 		currentask->t_scriptln++;	/* noninteractive mode	*/
+
+		status = (fgets (cmdblk, SZ_LINE, fp) == NULL ? EOF : OK);
+		if (status == EOF) {
+		    cmdblk[0] = '\0';
+		    break;
+		}
+
+		/* Check if this is a blank line. */
+		for (ip = cmdblk;  *ip == ' ' || *ip == '\t';  ip++)
+		    ;
+		if (*ip == '\n' || *ip == '\0')
+		    continue;
+
+		/* Check for the #{ ... #} lexmode toggle sequences.  These
+		 * are matched only at the beginning of a line.  #{ sets
+		 * command mode on the command input stream and #} clears it.
+		 */
+		if (*ip == '#') {
+		    if (ip == cmdblk) {
+			if (*(ip+1) == '{') {
+			    lex_setcpumode (fp);
+			    lexinit();
+			} else if (*(ip+1) == '}') {
+			    lex_clrcpumode (fp);
+			    lexinit();
+			}
+		    }
+		    continue;
+		}
+
+		break;
+	    }
+
+	    if (cldebug || echocmds())
+		eprintf ("%s", status == EOF ? "bye\n" : cmdblk);
+		
+	    return (status);
+	}
+
+
+	raw_cmd[SZ_LINE] = '\0';
+	while (YES) {
+
+	    /* Prompt the user for a new command if the input buffer is empty.
+	     * The CL prompt clears raw mode in case it is left in effect by a
+	     * program abort.
+	     */
+input_:
+	    /* Read the next command line. 
+	     */
+	    if (eh_readline == NO) {
+	        if (c_fstati (fileno(fp), F_UNREAD) == 0) {
+		    if (c_fstati ((XINT)STDIN, F_RAW) == YES)
+		        c_fseti ((XINT)STDIN, F_RAW, NO);
+		    if (cmdblk_line == 0)
+		        pprompt (curpack->pk_name);
+		    else
+		        pprompt (NOCLOSURE);
+	        }
+
+	    	if (fgets (raw_cmd, SZ_LINE, fp) == NULL)
+		    return (EOF);
+
+	    } else {
+		extern char epar_cmdbuf[];
+
+
+		/* If the epar/ehist command buffer is full, process that
+		 * rather than taking input from the terminal.
+		 */
+    		c_fseti ((XINT)STDIN, F_CANCEL, OK);
+    		c_fseti ((XINT)fileno(fp), F_CANCEL, OK);
+
+		if (*epar_cmdbuf) {
+    		    strcpy (raw_cmd, epar_cmdbuf);
+		    epar_cmdbuf[0] = '\0';
+
+		} else {
+		    char  *cmd = (char *)NULL;
+
+		    get_prompt((cmdblk_line==0) ? curpack->pk_name : NOCLOSURE);
+
+    		    if ((cmd = freadline (prompt)) == (char *)NULL)
+			return (EOF);
+
+		    pthread_mutex_lock (&samp_mutex);
+		    if (!cmd[0] && samp_cmd[0]) {
+			/* Got a SAMP message, replace the command.
+		  	 */
+			char cmdbuf[SZ_CMDBLK];
+
+			memset (cmdbuf, 0, SZ_CMDBLK);
+			get_samp_command (cmdbuf, SZ_CMDBLK);
+		        strcpy (raw_cmd, cmdbuf);
+		    } else {
+		        strcpy (raw_cmd, cmd);
+		    }
+    		    strcat (raw_cmd, "\n");
+
+		    pthread_mutex_unlock (&samp_mutex);
+		}
+	    }
+
+	    /* Check for the #{ ... #} lexmode toggle sequences.  These
+	     * are matched only at the beginning of a line.  #{ sets
+	     * command mode on the command input stream and #} clears it.
+	     */
+	    if (*(ip=raw_cmd) == '#') {
+		if (*(ip+1) == '{') {
+		    lex_setcpumode (fp);
+		    lexinit();
+		} else if (*(ip+1) == '}') {
+		    lex_clrcpumode (fp);
+		    lexinit();
+		}
+	    }
+
+	    /* Skip leading whitespace. */
+	    for (ip=raw_cmd;  *ip == ' ' || *ip == '\t';  ip++)
+		;
+
+	    /* For interactive comments, make sure we store them in the
+	     * history and the logfile.  This is so that users can add
+	     * comments into the logfile interactively.
+	     */
+	    if (*ip == '#') {
+		put_history (raw_cmd);
+	  	if (log_commands())
+		    put_logfile (raw_cmd);
+	    } else if (*ip != '\n' && *ip != '\0') {
+		cmdblk_line++;
+		break;
+	    }
+	}
+
+	/* If history directive, transform the directive into an executable
+	 * command block using the history data.  Echo the new command as
+	 * if the user had typed it, for verification.
+	 */
+	if (*raw_cmd == HISTCHAR) {
+	    /* Use screen style history editing only if the CL parameter
+	     * "ehinit" contains the boolean variable "verify" (or if the 
+	     * cmd is "ehistory", below).
+	     */
+	    if (eh_verify)
+		execute = edit_history_directive (raw_cmd+1, new_cmd);
+	    else {
+		execute = process_history_directive (raw_cmd, new_cmd);
+		fputs (new_cmd, currentask->t_stdout);
+	    }
+
+	} else if (expand_history_macros (raw_cmd, new_cmd)) {
+	    fputs (new_cmd, currentask->t_stdout);
+
+	} else {
+	    static  char ehist[] = "ehistory";
+	    int     n;
+
+	    for (n=0, ip=raw_cmd, op=ehist;  (*ip == *op);  ip++, op++)
+		n++;
+	    if (n > 0 && isspace (*ip)) {
+		while (isspace (*ip))
+		    ip++;
+		execute = edit_history_directive (ip, new_cmd);
+	    }
+	}
+
+	/* If user deletes entire line go back and get another command.  */
+	for (ip=new_cmd;  isspace (*ip);  ip++)
+	    ;
+	if (*ip == EOS) {
+	    cmdblk_line = 0;
+	    execute = 1;
+	    goto input_;
+	}
+
+	/* Now move the processed command into the cmdblk buffer.  If there
+	 * is not enough storage remaining in the cmdblk buffer, we have to
+	 * break the actual (large) command block up, calling yy_startblock to
+	 * start a new block, but without changing the line number within the
+	 * block.  We must not let the history mechanism limit the size of a
+	 * command block.
+	 */
+	op_cmdblk = ip_cmdblk - 1;		/* back up to EOS	*/
+	if (strlen (new_cmd) > (cmdblk + SZ_CMDBLK - op_cmdblk)) {
+	    temp = cmdblk_line;
+	    yy_startblock (LOG);
+	    cmdblk_line = temp;
+	}
+	ip_cmdblk = op = op_cmdblk;
+	for (ip=new_cmd;  (*op++ = *ip++) != EOS;  )
+	    ;
+
+	/* Save the "raw command" here for use in yy_startblock.  This is
+	 * to handle the problem of procedure script parsing overwriting
+	 * the raw command in cmdblk.  Save immediate mode and escapes, 
+	 * but don't save newlines.
+	 */
+	strcpy (raw_cmdblk, cmdblk);
+    	if (isalpha (cmdblk[0]) || 
+	    cmdblk[0] == '=' || cmdblk[0] == '!' || cmdblk[0] == '$') {
+	        int len = strlen (cmdblk);
+	        char buf[SZ_CMDBLK];
+
+	        memset (buf, 0, SZ_CMDBLK);
+	        strncpy (buf, cmdblk, len-1);	/* trounce the NL we do have */
+	        add_history (buf);
+	}
+
+	if (!execute)
+	    yy_startblock (NOLOG);
+
+	fflush (currentask->t_stdout);
+	return (OK);
+}
+
+
+/* Dummy procedures for platforms where we don't have GNU readline().
+*/
+#ifdef NO_READLINE
+char *
+freadline (char *prompt) { }
+int 
+add_history (char *buf)    { }
+#endif
+
+
+
+/* PROCESS_HISTORY_DIRECTIVE -- Transform a history directive into an
+ * executable command or command block.  There are two classes of
+ * directives: (1) string substitution editing of the last command block,
+ * and (2) search for an earlier command by some means and return that.
+ * If ":p" follows a directive, we generate the command and return false
+ * (no execute) as the function value.  Any text which follows the directive
+ * is appended to the new command block.
+ */
+int 
+process_history_directive (char *directive, char *new_command_block)
+{
+	register char *ip, *op, *p;
+	char	last_command_block[SZ_CMDBLK+1];
+	int	execute=1, edit=0;
+	int	record;
+	char	*rindex();
+
+	ip = directive + 1;			/* skip the '^'		*/
+	op = new_command_block;
+
+	/* Chop the newline. */
+	if ((p = rindex (ip, '\n')) != NULL)
+	    *p = EOS;
+
+	/* Scan the directive string to determine whether or not we have
+	 * an edit directive.  We have an edit directive if there is a second
+	 * (unescaped) history metacharacter in the directive.
+	 */
+	for (p=ip, edit=0;  *p != EOS;  p++)
+	    if (*p == '\\' && *(p+1) != EOS)
+		p++;
+	    else if (*p == HISTCHAR) {
+		edit = 1;
+		break;
+	    }
+
+	/* Directives "^^", "^str1^str2^", and "^str1^str2^g". */
+	if (edit) {
+	    /* Get last command and edit it */
+	    if (get_history (1, last_command_block, SZ_CMDBLK) == ERR)
+		cl_error (E_UERR, "Nothing in history buffer to edit");
+	    ip = directive +
+		stredit (directive, last_command_block, new_command_block);
+
+	/* Directives "^absnum" and "-relnum". */
+	} else if ((*ip == '-' && isdigit (*(ip+1))) || isdigit (*ip)) {
+	    if (*ip == '-')
+		record = -atoi(ip++);
+	    else
+		record = histnum - atoi(ip) + 1;
+	    if (get_history (record, new_command_block, SZ_CMDBLK) == ERR)
+		cl_error (E_UERR, "History record not found");
+	    while (isdigit (*ip))
+		ip++;
+
+	/* Directives "^", "^str", and "^?str".  */
+	} else
+	    ip = directive + search_history (directive, new_command_block);
+
+	/* Check for the ":p" no execute suffix */
+	execute = (strncmp (ip, NO_EXECUTE, strlen(NO_EXECUTE)) != 0);
+	if (!execute)
+	    ip += strlen (NO_EXECUTE);
+	
+	/* Append any text remaining in the history directive to the new
+	 * command block, BEFORE the final newline.
+	 */
+	op += strlen (new_command_block);
+	while (isspace (*(op-1)))
+	    --op;
+	expand_history_macros (ip, op);
+
+	/* Make sure the new command line ends with a newline. */
+	while (*op != EOS)
+	    op++;
+	while (isspace (*(op-1)))
+	    --op;
+	*op++ = '\n';
+	*op = EOS;
+
+	return (execute);
+}
+
+
+/* SEARCH_HISTORY -- Search for the occurrence of the given string in the
+ * history buffer, leaving the corresponding command in the output buffer
+ * if it matches the pattern.  Return the number of directive characters used.
+ * The "repeat last command" directive "^" is a special case: the null string
+ * matches anything.
+ */
+int 
+search_history (char *directive, char *new_command_block)
+{
+	register char *ip, *op, *p;
+	char	pattern[SZ_FNAME];
+	int	match_only_at_bol=1, record, patlen;
+
+	ip = directive + 1;			/* skip the '^'		*/
+
+	if (*ip == '\\' && *(ip+1) == MATCH_ANYWHERE)
+	    ip++;
+	else if (*ip == MATCH_ANYWHERE) {
+	    ip++;
+	    match_only_at_bol = 0;
+	}
+
+	/* Extract pattern, delimited by whitespace, EOS, ?, or ":p",
+	 * depending on whether we have ?? delimiters.
+	 */
+	patlen = strlen (NO_EXECUTE);
+	for (op=pattern;  (*op = *ip) != EOS;  op++, ip++)
+	    if (match_only_at_bol) {
+		if (isspace (*ip))
+		    break;
+		else if (strncmp (ip, NO_EXECUTE, patlen) == 0)
+		    break;
+	    } else if (*ip == '\\' && *(ip+1) == MATCH_ANYWHERE) {
+		*op = *++ip;
+	    } else if (*ip == MATCH_ANYWHERE) {
+		ip++;
+		break;
+	    }
+	*op++ = EOS;
+
+	/* Search backwards in history buffer until command is found
+	 * which matches the pattern.  The null pattern matches anything.
+	 */
+	patlen = strlen (pattern);
+	record = 1;
+
+	while (get_history (record++, new_command_block, SZ_CMDBLK) != ERR) {
+	    if (patlen == 0) {
+		break;
+	    } else if (match_only_at_bol) {
+		if (strncmp (new_command_block, pattern, patlen) == 0)
+		    break;
+	    } else {
+		for (p=new_command_block;  *p != EOS;  p++) {
+		    if (*p == *pattern && strncmp(p,pattern,patlen) == 0)
+			break;
+		}
+		if (*p != EOS)
+		    break;
+	    }
+	}
+
+	if (strlen (new_command_block) == 0)
+	    cl_error (E_UERR, "Event not found");
+
+	return (ip - directive);
+}
+
+
+/* STREDIT -- Edit string "in_text" according to the editing directive
+ *   string given as the first argument, placing the edited string in the
+ *   buffer "out_text".  Return the number of characters used in the
+ *   edit directive string.
+ * This is actually a general purpose string editor.  For the history code,
+ *   the edit directives are "^^", "^str", and "^?str".  The directive "^^"
+ *   is actually an edit directive wherein the match and substitute strings
+ *   are both null, causing the last command to be repeated without change.
+ * The first character in the edit directive is taken to be the edit
+ *   metacharacter (i.e., "^", "/", etc.).
+ */
+int 
+stredit (
+    char *edit_directive,		/* e.g., "^str1^str2^"		*/
+    char *in_text,			/* text to be edited		*/
+    char *out_text			/* buffer for output text	*/
+)
+{
+	register char *ip, *op, *pp;
+	char	metacharacter;
+	char	pattern[SZ_LINE+1], text[SZ_LINE+1];
+	int	replace_all_occurrences=0;
+	int	patlen, len_directive, nmatches;
+
+	/* Extract pattern and substitution strings.  The history metacharacter
+	 * may be included in a string if escaped.  Otherwise, we leave
+	 * escape sequences completely alone.
+	 */
+	ip = edit_directive;
+	metacharacter = *ip++;
+
+	for (op=pattern;  (*op = *ip) != EOS;  ip++, op++)
+	    if (*ip == '\\' && *(ip+1) == metacharacter)
+		*op = *++ip;
+	    else if (*ip == metacharacter) {
+		ip++;
+		break;
+	    }
+	*op = EOS;
+	patlen = strlen (pattern);
+
+	/* If the directive is "^^", we do not permit a substitution string
+	 * so that the directive may be used to append text to the previous
+	 * command.  We interpret the sequences "^\n" and "^\t" as newline
+	 * and tab, respectively.
+	 */
+	if (patlen > 0) {
+	    for (op=text;  (*op = *ip) != EOS;  ip++, op++)
+		if ((*ip == metacharacter && *(ip+1) == '\\') &&
+		    (*(ip+2) == 'n' || *(ip+2) == 't')) {
+		    ip += 2;
+		    *op = (*ip == 'n') ? '\n' : '\t';
+		} else if (*ip == '\\' && *(ip+1) == metacharacter) {
+		    *op = *++ip;
+		} else if (*op == '\n' || *op == metacharacter) {
+		    ip++;
+		    break;
+		}
+	    *op = EOS;
+	    if (*ip == MATCH_ALL) {
+		replace_all_occurrences = 1;
+		ip++;
+	    }
+	} else
+	    *text = EOS;
+
+	/* All done processing edit directive; get nchars processed. */
+	len_directive = ip - edit_directive;
+
+
+	/* Edit the command, unless directive is "^^" (null pattern). */
+	nmatches = 0;
+
+	for (ip=in_text, op=out_text;  *ip != EOS;  ) {
+	    /* Advance to next match */
+	    for (pp=pattern;  (*op = *ip) != EOS;  op++, ip++)
+		if (*ip == *pp && strncmp (ip, pattern, patlen) == 0) {
+		    nmatches++;
+		    break;
+		}
+	    if (patlen == 0)
+		break;
+	    else if (nmatches == 0)
+		cl_error (E_UERR, "No match");
+
+	    /* Copy replacement string, advance input pointer past the
+	     * matched string, if we have a match.
+	     */
+	    if (*ip == *pp) {
+		for (pp=text;  (*op = *pp++) != EOS;  op++)
+		    ;
+		ip += patlen;
+	    }
+
+	    if (!replace_all_occurrences) {
+		while ((*op = *ip++) != EOS)
+		    op++;
+		break;
+	    }
+	}
+
+	*op = EOS;
+	return (len_directive);
+}
+
+
+/* EXPAND_HISTORY_MACROS -- Copy the input string to the output string,
+ *   replacing all occurrences of "^$" by the final argument the last command,
+ *   all occurrences of "^^" by the first argument of the last command, and
+ *   all occurrences of "^*" by the full argument list of the last command.
+ * If the command block contains more than one line, we assume that the
+ *   argument list spans several lines.  If this is not true, the expansion
+ *   will not be what the user wanted (but then they probably screwed up).
+ * The function returns true if any macros were expanded.
+ */
+int 
+expand_history_macros (char *in_text, char *out_text)
+{
+	register char *ip, *op, *ap;
+	char	cmdblk[SZ_CMDBLK+1], *argp[100];
+	int	nargs=0, nrep=0, argno=0, have_arg_strings=0;
+	char	*index();
+
+
+	/* Copy the command text.  Fetch argument strings from history only
+	 * if a history macro is found.  Otherwise the copy is very fast.
+	 */
+	for (ip=in_text, op=out_text;  (*op = *ip) != EOS;  ip++, op++) {
+	    if (*ip == '"') {			/* span literal strings	*/
+		while (1) {
+		   *op++ = *ip++;
+		   if (*ip == '"' && *(ip+1) != '"') {
+		       *op = *ip;
+			break;
+		   }
+		}
+		continue;
+	    } else if (*ip == HISTCHAR) {
+		if (ip > in_text && *(ip-1) == '\\') {
+		    *(--op) = HISTCHAR;				/* \^	*/
+		    continue;
+		} else if (!isdigit(*(ip+1)) && index(ARGCHARS,*(ip+1)) == NULL)
+		    continue;
+
+		/* Parse the argument list of the previous command if have not
+		 * already done so.
+		 */
+		if (!have_arg_strings++) {
+		    if (get_history (1, cmdblk, SZ_CMDBLK) == ERR)
+			cl_error (E_UERR, "Nothing in history buffer");
+		    nargs = get_arglist (cmdblk, argp);
+		}
+
+		/* Set up the substitution.
+		 */
+		switch (*(ip+1)) {
+		case FIRSTARG:
+		    argno = 1;
+		    nrep = 1;
+		    break;
+		case LASTARG:
+		    argno = nargs;
+		    nrep = 1;
+		    break;
+		case ALLARGS:
+		    argno = 1;
+		    nrep = nargs;
+		    break;
+		default:
+		    argno = *(ip+1) - '0';
+		    nrep = 1;
+		    break;
+		}
+
+		/* Copy the arguments to the output command, overwriting the
+		 * history metacharacter (*op).
+		 */
+		while (--nrep >= 0 && argno <= nargs) {
+		    for (ap=argp[argno++];  (*op = *ap++);  op++)
+			;
+		    if (nrep > 0)
+			*op++ = ' ';
+		}
+
+		--op;		/* leave pointing at last char output	*/
+		ip++;		/* skip the macro type metacharacter	*/
+	    }
+	}
+
+	return (have_arg_strings > 0);
+}
+
+
+/* GET_ARGLIST -- Fetch the last command line and return an array of
+ * pointers to the whitespace delimited argument strings.  If parsing a
+ * full command line, argument "zero" is the task name (the first token),
+ * and argp[1] the first real argument.  The number of arguments
+ * (excluding the task name) is returned as the function value.
+ *
+ * NOTE -- The input argument list is modified (the argp[i] point into it).
+ * NOTE -- This procedure is used elsewhere in the CL to parse argument lists.
+ */
+int 
+get_arglist (
+    char *cmdblk,		/* buffer to store argument list in	*/
+    char *argp[]		/* receives argument pointers		*/
+)
+{
+	register char	*cp;
+	register int	nargs;
+
+	for (cp=cmdblk, nargs=0;  *cp != EOS;  ) {
+	    /* Advance to next token; convert newline to EOS. */
+	    while (*cp == ' ' || *cp == '\t')
+		cp++;
+	    if (*cp == '\n' || *cp == EOS) {
+		*cp = EOS;
+		break;
+	    }
+
+	    /* Set argument pointer and bump argument count. */
+	    argp[nargs++] = cp;
+
+	    /* Mark the end of the token. */
+	    while (*cp && !isspace (*cp))
+		cp++;
+	    if (*cp == ' ' || *cp == '\t')
+		*cp++ = EOS;
+	}
+
+	return (nargs - 1);
+}
+
+
+/* PUT_HISTORY -- Add a new record to the history buffer.  Record cannot
+ * be larger than SZ_CMDBLK, which must be smaller than SZ_HISTBUF.  Copy
+ * chars into histbuf in circular buffer fashion, overwriting old history
+ * data.  EOS delimits records in the history buffer.
+ */
+void 
+put_history (char *command)
+{
+	register char *ip, *op, *otop;
+
+	/* Make sure there is exactly one newline at the end of the command. */
+	for (ip = command + strlen(command) - 1;  ip >= command;  --ip)
+	    if (!isspace (*ip))
+		break;
+	*++ip = '\n';
+	*++ip = EOS;
+
+	otop = histbuf + SZ_HISTBUF;
+	ip = command;
+	op = op_hist;
+
+	do {
+	    *op++ = *ip;
+	    if (op >= otop) {
+		op = histbuf;
+		histbuf_full++;
+	    }
+	} while (*ip++ != EOS);
+
+	op_hist = op;
+	histnum++;
+}
+
+
+/* GET_HISTORY -- Fetch the indicated command from the history buffer,
+ * returning OK if found, ERR otherwise.
+ */
+int 
+get_history (int record, char *command, int maxch)
+{
+	char	*recptr;
+	char	*find_history();
+
+	if ((recptr = find_history (record)) == NULL) {
+	    *command = EOS;
+	    return (ERR);
+	} else {
+	    fetch_history (recptr, command, maxch);
+	    return (OK);
+	}
+}
+
+
+/* FETCH_HISTORY -- Extract the command pointed to by the first argument
+ * from the history buffer into the user buffer (the latter is a nice,
+ * well behaved linear rather than circular buffer).
+ */
+void 
+fetch_history (char *recptr, char *command, int maxch)
+{
+	register char	*ip, *op, *itop;
+	register int	n;
+
+	itop = histbuf + SZ_HISTBUF;
+	ip   = recptr;
+	op   = command;
+	n    = ((maxch < SZ_HISTBUF) ? maxch : SZ_HISTBUF) - 1;
+
+	while (--n >= 0 && ((*op = *ip++) != EOS) ) {
+	    /* *op++; */
+	    op++;
+	    if (ip >= itop)
+		ip = histbuf;
+	}
+
+	*op = EOS;
+}
+
+
+/* FIND_HISTORY -- Locate the indicated command record in the history buffer,
+ * returning a pointer to the first char or NULL.  Commands are referenced
+ * by number, where 1 is the most recent command, 2 the one before that, and
+ * so on.  We are done when we search so far back that we reach the location
+ * op_hist.  To speed up linear searches of the history buffer, we keep track
+ * of where we are on successive calls, provided the buffer has not been
+ * written into between calls.  We can detect this by saving a copy of
+ * op_hist in a static variable between calls.
+ */
+char *
+find_history (int record)
+{
+	register char *ip, *op, *bufptr;
+	static	int current_record = 0;
+	static	char *recptr, *old_ophist = NULL;
+
+	if (histnum == 0 || record <= 0)
+	    return (NULL);
+
+	/* We only search backwards into history: if desired record is
+	 * more recent than the "current record", or if the buffer has
+	 * been written into, reset and search from the beginning.  The
+	 * "current record" is the record pointed to by recptr.
+	 */
+	if (old_ophist != op_hist || record < current_record) {
+	    current_record = 0;
+	    old_ophist = recptr = op_hist;
+	}
+
+	ip = recptr;				/* start here		*/
+	op = op_hist;				/* not found if get here */
+	bufptr = histbuf;			/* wrap around if get here */
+
+	/* Search backwards into history for the record, starting from the
+	 * current position (initially record number "0", the next record to
+	 * be filled).  Each time through the loop, set recptr for the new
+	 * "current record".
+	 */
+	while (current_record < record) {
+	    if (--ip < bufptr) {		/* backup to EOS	*/
+		if (!histbuf_full)
+		    return (NULL);
+		ip = histbuf + SZ_HISTBUF - 1;
+	    }
+	    do {
+		if (--ip < bufptr) {
+		    /* Initially, before the buffer fill up, there is no EOS
+		     * preceeding the first record.
+		     */
+		    if (!histbuf_full)
+			break;
+		    ip = histbuf + SZ_HISTBUF - 1;
+		}
+		if (ip == op)
+		    return (NULL);		/* cannot find record	*/
+	    } while (*ip != EOS);
+
+	    /* Advance to first char of next record */
+	    if (++ip >= histbuf + SZ_HISTBUF)
+		ip = bufptr;
+	    recptr = ip;
+	    current_record++;
+	}
+	history_number = current_record;	/* save this globally  */
+	return (recptr);
+}
+
+
+/* SHOW_HISTORY -- Print the contents of the history buffer on the output
+ * stream, preceeding each command block with a 3 digit command number.
+ * Show at most min (max_commands, MAX_SHOWHIST) command blocks.
+ */
+void 
+show_history (FILE *fp, int max_commands)
+{
+	char	*recptr[MAX_SHOWHIST];
+	char	cmdblk[SZ_CMDBLK+1];
+	int	record;
+	char	*find_history();
+
+	/* Flush the "history" command so that it shows up in the history. */
+	yy_startblock (LOG);
+
+	/* Determine the number of records to show. */
+	for (record=0;  record < MAX_SHOWHIST;  record++)
+	    if ((recptr[record] = find_history (record+1)) == NULL)
+		break;
+	if (max_commands > 0)
+	    record = (record < max_commands) ? record : max_commands;
+
+	/* Print the records with the 3 digit record number plus a blank
+	 * on the first line and 4 blanks at the beginning of each successive
+	 * line of the block.
+	 */
+	while (record > 0) {
+	    fprintf (fp, "%3d ", (histnum - (--record)) % 1000);
+	    fetch_history (recptr[record], cmdblk, SZ_CMDBLK+1);
+	    print_command (fp, cmdblk, "", "    ");
+	    fflush (fp);
+	}
+}
+
+
+/* PPROMPT -- Print prompt as first two chars of prompt string plus "> ", i.e.,
+ * "pk> ".  If null prompt string (NOCLOSURE), print the continuation prompt
+ * ">>> ".  Also print, before the prompt, all ltasks in current package
+ * if menus() are enabled and a new package has been invoked.
+ */
+void 
+pprompt (register char *string)
+{
+	static	struct package *lastpack = NULL;
+	extern	long int run_level;
+
+	if (menus() && curpack != lastpack) {
+	    listhelp (curpack, NO);
+	    lastpack = curpack;
+	    printf ("\n");
+	    fflush (stdout);
+	}
+
+	if (strncmp ("clpackage", string, 9) == 0)
+	    printf ("vocl> ");
+	else
+	    printf ((eh_longprompt == YES) ? "%s> " : "%2.2s> ", string);
+	fflush (stdout);
+
+	run_level = 0;
+}
+
+
+/* GET_PROMPT -- Get prompt as first two chars of prompt string plus "> ", i.e.,
+ * "pk> ".  If null prompt string (NOCLOSURE), print the continuation prompt
+ * ">>> ".  Also print, before the prompt, all ltasks in current package
+ * if menus() are enabled and a new package has been invoked.
+ */
+void 
+get_prompt (register char *string)
+{
+	static	struct package *lastpack = NULL;
+	extern	long int run_level;
+
+        if (menus() && curpack != lastpack) {
+            listhelp (curpack, NO);
+            lastpack = curpack;
+	    printf ("\n");
+	    fflush (stdout);
+        }
+
+	if (strncmp ("clpackage", string, 9) == 0)
+	    strcpy (prompt, "vocl> ");
+	else
+	    sprintf (prompt,
+		(eh_longprompt == YES) ? "%s> " : "%2.2s> ", string);
+
+	run_level = 0;
+}
+
+
+/* PUT_LOGFILE -- Put a command into the logfile, if logging is enabled.
+ * Otherwise check if the logfile is open and close it, in case user has
+ * just turned logging off.  If the "share_logfile" switch is set the logfile
+ * is opened and closed each time a record is appended to the file, allowing
+ * other processes to access the same file.
+ */
+void 
+put_logfile (char *command)
+{
+	FILE	*fp;
+
+	if (keeplog()) {
+	    if (logfp == NULL)
+	        if (open_logfile (logfile()) == ERR)
+		    /* Do not abort by calling cl_error().  We could be a
+		     * background job accessing a shared logfile.  Also, we
+		     * want to avoid error recursion when logging an error.
+		     */
+		    return;
+
+  	    if (share_logfile) {
+		if ((fp = fopen (logfile(), "a"))) {
+		    print_command (fp, command, "", "");
+		    fclose (fp);
+		}
+	    } else
+	        print_command (logfp, command, "", "");
+
+	} else if (logfp != NULL)
+	    close_logfile (logfile());
+}
+
+
+/* OPEN_LOGFILE -- Open the named command logging file for appending,
+ * timestamp new session.  The logfile grows without bounds unless the
+ * user deletes it or starts a new one.
+ */
+int 
+open_logfile (char *fname)
+{
+	if (logfp != NULL)
+	    close_logfile (fname);
+
+	if ((logfp = fopen (fname, "a")) == NULL) {
+	    eprintf ("cannot open logfile\n");
+	    return (ERR);
+	}
+
+	if (!(firstask->t_flags & T_BATCH))
+	    fprintf (logfp, "\n# LOGIN %s\n", today());
+	
+	if (share_logfile)
+	    fclose (logfp);
+
+	return (OK);
+}
+
+
+/* CLOSE_LOGFILE -- Print termination message and close logfile.
+ */
+void 
+close_logfile (char *fname)
+{
+	register FILE *fp;
+
+	if (logfp != NULL) {
+	    if (share_logfile) {
+		if ((fp = fopen (fname, "a")) == NULL) {
+		    eprintf ("cannot open logfile\n");
+		    return;
+		}
+	    } else
+		fp = logfp;
+
+	    if (!(firstask->t_flags & T_BATCH))
+		fprintf (fp, "# Logout %s\n", today());
+
+	    fclose (fp);
+	    logfp = NULL;
+	}
+}
+
+
+/* RESET_LOGFILE -- The name of the logfile has been reset by the user.
+ * Close and reopen the logfile, but only if share_logfile option is off.
+ */
+void 
+reset_logfile (void)
+{
+	if (!share_logfile) {
+	    close_logfile ("");
+	    open_logfile (logfile());
+	}
+}
+
+
+/* PRINT_COMMAND -- Print a (possibly multiline) command to the same left
+ * margin as when it was entered.
+ */
+void 
+print_command (
+    register FILE *fp,
+    char *command,
+    char *marg1,
+    char *marg2		/* margin strings of first and subseq. cmds */
+)
+{
+	register char *ip;
+
+	fprintf (fp, marg1);
+	for (ip=command;  *ip != EOS;  ip++) {
+	    fputc (*ip, fp);
+	    if (*ip == '\n' && *(ip+1) != EOS)
+		fprintf (fp, marg2);
+	}
+}
+
+
+/* TODAY -- Get todays date as a string, for datestamping the logfile.
+ */
+char *
+today (void)
+{
+	static	char datebuf[64];
+
+	c_cnvtime (c_clktime(0L), datebuf, 64);
+	return (datebuf);
+}
+
+
+/* WHAT_RECORD -- Return the record number of the last edited history
+ */
+int 
+what_record (void)
+{
+	return (history_number);
+}
+
+
+/* PUTLOG -- Format and write a message to the logfile.  This is called by
+ * the putlog builtin (clputlog() in builtin.c) and in some places in the
+ * CL (e.g., exec.c).
+ */
+void 
+putlog (
+    struct task *tp,		/* pointer to task or NULL */
+    char *usermsg
+)
+{
+	register char	*ip, *op, *otop;
+	register int	n;
+	char	msg[SZ_LOGBUF], job[5];
+	char	*pkg, *tname, *today();
+	extern  int  bkgno;			/* job number if bkg job */
+
+	if (!keeplog())
+	    return;
+
+	/* If background job, format job number, but only if background
+	 * logging is enabled.
+	 */
+	if (firstask->t_flags & T_BATCH) {
+	    if (log_background())
+	    	sprintf (job, "[%d] ", bkgno);
+	    else
+		return;
+	} else
+	    job[0] = EOS;
+
+	/* If a valid task pointer is given, get the package and task name.
+	 * Otherwise, assume it's an internal (cl) logging message.
+	 */
+	if (tp) {
+	    pkg   = tp->t_ltp->lt_pkp->pk_name;
+	    tname = tp->t_ltp->lt_lname;
+	} else {
+	    pkg   = "cl";
+	    tname = "";
+	}
+
+	/* Format the message.  Only use time, no day and date.  Break long
+	 * messages into several lines.
+	 */
+	sprintf (msg, "# %8.8s %s%s%s %s- ",
+		(today() + 4), pkg, (tp ? "." : ""), tname, job);
+	otop = &msg[SZ_LOGBUF];
+	for (op=msg, n=0;  *op && op < otop;  op++)
+	    n++;
+	for (ip=usermsg;  (*op++ = *ip++) && op < otop;  n++)
+	    if (n + 2 >= MAXCOL) {
+		*op++ = '\\';
+		*op++ = '\n';
+		n = 0;
+	    }
+	*(op-1) = '\n';
+	*op = EOS;
+	    
+	put_logfile (msg);
+}
+
+
+
+/*  POLLINIT -- Initialize the input polling mechanism.
+*/
+pollInit ()
+{
+    /* Allocate the structure. */
+    if (poll_fd == NULL)
+        poll_fd = (PollFd *) calloc (1, sizeof(PollFd));
+
+    /* Get a descriptor set and initialize the stdin. */
+    c_poll_set ((poll_fd->fds = c_poll_open()), fileno(stdin), (int) POLLIN);
+    poll_fd->nfds++;
+}
diff --git a/pkg/vocl/lex.com b/pkg/vocl/lex.com
new file mode 100644
index 00000000..32c198cd
--- /dev/null
+++ b/pkg/vocl/lex.com
@@ -0,0 +1,12 @@
+$! Fix the lexyy.c file  (see lex.sed)   [VMS]
+$!
+$ open/write fp lex_fix.com
+$ write fp "$ edit/edt/nocommand lexyy.c"
+$ write fp "sub/getc(yyin)/yy_getc(yyin)/w"
+$ write fp "sub/yylex/lex_yylex/w"
+$ write fp "sub/YYLMAX 200/YYLMAX 2048/w"
+$ write fp "exit"
+$ write fp "$ exit"
+$ close fp
+$ @lex_fix.com
+$ delete lex_fix.com;*
diff --git a/pkg/vocl/lex.sed b/pkg/vocl/lex.sed
new file mode 100644
index 00000000..1b1a1377
--- /dev/null
+++ b/pkg/vocl/lex.sed
@@ -0,0 +1,4 @@
+s/getc(yyin)/yy_getc(yyin)/
+s/yylex/lex_yylex/
+s/YYLMAX 200/YYLMAX 2048/
+1d
diff --git a/pkg/vocl/lexicon.c b/pkg/vocl/lexicon.c
new file mode 100644
index 00000000..a6888d11
--- /dev/null
+++ b/pkg/vocl/lexicon.c
@@ -0,0 +1,704 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define	import_libc
+#define	import_ctype
+#define	import_xnames
+#define	import_lexnum
+#include <iraf.h>
+
+extern	int	cldebug;
+
+/*
+ * NOTE: This file is #included in the parser and inherits the parser global
+ * declarations.
+ */
+
+#define	LEXDEBUG	1
+#define	newtoken	(yyleng==0)
+
+int	_lexmodes;		/* nonzero enables mode switching	*/
+int	lexdebug=0;		/* debug lexical analyzer		*/
+int	lexcol=0;		/* nchars since \n or ;			*/
+int	pbtoken;		/* push back token			*/
+int	newarg;			/* whitespace argument delimiter seen	*/
+int	lhs;			/* "left hand side" switch for []	*/
+
+/* YYLEX -- Return the next token from the input stream.  Two separate lexical
+ * analyzers are provided, the "command mode" lexical analyzer for interactive
+ * command entry, and the "compute mode" analyzer for more sophisticated
+ * applications.  The nesting level of parentheses and braces is used to switch
+ * between the two modes.  When the paren level is nonzero compute mode is in
+ * effect.  Mode switching may be defeated by setting the external variable
+ * _lexmodes to zero.  A single parser accepts input from both lexical
+ * analyzers.
+ */
+int 
+yylex (void)
+{
+	register int	token;
+
+	if (_lexmodes && parenlevel == 0 && bracelevel < PBRACE) {
+	    while (!(token = lexicon()))
+		if (yywrap())
+		    break;
+	} else
+	    token = lex_yylex();
+
+	if (!lexdebug)
+	    return (token);
+
+#if LEXDEBUG
+	switch (token) {
+	case Y_CONSTANT:
+	    eprintf ("CONSTANT ");
+	    fprop (stderr, reference (operand, yylval));
+	    eprintf ("\n");
+	    break;
+	case Y_IDENT:
+	    eprintf ("IDENT ");
+	    fprop (stderr, reference (operand, yylval));
+	    eprintf ("\n");
+	    break;
+	case Y_OSESC:
+	    eprintf ("Y_OSESC ");
+	    fprop (stderr, reference (operand, yylval));
+	    eprintf ("\n");
+	    break;
+	case Y_APPEND:
+	    eprintf ("Y_APPEND\n");
+	    break;
+	case Y_ALLAPPEND:
+	    eprintf ("Y_ALLAPPEND\n");
+	    break;
+	case Y_ALLREDIR:
+	    eprintf ("Y_ALLREDIR\n");
+	    break;
+	case Y_GSREDIR:
+	    eprintf ("Y_GSREDIR\n");
+	    break;
+	case Y_ALLPIPE:
+	    eprintf ("Y_ALLPIPE\n");
+	    break;
+	case Y_NEWLINE:
+	    eprintf ("NEWLINE\n");
+	    break;
+	default:
+	    eprintf ("`%c'\n", token);
+	    break;
+	}
+#endif
+
+	return (token);
+}
+
+
+/* LEXICON -- Simple "conversational mode" lexical analyser.  Lexical analysis
+ * in the CL is carried out by a dual mode lexical analyser.  In conversational
+ * mode there are few tokens and few special characters; arguments are
+ * delimited by whitespace and may contain nonalphanumeric characters.  Few
+ * strings have to be quoted.  In computational mode the arithmetic operators
+ * are recognized and arguments must be delimited by commas.  Computational
+ * mode is in effect whenever the parenlevel is nonzero.
+ *
+ * The two modes are implemented with two separate lexical analyzers.  Gettok
+ * implements conversational mode, while computational mode is implemented with
+ * a LEX finite state automaton.  Gettok recognizes the following special chars:
+ *
+ *	[ \t]				argument delimiter
+ *	["']				string
+ *	\n				newline
+ *	\				single character escape
+ *	!				os escape
+ *	#				comment
+ *	&				spawn background job		*
+ *	(				lparen
+ *	+				plus (switch)
+ *	-				minus (switch)
+ *	;				eost				*
+ *	=				equals				*
+ *	+=				add and set
+ *	-=				subtract and set
+ *	*=				multiply and set
+ *	/=				divide and set
+ *	<				redirin
+ *	>				redir
+ *	>&				allredir
+ *	>>				append
+ *	>>&				allappend
+ *	>(G|I|P|)+			graphics stream redirection
+ *	{				lbrace
+ *	|				pipe
+ *	|&				allpipe
+ *	}				rbrace
+ *	[				beginning of index list
+ *	]				end of index list
+ *	://				URI token			*
+ *
+ * The history metacharacter ^ is processed before input is passed to the
+ * lexical analyser.  Any sequence of nonwhite characters that does not form
+ * one of the recognized tokens is returned as a string.
+ */
+int 
+lexicon (void)
+{
+	char	*bkgerr = "ERROR: cannot submit background job inside {}\n";
+	register int	ch, cch, cch2;
+	register int	token;
+	int	stringtok, identifier, setlevel;
+	int	clswitch = 0, isuri = 0;
+	char	*op, *index();
+
+	/* Return pushed back token if any.
+	 */
+	if (pbtoken) {
+	    token = pbtoken;
+	    pbtoken = 0;
+	    return (token);
+	}
+
+	/* Skip leading whitespace.  If whitespace is seen and we are in an
+	 * argument list (according to the parser) set flag to output the
+	 * comma argument delimiter if the next token begins an argument.
+	 * If whitespace or = is seen (except whitespace at the beginning of
+	 * a command) then set LHS to false, turning [] off as conversational
+	 * mode metacharacters (they will be automatically turned on when
+	 * compute mode is entered in an expression).
+	 */
+	while (ch = input())
+	    if (ch == ' ' || ch == '\t') {
+space:		if (lexcol > 0)
+		    lhs = 0;
+		if (inarglist)
+		    newarg++;
+	    } else if (ch == '\\') {
+		if ((ch = input()) != '\n') {
+		    unput (ch);
+		    break;
+		} else
+		    goto space;
+	    } else
+		break;
+	
+
+	/* Start new token.
+	 */
+	if (ch) {
+	    unput (ch);
+	    yyleng = 0;
+	    if (!inarglist)
+		newarg = 0;
+	} else
+	    return (0);
+
+
+	/* Identify and accumulate next token.  Simple tokens are returned as
+	 * integer constants, more complex tokens as operand structures in
+	 * yylval.
+	 */
+	while (ch = input()) {
+	    lexcol++;
+
+	    switch (ch) {
+	    case '&':
+		/* An ampersand triggers bkg execution in command mode, unless
+		 * it occurs in a token such as >& or >>&, in which case we
+		 * never get here.
+		 */
+		if (!newtoken) {
+		    unput (ch);
+		    goto tokout_;
+		} else {
+		    while (ch = input()) {
+			if (ch == ' ' || ch == '\t')
+			    continue;
+			else {
+			    char   bkgmsg[SZ_LINE+1];
+			    int    n = SZ_LINE;
+
+			    op = bkgmsg;
+			    unput (ch);
+			    if (bracelevel) {
+				eprintf (bkgerr);
+				return ('#');
+			    }
+
+			    while (--n >= 0 && (*op = input()) != '\n')
+				op++;
+			    *op = EOS;
+			    bkg_init (bkgmsg);
+			    return (Y_NEWLINE);
+			}
+		    }
+		    return (0);
+		}
+
+	    case ';':
+	    case '\n':
+		lexcol = 0;
+		lhs = 1;
+		goto etok_;
+
+	    case '\t':
+	    case ' ':
+		if (lexcol > 0)
+		    lhs = 0;
+		goto etok_;
+
+	    case '[':
+	    case ']':
+		/* [] are recognized as command mode metacharacters only
+		 * on the left hand side of an assignment statement.
+		 */
+		if (!lhs)
+		    goto deposit_;
+		/* Fall through */
+
+	    case '{':
+	    case '}':
+		/* We want to distinguish here between the use of {} for
+		 * the set selection operator in template strings, and the
+		 * conventional compound statement operator.  The distinction
+		 * is that { is recognized as a token only if occurs at the
+		 * beginning of a token, and } is recognized as a separate
+		 * token when inside a token only if it matches a { in the
+		 * same token.  Hence, alpha{xxx} is a single token in command
+		 * mode, whereas {xxx} is 3 tokens, the same as { xxx },
+		 * and xxx} is the same as xxx }.  Usage is completely
+		 * unambiguous if the { or } is preceded by a space.
+		 */
+		if (newtoken)
+		    return (ch);
+		if (stringtok) {
+		    if (ch == '{')
+			setlevel++;
+		    else if (setlevel == 0)
+			goto etok_;		/* } does not match { */
+		    else
+			--setlevel;
+		    goto deposit_;
+		}
+		/* fall through */
+
+	    case '=':
+etok_:		if (!newtoken) {
+		    unput (ch);
+		    goto tokout_;
+		} else if (ch == '\n') {
+		    return (Y_NEWLINE);
+		} else if (ch == '=') {
+		    token = ch;
+		    lhs = 0;
+		    goto eatwhite_;
+		} else
+		    return (ch);
+
+	    case ':':			/* a "://" in a URI?	*/
+		if (!newtoken) {
+		    cch = input();
+		    if (cch == 0)
+		        return (0);
+
+		    if (cch == '/') {
+		        cch2 = input();
+		        if (cch2 == 0)
+		            return (0);
+
+		        if (cch2 == '/') {	/* have a URI	*/
+
+			    /*  Accumulate URL up to whitespace.
+			     */
+		            yytext[yyleng++] = ch;
+		            yytext[yyleng++] = cch;
+		            yytext[yyleng++] = cch2;
+        		    while ((ch = input()) && (!index (" \t\n", ch))) {
+		    	        if (ch == '\\') {
+				    if (ch = input()) {
+			                if (ch == '\n')
+				            continue;
+			                else
+				            yytext[yyleng++] = '\\';
+			            } else
+			                break;
+				}
+		                yytext[yyleng++] = ch;
+			    }
+			    if (ch)
+		    	        unput (ch);
+
+			    yytext[yyleng] = '\0';
+			    goto tokout_;
+		        }
+
+		    } else {
+		        unput (cch);
+		        goto deposit_;
+		    }
+		}
+
+	    case '?':
+		/*  ?, ?? menu commands, recognized only at beginning of stmt 
+		 */
+		if (lexcol > 1) {
+		    goto deposit_;
+		} else if (ch = input()) {
+		    if (ch == '?')
+			return (crackident ("??"));
+		    else {
+			unput (ch);
+			return (crackident ("?"));
+		    }
+		} else
+		    return (0);
+
+	    case '+':
+	    case '-':
+		/* Plus and minus are recognized as the switch operators for
+		 * boolean parameters only if encountered while accumulating
+		 * a token and if followed by an argument delimiter, i.e.,
+		 * space, tab, newline, or semicolon.  If found at the beginning
+		 * of a token they are returned as a separate token and will be
+		 * interpreted by the parser as unary plus or minus.
+		 */
+		if (newtoken) {
+		    if (newarg) {
+			cch = input();
+			if (cch == 0)
+			    return (0);
+			unput (cch);
+
+			if (ch == '-' && isdigit (cch)) {
+			    unput (ch);
+			    newarg = 0;
+			    return (',');
+			} else {
+			    /* Not number; treat +- as a string char.
+			     */
+			    goto deposit_;
+			}
+
+		    } else {
+			cch = input();
+			if (cch == 0)
+			    return (0);
+
+			if (cch == '=') {
+			    if (ch == '+')
+				return (YOP_AOADD);
+			    else
+				return (YOP_AOSUB);
+			} else if (isdigit (cch)) {
+			    unput (cch);
+			    return (ch);
+			} else {
+			    unput (cch);
+			    goto deposit_;
+			}
+		    }
+
+		} else if (cch = input()) {
+		    clswitch = (isspace (cch) || cch == ';');
+		    if (cch == '=') {
+			unput(cch);
+			unput (ch);
+			goto tokout_;
+		    }
+		    unput (cch);
+		    if (clswitch) {
+			pbtoken = ch;
+			goto tokout_;
+		    } else
+			goto deposit_;
+		} else
+		    return (0);
+
+	    case '"':
+	    case '\'':
+		if (!newtoken) {
+		    unput (ch);
+		    goto tokout_;
+		} else if (newarg) {
+		    unput (ch);
+		    newarg = 0;
+		    return (',');
+		} else {
+		    traverse (ch);
+		    yylval = addconst (yytext, OT_STRING);
+		    return (Y_CONSTANT);
+		}
+
+	    case '\\':
+		if (ch = input()) {
+		    if (ch == '\n')
+			continue;
+		    else if (index ("&;=+-\"'\\#><()|", ch) != NULL)
+			goto deposit_;		/* put ch in string */
+		    else
+			goto escape_;		/* put \ch in string */
+		} else
+		    return (0);
+
+	    case '!':
+		/* OS escape is only recognized when the ! occurs as the first
+		 * token in a statement.
+		 */
+		if (lexcol > 1)
+		    goto deposit_;
+
+		/* Accumulate command.  Newline may be escaped to enter a long
+		 * command, but all other escapes are passed on unmodified.
+		 */
+		while ((ch = input()) && ch != '\n') {
+		    if (ch == '\\')
+			if (ch = input()) {
+			    if (ch == '\n')
+				continue;
+			    else
+				yytext[yyleng++] = '\\';
+			} else
+			    break;
+		    yytext[yyleng++] = ch;
+		}
+		if (ch)
+		    unput (ch);
+
+		yytext[yyleng] = '\0';
+		yylval = addconst (yytext, OT_STRING);
+		return (Y_OSESC);
+
+	    case '#':
+		/* Discard the comment line. */
+		while ((ch = input()) && ch != '\n')
+		    ;
+		if (ch) {
+		    unput (ch);
+		    continue;
+		} else
+		    return (0);
+
+	    case '>':
+	    case '<':
+	    case '(':
+		/* These characters are alike in that they all begin a new
+		 * argument when found in an argument list.
+		 */
+		if (!newtoken) {
+		    unput (ch);
+		    goto tokout_;
+		} else if (newarg) {
+		    unput (ch);
+		    newarg = 0;
+		    return (',');
+		} else if (ch == '<') {
+		    token = ch;
+		    goto eatwhite_;
+
+		} else if (ch == '>') {
+		    ch = input();
+		    if (ch == 0) {
+			return ('>');
+
+		    } else if (ch == '>') {
+			ch = input();
+			if (ch == 0) {
+			    return (Y_APPEND);
+			} else if (ch == 'G' || ch == 'I' || ch == 'P') {
+			    op = yytext;
+			    *op++ = '>';
+			    *op++ = '>';
+			    *op++ = ch;
+			    goto gsredir_;
+			} else if (ch == '&') {
+			    token = Y_ALLAPPEND;
+			    goto eatwhite_;
+			} else {
+			    unput (ch);
+			    token = Y_APPEND;
+			    goto eatwhite_;
+			}
+
+		    } else if (ch == 'G' || ch == 'I' || ch == 'P') {
+			/* Graphics stream redirection.
+			 */
+			op = yytext;
+			*op++ = '>';
+			*op++ = ch;
+gsredir_:
+			ch = input();
+			while (ch == 'G' || ch == 'I' || ch == 'P') {
+			    *op++ = ch;
+			    ch = input();
+			}
+			unput (ch);
+			*op = EOS;
+
+			yylval = addconst (yytext, OT_STRING);
+			token = Y_GSREDIR;
+			goto eatwhite_;
+
+		    } else if (ch == '&') {
+			token = Y_ALLREDIR;
+			goto eatwhite_;
+		    } else {
+			unput (ch);
+			token = '>';
+			goto eatwhite_;
+		    }
+
+		} else
+		    return ('(');
+
+	    case '|':
+		if (!newtoken) {
+		    unput (ch);
+		    goto tokout_;
+		} else if (ch = input()) {
+		    if (ch == '&')
+			return (Y_ALLPIPE);
+		    else {
+			unput (ch);
+			return ('|');
+		    }
+		} else
+		    return (0);
+
+	    case '*':
+	    case '/':
+		cch = input();
+		if (cch == 0)
+		    return (0);
+
+		if (newtoken) {
+		    if (cch == '=')
+			return ((ch=='*') ? YOP_AOMUL:YOP_AODIV);
+		    else {
+			unput (cch);
+			goto deposit_;
+		    }
+		} else {
+		    if (cch == '=') {
+			unput (cch);
+			unput (ch);
+			goto tokout_;
+		    } else {
+			unput (cch);
+			goto deposit_;
+		    }
+		}
+
+	    /* The following cases are included to force the compiler
+	     * to compile the case as an ASCII jump table.
+	     */
+	    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+	    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+	    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+	    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+	    case 'y': case 'z':
+	    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+	    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+	    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+	    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+	    case 'Y': case 'Z':
+		/* fall through to default */
+
+	    default:
+		goto deposit_;
+escape_:	
+		/* Deposit a character preceded by the escape character.
+		 */
+		if (!newarg) {
+		    unput (ch);
+		    ch = '\\';
+		}
+deposit_:
+		/* If the last token returned was a string argument and we
+		 * are starting a second, a delimiter token must be returned
+		 * to delimit the two arguments.  Check for chars not legal
+		 * in an identifier so that we can know whether to return
+		 * CONSTANT or call crackident() which returns IDENT if not
+		 * a reserved keyword.
+		 */
+		if (newtoken) {
+		    identifier = 1;
+		    stringtok  = 1;
+		    setlevel   = 0;
+		    if (newarg) {
+			unput (ch);
+			newarg = 0;
+			return (',');
+		    }
+		}
+
+		yytext[yyleng++] = ch;
+		if (ch == '[') {
+		    while ((ch = input()) != ']')
+		        yytext[yyleng++] = ch;
+		    yytext[yyleng++] = ch;
+		} else if (ch == '\\')
+		    yytext[yyleng++] = ch = input();
+		else if (!(isalnum(ch) || ch == '_' || ch == '$' || ch == '.'))
+		    identifier = 0;
+	    }
+	}
+
+tokout_:
+	yytext[yyleng] = '\0';
+
+	if (isdigit (yytext[0]) || yytext[0] == '.' && isdigit (yytext[1])) {
+	    int	token, toklen;
+
+	    token = c_lexnum (yytext, &toklen);
+	    if (token != LEX_NONNUM && toklen == yyleng) {
+		switch (token) {
+		case LEX_REAL:
+		    yylval = addconst (yytext, OT_REAL);
+		    break;
+		default:
+		    yylval = addconst (yytext, OT_INT);
+		    break;
+		}
+		return (Y_CONSTANT);
+	    }
+	}
+
+	if (identifier)
+	    return (crackident (yytext));
+	else {
+	    yylval = addconst (yytext, OT_STRING);
+	    return (Y_CONSTANT);
+	}
+
+eatwhite_:
+	/* Control transfers here after a token has been identified which is
+	 * followed by an associated argument (e.g. > file or < file).  Our
+	 * function is to discard any whitespace following the current token
+	 * in order to make whitespace optional in the input at this point.
+	 * This makes "> file" (for example) equivalent to ">file".
+	 */
+	newarg = 0;
+        while ((ch = input()) && (ch == ' ' || ch == '\t'))
+	    ;
+	if (ch) {
+	    unput (ch);
+	    return (token);
+	} else
+	    return (0);
+}
+
+
+/* LEXINIT -- Initialize the internal state variables of the lexical analyzer,
+ * e.g. when processing is interrupted by an interrupt.
+ */
+int 
+lexinit (void)
+{
+	if (lexmodes() && !lex_cpumodeset (currentask->t_in)) {
+	    lexcol = 0;
+	    newarg = 0;
+	    pbtoken = 0;
+	    lhs = 1;
+	    _lexmodes = 1;
+	} else
+	    _lexmodes = 0;
+}
diff --git a/pkg/vocl/lexyy.c b/pkg/vocl/lexyy.c
new file mode 100644
index 00000000..4fd6c1ff
--- /dev/null
+++ b/pkg/vocl/lexyy.c
@@ -0,0 +1,900 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+# define U(x) x
+# define NLSTATE yyprevious=YYNEWLINE
+# define BEGIN yybgin = yysvec + 1 +
+# define INITIAL 0
+# define YYLERR yysvec
+# define YYSTATE (yyestate-yysvec-1)
+# define YYOPTIM 1
+# define YYLMAX BUFSIZ
+# define output(c) putc(c,yyout)
+# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):yy_getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
+# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
+# define yymore() (yymorfg=1)
+# define ECHO fprintf(yyout, "%s",yytext)
+# define REJECT { nstr = yyreject(); goto yyfussy;}
+int yyleng; extern char yytext[];
+int yymorfg;
+extern char *yysptr, yysbuf[];
+int yytchar;
+FILE *yyin = {stdin}, *yyout = {stdout};
+extern int yylineno;
+struct yysvf { 
+	struct yywork *yystoff;
+	struct yysvf *yyother;
+	int *yystops;};
+struct yysvf *yyestate;
+extern struct yysvf yysvec[], *yybgin;
+# define YYNEWLINE 10
+int 
+lex_yylex (void){
+int nstr; extern int yyprevious;
+while((nstr = yylook()) >= 0)
+yyfussy: switch(nstr){
+case 0:
+if(yywrap()) return(0); break;
+case 1:
+	/* groups of blanks and tabs, while significant as delimiters,
+		 * are otherwise ignored.
+		 */ ;
+break;
+case 2:
+{	/* trailing ',' implies continuation */
+			return (',');
+		}
+break;
+case 3:
+{	/* trailing '\' completely absorbed */
+		}
+break;
+case 4:
+{
+			/* Host os command escape.  Remove everything up through
+			 * '!'.  Let clsystem decide what to do with null cmd.
+			 * Must precede the "!" YOP_NOT spec in this file.
+			 */
+			register char *cp;
+			for (cp = yytext;  *cp++ != '!';  )
+			    ;
+			yylval = addconst (cp, OT_STRING);
+			return (Y_OSESC);
+		}
+break;
+case 5:
+	return (Y_ALLPIPE);
+break;
+case 6:
+	return (Y_APPEND);
+break;
+case 7:
+	return (Y_ALLAPPEND);
+break;
+case 8:
+	return (Y_ALLREDIR);
+break;
+case 9:
+{
+			yylval = addconst (yytext, OT_STRING);
+			return (Y_GSREDIR);
+		}
+break;
+case 10:
+	return (YOP_LE);
+break;
+case 11:
+	return (YOP_GE);
+break;
+case 12:
+	return (YOP_EQ);
+break;
+case 13:
+	return (YOP_NE);
+break;
+case 14:
+	return (YOP_POW);
+break;
+case 15:
+	return (YOP_OR);
+break;
+case 16:
+	return (YOP_AND);
+break;
+case 17:
+	return (YOP_NOT);
+break;
+case 18:
+	return (YOP_AOADD);
+break;
+case 19:
+	return (YOP_AOSUB);
+break;
+case 20:
+	return (YOP_AOMUL);
+break;
+case 21:
+	return (YOP_AODIV);
+break;
+case 22:
+	return (YOP_AOCAT);
+break;
+case 23:
+	return (YOP_CONCAT);
+break;
+case 24:
+	{ if (dobrace) {
+			dobrace = NO;
+			return (*yytext);
+		  } else {
+			dobrace = YES;
+			unput (*yytext);
+			return (';');
+		  }
+		}
+break;
+case 25:
+	return (*yytext);
+break;
+case 26:
+	return (*yytext);
+break;
+case 27:
+	return (crackident (yytext));
+break;
+case 28:
+	return (crackident (yytext));
+break;
+case 29:
+	{	extern bracelevel;
+			if (bracelevel) {
+	    eprintf ("ERROR: background not allowed within statement block\n");
+			    return ('#');
+			} else {
+			    yyleng = 0;
+			    while ((yytext[yyleng]=input()) != '\n')
+				yyleng++;
+			    yytext[yyleng] = '\0';
+			    bkg_init (yytext);
+			    return (Y_NEWLINE);
+			}
+		}
+break;
+case 30:
+{
+			/* crackident() sets yylval and returns token value.
+			 */
+			return (crackident (yytext));
+		}
+break;
+case 31:
+{
+			/* must precede OT_REAL as integers also match there */
+			yylval = addconst (yytext, OT_INT);
+			return (Y_CONSTANT);
+		}
+break;
+case 32:
+{
+			yylval = addconst (yytext, OT_REAL);
+		 	return (Y_CONSTANT);
+		}
+break;
+case 33:
+{
+			/* sexagesimal format */
+			yylval = addconst (yytext, OT_REAL);
+			return (Y_CONSTANT);
+		}
+break;
+case 34:
+{	/* Quoted string.  call traverse() to read the
+			 * string into yytext.
+			 */
+			traverse (*yytext);
+			yylval = addconst (yytext, OT_STRING);
+			return (Y_CONSTANT);
+		}
+break;
+case 35:
+	return (Y_NEWLINE);
+break;
+case 36:
+{	/* Ignore a comment. */
+			while (input() != '\n')
+			    ;
+			unput ('\n');
+		}
+break;
+case 37:
+	return (*yytext);
+break;
+case -1:
+break;
+default:
+fprintf(yyout,"bad switch yylook %d",nstr);
+} return(0); }
+/* end of lex_yylex */
+
+#include "errs.h"
+
+/* See gram.c for the various support functions, such as addconst()
+ * and crackident().  Traverse is included here since it directly
+ * references input, unput, yytext, etc.
+ */
+
+/* TRAVERSE -- Called by the lexical analyzer when a quoted string has
+ * been recognized.  Characters are input and deposited in yytext (the
+ * lexical analyzer token buffer) until the trailing quote is seen.
+ * Strings may not span lines unless the newline is delimited.  The
+ * recognized escape sequences are converted upon input; all others are
+ * left alone, presumably to later be converted by other code.
+ * Quotes may be included in the string by escaping them, or by means of
+ * the double quote convention.
+ */
+int 
+traverse (int delim)
+{
+	register char *op, *cp, ch;
+	static	char *esc_ch  = "ntfr\\\"'";
+	static	char *esc_val = "\n\t\f\r\\\"\'";
+	char	*index();
+
+	for (op=yytext;  (*op = input()) != EOF;  op++) {
+	    if (*op == delim) {
+		if ((*op = input()) == EOF)
+		    break;
+		if (*op == delim)
+		    continue;	/* double quote convention; keep one */
+		else {
+		    unput (*op);
+		    break;			/* normal exit	*/
+		}
+
+	    } else if (*op == '\n') {		/* error recovery exit	*/
+		*op = '\0';
+		cl_error (E_UERR, "Newline while processing string");
+		break;
+
+	    } else if (*op == '\\') {
+		if ((*op = input()) == EOF) {
+		    break;
+		} else if (*op == '\n') {
+		    --op;			/* explicit continuation */
+		    while ((ch = input()) && isspace(ch) || ch == '#') {
+			if (ch == '#')
+			    while ((ch = input()) && ch != '\n')
+				;
+		    }
+		    unput (ch);
+		    continue;
+		} else if ((cp = index (esc_ch, *op)) != NULL) {
+		    *op = esc_val[cp-esc_ch];
+		} else if (isdigit (*op)) {	/* '\0DD' octal constant   */
+		    *op -= '0';
+		    while (isdigit (ch = input()))
+			*op = (*op * 8) + (ch - '0');
+		    unput (ch);
+		} else {
+		    ch = *op;			/* unknown escape sequence, */
+		    *op++ = '\\';		/* leave it alone.	    */
+		    *op = ch;
+		}
+	    }
+	}
+
+	*op = '\0';
+	yyleng = (op - yytext);
+}
+int yyvstop[] = {
+0,
+
+37,
+0,
+
+1,
+37,
+0,
+
+35,
+0,
+
+17,
+37,
+0,
+
+34,
+37,
+0,
+
+36,
+37,
+0,
+
+30,
+37,
+0,
+
+29,
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+26,
+37,
+0,
+
+31,
+32,
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+37,
+0,
+
+27,
+37,
+0,
+
+37,
+0,
+
+25,
+37,
+0,
+
+37,
+0,
+
+24,
+37,
+0,
+
+1,
+37,
+0,
+
+4,
+17,
+37,
+0,
+
+1,
+0,
+
+13,
+0,
+
+30,
+0,
+
+16,
+0,
+
+14,
+0,
+
+20,
+0,
+
+18,
+0,
+
+2,
+0,
+
+19,
+0,
+
+32,
+0,
+
+23,
+0,
+
+21,
+0,
+
+32,
+0,
+
+31,
+32,
+0,
+
+31,
+0,
+
+31,
+0,
+
+10,
+0,
+
+12,
+0,
+
+8,
+0,
+
+11,
+0,
+
+6,
+0,
+
+9,
+0,
+
+28,
+0,
+
+3,
+0,
+
+5,
+0,
+
+15,
+0,
+
+1,
+0,
+
+4,
+0,
+
+4,
+13,
+0,
+
+22,
+0,
+
+33,
+0,
+
+32,
+0,
+
+7,
+0,
+
+32,
+0,
+
+33,
+0,
+
+33,
+0,
+0};
+# define YYTYPE char
+struct yywork { YYTYPE verify, advance; } yycrank[] = {
+0,0,	0,0,	1,3,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	1,4,	1,5,	
+61,0,	0,0,	0,0,	4,28,	
+0,0,	0,0,	0,0,	13,35,	
+13,36,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	22,55,	22,56,	0,0,	
+26,59,	0,0,	1,6,	1,7,	
+1,8,	1,9,	4,28,	1,10,	
+1,7,	10,31,	13,35,	1,11,	
+1,12,	1,13,	1,14,	1,15,	
+1,16,	1,17,	2,26,	11,32,	
+22,55,	0,0,	24,57,	26,59,	
+26,60,	0,0,	0,0,	16,39,	
+64,69,	1,18,	1,19,	1,20,	
+1,21,	6,29,	1,9,	1,9,	
+12,34,	1,9,	11,33,	14,37,	
+1,9,	16,40,	2,27,	2,7,	
+2,8,	2,9,	18,48,	2,10,	
+2,7,	19,49,	21,54,	2,11,	
+39,63,	2,13,	2,14,	2,15,	
+2,16,	1,9,	38,62,	38,62,	
+0,0,	1,22,	0,0,	1,23,	
+1,9,	20,50,	0,0,	0,0,	
+0,0,	2,18,	2,19,	2,20,	
+2,21,	15,38,	15,38,	15,38,	
+15,38,	15,38,	15,38,	15,38,	
+15,38,	15,38,	15,38,	53,53,	
+0,0,	53,53,	0,0,	0,0,	
+20,51,	20,52,	38,62,	38,62,	
+53,53,	1,24,	1,25,	0,0,	
+0,0,	0,0,	20,53,	0,0,	
+20,53,	2,22,	0,0,	2,23,	
+2,9,	0,0,	9,30,	20,53,	
+24,58,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+9,30,	0,0,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	2,24,	2,25,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	0,0,	0,0,	0,0,	
+0,0,	9,30,	0,0,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	9,30,	9,30,	9,30,	
+9,30,	17,41,	0,0,	17,42,	
+17,42,	17,42,	17,42,	17,42,	
+17,42,	17,42,	17,42,	17,42,	
+17,42,	17,43,	0,0,	0,0,	
+0,0,	0,0,	27,60,	0,0,	
+17,44,	17,45,	17,44,	17,46,	
+17,46,	17,44,	27,60,	27,0,	
+41,41,	41,41,	41,41,	41,41,	
+41,41,	41,41,	41,41,	41,41,	
+41,41,	41,41,	0,0,	0,0,	
+0,0,	0,0,	0,0,	17,47,	
+52,67,	0,0,	0,0,	0,0,	
+41,62,	41,62,	0,0,	0,0,	
+17,44,	17,45,	17,44,	17,46,	
+17,46,	17,44,	0,0,	0,0,	
+27,60,	0,0,	0,0,	0,0,	
+0,0,	27,60,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	17,47,	
+0,0,	52,53,	27,61,	52,53,	
+41,62,	41,62,	27,60,	27,60,	
+0,0,	27,60,	52,53,	0,0,	
+27,60,	43,64,	43,64,	43,64,	
+43,64,	43,64,	43,64,	43,64,	
+43,64,	43,64,	43,64,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	27,60,	44,44,	44,44,	
+44,44,	44,44,	44,44,	44,44,	
+44,44,	44,44,	44,44,	44,44,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	0,0,	44,44,	
+44,44,	44,44,	44,44,	44,44,	
+44,44,	46,65,	0,0,	46,65,	
+0,0,	0,0,	46,66,	46,66,	
+46,66,	46,66,	46,66,	46,66,	
+46,66,	46,66,	46,66,	46,66,	
+60,60,	0,0,	44,47,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+60,60,	60,0,	0,0,	44,44,	
+44,44,	44,44,	44,44,	44,44,	
+44,44,	62,65,	0,0,	62,65,	
+0,0,	0,0,	62,68,	62,68,	
+62,68,	62,68,	62,68,	62,68,	
+62,68,	62,68,	62,68,	62,68,	
+0,0,	0,0,	44,47,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+0,0,	0,0,	60,60,	0,0,	
+0,0,	0,0,	0,0,	60,60,	
+65,68,	65,68,	65,68,	65,68,	
+65,68,	65,68,	65,68,	65,68,	
+65,68,	65,68,	0,0,	0,0,	
+0,0,	0,0,	0,0,	0,0,	
+60,60,	60,60,	0,0,	60,60,	
+0,0,	0,0,	60,60,	66,66,	
+66,66,	66,66,	66,66,	66,66,	
+66,66,	66,66,	66,66,	66,66,	
+66,66,	0,0,	0,0,	0,0,	
+0,0,	0,0,	69,70,	60,60,	
+69,69,	69,69,	69,69,	69,69,	
+69,69,	69,69,	69,69,	69,69,	
+69,69,	69,69,	70,70,	70,70,	
+70,70,	70,70,	70,70,	70,70,	
+70,70,	70,70,	70,70,	70,70,	
+0,0};
+struct yysvf yysvec[] = {
+0,	0,	0,
+yycrank+-1,	0,		0,	
+yycrank+-41,	yysvec+1,	0,	
+yycrank+0,	0,		yyvstop+1,
+yycrank+6,	0,		yyvstop+3,
+yycrank+0,	0,		yyvstop+6,
+yycrank+4,	0,		yyvstop+8,
+yycrank+0,	0,		yyvstop+11,
+yycrank+0,	0,		yyvstop+14,
+yycrank+102,	0,		yyvstop+17,
+yycrank+3,	0,		yyvstop+20,
+yycrank+9,	0,		yyvstop+23,
+yycrank+7,	0,		yyvstop+25,
+yycrank+10,	0,		yyvstop+27,
+yycrank+10,	0,		yyvstop+29,
+yycrank+57,	0,		yyvstop+31,
+yycrank+12,	0,		yyvstop+33,
+yycrank+179,	0,		yyvstop+36,
+yycrank+17,	0,		yyvstop+40,
+yycrank+20,	0,		yyvstop+42,
+yycrank+59,	0,		yyvstop+44,
+yycrank+19,	0,		yyvstop+46,
+yycrank+20,	0,		yyvstop+49,
+yycrank+0,	0,		yyvstop+51,
+yycrank+16,	0,		yyvstop+54,
+yycrank+0,	0,		yyvstop+56,
+yycrank+23,	0,		yyvstop+59,
+yycrank+-241,	0,		yyvstop+62,
+yycrank+0,	yysvec+4,	yyvstop+66,
+yycrank+0,	0,		yyvstop+68,
+yycrank+0,	yysvec+9,	yyvstop+70,
+yycrank+0,	0,		yyvstop+72,
+yycrank+0,	0,		yyvstop+74,
+yycrank+0,	0,		yyvstop+76,
+yycrank+0,	0,		yyvstop+78,
+yycrank+0,	yysvec+13,	0,	
+yycrank+0,	0,		yyvstop+80,
+yycrank+0,	0,		yyvstop+82,
+yycrank+22,	yysvec+15,	yyvstop+84,
+yycrank+23,	0,		yyvstop+86,
+yycrank+0,	0,		yyvstop+88,
+yycrank+204,	0,		yyvstop+90,
+yycrank+0,	yysvec+17,	yyvstop+92,
+yycrank+265,	0,		0,	
+yycrank+282,	0,		0,	
+yycrank+0,	yysvec+44,	yyvstop+95,
+yycrank+310,	yysvec+44,	0,	
+yycrank+0,	0,		yyvstop+97,
+yycrank+0,	0,		yyvstop+99,
+yycrank+0,	0,		yyvstop+101,
+yycrank+0,	0,		yyvstop+103,
+yycrank+0,	0,		yyvstop+105,
+yycrank+230,	0,		yyvstop+107,
+yycrank+44,	0,		yyvstop+109,
+yycrank+0,	0,		yyvstop+111,
+yycrank+0,	yysvec+22,	0,	
+yycrank+0,	0,		yyvstop+113,
+yycrank+0,	0,		yyvstop+115,
+yycrank+0,	0,		yyvstop+117,
+yycrank+0,	yysvec+26,	yyvstop+119,
+yycrank+-367,	0,		yyvstop+121,
+yycrank+-2,	yysvec+60,	yyvstop+123,
+yycrank+342,	0,		0,	
+yycrank+0,	0,		yyvstop+126,
+yycrank+2,	yysvec+43,	yyvstop+128,
+yycrank+368,	0,		0,	
+yycrank+391,	yysvec+44,	yyvstop+130,
+yycrank+0,	0,		yyvstop+132,
+yycrank+0,	yysvec+65,	yyvstop+134,
+yycrank+408,	0,		yyvstop+136,
+yycrank+418,	0,		yyvstop+138,
+0,	0,	0};
+struct yywork *yytop = yycrank+475;
+struct yysvf *yybgin = yysvec+1;
+char yymatch[] = {
+00  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,011 ,012 ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+011 ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,01  ,01  ,'+' ,01  ,'+' ,01  ,01  ,
+'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
+'0' ,'0' ,01  ,01  ,01  ,01  ,01  ,01  ,
+01  ,'A' ,'B' ,'A' ,'D' ,'D' ,'A' ,'G' ,
+'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,
+'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,
+'X' ,'G' ,'G' ,01  ,01  ,01  ,01  ,01  ,
+01  ,'A' ,'B' ,'A' ,'D' ,'D' ,'A' ,'G' ,
+'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,
+'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,'G' ,
+'X' ,'G' ,'G' ,01  ,01  ,01  ,01  ,01  ,
+0};
+char yyextra[] = {
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,
+0};
+#ifndef lint
+static	char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
+#endif
+
+int yylineno =1;
+# define YYU(x) x
+# define NLSTATE yyprevious=YYNEWLINE
+char yytext[YYLMAX];
+struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
+char yysbuf[YYLMAX];
+char *yysptr = yysbuf;
+int *yyfnd;
+extern struct yysvf *yyestate;
+int yyprevious = YYNEWLINE;
+int 
+yylook (void){
+	register struct yysvf *yystate, **lsp;
+	register struct yywork *yyt;
+	struct yysvf *yyz;
+	int yych, yyfirst;
+	struct yywork *yyr;
+# ifdef LEXDEBUG
+	int debug;
+# endif
+	char *yylastch;
+	/* start off machines */
+# ifdef LEXDEBUG
+	debug = 0;
+# endif
+	yyfirst=1;
+	if (!yymorfg)
+		yylastch = yytext;
+	else {
+		yymorfg=0;
+		yylastch = yytext+yyleng;
+		}
+	for(;;){
+		lsp = yylstate;
+		yyestate = yystate = yybgin;
+		if (yyprevious==YYNEWLINE) yystate++;
+		for (;;){
+# ifdef LEXDEBUG
+			if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
+# endif
+			yyt = yystate->yystoff;
+			if(yyt == yycrank && !yyfirst){  /* may not be any transitions */
+				yyz = yystate->yyother;
+				if(yyz == 0)break;
+				if(yyz->yystoff == yycrank)break;
+				}
+			*yylastch++ = yych = input();
+			yyfirst=0;
+		tryagain:
+# ifdef LEXDEBUG
+			if(debug){
+				fprintf(yyout,"char ");
+				allprint(yych);
+				putchar('\n');
+				}
+# endif
+			yyr = yyt;
+			if ( (int)yyt > (int)yycrank){
+				yyt = yyr + yych;
+				if (yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				}
+# ifdef YYOPTIM
+			else if((int)yyt < (int)yycrank) {		/* r < yycrank */
+				yyt = yyr = yycrank+(yycrank-yyt);
+# ifdef LEXDEBUG
+				if(debug)fprintf(yyout,"compressed state\n");
+# endif
+				yyt = yyt + yych;
+				if(yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				yyt = yyr + YYU(yymatch[yych]);
+# ifdef LEXDEBUG
+				if(debug){
+					fprintf(yyout,"try fall back character ");
+					allprint(YYU(yymatch[yych]));
+					putchar('\n');
+					}
+# endif
+				if(yyt <= yytop && yyt->verify+yysvec == yystate){
+					if(yyt->advance+yysvec == YYLERR)	/* error transition */
+						{unput(*--yylastch);break;}
+					*lsp++ = yystate = yyt->advance+yysvec;
+					goto contin;
+					}
+				}
+			if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
+# ifdef LEXDEBUG
+				if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
+# endif
+				goto tryagain;
+				}
+# endif
+			else
+				{unput(*--yylastch);break;}
+		contin:
+# ifdef LEXDEBUG
+			if(debug){
+				fprintf(yyout,"state %d char ",yystate-yysvec-1);
+				allprint(yych);
+				putchar('\n');
+				}
+# endif
+			;
+			}
+# ifdef LEXDEBUG
+		if(debug){
+			fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
+			allprint(yych);
+			putchar('\n');
+			}
+# endif
+		while (lsp-- > yylstate){
+			*yylastch-- = 0;
+			if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
+				yyolsp = lsp;
+				if(yyextra[*yyfnd]){		/* must backup */
+					while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
+						lsp--;
+						unput(*yylastch--);
+						}
+					}
+				yyprevious = YYU(*yylastch);
+				yylsp = lsp;
+				yyleng = yylastch-yytext+1;
+				yytext[yyleng] = 0;
+# ifdef LEXDEBUG
+				if(debug){
+					fprintf(yyout,"\nmatch ");
+					sprint(yytext);
+					fprintf(yyout," action %d\n",*yyfnd);
+					}
+# endif
+				return(*yyfnd++);
+				}
+			unput(*yylastch);
+			}
+		if (yytext[0] == 0  /* && feof(yyin) */)
+			{
+			yysptr=yysbuf;
+			return(0);
+			}
+		yyprevious = yytext[0] = input();
+		if (yyprevious>0)
+			output(yyprevious);
+		yylastch=yytext;
+# ifdef LEXDEBUG
+		if(debug)putchar('\n');
+# endif
+		}
+	}
+int 
+yyback (int *p, int m)
+{
+if (p==0) return(0);
+while (*p)
+	{
+	if (*p++ == m)
+		return(1);
+	}
+return(0);
+}
+	/* the following are only used in the lex library */
+int 
+yyinput (void){
+	return(input());
+	}
+int 
+yyoutput (int c) {
+	output(c);
+	}
+int 
+yyunput (int c) {
+	unput(c);
+	}
diff --git a/pkg/vocl/lists.c b/pkg/vocl/lists.c
new file mode 100644
index 00000000..547af32d
--- /dev/null
+++ b/pkg/vocl/lists.c
@@ -0,0 +1,121 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+/*
+ * LISTS -- Access lists for list-structured parameters.
+ */
+
+extern	char *eofstr;
+extern	char *nullstr;
+extern	int	cldebug;
+
+
+/* READLIST -- Read next value from list-structured parameter *pp and return
+ * an operand.  Operand will be UNDEF if there was no file or cannot open the
+ * named file (this will generate a query for the param) or eofstr if eof.
+ * As a special case, check for the value of the param being the string "stdin"
+ *   and read from the current standard input if it is.
+ * Call error() if get ferror while reading or can't open list file.
+ */
+struct operand 
+readlist (struct param *pp)
+{
+	struct	operand result;
+	int	bastype;
+	char	*line;
+
+	result.o_type = OT_INT;		/* in case we make an undef op	*/
+	line = pp->p_listval;
+
+	if ((pp->p_valo.o_type & OT_UNDEF) || *pp->p_val.v_s == '\0') {
+	    /* no list file name. */
+	    pp->p_flags &= ~P_LEOF;
+	    setopundef (&result);
+	    return (result);
+	}
+
+	if (pp->p_listfp == NULL && !(pp->p_flags & P_LEOF)) {
+	    char *filename = pp->p_val.v_s;
+	    if (!strcmp (filename, "STDIN") || !strcmp (filename, "stdin"))
+		pp->p_listfp = currentask->t_stdin;
+	    else if ((pp->p_listfp = fopen (filename, "r")) == NULL) {
+		/* should we tell user what's happening?
+		cl_error (E_UERR|E_P, "can not open list file `%s'",
+		    pp->p_val.v_s);
+		 */
+		setopundef (&result);
+		return (result);
+	    }
+	}
+
+	bastype = pp->p_type & OT_BASIC;
+
+	if (pp->p_listfp != NULL) {
+again:	    fgets (line, SZ_LINE, pp->p_listfp);
+	    if (ferror (pp->p_listfp)) {
+		closelist (pp);
+		/* Don't just let it go as undefined if get an actual error. */
+		cl_error (E_UERR|E_P, "list file read err");
+
+	    } else if (feof (pp->p_listfp)) {
+		closelist (pp);
+		pp->p_flags |= P_LEOF;
+		result = makeop (eofstr, OT_STRING);
+
+	    } else {
+		char *index(), *nlp, *ip;
+
+		nlp = index (line, '\n');
+		if (nlp != NULL)
+		    *nlp = '\0';
+
+		/* If not simple list structured struct type parameter (used
+		 * to get raw lines from a text file), ignore blank lines and
+		 * comments lines in the list.
+		 */
+		if (bastype != OT_STRING ||
+		    pp->p_type & (PT_FILNAM|PT_GCUR|PT_IMCUR|PT_UKEY)) {
+
+		    for (ip=line;  *ip && (*ip == ' ' || *ip == '\t');  ip++)
+			;
+		    if (*ip == EOS || *ip == '#')
+			goto again;
+		}
+			
+		result = makeop (line, bastype);
+	    }
+
+	} else
+	    result = makeop (eofstr, OT_STRING);
+
+	return (result);
+}
+
+
+/* CLOSELIST -- Close the list file in list-structured param pp.
+ * We assume (pp->p_type & PT_LIST) but do check that the file is not
+ * already closed and that we're not closing the real stdin.
+ */
+void 
+closelist (register struct param *pp)
+{
+	if (pp->p_listfp != NULL) {
+	    if (pp->p_listfp != stdin)
+		fclose (pp->p_listfp);
+	    pp->p_listfp = NULL;
+	}
+}
diff --git a/pkg/vocl/login.cl b/pkg/vocl/login.cl
new file mode 100644
index 00000000..0af86c65
--- /dev/null
+++ b/pkg/vocl/login.cl
@@ -0,0 +1,112 @@
+# LOGIN.CL -- User login file for the IRAF command language.
+
+# Identify login.cl version (checked in images.cl).
+if (defpar ("logver"))
+    logver = "IRAF V2.16 Dec 2011"
+
+set	home		= "pkg$vocl/"
+set	imdir		= "uparm$"
+set	uparm		= "home$uparm/"
+set	userid		= "VOCL"
+
+# Set the terminal type.
+stty xgterm
+
+# Uncomment and edit to change the defaults.
+#set	editor		= vi
+#set	printer		= lw
+#set	stdimage	= imt800
+#set	stdimcur	= stdimage
+#set	stdplot		= lw
+#set	clobber		= no
+#set	filewait	= yes
+#set	cmbuflen	= 512000
+#set	min_lenuserarea	= 24000
+#set	imtype		= "imh"
+
+
+
+# IMTOOL/XIMAGE stuff.  Set node to the name of your workstation to
+# enable remote image display.
+#set	node		= ""
+
+# CL parameters you might want to change.
+#ehinit   = "nostandout eol noverify"
+#epinit   = "standout showall"
+showtype  = yes
+
+# Environment values you might want to change.
+#reset erract    = "noabort notrace noclear flpr" ; keep
+#reset erract    = "abort trace flpr" ; keep
+
+# Default USER package; extend or modify as you wish.  Note that this can
+# be used to call FORTRAN programs from IRAF.
+
+package user
+
+task	$adb $bc $cal $cat $comm $cp $csh $date $dbx $df $diff	= "$foreign"
+task	$du $find $finger $ftp $grep $lpq $lprm $ls $mail $make	= "$foreign"
+task	$man $mon $mv $nm $od $ps $rcp $rlogin $rsh $ruptime	= "$foreign"
+task	$rwho $sh $spell $sps $strings $su $telnet $tip $top	= "$foreign"
+task	$touch $vi $emacs $w $wc $less $rusers $sync $pwd $gdb	= "$foreign"
+
+task	$xc $mkpkg $generic $rtar $wtar $buglog			= "$foreign"
+#task	$fc = "$xc -h $* -limfort -lsys -lvops -los"
+task	$fc = ("$" // envget("iraf") // "unix/hlib/fc.csh" //
+	    " -h $* -limfort -lsys -lvops -los")
+task	$nbugs = ("$(setenv EDITOR 'buglog -e';" //
+	    "less -Cqm +G " // envget ("iraf") // "local/bugs.*)")
+task	$cls = "$clear;ls"
+
+if (access ("loginuser.cl"))
+    cl < "loginuser.cl"
+;
+
+keep;   clpackage
+
+prcache directory
+cache   directory page type help
+
+# Print the message of the day.
+if (access (".hushiraf"))
+    menus = no
+else {
+    clear; type hlib$motd
+}
+
+
+# Uncomment to initialize the SAMP interface on startup.
+if (deftask ("samp") == yes) {
+  printf ("Initializing SAMP .... ")
+  if (sampHubAccess() == yes) {
+     samp quiet
+     samp ("on", 						>& "dev$null")
+     samp noquiet
+     print ("on")
+  } else 
+     print ("No Hub Available\n")
+}
+
+
+# Delete any old MTIO lock (magtape position) files.
+if (deftask ("mtclean"))
+    mtclean
+else
+    delete uparm$mt?.lok,uparm$*.wcs verify-
+
+# List any packages you want loaded at login time, ONE PER LINE.
+images          # general image operators
+plot            # graphics tasks
+dataio          # data conversions, import export
+lists           # list processing
+
+# The if(deftask...) is needed for V2.9 compatibility.
+if (deftask ("proto"))
+    proto       # prototype or ad hoc tasks
+
+tv              # image display
+utilities       # miscellaneous utilities
+noao            # optical astronomy packages
+vo		# Virtual Observatory package
+
+keep
diff --git a/pkg/vocl/logout.cl b/pkg/vocl/logout.cl
new file mode 100644
index 00000000..f5ca4f37
--- /dev/null
+++ b/pkg/vocl/logout.cl
@@ -0,0 +1,5 @@
+# LOGOUT.CL -- Executed when you log out of the CL.  Keep this around in the CL
+# directory just to make sure this feature continues to work.
+
+history (100, >> "uparm$history.cl")
+time
diff --git a/pkg/vocl/main.c b/pkg/vocl/main.c
new file mode 100644
index 00000000..48b4fbeb
--- /dev/null
+++ b/pkg/vocl/main.c
@@ -0,0 +1,849 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <string.h>
+
+#define	import_spp
+#define	import_libc
+#define	import_fset
+#define	import_main
+#define	import_stdio
+#define	import_error
+#define	import_setjmp
+#define	import_knames
+#define	import_prtype
+#define	import_xwhen
+#define import_xnames
+#include <iraf.h>
+
+#include "config.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "operand.h"
+#include "param.h"
+#include "clmodes.h"
+#include "task.h"
+#include "errs.h"
+#include "mem.h"
+#include "proto.h"
+
+
+#define CLDIR	"cl$"
+#define HOSTLIB "hlib$"
+
+/*
+ * MAIN -- The main program of the CL.
+ *
+ * Repetitively call yyparse() and run() until hit eof (or "bye") during
+ *   the lowest cl.  The instructions exec and bye change the pc so that
+ *   new code is compiled and run in a recursive fashion without having to
+ *   call run() itself recursively.
+ *
+ * TODO:
+ *	check access rights of file-type params in inspect.
+ *	add < and > chars to mode param.
+ *	all the other TODO's and more i'm sure...
+ */
+
+#define	FOREGROUND	0
+#define	BACKGROUND	1
+#define	BKG_QUANTUM	30	/* period(sec) bkgjob checkup		*/
+#define	MAX_INTERRUPTS	5	/* max interrupts of a task		*/
+#define	LEN_INTRSTK	10	/* max nesting of saved interrupts	*/
+typedef	int (*PFI)();
+
+extern	int yydebug;		/* print each parser state if set	*/
+extern	FILE *yyin;		/* where parser reads from		*/
+extern	yeof;			/* set when yacc sees eof 		*/
+extern	dobkg;			/* set when code is to be done in bkg	*/
+extern	bkgno;			/* job number if bkg job		*/
+
+int	cldebug = 0;		/* print out lots of goodies if > 0	*/
+int	cltrace = 0;		/* trace instruction execution if > 0	*/
+
+static	PFI old_onipc;		/* X_IPC handler chained to onint()	*/
+static	long *jumpcom;		/* IRAF Main setjmp/longjmp buffer	*/
+static	jmp_buf jmp_save;	/* save IRAF Main jump vector		*/
+static	jmp_buf jmp_clexit;	/* clexit() jumps here			*/
+static	int intr_sp;		/* interrupt save stack pointer		*/
+static	XINT intr_save[LEN_INTRSTK];	/* the interrupt save stack	*/
+memel	cl_dictbuf[DICTSIZE];	/* the dictionary area			*/
+
+jmp_buf errenv;			/* cl_error() jumps here		*/
+jmp_buf intenv;			/* X_INT during process jumps here	*/
+int	validerrenv;		/* stays 0 until errenv gets set	*/
+int	loggingout;		/* set while processing logout file	*/
+int	gologout;		/* set when logout() is typed		*/
+int	alldone;		/* set by oneof when popping firstask	*/
+int	recursion;		/* detect error recursion in ONERROR	*/
+int	errlev;			/* detect error recursion in CL_ERROR	*/
+int	ninterrupts;		/* number of onint() calls per task	*/
+int	currentline;		/* current line being executed		*/
+int	errorline;		/* error line being recovered		*/
+long	cpustart, clkstart;	/* starting cpu, clock times if bkg	*/
+int	logout_status = 0;	/* optional status arg to logout() 	*/
+
+extern  XINT samp;		/* samp handle				*/
+extern  int samp_registered;
+
+static  void execute();
+static  void login(), logout();
+static  void startup(), shutdown();
+static  char *file_concat (char  *in1, char  *in2);
+
+	
+static  char *tmpfile = NULL;
+extern	char epar_cmdbuf[];
+
+
+/* C_MAIN -- Called by the SPP procedure in cl.x to fire up the CL.
+ * In effect we are chained to the IRAF Main, being called immediately after
+ * the file system, etc. is initialized.  When we exit we signal that the
+ * interpreter be skipped, proceeding directly to process shutdown.
+ */
+c_main (prtype, bkgfile, cmd)
+int	*prtype;		/* process type (connected, detached)	*/
+PKCHAR	*bkgfile;		/* bkgfile filename if detached		*/
+PKCHAR	*cmd;			/* host command line			*/
+{
+	XINT	bp;
+
+	/* Save the setjmp vector of the IRAF Main for restoration at clexit
+	 * time.  We need to intercept all errors and do error recovery
+	 * ourselves during normal execution, but when the CL exits we are
+	 * not prepared to deal with errors occuring during shutdown.
+	 */
+	XMJBUF (&bp);  jumpcom = (long *)&Memc[bp];
+	cl_amovi ((int *)jumpcom, (int *)jmp_save, LEN_JUMPBUF);
+
+	/* Init clexit() in case we have to panic stop.  */
+	if (setjmp (jmp_clexit))
+	    goto exit_;
+
+	/* Set up dictionary and catch signals.  If we are background, read in
+	 * file and jump right into run, else hand craft first task.  Die if
+	 * these fail.
+	 */
+	startup ();
+
+	if (*prtype == PR_DETACHED) {
+	    bkg_startup ((char *)bkgfile);
+	    cpustart = c_cputime (0L);
+	    clkstart = c_clktime (0L);
+	    execute (BACKGROUND);
+	} else {
+	    login ((char *) cmd);
+	    execute (FOREGROUND);
+	    logout();
+	    execute (FOREGROUND);
+	}
+
+	shutdown();
+
+exit_:
+	/* Return to the IRAF Main.  The PR_EXIT code commands the main to
+	 * skip the interpreter loop and shutdown.  Restore the error
+	 * jump vector in the IRAF Main so that it can handle errors occuring
+	 * during shutdown; we are turning control back over to the Main.
+	 * This is ugly, but the real problem is the jump vectors.  There
+	 * seems to be no alternative to this sort of thing...
+	 */
+	cl_amovi ((int *)jmp_save, (int *)jumpcom, LEN_JUMPBUF);
+	return (PR_EXIT | (logout_status << 1));
+}
+
+
+/* CLEXIT -- Called on fatal error from error() when get an error so bad that we
+ * should commit suicide.
+ */
+int 
+clexit (void)
+{
+	longjmp (jmp_clexit, 1);
+}
+
+
+/* CLSHUTDOWN -- Public entry for shutdown.
+ */
+int 
+clshutdown (void)
+{
+	shutdown();
+}
+
+
+/* STARTUP -- CL startup code.  Called by onentry() at process startup.
+ *   Allocate space for the dictionary, post exception handlers, initialize
+ *   error recovery.
+ *
+ * NOTE: in the current implementation a fixed size buffer is allocated for
+ *   the dictionary due to the difficulty of passing the dictionary to the
+ *   bkg CL if a dynamically allocated dictionary is used.  The problem is
+ *   that the dictionary is full of pointers to absolute addresses, and
+ *   we cannot control where the memory allocator in the bkg CL will allocate
+ *   a buffer.  A simple binary copy of the dictionary to different region
+ *   of memory in the bkg CL will leave the pointers pointing into limbo.
+ *
+ * TODO: Write a pair of procedures for each major data structure to dump
+ *   and restore the data structure in a binary array.  Passing the CL context
+ *   to the bkg CL would then be a matter of calling the dump procedure for
+ *   each major data structure to dump the structure into the bkgfile, then
+ *   doing a matching restore in the bkg CL to restore the data structure
+ *   to a different region of memory.  The ENV package does this already.
+ *   The only alternative would be to use indices rather than pointers in
+ *   the dictionary, which is not what C likes to do.
+ */
+static void 
+startup (void)
+{
+	int	onint(), onipc();
+
+	/* Set up pointers to dictionary buffer.
+	 */
+	dictionary = cl_dictbuf;
+	topd = 0;
+	maxd = DICTSIZE;
+
+	if (cldebug)
+	    printf ("dictionary starts at %d (0%o)\n", dictionary, dictionary);
+
+	/* Post exception handlers for interrupt and write to IPC with no
+	 * reader.  The remaining exceptions use the standard handler.
+	 */
+	c_xwhen (X_IPC, onipc, &old_onipc);
+	intr_reset();
+
+        /*  Initialize the input polling mechanism. 
+	 */
+        pollInit();
+
+	/* The following is a temporary solution to an initialization problem
+	 * with pseudofile i/o.
+	 */
+	PRPSINIT();
+}
+
+
+/* SHUTDOWN -- Call this to exit gracefully from the whole cl; never return.
+ * Write out any remaining PF_UPDATE'd pfiles by restoring topd to just above
+ *   first task unless we are in batch mode, then just flush io and die..
+ * So that the restor will include the cl's pfile and any other pfiles that
+ *   might have been cached or assigned into, we force its topd to be
+ *   below its pfile head.  See the "pfp < topdp" loop in restor().
+ * Don't bother with restor'ing if BATCH since we don't want to write out
+ *   anything then anyway.
+ */
+static void 
+shutdown (void)
+{
+	float	cpu, clk;
+
+	pr_dumpcache (0, YES);		/* flush process cache	*/
+	clgflush();			/* flush graphics output */
+
+	if (firstask->t_flags & T_BATCH) {
+	    iofinish (currentask);
+	    if (notify()) {
+		cpu = (float)c_cputime(cpustart) / 1000.;
+		clk = (float)c_clktime(clkstart);
+		fprintf (stderr, "\n[%d] done  %.1f %.0m %d%%\n", bkgno,
+		    cpu, clk/60., (int)((clk > 0 ? cpu / clk : 0.) * 100.));
+	    }
+
+	} else {
+	    firstask->t_topd = dereference (firstask->t_ltp) + LTASKSIZ;
+	    restor (firstask);
+	}
+
+	/* Clean up and temp file created for startup.
+	*/
+	if (tmpfile)				
+	    c_delete (tmpfile);
+
+	yy_startblock (LOG);			/* flush and close log	*/
+	close_logfile (logfile());
+	clexit();
+}
+
+
+/* EXECUTE -- Each loop corresponds to an exec in the interpreted code.
+ * This occurs when a script task or process is ready to run.  In background
+ * mode, we skip the preliminaries and jump right in and interpret the
+ * compiled code.
+ */
+static void 
+execute (int mode)
+{
+	int	parsestat;
+	XINT	old_parhead;
+	char	*curcmd();
+	extern  char *onerr_handler;
+
+
+	alldone = 0;
+	gologout = 0;
+	if (mode == BACKGROUND) {
+	    if (setjmp (jumpcom))
+		onerr();
+	    goto bkg;
+	}
+
+	/* Called when control stack contains only the firsttask.  ONEOF sets
+	 * alldone true when eof/bye is seen and currentask=firstask,
+	 * terminating the loop and returning to main.
+	 */
+	do {
+	    /* Bkg_update() checks for blocked or finished bkg jobs and prints
+	     * a message if it finds one.  This involves one or more access()
+	     * calls so don't call it more than every 5 seconds.  The errenv
+	     * jump vector is used by cl_error() for error restart.  The JUMPCOM
+	     * vector is used to intercept system errors which would otherwise
+	     * restart the CL.
+	     */
+	    if (currentask->t_flags & T_INTERACTIVE) {
+		static	long last_clktime;
+
+		if (c_clktime (last_clktime) > BKG_QUANTUM) {
+		    last_clktime = c_clktime (0L);
+		    bkg_update (1);
+		}
+		validerrenv = 1;
+		setjmp (errenv);
+		ninterrupts = 0;
+		if (setjmp (jumpcom))
+		    onerr();
+	    } else if (!(currentask->t_flags & T_SCRIPT))
+		setjmp (intenv);
+    
+	    pc = currentask->t_bascode;
+	    currentask->t_topd = topd;
+	    currentask->t_topcs = topcs;
+	    recursion = 0;
+	    errlev = 0;
+	    c_erract (OK);
+	    yeof = 0;
+
+	    /* In the new CL the parser needs to know more about parameters
+	     * than before.  Hence param files may be read in during parsing.
+	     * Since we discard the dictionary after parsing we must unlink
+	     * these param files, and re-read them when the
+	     * program is run.  This is inefficient but appears to work.
+	     */
+	    old_parhead = parhead;
+
+	    if (gologout)
+		yeof++;
+	    else {
+  		if (cltrace > 1) 
+		    eprintf ("main.c: start of yyparse\n");
+		yy_startblock (LOG);		/* start new history blk   */
+		parsestat = yyparse();		/* parse command block	   */
+  		if (cltrace > 1) 
+		    eprintf ("main.c: end of yyparse\n");
+
+		topd = currentask->t_topd;	/* discard addconst()'s    */
+		topcs = currentask->t_topcs;	/* discard compiler temps  */
+		parhead = old_parhead;		/* forget param files.	   */
+		if (parsestat != 0)
+		    cl_error (E_IERR, "parser gagged");
+	    }
+
+	    if (dobkg) {
+		bkg_spawn (curcmd());
+	    } else {
+bkg:
+		if (yeof)
+		    oneof();			/* restores previous task  */
+		else {
+		    /* set stack above pc, point pc back to code */
+		    topos = basos = pc - 1;
+		    pc = currentask->t_bascode;
+		}
+
+		if (!alldone) {
+		    run();			/* run code starting at pc */
+
+		    /* Save the last line executed from this run.  In the
+		     * event the task failed, this will be the line number
+		     * of the failure we'll need during error recovery.
+		     */
+		    if (currentline < currentask->t_scriptln)
+  		        errorline = currentline;
+		}
+	    }
+	} until (alldone);
+}
+
+
+/* LOGIN -- Hand-craft the first cl process.  Push the first task to become
+ * currentask, set up clpackage at pachead and set cl as its first ltask.
+ * Add the builtin function ltasks.  Run the startup file as the stdin of cl.
+ * If any of this fails, we die.
+ */
+static void 
+login (char *cmd)
+{ 
+	register struct task *tp;
+	register char *ip, *op, *arg;
+	register struct param *pp;
+	struct	ltask *ltp;
+	struct	operand o;
+	char	*loginfile = LOGINFILE;
+	char	alt_loginfile[SZ_PATHNAME];
+	char	init_envfile[SZ_PATHNAME];
+	char	clstartup[SZ_PATHNAME];
+	char	clprocess[SZ_PATHNAME];
+        char 	ebuf[FAKEPARAMLEN];
+	char	arglist[SZ_LINE], *ap;
+	char    samp_onstart[SZ_FNAME];
+
+
+	/* Initialize.
+	*/
+	memset (alt_loginfile, 0, SZ_PATHNAME);
+	memset (init_envfile, 0, SZ_PATHNAME);
+	memset (clstartup, 0, SZ_PATHNAME);
+	memset (clprocess, 0, SZ_PATHNAME);
+	memset (arglist, 0, SZ_LINE);
+	memset (ebuf, 0, FAKEPARAMLEN);
+
+	strcpy (clstartup, HOSTLIB);
+	strcat (clstartup, CLSTARTUP);
+	strcpy (clprocess, CLDIR);
+	strcat (clprocess, CLPROCESS);
+
+	tp = firstask = currentask = pushtask();
+	tp->t_in = tp->t_stdin = stdin;
+	tp->t_out = tp->t_stdout = stdout;
+	tp->t_stderr = stderr;
+	tp->t_stdgraph = fdopen (STDGRAPH, "w");
+	tp->t_stdimage = fdopen (STDIMAGE, "w");
+	tp->t_stdplot  = fdopen (STDPLOT,  "w");
+	tp->t_pid = -1;
+	tp->t_flags |= (T_INTERACTIVE|T_CL);
+
+	/* Make root package.  Avoid use of newpac() since pointers are not
+	 * yet set right.
+	 */
+	pachead = topd;
+	curpack = (struct package *) memneed (PACKAGESIZ);
+	curpack->pk_name = comdstr (ROOTPACKAGE);
+	curpack->pk_ltp = NULL;
+	curpack->pk_pfp = NULL;
+	curpack->pk_npk = NULL;
+	curpack->pk_flags = 0;
+
+	/* Initialize the input buffers.  */
+	strcpy (epar_cmdbuf, "");
+
+	/* Make first ltask.
+	 */
+	ltp = newltask (curpack, "cl", clprocess, (struct ltask *) NULL);
+	tp->t_ltp = ltp;
+	ltp->lt_flags |= (LT_PFILE|LT_CL);
+
+	tp->t_pfp = pfileload (ltp);	/* call newpfile(), read cl.par */
+	tp->t_pfp->pf_npf = NULL;
+	setclmodes (tp);		/* uses cl's params		*/
+
+	setbuiltins (curpack);		/* add more ltasks off clpackage*/
+	cl_sampInit ();			/* initialize SAMP interface	*/
+
+	/* Define the second package, the "clpackage", and make it the
+	 * current package (default package at startup).  Tasks subsequently
+	 * defined by the startup script will get put in clpackage.
+	 */
+	curpack = newpac (CLPACKAGE, "bin$");
+
+	/* Compile code that will run the startup script then, if it exists
+ 	 * in the current directory, a login.cl script.  We need to do as
+	 * much by hand here as the forever loop in main would have if this
+	 * code came from calling yyparse().
+	 */
+	if (c_access (clstartup,0,0) == NO)
+	    cl_error (E_FERR, "Cannot find startup file `%s'", clstartup);
+
+	currentask->t_bascode = 0;
+	pc = 0;
+	o.o_type = OT_STRING;
+	o.o_val.v_s = clstartup;
+	compile (CALL, "cl");
+	compile (PUSHCONST, &o);
+	compile (REDIRIN);
+	compile (EXEC);
+	compile (FIXLANGUAGE);
+
+	/* The following is to permit error recovery in the event that an
+	 * error occurs while reading the user's LOGIN.CL file.
+	 */
+	validerrenv = 1;
+	if (setjmp (errenv)) {
+	    eprintf ("Error while reading login.cl file");
+	    eprintf (" - may need to rebuild with mkiraf\n");
+	    eprintf ("Fatal startup error.  CL dies.\n");
+	    clexit();
+	}
+	ninterrupts = 0;
+	if (setjmp (jumpcom))
+	    onerr();
+
+	/* Nondestructively decompose the host command line into the startup
+	 * filename and/or the argument string.
+	 */
+	ap = &arglist[0];
+	arg = cmd;
+	while ( *arg ) {
+	    if (strncmp (arg, "-i ", 3) == 0) {
+	        for (ip=arg+2;  *ip && isspace(*ip);  ip++) ;
+	        for (op=init_envfile;  *ip && *ip != ' ';  *op++ = *ip++) ;
+	        *op = EOS;
+	        for (  ;  *ip && isspace(*ip);  ip++) ;
+	        arg = ip;
+	    } else if (strncmp (arg, "-f ", 3) == 0) {
+	        for (ip=arg+2;  *ip && isspace(*ip);  ip++) ;
+	        for (op=alt_loginfile;  *ip && *ip != ' ';  *op++ = *ip++) ;
+	        *op = EOS;
+	        for (  ;  *ip && isspace(*ip);  ip++) ;
+	        arg = ip;
+	    } else {
+		while (*arg && *arg != ' ')
+		    *ap++ = *arg++;
+		if (*arg == ' ') 
+		    *ap++ = *arg++;
+	    }
+	}
+
+
+	/* Copy any user supplied host command line arguments into the
+	 * CL parameter $args to use in the startup script (for instance).
+	 */
+	o.o_type = OT_STRING;
+	strcpy (o.o_val.v_s, arglist);
+	compile (PUSHCONST, &o);
+	compile (ASSIGN, "args");
+
+	if (alt_loginfile[0] || init_envfile[0]) {
+	    if (init_envfile[0] && (c_access (init_envfile,0,0) == YES)) {
+		/*  Concatentate init and login files. 
+		 */
+		tmpfile = file_concat (init_envfile, alt_loginfile);
+		o.o_val.v_s = tmpfile;
+
+	    } else
+		o.o_val.v_s = alt_loginfile; 	/* no init, use alt */
+
+	    /* Execute the file.
+	    */
+	    compile (CALL, "cl");
+	    compile (PUSHCONST, &o);
+	    compile (REDIRIN);
+	    compile (EXEC);
+
+	} else if (c_access (loginfile,0,0) == NO) {
+	    char *home = envget ("HOME");
+	    char global[SZ_LINE];
+
+	    memset (global, 0, SZ_LINE);
+	    sprintf (global, "%s/.iraf/login.cl", home);
+	    if (c_access (global, 0, 0) == YES) {
+	        o.o_val.v_s = global;
+	        compile (CALL, "cl");
+	        compile (PUSHCONST, &o);
+	        compile (REDIRIN);
+	        compile (EXEC);
+	    } else {
+	        printf ("Warning: no login.cl found in login directory\n");
+	    }
+
+	} else {
+	    o.o_val.v_s = loginfile;
+	    compile (CALL, "cl");
+	    compile (PUSHCONST, &o);
+	    compile (REDIRIN);
+	    compile (EXEC);
+	}
+
+	/* Initialize the fake error params.
+	 */
+        pp = addparam (firstask->t_pfp, "$errno,i,h,0\n", NULL);
+        pp->p_mode |= M_FAKE;
+
+        pp = addparam (firstask->t_pfp, "$errmsg,s,h,\"\"\n", NULL);
+        pp->p_mode |= M_FAKE;
+
+        pp = addparam (firstask->t_pfp, "$errtask,s,h,\"\"\n", NULL);
+        pp->p_mode |= M_FAKE;
+
+        pp = addparam (firstask->t_pfp, "$err_dzvalue,i,h,1\n", NULL);
+        pp->p_mode |= M_FAKE;
+
+	/* Initialize the error action.  */
+	erract_init();
+
+	compile (END);
+	topos = basos = pc - 1;
+	pc = 0;
+	run();			/* returns after doing the first EXEC	*/
+
+
+	/*  If the hlib$zzsetenv.def file says to initialize SAMP on startup,
+	 *  do it now.  Otherwise, we'll leave it to the user to manually
+	 *  start listening for messages when they're ready.  Note we always
+	 *  initialize the SAMP interface.
+	 */
+	
+	if (c_envgets ("samp_onstart", samp_onstart, SZ_FNAME) > 0) {
+	    if (strncasecmp ("yes", samp_onstart, 2) == 0 && !samp_registered)
+	        cl_sampStart ();
+	}
+
+	/* Add nothing here that will effect the dictionary or the stacks.
+	 */
+	if (cldebug)
+	    printf ("topd, pachead, parhead: %u, %u, %u\n",
+		topd, pachead, parhead);
+}
+
+
+/*  FILE_CONCAT -- Concatenate two files to a temporary output file.  Return
+ *  the name of the output file created.
+ */
+static char *
+file_concat (char  *in1, char  *in2)
+{
+	FILE *fd1, *fd2, *out;
+	static char *tmpfile, buf[SZ_LINE];
+
+
+	strcpy (buf, "/tmp/envcl");
+	tmpfile = mktemp (buf);
+	if (c_access (tmpfile, 0, 0) == YES)
+	    c_delete (tmpfile);
+	if ((out = fopen (tmpfile, "wt")) == NULL)
+	    printf ("Warning: tmp output file '%s' not found\n", tmpfile);
+
+
+	if (c_access (in1, 0, 0) == YES) {
+	    if ((fd1 = fopen (in1, "rt")) == NULL)
+	        printf ("Warning: file1 '%s' not found\n", in1);
+	    while (fgets (buf, SZ_LINE, fd1))
+	        fputs (buf, out);
+	    fclose (fd1);
+	}
+
+	if (c_access (in2, 0, 0) == YES) {
+	    if ((fd2 = fopen (in2, "rt")) == NULL)
+	        printf ("Warning: file2 '%s' not found\n", in2);
+	    while (fgets (buf, SZ_LINE, fd2))
+	        fputs (buf, out);
+	    fclose (fd2);
+	}
+
+	fclose (out);
+	return (tmpfile);
+}
+
+
+/* LOGOUT -- Process the system logout file.  Called when the user logs
+ * off in an interactive CL (not called by bkg cl's).  The standard input
+ * of the CL is hooked to the system logout file and when the eof of the
+ * logout file is seen the CL really does exit.
+ */
+static void 
+logout (void)
+{ 
+	register struct task *tp;
+	char	logoutfile[SZ_PATHNAME];
+	FILE	*fp;
+
+
+	if (samp >= 0 && samp_registered)
+	    cl_sampStop ();
+
+	strcpy(logoutfile, HOSTLIB);
+	strcat(logoutfile, CLLOGOUT);
+
+	if ((fp = fopen (logoutfile, "r")) == NULL)
+	    cl_error (E_FERR,
+		"Cannot open system logout file `%s'", logoutfile);
+
+	tp = firstask;
+	tp->t_in = tp->t_stdin = fp;
+	yyin = fp;
+	tp->t_flags = (T_CL|T_SCRIPT);
+	loggingout = 1;
+	gologout = 0;
+}
+
+
+/* MEMNEED -- Increase topd by incr INT's.  Since at present the dictionary
+ * is fixed in size, abort if the dictionary overflows.
+ */
+char *
+memneed (
+    int incr		/* amount of space desired in ints, not bytes	*/
+)
+{
+	memel *old;
+
+	old = daddr (topd);
+	topd += incr;
+
+        /* Quad alignment is desirable for some architectures. */
+        if (topd & 1)
+            topd++;
+
+	if (topd > maxd)
+	    cl_error (E_IERR, "dictionary full");
+
+	return ((char *)old);
+}
+
+
+/* ONINT -- Called when the interrupt exception occurs, i.e., the usual user
+ *   attention-getter.  (cntrl-c on dec, delete on unix, etc.).  Also called
+ *   when we are killed as a bkg job.
+ * If the current task is a script or the terminal, abort execution and
+ *   initiate error recovery.  If the task is in a child process merely send
+ *   interrupt to the child and continue execution (giving the child a chance
+ *   to cleanup before calling error, or to ignore the interrupt entirely).
+ *   If the task wants to terminate it will send the ERROR statement to the CL.
+ * If we are a bkg job, call bkg_abort to clean up (delete temp files, etc.)
+ *   before shutting down.
+ */
+/* ARGSUSED */
+int 
+onint (
+    int *vex,			/* virtual exception code	*/
+    int (**next_handler)(void)	/* next handler to be called	*/
+)
+{
+	if (firstask->t_flags & T_BATCH) {
+	    /* Batch task.
+	     */
+	    iofinish (currentask);
+	    bkg_abort();
+	    clexit();
+
+	} else if (currentask->t_flags & (T_SCRIPT|T_CL|T_BUILTIN)) {
+	    /* CL task.
+	     */
+	    cl_error (E_UERR, "interrupt!!!");
+
+	} else {
+	    /* External task connected via IPC.  Pass the interrupt on to
+	     * the child.
+	     */
+	    c_prsignal (currentask->t_pid, X_INT);
+
+	    /* Cancel any output and disable i/o on the tasks pseudofiles.
+	     * This is necessary to cancel any i/o still buffered in the
+	     * IPC channel.  Commonly when the task is writing to STDOUT,
+	     * for example, the CL will be writing the last buffer sent
+	     * to the terminal, while the task waits after having already
+	     * pushed the next buffer into the IPC.  When we resume reading
+	     * from the task we will see this buffered output on the next
+	     * read and we wish to discard it.  Leave STDERR connected to
+	     * give a path to the terminal for recovery actions such as
+	     * turning standout or graphics mode off.  This gives the task
+	     * a chance to cleanup but does not permit full recovery.  The
+	     * pseudofiles will be reconnected for the next task run.
+	     */
+	    c_fseti (fileno(stdout),            F_CANCEL, OK);
+	    c_fseti (fileno(currentask->t_in),  F_CANCEL, OK);
+	    c_fseti (fileno(currentask->t_out), F_CANCEL, OK);
+
+	    c_prredir (currentask->t_pid, STDIN, 0);
+	    c_prredir (currentask->t_pid, STDOUT, 0);
+
+	    /* If a subprocess is repeatedly interrupted we assume that it
+	     * is hung in a loop and abort, advising the user to kill the
+	     * process.
+	     */
+	    if (++ninterrupts >= MAX_INTERRUPTS)
+		cl_error (E_UERR, "subprocess is hung; should be killed");
+	    else
+		longjmp (intenv, 1);
+	}
+
+	*next_handler = NULL;
+}
+
+
+/* INTR_DISABLE -- Disable interrupts, e.g., to protect a critical section
+ * of code.
+ */
+int 
+intr_disable (void)
+{
+	PFI	junk;
+
+	if (intr_sp >= LEN_INTRSTK)
+	    cl_error (E_IERR, "interrupt save stack overflow");
+	c_xwhen (X_INT, X_IGNORE, &junk);
+	intr_save[intr_sp++] = (XINT) junk;
+}
+
+
+/* INTR_ENABLE -- Reenable interrupts, reposting the interrupt vector saved
+ * in a prior call to INTR_DISABLE.
+ */
+int 
+intr_enable (void)
+{
+	PFI	junk;
+
+	if (--intr_sp < 0)
+	    cl_error (E_IERR, "interrupt save stack underflow");
+	c_xwhen (X_INT, intr_save[intr_sp], &junk);
+}
+
+
+/* INTR_RESET -- Post the interrupt handler and clear the interrupt vector
+ * save stack.
+ */
+int 
+intr_reset (void)
+{
+	PFI	junk;
+	int	onint();
+
+	c_xwhen (X_INT, onint, &junk);
+	intr_sp = 0;
+}
+
+
+/* ONERR -- Called when system error recovery takes place.  The setjmp in
+ * execute() overrides the setjmp (ZSVJMP) in the IRAF Main.  When system error
+ * recovery takes place, c_erract() calls ZDOJMP to restart the IRAF Main.
+ * We do not want to lose the runtime context of the CL, so we restart the
+ * CL main instead by intercepting the vector.  We get the error message from
+ * the system and call cl_error() which eventually does a longjmp back to
+ * the errenv in execute().
+ */
+int 
+onerr (void)
+{
+	char	errmsg[SZ_LINE];
+	extern	int do_error;
+
+	c_erract (EA_RESTART);
+	c_errget (errmsg, SZ_LINE);
+
+	errorline = currentline;
+
+	if (recursion++)
+	    longjmp (errenv, 1);
+	else
+	    cl_error (E_UERR, errmsg);
+}
+
+
+/* CL_AMOVI -- Copy an integer sized block of memory.
+ */
+int 
+cl_amovi (register int *ip, register int *op, register int len)
+{
+	while (--len)
+	    *op++ = *ip++;
+}
diff --git a/pkg/vocl/mem.h b/pkg/vocl/mem.h
new file mode 100644
index 00000000..752b3be5
--- /dev/null
+++ b/pkg/vocl/mem.h
@@ -0,0 +1,109 @@
+/*
+ * MEM.H -- Define the dictionary, the stack, indices of various kinds, 
+ * and ways of converting the indices into true address pointers.
+ *
+ * Structures that live within the dictionary may use pointers to
+ * point at other structures (such as the task and parameter chains) but
+ * things that simply point AT the dictionary and that move around are indices
+ * into what appears to be the array of unsigned integers called dictionary.
+ * This is to facilitate putting things of disparate types into the array.
+ */
+
+/* bytes per int;
+ * typically used when putting things in the dictionary like strings, operands
+ * and codeentries. also, the pc must be advanced in ints.
+ *
+ * N.B. it is FUNDAMENTALLY ASSUMED throughout that an int is large enough to
+ * hold a pointer to an int. Further, although casts are used carefully as
+ * much as possible and so a good compiler will do much of the work,
+ * it is also pretty much taken for granted that all pointers are the
+ * same size, in particular that (char *) is the same size as (unsigned *).
+ */
+
+#define	BPI	(sizeof (memel))
+#define	btoi(x)	((int)((((x)+BPI-1)/BPI))) /* avoid promotion to unsigned */
+#define dtoi(x) ((int)(sizeof(double))/(sizeof(memel))*x)
+
+/* the dictionary starts at the top of the system break and grows as needed.
+ * if this is hard to do on your os, declare it as a genuine array and
+ *   forever fix the value of maxd by initializing them in their declarations
+ *   in compile.c. see machdep.c.
+ */
+
+
+extern memel *dictionary;    /* base of the dictionary; never moves */
+
+/* ----------
+ * convert a dictionary index into a structure pointer.
+ * also, dereference a pointer to a dictionary index.
+ */
+
+#define	reference(sname,index)	((struct sname *) (&dictionary[index]))
+/*
+#define	dereference(ptr) \
+(((unsigned)(char *)(ptr) - (unsigned)(char *)(dictionary))/BPI)
+*/
+#define	dereference(ptr) \
+(((char *)(ptr) - (char *)(dictionary))/BPI)
+
+/* ----------
+ * Generic push/pop memory routines.  Can be used to push/pop any integer type
+ * argument regardless of size, so long as it fits in a memel.
+ */
+#define push(v)		pushmem((memel)v)
+#define ppush(v)	ppushmem((memel)v)
+#define pop		popmem
+
+/* ----------
+ * convert a dictionary index into a genuine address; type will be 
+ * the type of dictionary.
+ */
+
+#define	daddr(x)			(&dictionary[x])
+
+/* ----------
+ * maxd: smallest d. index that is out of range and will give mem fault if
+ *	referenced. commonly referred to as the "system break".
+ * topd: next d. index available for use, ie, it is the smallest d. index
+ *	not in use.
+ * pachead: dictionary index of most recently added package.
+ * parhead: 		   "			    pfile.
+ * envhead:                "                        environment.
+ */
+
+extern XINT maxd;
+extern XINT topd;
+extern XINT pachead;
+extern XINT parhead;
+extern XINT envhead;
+
+/* ----------
+ * these are indices into the stack defined in stack.c.
+ * topcs: the smallest index into stack[], ie, the "top" index of the control
+ *	stack since it grows downwards, that has been used.
+ * topos: the largest index into stack[], ie, the top of the operand stack
+ *	since it grows upwards, that has been used.
+ * pc: at compile time, this is the stack[] index at which the next codeentry
+ *	may be compiled; at run time, it is the program counter and points
+ *	to the next codeentry to be run	(it is bumped before the "execute"
+ *	cycle begins. see run()).
+ * basos: not used at compile time, but when compilation ends and runtime
+ *	begins, it is set to pc and thus serves as the base of the operand
+ *	stack as everything below it will be compiled code. when compiling
+ *	starts again, this, and pc, are set to zero to forcibly clear the
+ *	operand stack.
+ */
+
+extern memel stack[];		/* space for the stacks			*/
+extern XINT topcs;		/* top of control stack			*/
+extern XINT topos;		/* top of operand stack			*/
+extern XINT basos;		/* base of operand stack		*/
+extern XINT pc;			/* program counter			*/
+
+/* ----------
+ * reference a codeentry in stack at x.
+ */
+#define	coderef(x)	((struct codeentry *)&stack[x])
+
+extern char *memneed();		/* insures enough core, returns start	*/
+extern char *comdstr();		/* compile string at topd, return start	*/
diff --git a/pkg/vocl/mkdist b/pkg/vocl/mkdist
new file mode 100755
index 00000000..65f92be6
--- /dev/null
+++ b/pkg/vocl/mkdist
@@ -0,0 +1,87 @@
+#!/bin/csh -f
+#
+#  Build the VOCL self-installer distribution
+#
+###############################################################################
+
+
+if ((! $?iraf) || (! $?IRAFARCH)) then
+    echo -n "ERROR: "
+    echo    "Must define 'iraf' and 'IRAFARCH' before building!!"
+    echo    "Quitting."
+    exit 1
+endif
+
+
+# Process command line arguments.
+set	exec	= yes
+set src_only	= no
+
+while ("$1" != "")
+    switch ("$1")
+    case -n:                            # no execute
+        set exec = no
+        breaksw
+    case -src:                          # source-only distribution
+        set src_only = yes
+        breaksw
+    default:
+	echo "mkdist: unknown argument $1"
+	breaksw
+    endsw
+
+    if ("$2" == "") then
+        break
+    else
+        shift
+    endif
+end
+
+
+# Do it.
+echo "Removing old binaries ...."
+  if ($exec == "yes" && $src_only == "no") then
+    rmbin .
+  endif 
+	
+echo "Rebuilding VOCL ...."
+  if ($exec == "yes" && $src_only == "no") then
+    mkpkg relink
+  endif 
+
+	
+echo "Creating VOCL distribution...."
+  if ($exec == "yes") then
+
+    # Exclude other distribution files and platform-specific libs 
+    # tarball.
+    if ($src_only == "yes") then
+        /bin/ls -1 vocl_install_* *.[aeo] */*.[aeo]    > /tmp/_ex$$
+    else
+        /bin/ls -1 vocl_install_* lib*.a */*.[aeo]     > /tmp/_ex$$
+    endif
+
+    # Create a tar of the source and binary
+    if ($IRAFARCH == "ssun" || $IRAFARCH == "sparc") then
+        tar -cfX - /tmp/_ex$$ . | gzip > /tmp/_tar$$
+    else
+        tar -cf - -X /tmp/_ex$$ . | gzip > /tmp/_tar$$
+    endif
+
+    # Encode the tarball and build the installer itself.
+    uuencode /tmp/_tar$$ vocl_tar.gz > /tmp/_uu$$
+    if ($src_only == "yes") then
+        cat vocl_install.csh /tmp/_uu$$ | sed -e 's/VERSION_DATE/`date`/' \
+	    > vocl_install_src.csh
+        chmod 777 vocl_install_src.csh
+    else
+        cat vocl_install.csh /tmp/_uu$$ | sed -e 's/VERSION_DATE/`date`/' \
+	    > vocl_install_${IRAFARCH}.csh
+        chmod 777 vocl_install_${IRAFARCH}.csh
+    endif
+
+    # Clean up.
+    /bin/rm -f /tmp/_tar$$ /tmp/_uu$$ /tmp/_ex$$
+  endif 
+	
+echo "Done."
diff --git a/pkg/vocl/mkpkg b/pkg/vocl/mkpkg
new file mode 100644
index 00000000..8658ad8e
--- /dev/null
+++ b/pkg/vocl/mkpkg
@@ -0,0 +1,226 @@
+# Make the CL.
+
+$call	relink				# make vocl.e in current directory
+$exit
+
+update:					# make vocl.e and install in bin$
+        $ifeq (MACH, sparc) then
+            $set    XFLAGS          = "$(XFLAGS) -/DNO_READLINE"
+        $endif
+	$call	relink
+	$call	install
+	;
+
+relink:
+	# [MACHDEP] The following is machine dependent, but is exercised only
+	# on our software development system when changes are made to the
+	# grammar of the CL.  On other systems the files lexyy.c, ytab.c, and
+	# ytab.h may be used without modification.
+
+	$ifeq (hostid, unix)
+	    $ifolder (lexyy.c, grammar.l)
+		$echo "rebuilding lexyy.c"
+		!lex -t grammar.l | sed -f lex.sed > lexyy.c
+	    $endif
+	    $ifolder (ytab.c,  grammar.y)
+		$echo "rebuilding ytab.c"
+		$ifeq (MACH, linux, redhat, suse)
+		    !yacc -vd grammar.y; 
+		    !egrep -v "\<stdlib.h\>" y.tab.c > ytab.c; 
+		    !egrep -v "\<stdio.h\>" ytab.c > ntab.c; mv ntab.c ytab.c
+		    !mv y.tab.h ytab.h
+		$else
+		    !yacc -vd grammar.y; mv y.tab.c ytab.c; mv y.tab.h ytab.h
+		$endif
+	    $endif
+	$endif
+
+	$ifeq (siteid, stsci)
+	$ifeq (hostid, vms)
+	    $ifolder (lexyy.c, grammar.l)
+		$echo "rebuilding lexyy.c"
+		!lex grammar.l
+		!@lex.com
+	    $endif
+	    $ifolder (ytab.c,  grammar.y)
+		$echo "rebuilding ytab.c"
+		!yacc -vd grammar.y
+	    $endif
+	$endif
+	$endif
+
+	$ifeq (MACH, sparc) then
+	    $set    XFLAGS          = "$(XFLAGS) -/DNO_READLINE"
+	$endif
+
+	$update libpkg.a
+
+	#$set	xflags = "$(xflags) -x -/DYYDEBUG"
+	$set	xflags = "$(xflags) -x -/I../../vendor/ -I./"
+	$omake  vocl.x
+	$omake	globals.c <libc/libc.h> <libc/stdio.h> <libc/spp.h>\
+		construct.h eparam.h operand.h param.h task.h
+	$omake	opcodes.c <libc/libc.h> <libc/spp.h> <libc/stdio.h> config.h\
+		construct.h errs.h grammar.h mem.h opcodes.h operand.h\
+		param.h task.h
+link:
+	$set	LIBS = "-lc -lcur -lds -lstg"
+	$ifneq (MACH, sparc) then
+	  $ifeq (MACH, linux) then
+	    $set	LIBS2 = "-/L/usr/lib32 -lreadline -lncurses"
+	  $else
+	    $set	LIBS2 = "-lreadline -lncurses"
+	  $endif
+	$else
+	$set	LIBS2 = ""
+	$endif
+	$link	vocl.o globals.o opcodes.o libpkg.a $(LIBS) $(LIBS2)
+	;
+
+install:
+	$move	vocl.e bin$
+	;
+
+libpkg.a:
+	#$set	xflags = "$(xflags) -qx -/DYYDEBUG"
+	$set	xflags = "$(xflags) -x -/I../../vendor/ -I./"
+
+	binop.c		<libc/spp.h> <libc/libc.h> <libc/xnames.h>\
+			<libc/math.h> <libc/ctype.h> config.h\
+			operand.h errs.h
+
+	bkg.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/knames.h> <libc/xwhen.h> <libc/ctype.h>\
+			clmodes.h config.h operand.h clmodes.h\
+			mem.h errs.h param.h task.h
+
+	builtin.c	<libc/spp.h> <libc/libc.h> <libc/fset.h>\
+			<libc/error.h> <libc/ctype.h> <libc/stdio.h>\
+			<libc/alloc.h> <libc/ttset.h> clmodes.h\
+			config.h mem.h operand.h param.h task.h errs.h
+
+	clprintf.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h operand.h param.h\
+			task.h errs.h
+
+	clsystem.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			errs.h
+
+	compile.c	<libc/spp.h> <libc/libc.h> config.h\
+			operand.h opcodes.h mem.h errs.h
+
+	debug.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			operand.h mem.h grammar.h opcodes.h config.h param.h\
+			task.h
+
+	decl.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			clmodes.h operand.h mem.h grammar.h opcodes.h config.h\
+			param.h task.h errs.h construct.h ytab.h
+
+	edcap.c		<libc/stdio.h> <libc/libc.h> <libc/ctype.h>\
+			<libc/fset.h> <libc/spp.h> config.h operand.h\
+			param.h task.h eparam.h
+
+	eparam.c	<libc/stdio.h> <libc/libc.h> <libc/error.h>\
+			<libc/ctype.h> <libc/ttset.h> <libc/fset.h>\
+			<libc/spp.h> config.h mem.h operand.h\
+			errs.h param.h grammar.h task.h eparam.h
+
+	errs.c		<libc/spp.h> <libc/libc.h> <libc/fset.h>\
+			<libc/stdio.h> <libc/setjmp.h> <libc/knames.h>\
+			<libc/xnames.h> clmodes.h\
+			config.h operand.h param.h task.h mem.h errs.h\
+			grammar.h construct.h
+
+	exec.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/xwhen.h> clmodes.h config.h mem.h\
+			opcodes.h operand.h param.h task.h errs.h\
+			grammar.h
+
+	gquery.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h operand.h param.h grammar.h\
+			task.h clmodes.h
+
+	gram.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			clmodes.h operand.h mem.h grammar.h\
+			opcodes.h config.h param.h task.h errs.h construct.h\
+			ytab.h
+
+	history.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/fset.h> <libc/ctype.h> config.h errs.h\
+			mem.h operand.h param.h task.h clmodes.h grammar.h
+
+	lists.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h mem.h operand.h param.h\
+			task.h errs.h
+
+	main.c		<libc/spp.h> <libc/libc.h> <libc/fset.h>\
+			<libc/main.h> <libc/stdio.h> <libc/error.h>\
+			<libc/setjmp.h> <libc/knames.h> <libc/prtype.h>\
+			<libc/xwhen.h> <libc/xnames.h> grammar.h\
+			opcodes.h operand.h param.h config.h clmodes.h task.h\
+			errs.h mem.h
+
+	modes.c		<libc/spp.h> <libc/libc.h>\
+			<libc/stdio.h> <libc/ctype.h> clmodes.h\
+			config.h construct.h operand.h param.h grammar.h\
+			mem.h task.h errs.h
+
+        multop.c        <libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+                        clmodes.h operand.h mem.h grammar.h\
+                        opcodes.h config.h param.h task.h errs.h construct.h\
+                        ytab.h
+
+	operand.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			errs.h config.h operand.h param.h grammar.h\
+			mem.h task.h construct.h eparam.h
+
+	param.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h operand.h param.h grammar.h mem.h\
+			task.h errs.h clmodes.h construct.h
+
+	pfiles.c	<libc/spp.h> <libc/libc.h> <libc/finfo.h>\
+			<libc/stdio.h> <libc/ctype.h> config.h\
+			errs.h operand.h mem.h param.h task.h grammar.h
+
+	prcache.c	<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/error.h> <libc/finfo.h> <libc/prstat.h>\
+			config.h errs.h task.h
+
+	scan.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h operand.h param.h grammar.h\
+			task.h errs.h
+
+	stack.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			mem.h operand.h config.h param.h task.h\
+			errs.h
+
+	task.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			config.h operand.h param.h mem.h task.h\
+			errs.h clmodes.h
+
+	unop.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/xnames.h> <libc/math.h> config.h\
+			operand.h errs.h task.h param.h
+
+	ytab.c		<libc/spp.h> <libc/libc.h> <libc/stdio.h>\
+			<libc/ctype.h> config.h mem.h operand.h\
+			param.h grammar.h opcodes.h clmodes.h task.h\
+			construct.h errs.h lexyy.c lexicon.c
+
+
+	# VO-related sources.
+
+	builtin_vo.c	config.h clmodes.h mem.h operand.h opcodes.h \
+		    	param.h task.h errs.h
+
+	voclient.c	config.h clmodes.h operand.h mem.h grammar.h \
+			opcodes.h param.h task.h errs.h \
+			construct.h ytab.h
+
+	samp.c		clsamp.h
+	sampCmd.c	clsamp.h
+	sampFuncs.c	clsamp.h
+	sampHandlers.c	clsamp.h
+	;
+
diff --git a/pkg/vocl/modes.c b/pkg/vocl/modes.c
new file mode 100644
index 00000000..c83d81cd
--- /dev/null
+++ b/pkg/vocl/modes.c
@@ -0,0 +1,1261 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "construct.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "mem.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+/*
+ * MODES -- Handle the parameter mode operations, such as determining effective
+ *   mode, checking if in range and queries.
+ * Also handle the global modes of the cl, such as abbreviations, menus, and
+ *   logging.  Macro defns for all but abbreviations are in clmodes.h; it is
+ *   involved enough to be a real function in this file.
+ */
+
+#define INIT_DELAY	3		/* sleep params, bkg_query()	*/
+#define	DELAY_MULT	1.4
+#define	MAXDELAY	(60*5)		/* sleep at most 5 minutes	*/
+#define	BKQ_TIMEOUT	(60*60*3)	/* time out after 3 hours	*/
+#define	SZ_PROMPTBUF	SZ_LINE		/* avoid string overflow	*/
+
+extern	int cldebug;
+extern	char *eofstr;
+extern	int bkgno;		/* our job number, if background	*/
+extern	int ppid;		/* parent's pid, if background		*/
+
+/* These are set, by setclmodes(), right after the cl's pfile is read. there
+ *   is one for each special-function cl parameter.
+ * Once set, they are used by the macros in clmodes.h to efficiently determine
+ *   the various function settings yet allow them to remain normal parameters.
+ */
+struct	param *clabbrev;	/* allow abbreviations?			*/
+struct	param *clmenus;		/* display tasks in curpack with prompt?*/
+struct	param *clshowtype;	/* display task type in menus		*/
+struct	param *clkeeplog;	/* keep all input in logfile?		*/
+struct	param *cllexmodes;	/* enable lexical mode switching	*/
+struct	param *cllogfile;	/* name of the logfile			*/
+struct	param *clnotify;	/* notify parent when bkg task is done	*/
+struct	param *clecho;		/* echo commands from scripts on stderr	*/
+int	cllogmode = LOG_COMMANDS;	/* Logging control flag */
+
+
+/* Calculate the effective mode for the given parameter, considering
+ *   its own mode and the modes for the current task and the cl.
+ *   Inhibit query mode if set on the command line or hidden but
+ *   enable it if the param is not in range.  The range test cannot be done
+ *   here for list params because we'd have to read the list to do it.
+ * Return a bit-mapped code (built up of M_XXX bits) of the result.
+ * Since learn mode is not defined at the parameter level, pp == NULL
+ *   is used to indicate we are just interested in M_LEARN info.
+ * Local variables cannot be prompted for so it is an error if their
+ *   values are undefined.
+ */
+int 
+effmode (struct param *pp)
+{
+	static	char	*localerr =
+		"Attempt to access undefined local variable `%s'.\n";
+
+	register int	mode, modebits;
+	struct	operand o;
+	int	clmode, ltmode, pkmode, offset;
+	int	interactive;
+
+
+	/* Check if param is a local variable.  If it is undefined
+	 * this is an ERR, if defined just return mode 0 to defeat
+	 * querying.
+	 */
+	if (pp != NULL) {
+	    if (pp->p_mode & M_LOCAL) {
+		if (opundef (&(pp->p_valo)))
+		    cl_error (E_UERR, localerr, pp->p_name);
+		return (0);
+	    }
+	}
+
+	/* Determine whether or not the current task was called interactively.
+	 * Menu mode is only permitted for tasks called interactively.
+	 */
+	interactive = 0;
+	if (prevtask)
+	    interactive = (prevtask->t_flags & (T_INTERACTIVE|T_BATCH));
+	if (interactive)
+	    modebits = (M_QUERY|M_HIDDEN|M_MENU);
+	else
+	    modebits = (M_QUERY|M_HIDDEN);
+
+	clmode = scanmode (firstask->t_modep->p_val.v_s);
+	ltmode = scanmode (currentask->t_modep->p_val.v_s);
+	pkmode = -1;
+
+	mode = 0;
+	if (pp != NULL) {
+	    /* In determining the effective mode we go up the hierarchy of
+	     * parameter, task, package, cl.  The mode is taken from the first
+	     * of these which is not automatic.
+	     */
+	    if ( (mode = (pp->p_mode & modebits)) )
+		;
+	    else if ( (mode = (ltmode & modebits)) )
+		;
+	    else {
+		/* Check the mode of the package to which the ltask belongs,
+		 * which need not be the "current" package.
+		 */
+		struct pfile *pfp;
+
+		if ( (pfp = currentask->t_ltp->lt_pkp->pk_pfp) ) {
+	 	    struct param   *ppx;
+	 	    ppx = paramfind (pfp, "mode", 0, YES);
+	 	    if ((ppx != NULL)  &&  (ppx != (struct param *)ERR))
+	 		pkmode = scanmode (ppx->p_val.v_s);
+	 	}
+
+		if (pkmode > 0 && (mode = (pkmode & modebits)))
+		    ;
+		else if ( (mode = (clmode & modebits)) )
+		    ;
+		else
+		    mode = M_AUTO;
+	    }
+
+	    /* Defeat query mode if param set on command line or it's a
+	     * hidden param or if menu mode is in effect.
+	     */
+	    if ((pp->p_flags & P_CLSET) || (pp->p_mode & M_HIDDEN) ||
+		(mode & M_MENU))
+		mode &= ~M_QUERY;
+
+	    /* Query unconditionally if param is out of range or undefined.
+	     */
+	    if (!(mode & M_QUERY) && !(pp->p_type & PT_LIST)) {
+
+		/* To check whether an array element is in range we
+		 * must get the appropriate element of the array.  However
+		 * the stack must be reset so that the element can be accessed
+		 * again by the calling routine.
+		 */
+		if (pp->p_type & PT_ARRAY) {
+		    offset = getoffset(pp);
+
+		    poffset (offset);
+		    paramget(pp, FN_VALUE);
+
+		    poffset (offset);
+
+		    o = popop();
+		    if (!inrange (pp, &o))
+			mode |= M_QUERY;
+
+		} else {
+		    /* Use temporary scratch variable for range checking in
+		     * this case; sometimes the value of an enumerated
+		     * parameter would get trashed in the process.  There is
+		     * probably some deeper, darker bug lurking down there,
+		     * but haven't found it yet, so this will suffice for now.
+		     */
+		    o = pp->p_valo;
+		    if (!inrange (pp, &o))
+			mode |= M_QUERY;
+		}
+	    }
+	}
+
+	/* Enable learn mode only for tasks called interactively - don't bother
+	 * to learn parameters if the task is called from a script or in batch
+	 * mode.
+	 */
+	if (interactive)
+	    mode |= (clmode & M_LEARN) | (ltmode & M_LEARN);
+
+	return (mode);
+}
+
+
+/* TASKMODE -- Determine the effective mode for a task.
+ */
+int 
+taskmode (register struct task *tp)
+{
+	register int	modebits, mode;
+	struct	pfile *pfp;
+	int	clmode, pkmode, ltmode;
+	int	interactive, learn;
+
+	/* Determine whether or not the task was called interactively.
+	 * Menu mode is only permitted for tasks called interactively.
+	 */
+	interactive = 0;
+	if (next_task(tp))
+	    interactive = (next_task(tp)->t_flags & (T_INTERACTIVE|T_BATCH));
+	if (interactive)
+	    modebits = (M_QUERY|M_HIDDEN|M_MENU);
+	else
+	    modebits = (M_QUERY|M_HIDDEN);
+
+	ltmode = scanmode (tp->t_modep->p_val.v_s);
+	clmode = scanmode (firstask->t_modep->p_val.v_s);
+	learn  = ((ltmode|clmode) & M_LEARN);
+
+	/* If the mode of the task is anything but AUTO we are done.
+	 */
+	if ( (mode = (ltmode & modebits)) )
+	    if (interactive || !(mode & M_MENU))
+		return (mode|learn);
+
+	/* If the package to which the task belongs has a pfile and the mode
+	 * of the package is anything but AUTO, we are done.
+	 */
+	if ( (pfp = tp->t_ltp->lt_pkp->pk_pfp) ) {
+	    struct param   *ppx;
+
+	    pkmode = ERR;
+	    ppx = paramfind (pfp, "mode", 0, YES);
+	    if ((ppx != NULL) && (ppx != (struct param *)ERR))
+		pkmode = scanmode (ppx->p_val.v_s);
+
+	    if (pkmode != ERR && (mode = (pkmode & modebits)))
+		if (interactive || !(mode & M_MENU))
+		    return (mode|learn|(pkmode&M_LEARN));
+	}
+
+	/* Return the CL mode (menu mode not permitted at the CL level).
+	 */
+	return (clmode);
+}
+
+
+/* QUERY -- Query the user for the value of a parameter.  Prompt with the
+ *  current value if any.  Keep this up until we can push a reasonable value.
+ *  Also, store the new value in the parameter (except for list params, where,
+ *  since the values are not kept, all that may change is P_LEOF if seen).
+ * Give prompt, or name if none, current value and range if int, real or 
+ *   filename.  Accept CR to leave value unchanged, else take the string
+ *   entered to be the new value.  Repeat until parameter value is in range.
+ * We mean to talk straight to the user here; thus, interact with the real
+ *   stdio, not the effective t_stdio, so that redirections do not get in
+ *   the way.  In batch mode, a forced query is handled by writing a
+ *   message on the terminal of the parent cl (the original stderr), and
+ *   leaving some info describing the query in a file in uparm (if there is
+ *   no uparm, we abort).  We then loop, waiting for the user to run "service"
+ *   in the interactive cl to service the query, leaving the answer in a
+ *   another file which we read and then delete.  If we wait a long time and
+ *   get no response, we timeout.
+ */
+void 
+query (struct param *pp)
+{
+	static	char *oormsg =
+		"ERROR: Parameter value is out of range; try again";
+	register char *ip;
+	char	buf[SZ_PROMPTBUF+1];
+	struct	operand o;
+	int	bastype, batch, arrflag, offset=0, n_ele, max_ele, fd;
+	char	*index(), *nlp, *nextstr();
+	char	*bkg_query(), *query_status;
+	char	*abuf;
+
+	bastype = pp->p_type & OT_BASIC;
+	batch = firstask->t_flags & T_BATCH;
+	arrflag = pp->p_type & PT_ARRAY;
+
+	if (arrflag) {			/* We may access the array many     */
+	    offset = getoffset (pp);	/* times, so save the offset and    */
+					/* push it when necessary.	    */
+	    poffset (offset);
+	    max_ele = size_array (pp) - offset;
+	} else
+	    max_ele = 1;
+
+
+	forever {
+	    if (batch) {
+		/* Query from a background job.
+		 */
+		query_status = bkg_query (buf, SZ_PROMPTBUF, pp);
+
+	    } else if (pp->p_type & (PT_GCUR|PT_IMCUR)) {
+		/* Read a graphics cursor.
+		 */
+		char	source[33];
+		int	cursor;
+
+		/* Determine the source of graphics cursor input, chosen from
+		 * either the graphics or image cursor or the terminal.
+		 */
+		if (pp->p_type & PT_GCUR) {
+		    if (c_envfind ("stdgcur", source, 32) <= 0)
+			strcpy (source, "stdgraph");
+		} else {
+		    if (c_envfind ("stdimcur", source, 32) <= 0)
+			strcpy (source, "stdimage");
+		}
+
+		if (strcmp (source, "stdgraph") == 0)
+		    cursor = STDGRAPH;
+		else if (strcmp (source, "stdimage") == 0)
+		    cursor = STDIMAGE;
+		else
+		    goto text_query;		/* get value from terminal */
+
+		/* Read a physical graphics cursor.
+		 */
+		pp->p_flags &= ~P_LEOF;
+		if (cursor == STDIMAGE) {
+		    /* The following is a kludge used to temporarily implement
+		     * the logical image cursor read.  In the future this will
+		     * be eliminated, and the c_rcursor call below (cursor
+		     * mode) will be used for stdimage as well as for stdgraph.
+		     * The present code (IMDRCUR) goes directly to the display
+		     * server to get the cursor value, bypassing cursor mode
+		     * and the (currently nonexistent) stdimage kernel.
+		     */
+		    char    str[SZ_LINE+1], keystr[10];
+		    int     wcs, key;
+		    float   x, y;
+
+		    if (c_imdrcur ("stdimage",
+			&x,&y,&wcs,&key,str,SZ_LINE, 1, 1) == EOF) {
+			query_status = NULL;
+
+		    } else {
+			if (isprint(key) && !isspace(key))
+			    sprintf (keystr, "%c", key);
+			else
+			    sprintf (keystr, "\\%03o", key);
+			sprintf (buf, "%.3f %.3f %d %s %s\n",
+			    x, y, wcs, keystr, str);
+		        query_status = (char *) ((XINT) strlen(buf));
+		    }
+
+		} else if (c_rcursor (cursor, buf, SZ_PROMPTBUF) == EOF) {
+		    query_status = NULL;
+		} else
+		    query_status = (char *) ((XINT) strlen(buf));
+
+	    } else if (pp->p_type & PT_UKEY) {
+		/* Read a user keystroke command from the terminal.
+		 */
+		pp->p_flags &= ~P_LEOF;
+		if (c_rdukey (buf, SZ_PROMPTBUF) == EOF)
+		    query_status = NULL;
+		else
+		    query_status = (char *) ((XINT) strlen(buf));
+
+	    } else {
+text_query:	fd = spf_open (buf, SZ_PROMPTBUF);
+		pquery (pp, fdopen(fd,"a"));
+		spf_close (fd);
+
+		c_stgputline ((XINT)STDOUT, buf);
+		if (c_stggetline ((XINT)STDIN, buf, SZ_PROMPTBUF) > 0)
+		    query_status = (char *) ((XINT) strlen(buf));
+		else
+		    query_status = NULL;
+	    }
+
+	    ip = buf;
+
+	    /* Set o to the current value of the parameter.  Beware that some
+	     * of the logical branches which follow assume that struct o has
+	     * been initialized to the current value of the parameter.
+	     */
+	    if (pp->p_type & PT_LIST)
+		setopundef (&o);
+	    else if (arrflag) {
+		paramget(pp, FN_VALUE);
+		poffset (offset);
+		o = popop();
+	    } else
+		o = pp->p_valo;
+
+	    /* Handle eof, a null-length line (lone carriage return),
+	     * and line with more than SZ_LINE chars.  Ignore leading whitespace
+	     * if basic type is not string.
+	     */
+	    if (query_status == NULL) {
+		/* Typing eof will use current value (as will a lone
+		 * newline) but if param is a list, it is a meaningful
+		 * answer.
+		 */
+		if (pp->p_type & PT_LIST) {
+		    closelist (pp);		/* close an existing file */
+		    pp->p_flags |= P_LEOF;
+		    o = makeop (eofstr, OT_STRING);
+		    break;
+		}
+		goto testval;
+	    }
+
+	    /* Ignore leading whitespace if it is not significant for this
+	     * datatype.  Do this before testing for empty line, so that a
+	     * return such as " \n" is equivalent to "\n".  I.e., do not
+	     * penalize the user if they type the space bar by accident before
+	     * typing return to accept the default value.
+	     */
+	    if (bastype != OT_STRING || (pp->p_type & (PT_FILNAM|PT_PSET)))
+		while (*ip == ' ' || *ip == '\t')
+		    ip++;
+
+	    if (*ip == '\n') {
+		/* Blank lines usually just accept the current value
+		 * but if the param is a string and is undefined,
+		 * it sets the string to a (defined) nullstring.
+		 */
+		*ip = '\0';
+		if (bastype == OT_STRING && opundef (&o))
+		    o = makeop (ip, bastype);
+		else
+		    goto testval;
+	    }
+
+	    if ((nlp = index (ip, '\n')) != NULL)
+		*nlp = '\0';			/* cancel the newline	*/
+	    else
+		goto testval;
+
+	    /* Finally, we have handled the pathological cases...
+	     */
+	    if ((pp->p_type & PT_LIST) &&
+		(!strcmp (ip,eofstr) || !strcmp (ip,"eof"))) {
+
+		closelist (pp);
+		pp->p_flags |= P_LEOF;
+		o = makeop (eofstr, OT_STRING);
+		break;
+
+	    } else {
+		if (arrflag) {
+		    /* In querying for arrays we may set more than one
+		     * element of the array in a single query.  However
+		     * we must set the first element.  So we will pretend
+		     * to be a scalar until that first element is set
+		     * and then enter a loop where we may set other
+		     * elements.
+		     */
+		    abuf = ip;
+		    ip = nextstr(&abuf, stdin);
+		    if (ip == NULL  ||  ip == (char *) ERR  ||  ip == undefval)
+			goto testval;
+		}
+
+		o = makeop (ip, bastype);
+	    }
+
+testval:
+	    /* If parameter value is in range, we are done.  If it is out of
+	     * range and we are a batch job or an interactive terminal job,
+	     * print an error message and request that the user enter a legal
+	     * value.  If the CL is being run taking input from a file, abort,
+	     * else we will go into a loop reading illegal values from the
+	     * input file and printing out lots of error messages.
+	     */
+	    if (inrange (pp, &o))
+		break;
+	    else if (batch)
+		eprintf ("\n[%d] %s", bkgno, oormsg);
+	    else if (isatty (fileno (stdin)))
+		eprintf ("%s\n", oormsg);
+	    else
+		cl_error (E_UERR, oormsg);
+	}
+
+	if (!(pp->p_type & PT_LIST)) {
+	    /* update param with new value.
+	     */
+	    if (cldebug) {
+		eprintf ("changing `%s.p_val' to ", pp->p_name);
+		fprop (stderr, &o);
+		eprintf ("\n");
+	    }
+
+	    pushop (&o);
+	    paramset (pp, FN_VALUE);
+	    pp->p_flags |= P_QUERY;
+	}
+
+	pushop (&o);
+
+	if (arrflag  &&  query_status != NULL  &&  *ip != '\0') {
+	    /* If we have an array assign values until something
+	     * is used up or until we hit any error.
+	     */
+	    n_ele = 1;
+	    forever {
+		if (n_ele >= max_ele)		/* End of array. */
+		    break;
+		ip = nextstr(&abuf, stdin);
+
+		if (ip == NULL)			/* End of query line. */
+		    break;
+
+		if (ip == (char *) ERR) {	/* Error on query line. */
+		    eprintf("Error loading array value.\n");
+		    break;
+		}
+
+		if (ip != undefval) {
+		    o = makeop (ip, bastype);
+		    if ( ! inrange (pp, &o) ) {	/* Not in range. */
+			eprintf("Array value outside range.\n");
+			break;
+		    }
+
+		    offset++;			/* Next element in array. */
+		    poffset (offset);
+
+		    pushop (&o);
+		    paramset (pp, FN_VALUE);
+		} else
+		    offset++;
+
+		n_ele++;
+	    }
+	}
+}
+
+
+/* NEXTSTR -- Get the next string in a prompt.
+ */
+char *
+nextstr (char **pbuf, FILE *fp)
+{
+	char	*p, *nxtchr();
+	static	char	tbuf[SZ_LINE];
+	char	quote;
+	int	cnt;
+
+	p = *pbuf;
+
+	/* Skip white space. */
+	while ( *p == ' '  ||  *p == '\t'  ||  *p =='\n')
+	    p = nxtchr(p, fp);
+
+	/* Reached end?	*/
+	if (*p == '\0') {
+	    *pbuf = p;
+	    return (NULL);
+	}
+
+	quote = '\0';
+	cnt = 0;
+
+	/* Quoted string. */
+	if (*p == '\''  ||  *p == '"') {
+	    quote = *p;
+	    p = nxtchr (p, fp);
+
+	    while (*p != quote) {
+
+		if (p == '\0'  ||  cnt >= SZ_LINE)
+		    return ( (char *) ERR);
+
+		else {
+		    tbuf[cnt++] = *p;
+		    p = nxtchr(p, fp);
+		}
+	    }
+	    /* Skip quote. */
+	    p = nxtchr (p, fp);
+
+	} else {
+	    /* Unquoted string. */
+	    while (*p != ' '   &&  *p != '\t'   &&  *p != '\n'  &&
+	      *p != '\0'  &&  *p != ',') {
+
+		if (cnt >= SZ_LINE)
+		    return ( (char *) ERR );
+
+		tbuf[cnt++] = *p;
+		p = nxtchr (p, fp);
+	    }
+	}
+	tbuf[cnt] = '\0';
+
+	/* Skip any white-space following. */
+	while (*p == ' '  ||  *p == '\t'  ||  *p == '\n')
+	    p = nxtchr(p, fp);
+
+	if (*p != ','   &&  *p != '\0')
+	    return ( (char *) ERR);
+
+	/* Skip delimiter. */
+	if (*p == ',')
+	   p = nxtchr(p, fp);
+
+	*pbuf = p;
+	if (cnt == 0) {
+	    /* Return a quoted null string, otherwise the field was skipped. */
+	    if (quote != '\0')
+		return (tbuf);
+	    else
+		return (undefval);
+	} else
+	    return (tbuf);
+}
+
+
+/* NXTCHR -- Get a pointer to the next char, reading the next line if necessary.
+ */
+char *
+nxtchr (char *p, FILE *fp)
+{
+	/* P may point to within readbuf on return, so it had better be
+	 * static.
+	 */
+	static	char	readbuf[SZ_LINE];
+
+	if (*p)
+	    p++;
+start:
+	if (*p == '\\')
+	    if (*(p+1) == '\n') {
+		if (fgets (readbuf, SZ_LINE, fp) == NULL)
+		    /* We assume that the newline is always followed by a
+		     * null in return from fgets.
+		     */
+		    return (p+2);
+		else {
+		    p = readbuf;
+		    goto start;
+		}
+	    }
+
+	return (p);
+}
+
+
+/* PQUERY -- Print the query message.
+ */
+void 
+pquery (register struct param *pp, FILE *fp)
+{
+	struct	operand o;
+	int	offset=0, arrflag=0;
+
+	arrflag = pp->p_type & PT_ARRAY;
+
+	fprintf (fp, *pp->p_prompt == '\0' ? pp->p_name : pp->p_prompt);
+
+	/* Show the ranges if they are defined and this is a parameter
+	 * type that has ranges.
+	 */
+	if (range_check (pp)) {
+	    fprintf (fp, " (");
+	    if (!(pp->p_flags & (P_IMIN|P_UMIN))) {
+		paramget (pp, FN_MIN);
+		o = popop();
+		fprop (fp, &o);
+	    }
+	    if ((pp->p_type & OT_BASIC) != OT_STRING)
+		fprintf (fp, ":");
+	    if (!(pp->p_flags & (P_IMAX|P_UMAX))) {
+		paramget (pp, FN_MAX);
+		o = popop();
+		fprop (fp, &o);
+	    }
+	    fputc (')', fp);
+	}
+
+	/* Print the array indices.  We get the offset and convert back
+	 * to the indices.  This works regardless of the offset mode.
+	 */
+	if (arrflag) {
+	    int	dim, d, rem, temp;
+	    short *len, *off;
+
+	    offset = getoffset (pp);
+	    poffset (offset);		/* Restore stack for later reference */
+
+	    dim = pp->p_val.v_a->a_dim;
+	    len = &(pp->p_val.v_a->a_len) ;
+	    off = &(pp->p_val.v_a->a_off) ;
+
+	    fputc ('[', fp);
+	    temp = offset;
+	    for (d=0; d<dim; d++) {
+
+		if (d>0)
+		    fputc (',', fp);
+
+		rem = (temp % *len) + *off;
+		fprintf (fp, "%d",rem);
+		temp = temp / *len;
+		len = len + 2;
+		off = off + 2;
+	    }
+  	    fputc (']', fp);
+	}
+	
+	/* Set o to the current value of the parameter.  List files do
+	 * not keep a value in core, however, and we certainly do not want
+	 * to read the list to get one.
+	 */
+	if (pp->p_type & PT_LIST)
+	    setopundef (&o);
+	else {
+	    paramget (pp, FN_VALUE);
+	    o = popop();
+
+	    /* Restore offset on stack if array. */
+	    if (arrflag) {
+		poffset (offset);
+	    }
+	}
+
+	/* Print current value if not undefined.  Ok if just indefinite.
+	 */
+	if (!opundef (&o)) {
+	    if ((o.o_type & OT_BASIC) != OT_STRING || *(o.o_val.v_s) != '\0') {
+		fprintf (fp, " (");
+		fprop (fp, &o);
+		fputc (')', fp);
+	    }
+	}
+	fprintf (fp, ": ");
+	fflush (fp);
+}
+
+
+/* BKG_QUERY -- Send the "waiting for parameter input" to the user terminal,
+ * and loop until the background query response file is readable.
+ * This happens when the user responds to the query by executing "service".
+ * Check frequently in the beginning, gradually lengthening the sleep periods
+ * so that we do not hog the machine if the user is out to lunch.  Timeout
+ * after a suitable interval if no response.
+ */
+char *
+bkg_query (
+    char *obuf,			/* same calling sequence as 'fgets' */
+    int maxch,
+    register struct param *pp
+)
+{
+	char	bqfile[SZ_PATHNAME], qrfile[SZ_PATHNAME];
+	int	waitime, delay;
+	char	*envget(), *fgets_status;
+	FILE	*fp, *in;
+
+	if (notify())
+	    eprintf ("\n[%d] stopped waiting for parameter input\n", bkgno);
+	get_bkgqfiles (bkgno, ppid, bqfile, qrfile);
+	
+	/* Get names of the query and query response files and open the query
+	 * file to receive the query.  Post query request on the user terminal.
+	 * If an old query response file happens to be lying about, delete it.
+	 */
+	c_delete (bqfile);
+	if ((fp = fopen (bqfile, "w")) == NULL)
+	    cl_error (E_UERR, "Cannot create file `%s' for query", bqfile);
+	c_delete (qrfile);
+
+	/* Print the query prompt into the background query request file.
+	 */
+	pquery (pp, fp);
+	fclose (fp);
+
+	waitime = 0;
+	delay = INIT_DELAY;
+
+	/* Loop until the query response file is readable.  Sleep for
+	 * progressively longer intervals if no response, then timeout.
+	 */
+	do {
+	    if (waitime > BKQ_TIMEOUT) {
+		c_delete (bqfile);
+		cl_error (E_UERR, "Timeout on query");
+	    } else {
+		delay = (delay *= DELAY_MULT) > MAXDELAY ? MAXDELAY : delay;
+		c_tsleep (delay);
+		waitime += delay;
+	    }
+	} while (c_access (qrfile,0,0) == NO);
+
+	if ((in = fopen (qrfile, "r")) == NULL)
+	    cl_error (E_UERR, "cannot open query response file");
+
+	fgets_status = fgets (obuf, maxch, in);
+	fclose (in);
+	c_delete (qrfile);
+
+	return (fgets_status);
+}
+
+
+/* SERVICE_BKGQUERY -- Called by the user to service a background query.
+ * We must open the background query file for the indicated task and type
+ * out the prompt therein for the user.  The user's response in then placed
+ * in the query response file, we delete the original query file, and we
+ * are done.  When the bkg job wakes up it will read the response file and
+ * (assuming there are no errors) continue on.
+ */
+void 
+service_bkgquery (
+    int bkgno			/* ordinal of job requiring service	*/
+)
+{
+	register int ch;
+	char	bqfile[SZ_PATHNAME], qrfile[SZ_PATHNAME];
+	char	qrtemp[SZ_PATHNAME];
+	char	response[SZ_LINE+1];
+	FILE	*fp;
+
+	if (bkg_jobactive (bkgno) == NO)
+	    cl_error (E_UERR, "No such job");
+	else
+	    get_bkgqfiles (bkgno, c_getpid(), bqfile, qrfile);
+	c_mktemp ("uparm$QR", qrtemp, SZ_PATHNAME);
+
+	if ((fp = fopen (bqfile, "r")) == NULL)
+	    cl_error (E_UERR, "No query is pending for bkg job [%d]", bkgno);
+
+	/* Copy query file verbatim to the user's terminal.  The last line
+	 * will not have a newline, but that is ok here.
+	 */
+	while ((ch = fgetc(fp)) != EOF)
+	    putchar (ch);
+	fflush (stdout);
+
+	/* Get user's response and write into query response file.
+	 * We write the response first into a temp file and then rename the
+	 * temp file to eliminate the chance that the bkg job will try to
+	 * open and read the response file before the data has all been
+	 * written into it (happens on systems that do not lock files
+	 * opened by another process for writing).
+	 */
+	c_delete (qrtemp);
+	fgets (response, SZ_LINE, stdin);
+	if ((fp = fopen (qrtemp, "w")) == NULL)
+	    cl_error (E_UERR, "Cannot open `%s' to respond to query", qrtemp);
+	fputs (response, fp);
+	fclose (fp);
+	c_rename (qrtemp, qrfile);
+
+	/* Do not delete the query file until we successfully respond to
+	 * the query (in case of an abort).
+	 */
+	c_delete (bqfile);
+}
+
+
+/* GET_BKGQFILES -- Get the name of a background query file.  This routine
+ * aborts if the directory uparm$ is not defined.  Since we have two processes
+ * communicating via files, we must have a fixed directory both processes
+ * expect to find the files.  We assume that the user does not start a bkg
+ * job and then change uparm$ in the foreground cl.
+ */
+void 
+get_bkgqfiles (int bkgno, int pid, char *bkg_query_file, char *query_response_file)
+{
+	int	filecode;
+	char	*envget();
+
+	if (envget (UPARM) == NULL)
+	    cl_error (E_UERR,
+		"Logical directory 'uparm$' not defined, cannot query");
+	
+	filecode = bkgno * 10000 + (pid % 10000);
+	sprintf (bkg_query_file, "%sBQF%d", envget(UPARM), filecode);
+	sprintf (query_response_file, "%sBQR%d", envget(UPARM), filecode);
+}
+
+
+/* INRANGE -- Check whether operand *op is in range, that is, that its o_val
+ *   field is within the limits defined by the p_min/max fields in param *pp.
+ *   Return YES if it is in range, else NO.  In the case of filenames, also
+ *   check that the PT_FXX access attributes are true.  Also, filenames are
+ *   considered out of range is they are indefinite (unlike other types; see
+ *   below).
+ * The basic types for the operand and the parameter must agree.
+ * Always return YES for types that do not have ranges (only ints, reals,
+ *   and filenames have ranges), when min > max, or when op is INDEF.
+ *   Always return NO if op is UNDEFined.
+ * This routine uses binexp() and thus the operand stack.
+ */
+int 
+inrange (register struct param *pp, register struct operand *op)
+{
+	register int fulltype, bastype;
+	struct	operand omin, test;
+
+	fulltype = pp->p_type;
+	bastype = fulltype & OT_BASIC;
+
+	/* If the operand is undefined, it is out of range.  Indefinite is
+	 * inrange for int and real type params.
+	 */
+	if (opundef (op))
+	    return (NO);
+	if (opindef (op) && bastype & (OT_INT|OT_REAL))
+	    return (YES);
+
+	/* If range checking is disabled, and the parameter value is defined,
+	 * it is in range.
+	 */
+	if (range_check (pp) == 0)
+	    return (YES);
+
+	if (fulltype & PT_FILNAM) {
+	    /* check any access attributes given.
+	     */
+	    char *filnam = op->o_val.v_s;
+	    if (opindef (op))
+		return (NO);
+
+	    if ((fulltype & PT_FER)  && c_access (filnam, READ_ONLY, 0) == NO)
+		cl_error (E_UERR, "File `%s' is not readable", filnam);
+	    if ((fulltype & PT_FEW)  && c_access (filnam, WRITE_ONLY, 0) == NO)
+		cl_error (E_UERR, "File `%s' is not writable", filnam);
+	    if ((fulltype & PT_FNOE) && c_access (filnam,0,0) == YES)
+		cl_error (E_UERR, "File `%s' exists", filnam);
+
+	    if ((fulltype & PT_FTXT) && c_access (filnam, 0, TEXT_FILE) == NO)
+		cl_error (E_UERR, "File `%s' is not a text file", filnam);
+	    if ((fulltype & PT_FBIN) && c_access (filnam, 0, TEXT_FILE) == YES)
+		cl_error (E_UERR, "File `%s' is not a binary file", filnam);
+	}
+
+	/* If the param is string valued and the legal values are enumerated,
+	 * any minimum match abbreviation is considered in range.  Return the
+	 * FULL string in the operand structure.  The legal values of an
+	 * enumerated string type parameter are given in the min field as a
+	 * string of the form "val|val|val".  Embedded whitespace is not
+	 * permitted.
+	 */
+	if (bastype == OT_STRING && !(pp->p_flags & P_UMIN)) {
+	    char	*s, *delim, *match;
+	    char	*val, *index();
+	    int		n;
+
+	    paramget (pp, FN_MIN);
+	    omin = popop();
+	    if (omin.o_type != OT_STRING || op->o_type != OT_STRING)
+		return (NO);
+
+	    val = op->o_val.v_s;
+	    n = strlen (val);
+	    match = NULL;
+
+	    for (delim = s = omin.o_val.v_s;  delim && *s;  s=delim+1) {
+		delim = index (s, '|');
+		if (delim)
+		    *delim = '\0';
+		if (strncmp (s, val, n) == 0) {
+		    if (match) {
+			eprintf ("ambiguous abbreviation '%s'\n", val);
+			return (NO);
+		    } else
+			match = s;
+		}
+	    }
+
+	    if (match != NULL)
+		op->o_val.v_s = comdstr (match);
+	    return (match != NULL);
+	}
+	
+	/* Check the minimum value, if one is given.
+	 */
+	if (!(pp->p_flags & (P_IMIN|P_UMIN))) {
+	    pushop (op);
+	    paramget (pp, FN_MIN);
+	    binexp (OP_GE);		/* op >= p_min?			*/
+	    test = popop();
+	    if (!test.o_val.v_i)	/* if (false) op out of range	*/
+		return (NO);
+	}
+
+	/* Check the maximum value, if one is given.
+	 */
+	if (!(pp->p_flags & (P_IMAX|P_UMAX))) {
+	    pushop (op);
+	    paramget (pp, FN_MAX);
+	    binexp (OP_LE);		/* op <= p_max?			*/
+	    test = popop();
+	    if (!test.o_val.v_i)	/* if (false) op out of range	*/
+		return (NO);
+	}
+	return (YES);
+}
+
+
+/* RANGE_CHECK -- Determine if range checking is in effect.  Range checking
+ * is only employed for int, real, string (enumerated) and filename params.
+ * If both the min and max fields are set, but max is less than min, checking
+ * is disabled.
+ */
+int 
+range_check (struct param *pp)
+{
+	int	fulltype, bastype;
+	struct	operand test, omin, omax;
+
+	fulltype = pp->p_type;
+	bastype = fulltype & OT_BASIC;
+
+	/* No range checking for bools, or when range values are undefined
+	 * or indefinite.
+	 */
+	if (bastype == OT_BOOL ||
+	    fulltype & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET))
+	    return (NO);
+	if (pp->p_flags & (P_IMIN|P_UMIN) && pp->p_flags & (P_IMAX|P_UMAX))
+	    return (NO);
+
+	/* Range checking is disabled if the max value is set lower than
+	 * the min value.
+	 */
+	if (!(pp->p_flags & (P_UMIN|P_IMIN|P_UMAX|P_IMAX))) {
+	    omax.o_type = omin.o_type = bastype;
+	    omin.o_val = pp->p_min;
+	    omax.o_val = pp->p_max;
+	    pushop (&omin);
+	    pushop (&omax);
+	    binexp (OP_GT);		/* p_min > p_max?		*/
+	    test = popop();
+	    if (test.o_val.v_i)		/* if (true) artificially pass	*/
+		return (NO);
+	}
+
+	return (YES);			/* should range check		*/
+}
+
+
+/* SETCLMODES -- Set up the cl mode reference pointers to point to their
+ * special-function params. tp is firstask.  Set the pointers to NULL if the
+ * parameter is not found.  Called once by login() after the cl's pfile has
+ * been read in.
+ */
+void 
+setclmodes (struct task *tp)
+{
+	register struct param *pp;
+	register char *name;
+	int	bastype;
+
+	clabbrev = clmenus = clshowtype = clkeeplog = cllexmodes = cllogfile =
+	    clnotify = clecho = NULL;
+
+	for (pp = tp->t_pfp->pf_pp; pp != NULL; pp = pp->p_np) {
+
+	    /* Set "CL parameter" bit to aid checking in paramset().
+	     * Also, parse any parameters that need it.  (This is necessary
+	     * to get the current values of `logmode' when running in bkg.)
+	     */
+	    pp->p_flags |= P_CL;
+	    parse_clmodes (pp, &pp->p_valo);
+
+	    /* Limit the strcmp's to only those params with the right
+	     * basic time to speed this up a bit.  Be careful when adding
+	     * new entries that they go into the right type.
+	     * For now, at least, ignore all list params.
+	     */
+	    if (pp->p_type & PT_LIST)
+		continue;
+
+	    bastype = pp->p_type & OT_BASIC;
+	    name = pp->p_name;
+	    if (bastype == OT_STRING) {
+		if (!strcmp (name, "mode"))
+		    firstask->t_modep = pp;
+		else if (!strcmp (name, "logfile"))
+		    cllogfile = pp;
+	    } else if (bastype == OT_BOOL) {
+		if (!strcmp (name, "menus"))
+		    clmenus = pp;
+		else if (!strcmp (name, "showtype"))
+		    clshowtype = pp;
+		else if (!strcmp (name, "keeplog"))
+		    clkeeplog = pp;
+		else if (!strcmp (name, "lexmodes"))
+		    cllexmodes = pp;
+		else if (!strcmp (name, "abbreviate"))
+		    clabbrev = pp;
+		else if (!strcmp (name, "notify"))
+		    clnotify = pp;
+		else if (!strcmp (name, "echo"))
+		    clecho = pp;
+	    }
+	}
+}
+
+
+#define NEXT_TOKEN  while (*ip == ' ' || *ip == '\t' || *ip == '\n') ip++; \
+		    if (!*ip) break;
+#define NEXT_WHITE  while (*ip != ' ' && *ip != '\t' && *ip != '\0') ip++;
+
+/* PARSE_CLMODES -- Called whenever a CL parameter is set at runtime.  A 
+ * few of the CL parameters need to be parsed and internal variables set
+ * appropriately.  Tokens in the parameter strings are white-space 
+ * delimited.
+ */
+void 
+parse_clmodes (struct param *pp, struct operand *newval)
+{
+	register char  *name, *ip;
+
+	name = pp->p_name;
+
+	if (!strcmp (name, "logmode")) {
+	    ip = newval->o_val.v_s;
+	    while (*ip) {
+		NEXT_TOKEN;
+
+		/* Check the next token; only a few matching characters 
+		 * are needed.  Default values are set elsewhere, so we
+		 * check for all possibilities here.
+		 */
+		if      (strncmp (ip, "commands", 5) == 0)
+		    cllogmode |= LOG_COMMANDS;
+		else if (strncmp (ip, "nocommands", 5) == 0)
+		    cllogmode &= ~LOG_COMMANDS;
+
+	    	else if (strncmp (ip, "background", 5) == 0)
+		    cllogmode |= LOG_BACKGROUND;
+	    	else if (strncmp (ip, "nobackground", 5) == 0)
+		    cllogmode &= ~LOG_BACKGROUND;
+
+	    	else if (strncmp (ip, "errors", 5) == 0)
+		    cllogmode |= LOG_ERRORS;
+	    	else if (strncmp (ip, "noerrors", 5) == 0)
+		    cllogmode &= ~LOG_ERRORS;
+
+	    	else if (strncmp (ip, "trace", 5) == 0)
+		    cllogmode |= LOG_TRACE;
+	    	else if (strncmp (ip, "notrace", 5) == 0)
+		    cllogmode &= ~LOG_TRACE;
+
+	    	else if (*ip != '\0')
+		    eprintf ("unrecognized logging set-option `%s'\n", ip);
+
+		NEXT_WHITE;
+	    }
+
+	} else if (!strcmp (name, "logfile")) {
+	    reset_logfile();
+
+	} else if (!strcmp (name, "epinit")) {
+	    ip = newval->o_val.v_s;
+	    while (*ip) {
+		NEXT_TOKEN;
+
+		if      (strncmp (ip, "standout", 5) == 0)
+		    ep_standout = YES;
+		else if (strncmp (ip, "nostandout", 5) == 0)
+		    ep_standout = NO;
+	    	else if (strncmp (ip, "showall", 5) == 0)
+		    ep_showall = YES;
+	    	else if (strncmp (ip, "noshowall", 5) == 0)
+		    ep_showall = NO;
+	    	else if (*ip != '\0')
+		    eprintf ("unrecognized eparam set-option `%s'\n", ip);
+
+		NEXT_WHITE;
+	    }
+
+	} else if (!strcmp (name, "ehinit")) {
+	    ip = newval->o_val.v_s;
+	    while (*ip) {
+		NEXT_TOKEN;
+
+		if      (strncmp (ip, "verify", 5) == 0)
+		    eh_verify = YES;
+		else if (strncmp (ip, "noverify", 5) == 0)
+		    eh_verify = NO;
+	    	else if (strncmp (ip, "standout", 5) == 0)
+		    eh_standout = YES;
+	    	else if (strncmp (ip, "nostandout", 5) == 0)
+		    eh_standout = NO;
+	    	else if (strncmp (ip, "bol", 3) == 0)
+		    eh_bol = YES;
+	    	else if (strncmp (ip, "eol", 3) == 0)
+		    eh_bol = NO;
+	    	else if (strncmp (ip, "readline", 3) == 0)
+#ifdef NO_READLINE
+		    eh_readline = NO;
+#else
+		    eh_readline = YES;
+#endif
+	    	else if (strncmp (ip, "noreadline", 3) == 0)
+		    eh_readline = NO;
+	    	else if (strncmp (ip, "longprompt", 3) == 0)
+		    eh_longprompt = YES;
+	    	else if (strncmp (ip, "nolongprompt", 3) == 0)
+		    eh_longprompt = NO;
+	    	else if (*ip != '\0')
+		    eprintf ("unrecognized ehistory set-option `%s'\n", ip);
+
+		NEXT_WHITE;
+	    }
+
+	} else if (!strcmp (name, "szprcache")) {
+	    /* Change the size of the process cache.
+	     */
+	    pr_setcache (newval->o_val.v_i);
+
+	} else if (!strcmp (name, "mode")) {
+	    /* Menu mode is not permitted at the CL level.
+	     */
+	    char   *index();
+
+	    if (index (newval->o_val.v_s, 'm') != NULL)
+		cl_error (E_UERR,
+		    "menu mode is permitted only for packages and tasks");
+	}
+}
+
+
+/* ABBREV -- Determine if abbreviations are allowed.  Abbreviations are
+ * only allowed if the currentask is interactive (or batch), or if the
+ * currentask is a builtin and the previous task is interactive (or batch),
+ * regardless of value of clabbrev parameter.
+ */
+int 
+abbrev (void)
+{
+	/* Enable abbreviations everywhere for now.
+	int	cflags = currentask->t_flags;
+	int	pflags = prevtask->t_flags;
+
+	if (clabbrev == NULL)
+	    return (NO);
+	if ((clabbrev->p_valo.o_type & (OT_UNDEF|OT_INDEF)) ||
+	    !clabbrev->p_valo.o_val.v_i)
+	    return (NO);
+
+ 	if (cflags & (T_INTERACTIVE|T_BATCH))
+	    return (YES);
+	if ((cflags & T_BUILTIN) && (pflags & (T_INTERACTIVE|T_BATCH)))
+	    return (YES);
+	
+	return (NO);
+	 */
+
+	return (YES);
+}
+
+/* POFFSET--push an offset in an array for a later reference.
+ */
+void 
+poffset (int off)
+{
+	n_indexes++;
+	push (off);
+	offsetmode(1);
+}
diff --git a/pkg/vocl/multop.c b/pkg/vocl/multop.c
new file mode 100644
index 00000000..fb0eed3f
--- /dev/null
+++ b/pkg/vocl/multop.c
@@ -0,0 +1,213 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "construct.h"
+#include "ytab.h"		/* pick up yacc token #defines		*/
+
+
+#define	TRIM_LEFT	1
+#define	TRIM_RIGHT	2
+
+extern  int do_error;           /* runtime error handling               */
+extern  ErrCom  errcom;
+
+extern int optbl[];
+extern char *ifnames[];
+
+
+/* MULTOP -- 
+ */
+void
+multop (
+    int     opcode,
+    int     op_index,
+    int     nargs
+)
+{
+	int	i, n, subi[2];
+	int	trim_side = TRIM_LEFT|TRIM_RIGHT;
+	char	*trim = " \t";
+	char	sbuf[SZ_LINE+1], from[SZ_LINE+1], to[SZ_LINE+1];
+	char	*sb = sbuf;
+	struct	operand o;
+	int 	op = optbl[op_index];	
+
+
+	memset (to, 0, SZ_LINE+1);
+	memset (from, 0, SZ_LINE+1);
+	memset (sbuf, 0, SZ_LINE+1);
+
+	switch (op & OP_MASK) {
+	case OP_NSCAN:
+	    if (nargs > 0)
+		cl_error (E_UERR, "nscan has no arguments");
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = get_nscanval();
+	    pushop (&o);
+	    break;
+		
+	case OP_MAX:
+	case OP_MIN:
+	    if (nargs <= 0)
+	        cl_error (E_UERR, e_geonearg, ifnames[op_index]);
+	    /* just leave top op if its the only one.
+	     */
+	    if (nargs > 1) {
+	        op &= OP_MASK;	/* avoid masking for every loop	*/
+	        while (--nargs)
+	    	binop (op);
+	    }
+	    break;
+
+	case OP_STRSUB:
+	    if (nargs != 3)
+	        cl_error (E_UERR, "strsub requires 3 arguments");
+
+	    opcast (OT_STRING);			/* get old value	*/
+	    o = popop();
+	    strcpy (to, o.o_val.v_s);
+
+	    opcast (OT_STRING);			/* get new value	*/
+	    o = popop();
+	    strcpy (from, o.o_val.v_s);
+
+	    opcast (OT_STRING);			/* get string arg	*/
+	    o = popop();
+
+	    strcpy (sbuf, o.o_val.v_s);		/* substitute strings	*/
+	    str_replace (&sb, from, to);
+
+	    o.o_val.v_s = sbuf;
+	    pushop (&o);
+	    break;
+
+	case OP_SUBSTR:
+	    if (nargs != 3)
+	        cl_error (E_UERR, "substr requires 3 arguments");
+
+	    for (n=1;  n >= 0;  n--) {	/* get indices		*/
+	        opcast (OT_INT);
+	        o = popop();
+	        subi[n] = o.o_val.v_i;
+	    }
+
+	    opcast (OT_STRING);		/* get string arg	*/
+	    o = popop();
+
+	    if (subi[1] >= subi[0]) {
+	        n = subi[1] - subi[0] + 1;
+	        strncpy (sbuf, &o.o_val.v_s[subi[0]-1], n);
+	    } else {
+	        /* Reverse the string. */
+	        n = subi[0] - subi[1] + 1;
+	        for (i = 0; i < n; i++)
+	    	sbuf[i] = o.o_val.v_s[subi[0]-i-1];
+	    }
+	    sbuf[n] = '\0';
+
+	    o.o_val.v_s = sbuf;
+	    pushop (&o);
+	    break;
+
+	case OP_TRIML:
+	    trim_side &= ~TRIM_RIGHT;
+	    goto trim_;
+	case OP_TRIMR:
+	    trim_side &= ~TRIM_LEFT;
+	    goto trim_;
+	case OP_TRIM:
+	    {
+		int	o1, o2;
+		struct operand istr;
+		char *index();
+		extern void *memset();
+trim_:
+		if (nargs >= 2) {
+		    /* Get the chars to trim, otherwise its whitespace.  */
+		    opcast (OT_STRING);
+		    trim = popop().o_val.v_s;
+		}
+		istr = popop();
+
+	  	o1 = 0;  
+		o2 = strlen (istr.o_val.v_s) - 1;
+
+		memset (sbuf, 0, SZ_LINE);
+		if (trim_side & TRIM_LEFT)
+		    while (index (trim, (int)istr.o_val.v_s[o1])) o1++;
+		if (trim_side & TRIM_RIGHT) {
+		    while (index (trim, (int)istr.o_val.v_s[o2])) o2--;  
+		    istr.o_val.v_s[++o2] = '\0';
+		}
+		strncpy (sbuf, &istr.o_val.v_s[o1], o2-o1+1);
+
+	        o.o_type = OT_STRING;
+	        o.o_val.v_s = sbuf;
+	        pushop (&o);
+	    }
+	    break;
+
+	case OP_ERRPOP:
+	    if (nargs > 0)
+	        cl_error (E_UERR, "errpop has no arguments");
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = errcom.errflag;
+	    do_error = YES;
+	    errcom.nhandlers--;
+	    pushop (&o);
+	    break;
+		
+	case OP_ERRPEEK:
+	    if (nargs > 0)
+	        cl_error (E_UERR, "errpeek has no arguments");
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = errcom.errflag;
+	    pushop (&o);
+	    break;
+		
+	case OP_ERRMSG:
+	    if (nargs > 0)
+	        cl_error (E_UERR, "errmsg has no arguments");
+	    o.o_type = OT_STRING;
+	    o.o_val.v_s = errcom.errmsg;
+	    pushop (&o);
+	    break;
+		
+	case OP_ERRCODE:
+	    if (nargs > 0)
+	        cl_error (E_UERR, "errcode has no arguments");
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = errcom.errcode;
+	    pushop (&o);
+	    break;
+		
+	case OP_ERRTASK:
+	    if (nargs > 0)
+	        cl_error (E_UERR, "errmsg has no arguments");
+	    o.o_type = OT_STRING;
+	    o.o_val.v_s = errcom.task;
+	    pushop (&o);
+	    break;
+
+	default:
+	    goto err;
+	}
+
+	return;
+
+err:    cl_error (E_IERR, e_badsw, op, "intrfunc()");
+}
diff --git a/pkg/vocl/opcodes.c b/pkg/vocl/opcodes.c
new file mode 100644
index 00000000..bbc2126d
--- /dev/null
+++ b/pkg/vocl/opcodes.c
@@ -0,0 +1,1400 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "task.h"
+#include "opcodes.h"
+#include "errs.h"
+#include "construct.h"
+#include "proto.h"
+
+/*
+ * OPCODES -- This is the instruction set that forms the internal language of
+ *   the CL.  The runtime interpreter (in runtime.c) executes these functions
+ *   as they are discovered in the compiled code.  The code is generated
+ *   incrementally as the grammar is recognized in grammar.y by calls to
+ *   compile().  The argument, argp, if needed, is the true addr of the start
+ *   of the instruction arguments.
+ * If anything goes wrong, error() is called but DOES NOT RETURN; see errs.c.
+ *
+ * Comments indicate stack usage. expected operands are before the `.' 
+ *   (rightmost being on "top" of stack), resulting operands are after.
+ *
+ * At the end of this file is the opcode jumptable. The order of the entries
+ * must agree with the definitions of the opcode constants in operand.h.
+ * see runtime.c.
+ */
+
+extern	int cldebug;
+extern	char *nullstr;
+int	binpipe;			/* last pipe binary or text ? */
+char	*comdstr();
+extern	struct param *ppfind();		/* search task psets for param */
+extern	int currentline;
+
+
+void 
+o_undefined (void)
+{
+	cl_error (E_IERR, e_uopcode, 0);
+}
+
+/* <new value for named argument> .
+ * Assign the top operand to the named parameter.  Also, make the type of the
+ * fake parameter the same as the type of the operand.
+ */
+void 
+o_absargset (memel *argp)
+{
+	char	*argname = (char *) argp;
+	char	*pk, *t, *p, *f;
+	struct	pfile *pfp;
+	struct	param *pp;
+
+	pfp = newtask->t_pfp;
+	if (pfp->pf_flags & PF_FAKE) {
+	    /* use full argname and always assign to value field.
+	     */
+	    struct operand o;
+	    int	string_len=0;
+	    o = popop();
+	    if ((o.o_type & OT_BASIC) == OT_STRING)
+		string_len = strlen (o.o_val.v_s);
+	    pp = newfakeparam (pfp, argname, 0, o.o_type, string_len);
+	    pushop (&o);
+	    f = argname;
+	    *f = FN_NULL;
+
+	} else {
+	    breakout (argname, &pk, &t, &p, &f);
+	    if (*pk)
+		cl_error (E_UERR, e_simplep, p);
+	    pp = ppfind (pfp, t, p, 0, NO);
+	    if (pp == NULL)
+		cl_error (E_UERR, e_pnonexist, p);
+	    if ((XINT)pp == ERR)
+		cl_error (E_UERR, e_pambig, p, pfp->pf_ltp->lt_lname);
+	}
+
+	paramset (pp, *f);
+	if (pp->p_type & PT_PSET)
+	    psetreload (pfp, pp);
+	pp->p_flags |= P_CLSET;
+}
+
+/* <op1> <op2> . <op2 + op1>
+ */
+void 
+o_add (void)
+{
+	binop (OP_ADD);
+}
+
+/* <increment to be added to named parameter> .
+ */
+void 
+o_addassign (memel *argp)
+{
+	/* order of operands will be incorrect.
+	 * strictly speaking, only strings are not commutative but we need
+	 * to pop both operands anyway to check.
+	 */
+	char *pname = (char *) argp;
+	char *pk, *t, *p, *f;
+	struct param *pp;
+	struct operand o1, o2;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+	validparamget (pp, *f);
+	o1 = popop();
+	o2 = popop();
+
+	if ((o2.o_type & OT_BASIC) == OT_STRING) {
+	    /* copy o2 onto dictionary to avoid overwriting it on stack
+	     * when o1 is pushed. we can get by with not worrying about o1
+	     * as long as whatever code copies the string works when the
+	     * strings overlap.
+	     */
+	    XINT oldtopd = topd;
+	    char *s2 = memneed (btoi (strlen (o2.o_val.v_s) + 1));
+	    strcpy (s2, o2.o_val.v_s);
+	    o2.o_val.v_s = s2;
+	    pushop (&o1);
+	    pushop (&o2);
+	    topd = oldtopd;		/* discard temp string area	*/
+
+	} else {
+	    pushop (&o1);
+	    pushop (&o2);
+	}
+
+	binop (OP_ADD);
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* <name of file to be appended> .
+ * includes stdout as well as stderr.
+ */
+void 
+o_allappend (void)
+{
+	struct	operand o;
+	char	*fname, *mode;
+
+	opcast (OT_STRING);
+	o = popop();
+	fname = o.o_val.v_s;
+
+	if (newtask->t_flags & T_FOREIGN &&
+	    newtask->t_stdout == stdout && newtask->t_stderr == stderr) {
+
+	    /* If foreign task and i/o has not already been redirected by
+	     * the parent, let ZOSCMD open the spool file.
+	     */
+	    newtask->ft_out = newtask->ft_err = comdstr (fname);
+	    newtask->t_flags |= T_APPEND;
+
+	} else {
+	    mode = (newtask->t_flags & T_STDOUTB) ? "ab" : "a";
+
+	    if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
+		cl_error (E_UERR, e_appopen, fname);
+
+	    newtask->t_stderr = newtask->t_stdout;
+	    newtask->t_flags |= (T_MYOUT|T_MYERR);
+	}
+}
+
+
+/* <name of file to be used as stderr> .
+ * redirect everything, including the stderr channel.
+ */
+void 
+o_allredir (void)
+{
+	struct	operand o;
+	char	*fname, *mode;
+
+	opcast (OT_STRING);
+	o = popop();
+	fname = (o.o_val.v_s);
+
+	if (newtask->t_flags & T_FOREIGN &&
+	    newtask->t_stdout == stdout && newtask->t_stderr == stderr) {
+
+	    /* If foreign task and i/o has not already been redirected by
+	     * the parent, let ZOSCMD open the spool file.
+	     */
+	    newtask->ft_out = newtask->ft_err = comdstr (fname);
+
+	} else {
+	    mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";
+
+	    if ((newtask->t_stderr = fopen (fname, mode)) == NULL)
+		cl_error (E_UERR, e_wopen, fname);
+
+	    newtask->t_stdout = newtask->t_stderr;
+	    newtask->t_flags |= (T_MYOUT|T_MYERR);
+	}
+}
+
+
+/* <op1> <op2> . <op1 && op2>
+ */
+void 
+o_and (void)
+{
+	binexp (OP_AND);
+}
+
+/* <name of file to be appended> .
+ */
+void 
+o_append (void)
+{
+	struct	operand o;
+	char	*fname, *mode;
+
+	opcast (OT_STRING);
+	o = popop();
+	fname = (o.o_val.v_s);
+
+	if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
+	    /* If foreign task let ZOSCMD open the spool file.
+	     */
+	    newtask->ft_out = comdstr (fname);
+	    newtask->t_flags |= T_APPEND;
+	} else {
+	    mode = (newtask->t_flags & T_STDOUTB) ? "ab" : "a";
+
+	    if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
+		cl_error (E_UERR, e_appopen, fname);
+
+	    newtask->t_flags |= T_MYOUT;
+	}
+}
+
+
+/* <new value for named parameter> .
+ */
+void 
+o_assign (memel *argp)
+{
+	char *pname = (char *) argp;
+	char *pk, *t, *p, *f;
+	struct param *pp;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* <truth value> .
+ * branch if false (or INDEF).
+ */
+void 
+o_biff (memel *argp)
+{
+	extern XINT pc;
+	struct operand o;
+
+	opcast (OT_BOOL);
+	o = popop();
+	if (!o.o_val.v_i || opindef (&o))
+	    pc += (int)*argp;
+}
+
+/* .
+ * arrange to start a new task. set newtask.
+ * see runtime.c
+ */
+void 
+o_call (memel *argp)
+{
+	callnewtask ((char *) argp);
+}
+
+/* <op> . <- op>
+ */
+void 
+o_chsign (void)
+{
+	unop (OP_MINUS);
+}
+
+/* <op> // <op>
+ * string concatenation
+ */
+void 
+o_concat (void)
+{
+	binop (OP_CONCAT);
+}
+
+/* <op1> <op2> . <op1 / op2>
+ */
+void 
+o_div (void)
+{
+	binop (OP_DIV);
+}
+
+void 
+o_doend (void)
+{
+}
+
+/* <value to be divided into named parameter> .
+ */
+void 
+o_divassign (memel *argp)
+{
+	char	*pname = (char *) argp;
+	char	*pk, *t, *p, *f;
+	struct	param *pp;
+	struct	operand o1, o2;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+
+	validparamget (pp, *f);		/* get param value on stack	*/
+	o1 = popop();			/* swap operands		*/
+	o2 = popop();
+	pushop (&o1);
+	pushop (&o2);
+	binop (OP_DIV);			/* perform the division		*/
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* <value to be concatenated onto named parameter> .
+ */
+void 
+o_catassign (memel *argp)
+{
+	char	*pname = (char *) argp;
+	char	*pk, *t, *p, *f;
+	char	s1[1024+1];
+	struct	operand o1, o2;
+	struct	param *pp;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+	paramget (pp, *f);
+
+	/* If param value is undefined merely assign into it, otherwise
+	 * concatenate operand to current value.
+	 */
+	o1 = popop();
+	if (!opundef(&o1)) {
+	    /* Must copy string value off of operand stack or the next
+	     * pushop below will reuse the space!
+	     */
+	    o2 = popop();
+	    strncpy (s1, o2.o_val.v_s, 1024);
+	    s1[1024] = EOS;
+	    o2.o_val.v_s = s1;
+
+	    pushop (&o1);
+	    pushop (&o2);
+	    binop (OP_CONCAT);
+	}
+
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* <op1> <op2> . <op1 == op2>
+ */
+void 
+o_eq (void)
+{
+	binexp (OP_EQ);
+}
+
+/* run the newtask. see exec.c.
+ */
+void 
+o_exec (void)
+{
+	execnewtask ();
+}
+
+/* <op1> <op2> . <op1 > op2>
+ */
+void 
+o_ge (void)
+{
+	binexp (OP_GE);
+}
+
+/* unconditional goto.
+ * *argp is the SIGNED increment to be added to pc.
+ */
+void 
+o_dogoto (memel *argp)
+{
+	extern XINT pc;
+	pc += (int)*argp;
+	if (pc >= STACKSIZ)
+	    cl_error (E_IERR, "pc set wildly to %d during goto", pc);
+}
+
+/* <op1> <op2> . <op1 > op2>
+ */
+void 
+o_gt (void)
+{
+	binexp (OP_GT);
+}
+
+/* <string operand> .
+ * if argument to which we are assigning is a simple string or filename (or
+ *   list, since assigning to a list sets a filename too), set it to o_val.v_s,
+ * else use o_val.v_s as the name of a parameter and use its value as the name
+ *   of the variable, that is, do an indirect through o_val.v_s.
+ * compiled when the parser sees a simple identifier, not in an expression.
+ *   this avoids quotes around simple strings and filenames.
+ * if the parameter is to be fake, make it type string and do not do the
+ *   indirection.
+ */
+void 
+o_indirabsset (memel *argp)
+{
+	char	*argname = (char *) argp;
+	char	*pk, *t, *p, *f;
+	struct	pfile *pfp;
+	struct	param *pp;
+	int	type, string_len;
+
+	pfp = newtask->t_pfp;
+	if (pfp->pf_flags & PF_FAKE) {
+	    struct	operand o;
+	    o = popop();
+	    string_len = strlen (o.o_val.v_s);
+	    pp = newfakeparam (pfp, argname, 0, OT_STRING, string_len);
+	    f = argname;
+	    *f = FN_NULL;
+	    pushop (&o);
+
+	} else {
+	    breakout (argname, &pk, &t, &p, &f);
+	    if (*pk)
+		cl_error (E_UERR, e_simplep, p);
+	    pp = ppfind (pfp, t, p, 0, NO);
+	    if (pp == NULL)
+		cl_error (E_UERR, e_pnonexist, p);
+	    if ((XINT)pp == ERR)
+		cl_error (E_UERR, e_pambig, p, pfp->pf_ltp->lt_lname);
+	}
+
+	/* lone identifiers are treated as strings, rather than variables,
+	 * if the corresponding parameter is a simple string, filename or list.
+	 * note that fakeparams are made as strings.
+	 */
+	type = pp->p_type;
+	if (type & (PT_FILNAM|PT_LIST|PT_PSET)) {
+	    struct operand o;
+	    o = popop();
+	    pushop (&o);
+	} else if ((type & OT_BASIC) != OT_STRING ||
+	    type & (PT_STRUCT|PT_IMCUR|PT_GCUR|PT_UKEY)) {
+
+	    opindir(); /* replace top op with value of o_val.v_s */
+	}
+
+	paramset (pp, *f);
+	if (pp->p_type & PT_PSET)
+	    psetreload (pfp, pp);
+	pp->p_flags |= P_CLSET;
+}
+
+/* <string operand> .
+ * if argument to which we are assigning is a simple string or filename (or
+ *   list, since assigning to a list sets a filename too), set it to o_val.v_s,
+ * else use o_val.v_s as the name of a parameter and use its value as the name
+ *   of the variable, that is, do an indirect through o_val.v_s.
+ * compiled when the parser sees a simple identifier, not in an expression.
+ *   this avoids quotes around simple strings and filenames.
+ */
+void 
+o_indirposset (memel *argp)
+{
+	int pos = (int) *argp;
+	struct pfile *pfp;
+	struct param *pp;
+	int type, string_len;
+
+	pfp = newtask->t_pfp;
+	if (pfp->pf_flags & PF_FAKE) {
+	    struct	operand o;
+	    o = popop();
+	    string_len = strlen (o.o_val.v_s);
+	    pp = newfakeparam (pfp, (char *) NULL, pos, OT_STRING, string_len);
+	    pushop (&o);
+	} else {
+	    pp = paramfind (pfp, (char *) NULL, pos, NO);
+	    if (pp == NULL)
+		cl_error (E_UERR, e_posargs, newtask->t_ltp->lt_lname);
+	}
+
+	/* lone identifiers are treated as strings, rather than variables,
+	 * if the corresponding parameter is a simple string, filename or list.
+	 * note that fakeparams are made as strings.
+	 */
+	type = pp->p_type;
+	if (type & (PT_FILNAM|PT_LIST|PT_PSET)) {
+	    struct operand o;
+	    o = popop();
+	    pushop (&o);
+	} else if ((type & OT_BASIC) != OT_STRING ||
+	    type & (PT_STRUCT|PT_IMCUR|PT_GCUR|PT_UKEY)) {
+
+	    opindir(); /* replace top op with value of o_val.v_s */
+	}
+
+	paramset (pp, FN_NULL);
+	pfp->pf_n++;
+	pp->p_flags |= P_CLSET;
+}
+
+/* Increment the loop counters for an implicit loop.
+ */
+void 
+o_indxincr (memel *argp)
+{
+	int	i;
+	i = 0;
+	while (i < n_oarr) {
+	    if (oarr_curr[i] < oarr_end[i] ) {
+		oarr_curr[i] ++;
+		i_oarr = 0;
+		pc += argp[0];	/* Branch to beginning of statement. */
+		return;
+	    } else  {
+		oarr_curr[i] = oarr_beg[i];
+		i++;
+	    }
+	}
+
+	/* Finished loop, branch around stored data. */
+	pc += argp[1];
+
+	/* Clear flag for next implicit loop. */
+	imloopset = 0;
+}
+
+
+/* .
+ * given the name of a parameter, print it on t_out, the task pipe channel.
+ */
+void 
+o_inspect (memel *argp)
+{
+	char *pname = (char *) argp;
+	char *pk, *t, *p, *f;
+	struct param *pp;
+	struct operand o;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+
+	if (*f == FN_NULL && (pp->p_type & PT_LIST)) {
+	    /* Hitting EOF from a list is ok during an inspect stmt so
+	     * avoid using paramget() with its EOF error.
+	     * readlist() may set P_LEOF.
+	     */
+	    o = readlist (pp);
+	    if ((pp->p_flags & P_LEOF) || inrange (pp, &o))
+		pushop (&o);
+	    else
+		query (pp);
+	} else
+	    validparamget (pp, *f);
+
+	o = popop();
+
+	if (cldebug && (o.o_type & OT_BASIC) == OT_STRING)
+	    eprintf ("Inspect--%s\n", o.o_val.v_s);
+
+	prop (&o);
+	tprintf ("\n");
+}
+
+
+/* [<op1> <op2> ... <opn>] <nops> . <result>
+ * intrinsic functions, like sin, cos, mod, etc.
+ * argp is the name of the function to run and the top operand (we guarantee
+ * at least one) is the number of remaining operands to be used.
+ * all the defines are in operand.h. the function names and running them is
+ * done by intrfunc() in gram.c.
+ */
+void 
+o_intrinsic (memel *argp)
+{
+	char *funcname = (char *) argp;
+	struct operand o;
+	int nargs;
+
+	o = popop();
+	nargs = o.o_val.v_i;
+
+	intrfunc (funcname, nargs);
+}
+
+/* <op1> <op2> . <op1 <= op2>
+ */
+void 
+o_le (void)
+{
+	binexp (OP_LE);
+}
+
+/* <op1> <op2> . <op1 < op2>
+ */
+void 
+o_lt (void)
+{
+	binexp (OP_LT);
+}
+
+/* <op1> <op2> . <op2 * op1>
+ */
+void 
+o_mul (void)
+{
+	binop (OP_MUL);
+}
+
+/* <value to be multiplied into named parameter> .
+ */
+void 
+o_mulassign (memel *argp)
+{
+	char	*pname = (char *) argp;
+	char	*pk, *t, *p, *f;
+	struct	param *pp;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+
+	validparamget (pp, *f);
+	binop (OP_MUL);
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* <op1> <op2> . <op1 != op2>
+ */
+void 
+o_ne (void)
+{
+	binexp (OP_NE);
+}
+
+/* <op> . <!op>
+ */
+void 
+o_not (void)
+{
+	unexp (OP_NOT);
+}
+
+/* <op1> <op2> . <op1 || op2>
+ */
+void 
+o_or (void)
+{
+	binexp (OP_OR);
+}
+
+
+/* OSESC -- Send a command to the host system.  Command is a string pointed
+ * to by argp.  Try to run it so its stdout and stderr will go to out t_stdout
+ * and t_stderr of the current task.
+ */
+void 
+o_osesc (memel *argp)
+{
+	char *command = (char *)argp;
+
+	clsystem (command, currentask->t_stdout, currentask->t_stderr);
+}
+
+
+/* <new value for argument at command position *argp> .
+ */
+void 
+o_posargset (memel *argp)
+{
+	int	pos = (int) *argp;
+	struct	pfile *pfp;
+	struct	param *pp;
+	struct	operand o;
+	int	string_len=0;
+
+	pfp = newtask->t_pfp;
+
+	if (pos < 0) {
+	    /* Lone comma in arg list, merely bump nargs counter */
+	    pfp->pf_n++;
+	    return;
+	}
+
+	if (pfp->pf_flags & PF_FAKE) {
+	    o = popop();
+	    if ((o.o_type & OT_BASIC) == OT_STRING)
+		string_len = strlen (o.o_val.v_s);
+	    pp = newfakeparam (pfp, (char *) NULL, pos, o.o_type, string_len);
+	    pushop (&o);
+	} else {
+	    pp = paramfind (pfp, (char *) NULL, pos, NO);
+	    if (pp == NULL)
+		cl_error (E_UERR, e_posargs, newtask->t_ltp->lt_lname);
+	}
+
+	paramset (pp, FN_NULL);
+	pfp->pf_n++;
+	pp->p_flags |= P_CLSET;
+}
+
+
+/* <op1> <op2> . <op1 ** op2>
+ */
+void 
+o_dopow (void)
+{
+	binop (OP_POW);
+}
+
+
+/* <exprn-1> ... <expr1> <dest> <n> .
+ * Do the print task.  First op on stack is number of operands to follow.
+ * Next one is the name of the destination parameter, rest are values to
+ * be printed.
+ */
+void 
+o_doprint (void)
+{
+	/* This is not used -- print is imp. as a builtin task.
+	struct operand o;
+
+	o = popop();
+	print (o.o_val.v_i - 1);
+	 */
+}
+
+/* <value to be printed> .
+ * used to print an operand on the stack. not to be confused with doprint.
+ */
+void 
+o_immed (void)
+{
+	struct operand o;
+
+	o = popop();
+	prop (&o);
+	tprintf ("\n");
+}
+
+/* . <new constant>
+ * The "illegal constant" business comes from the possibility of syntactically
+ * correct but valuely wrong sexagesimal constants, such as 1:222:1.
+ * We don't want to abort in sexa() because it may be used to digest a query
+ * response and producing a quiet undefined op there is correct.
+ */
+void 
+o_pushconst (memel *argp)
+{
+	/* argument is pointer to an operand */
+	struct operand *op;
+
+	op = (struct operand *) argp;
+	if (opundef (op))
+	    cl_error (E_UERR, "illegal constant");
+	pushop (op);
+}
+
+/* Push an index value onto the control stack for later use
+ * when the parameter is accessed.
+ */
+void 
+o_pushindex (int *mode)
+{
+	struct operand op;
+
+	 if (cldebug)
+	    printf ("PUSHINDEX: mode=%d loopset=%d\n", *mode, imloopset);
+
+	if (*mode == 0) {	/* Normal array index reference. */
+	    opcast(OT_INT);
+	    op = popop();
+	    push (op.o_val.v_i);
+	} else if (*mode == -1  ||  imloopset) {
+	    /* Array reference in implicit loop. */
+	    push (oarr_curr[i_oarr]);
+	    i_oarr++;
+	    if (i_oarr >= n_oarr)
+		i_oarr = 0;
+	} else {
+	    /* This is the first array reference in an implicit loop.
+	     * It must initialize the loop parameters.  The argument
+	     * is an offset to the initialization info.
+	     */
+	    int stk;
+
+	    stk = pc + *mode;
+
+	    n_oarr = stack[stk++];
+	    for (i_oarr=0; i_oarr<n_oarr; i_oarr++) {
+		oarr_beg[i_oarr] = stack[stk++];
+		oarr_curr[i_oarr] = oarr_beg[i_oarr];
+		oarr_end[i_oarr] = stack[stk++];
+	    }
+	    /* Set flag so that we don't do this again. */
+	    imloopset++;
+
+	    /* And we still have to push a value. */
+	    push (oarr_curr[0]);
+	    i_oarr = 1;
+	    if (i_oarr >= n_oarr)
+		i_oarr = 0;
+	}
+
+	/* Increment counter of number of indexes pushed.
+	 */
+	n_indexes++;
+}
+
+/* . <value of parameter>
+ */
+void 
+o_pushparam (memel *argp)
+{
+	char *pname = (char *) argp;
+	char *pk, *t, *p, *f;
+	struct param *pp;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+	validparamget (pp, *f);
+}
+
+
+/* <name of file to be used as stdout> .
+ */
+void 
+o_redir (void)
+{
+	struct	operand o;
+	char	*fname, *mode;
+
+	opcast (OT_STRING);
+	o = popop();
+	fname = (o.o_val.v_s);
+
+	if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
+	    /* If foreign task let ZOSCMD open the spool file.
+	     */
+	    newtask->ft_out = comdstr (fname);
+
+	} else if (strcmp (fname, IPCOUT) == 0) {
+	    /* Redirect the task stdout via IPC to a subprocess. */
+	    newtask->t_stdout = newtask->t_out;
+	    newtask->t_flags |= T_IPCIO;
+
+	} else {
+	    mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";
+
+	    if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
+		cl_error (E_UERR, e_wopen, fname);
+
+	    newtask->t_flags |= T_MYOUT;
+	}
+}
+
+
+/* <name of file to be used as stdin> .
+ */
+void 
+o_redirin (void)
+{
+	struct	operand o;
+	char	*fname, *mode;
+
+	opcast (OT_STRING);
+	o = popop();
+	fname = (o.o_val.v_s);
+
+	if (newtask->t_flags & T_FOREIGN && newtask->t_stdin == stdin) {
+	    /* If foreign task let ZOSCMD open the command file.
+	     */
+	    newtask->ft_in = comdstr (fname);
+	} else {
+	    mode = (newtask->t_flags & T_STDINB) ? "rb" : "r";
+
+	    if ((newtask->t_stdin = fopen (fname, mode)) == NULL)
+		cl_error (E_UERR, e_ropen, fname);
+
+	    newtask->t_flags |= T_MYIN;
+	}
+}
+
+
+/* GSREDIR -- Graphics stream redirection.
+ * <filename> .
+ */
+void 
+o_gsredir (memel *argp)
+{
+	register char	*ip;
+	register FILE	*fp;
+	char	*streams = (char *)argp;
+	struct	operand o;
+	char	*fname;
+	int	count;
+
+	/* Get the filename.
+	 */
+	opcast (OT_STRING);
+	o = popop();
+	fname = o.o_val.v_s;
+
+	/* Scan the redir token to determine the file access mode, e.g., if
+	 * ">G", create a new file, and if ">>G", append to a file.
+	 */
+	for (count=0, ip=streams;  *ip;  ip++)
+	    if (*ip == '>')
+		count++;
+
+	if ((fp = fopen (fname, count > 1 ? "ab" : "wb")) == NULL)
+	    cl_error (E_UERR, e_wopen, fname);
+
+	/* The first string operand on the stack is some combination of the
+	 * characters GIP, listing the streams (stdgraph, stdimage, stdplot)
+	 * to be redirected to the named file.  The lexical analyzer guarantees
+	 * that we will not be called unless the string consists of some
+	 * combination of the characters >GIP, hence error checking for other
+	 * char, no chars, etc., is not needed.
+	 */
+	for (ip=streams;  *ip;  ip++)
+	    if (*ip == 'G') {
+		newtask->t_flags |= T_MYSTDGRAPH;
+		newtask->t_stdgraph = fp;
+	    } else if (*ip == 'I') {
+		newtask->t_flags |= T_MYSTDIMAGE;
+		newtask->t_stdimage = fp;
+	    } else if (*ip == 'P') {
+		newtask->t_flags |= T_MYSTDPLOT;
+		newtask->t_stdplot = fp;
+	    }
+}
+
+
+void 
+o_doaddpipe (memel *argp)
+{
+	XINT	getpipe_pc = *argp;
+	char	*x1, *pk, *t, *x2;	
+	char	*ltname;
+	struct	operand	o;
+	struct	ltask *ltp;
+	char	*addpipe();
+
+	/* ADDPIPE is called immediately before REDIR and before EXEC so we
+	 * do not have to worry about storing the pipefile name in the dict.
+	 * Our argument is the PC of the GETPIPE instruction, the args field
+	 * of which is the taskname of the second task in the pipe.  If either
+	 * the new task (first task in the pipe) or the second task is a
+	 * FOREIGN task, the pipe must be created as a text file.
+	 */
+	ltname = (char *)&(coderef(getpipe_pc)->c_args);
+	if (*ltname == '$')
+	    ltname++;
+	breakout (ltname, &x1, &pk, &t, &x2);
+	ltp = cmdsrch (pk, t);
+
+	binpipe = ((ltp == NULL || !(ltp->lt_flags & LT_FOREIGN)) &&
+	    !(newtask->t_flags & T_FOREIGN));
+
+	if (binpipe)
+	    newtask->t_flags |= T_STDOUTB;
+
+	o.o_type = OT_STRING;
+	o.o_val.v_s = comdstr (addpipe());
+	pushop (&o);
+}
+
+
+void 
+o_dogetpipe (
+    memel *argp			/* name of ltask (not used) */
+)
+{
+	struct	operand o;
+	char	*getpipe(), *comdstr();
+
+	/* GETPIPE is called immediately before REDIRIN and before EXEC so we
+	 * do not have to worry about storing the pipefile name in the dict.
+	 * The flag binpipe is set by the last ADDPIPE if the pipe is a binary
+	 * file.
+	 */
+	if (binpipe)
+	    newtask->t_flags |= T_STDINB;
+
+	o.o_type = OT_STRING;
+	o.o_val.v_s = comdstr (getpipe());
+	pushop (&o);
+}
+
+
+void 
+o_rmpipes (memel *argp)
+{
+	delpipes ((int)*argp);
+}
+
+
+void 
+o_doreturn (void)
+{
+	eprintf ("return not implemented\n");
+}
+
+/* <paramn> ... <param1> <source> <n> .
+ * do the scan function. first op on stack is number of string ops to
+ * follow, rest are names of destination params.  SCAN scans the standard
+ * input.
+ */
+void 
+o_doscan (void)
+{
+	struct operand o;
+
+	o = popop();
+	cl_scan (o.o_val.v_i - 1, "stdin");
+}
+
+void 
+o_doscanf (void)
+{
+	struct operand o;
+	struct operand o_sv[64];
+	char	format[SZ_LINE];
+	int	nargs, i;
+
+	/* Get number of arguments. */
+	o = popop();
+	nargs = o.o_val.v_i;
+
+	/* Get scan format.  Unfortunately the way the parser works this
+	 * is the last operand on the stack.  We need to pop and save the
+	 * first nargs-1 operands and restore them when done.
+	 */
+	for (i=0;  i < nargs-1;  i++)
+	    o_sv[i] = popop();
+
+	o = popop();
+	if ((o.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_UERR, "scanf: bad format string\n");
+	strcpy (format, o.o_val.v_s);
+
+	for (--i;  i >= 0;  i--)
+	    pushop (&o_sv[i]);
+
+	/* Do the scan. */
+	cl_scanf (format, nargs-2, "stdin");
+}
+
+/* <paramn> ... <param1> <source> <n> .
+ * Do the fscan function.  First op on stack is number of string ops to
+ * follow.  Next one is the name of the source parameter, rest are names of
+ * destination params.
+ */
+void 
+o_dofscan (void)
+{
+	struct operand o;
+
+	o = popop();
+	cl_scan (o.o_val.v_i - 1, "");
+}
+
+void 
+o_dofscanf (void)
+{
+	struct operand o, o_sv[64];
+	char	format[SZ_LINE];
+	char	pname[SZ_FNAME];
+	int	nargs, i;
+
+	/* Get number of arguments. */
+	o = popop();
+	nargs = o.o_val.v_i;
+
+	/* Get scan format and input parameter name.  The arguments on the
+	 * stack are pushed in the order input param name, format string,
+	 * and then the output arguments.
+	 */
+
+	/* Get output arguments. */
+	for (i=0;  i < nargs-2;  i++)
+	    o_sv[i] = popop();
+
+	/* Get format string. */
+	o = popop();
+	if ((o.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_UERR, "fscanf: bad format string\n");
+	strcpy (format, o.o_val.v_s);
+
+	/* Get parameter name. */
+	o = popop();
+	if ((o.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_UERR, "fscanf: bad input parameter specification\n");
+	strcpy (pname, o.o_val.v_s);
+
+	/* Restore the output argument operands. */
+	for (--i;  i >= 0;  i--)
+	    pushop (&o_sv[i]);
+
+	/* Restore the input parameter name operand. */
+	o.o_type = OT_STRING;
+	o.o_val.v_s = pname;
+	pushop (&o);
+
+	/* Do the scan. */
+	cl_scanf (format, nargs-2, "");
+}
+
+/* <op1> <op2> . <op1 - op2>
+ */
+void 
+o_sub (void)
+{
+	binop (OP_SUB);
+}
+
+/* <value to be subtracted from named parameter> .
+ */
+void 
+o_subassign (memel *argp)
+{
+	/* operands are backwards on stack, so negate and add. can get by
+	 * with this as long as subtraction is never defined for strings.
+	 * if it is someday, will have to do something like in addassign.
+	 */
+	char *pname = (char *) argp;
+	char *pk, *t, *p, *f;
+	struct param *pp;
+
+	breakout (pname, &pk, &t, &p, &f);
+	pp = paramsrch (pk, t, p);
+
+	unop (OP_MINUS);
+	validparamget (pp, *f);
+	binop (OP_ADD);
+	paramset (pp, *f);
+	pp->p_flags |= P_SET;
+}
+
+/* Doswitch finds the appropriate location to jump to in the
+ * jump table and goes there.
+ */
+void 
+o_doswitch (int *jmpdelta)
+
+{
+	int pdft, icase, jmptable;
+	int value=0;
+	struct operand o;
+	memel delta;
+	/* Remember to subtract SZ_CE 'cuz PC has already been incremented. */
+	jmptable = *jmpdelta + pc - SZ_CE;
+
+	o = popop();
+	if (o.o_type == OT_INT)
+	    value = o.o_val.v_i;
+	else if (o.o_type == OT_STRING) {
+	    if (*o.o_val.v_s != '\0'  &&  *(o.o_val.v_s+1) == '\0')
+		value = (int) *o.o_val.v_s;
+	    else
+		cl_error(E_UERR, "Illegal switch value.");
+	} else
+	    cl_error (E_UERR, "Illegal switch value.");
+
+	pdft = stack[jmptable];
+
+	if (cldebug)
+	    eprintf ("doswitch: pdft=%d\n", pdft);
+
+	/* Loop over cases.
+	 */
+	for (icase= jmptable + 1; stack[icase] != 0; icase++) {
+	    int nval, ival, pcase;
+	    memel *val;
+
+	    pcase = stack[icase] + pc - SZ_CE;
+	    nval = coderef(pcase)->c_length - (SZ_CE - 1);
+	    currentline = coderef(pcase)->c_scriptln;
+
+	    /* Loop over all values for a particular case.
+	     */
+	    val = & (coderef(pcase)->c_args);
+	    for (ival=0; ival<nval; ival++, val++) {
+		if (*val == value) {
+		    /* Remember to skip over the CASE operand itself. */
+		    delta =  pcase + (nval+(SZ_CE-1)) - (pc-SZ_CE) - SZ_CE;
+		    o_dogoto (&delta);
+		    return;
+		}
+	    }
+	}
+
+	/* Default? */
+	if (pdft != 0) {
+	    pdft = pdft + pc - SZ_CE;
+	    /* Skipping over DEFAULT block takes 2 ints.
+	     */
+	    delta =  (pdft+(SZ_CE-1)) - (pc-SZ_CE) - SZ_CE;
+	    o_dogoto (&delta);
+	    return;
+	}
+
+	/* If there is no default we just drop through to the
+	 * next statement which is a branch beyond the SWITCH.
+	 */
+}
+
+
+void 
+o_swoff (memel *argp)
+{
+	register char *pname = (char *)argp;
+	register struct param *pp;
+	struct	operand o;
+	struct	pfile *pfp;
+	char	*pk, *t, *p, *f;
+
+	breakout (pname, &pk, &t, &p, &f);
+	if (*pk)
+	    cl_error (E_UERR, e_simplep, p);
+	pfp = newtask->t_pfp;
+	pp = ppfind (pfp, t, p, 0, NO);
+	if (pp == NULL)
+	    cl_error (E_UERR, e_pnonexist, p);
+	if ((XINT)pp == ERR)
+	    cl_error (E_UERR, e_pambig, p, newtask->t_ltp->lt_lname);
+
+	o.o_type = OT_BOOL;
+	o.o_val.v_i = NO;
+	pushop (&o);
+	paramset (pp, FN_VALUE);
+	if (pp->p_type & PT_PSET)
+	    psetreload (pfp, pp);
+
+	pp->p_flags |= P_CLSET;
+}
+
+void 
+o_swon (memel *argp)
+{
+	register char *pname = (char *)argp;
+	register struct param *pp;
+	struct	pfile *pfp;
+	struct	operand o;
+	char	*pk, *t, *p, *f;
+
+	breakout (pname, &pk, &t, &p, &f);
+	if (*pk)
+	    cl_error (E_UERR, e_simplep, p);
+
+	pfp = newtask->t_pfp;
+	pp = ppfind (pfp, t, p, 0, NO);
+	if (pp == NULL)
+	    cl_error (E_UERR, e_pnonexist, p);
+	if ((XINT)pp == ERR)
+	    cl_error (E_UERR, e_pambig, p, newtask->t_ltp->lt_lname);
+
+	o.o_type = OT_BOOL;
+	o.o_val.v_i = YES;
+	pushop (&o);
+	paramset (pp, FN_VALUE);
+	if (pp->p_type & PT_PSET)
+	    psetreload (pfp, pp);
+
+	pp->p_flags |= P_CLSET;
+}
+
+
+/* FIXLANGUAGE -- Called only once, during startup after processing the
+ * cl startup file (clpackage.cl) to set the PKCCL flag for task LANGUAGE
+ * in the package CLPACKAGE.  Thereafter, when language is executed it
+ * will merely cause the current package to be changed.  This cannot be
+ * done in the conventional way since clpackage.language() is never
+ * executed to load the language package, since it is the root package.
+ */
+void 
+o_fixlanguage (void)
+{
+	register struct ltask *ltp;
+
+	ltp = ltasksrch (CLPACKAGE, ROOTPACKAGE);
+	ltp->lt_flags |= (LT_PACCL|LT_CL);
+	ltp->lt_pkp = pacfind (ROOTPACKAGE);
+}
+
+
+/* the opcode jump table.
+ *
+ * order of the entries here must agree with constants in opcodes.h.
+ * if the name is a keyword in C or a common library entry point,
+ * then precede it with "do" but alphabetize it according to its intended name.
+ */
+
+void (*opcodetbl[])() = {
+/*  0 */	o_undefined,
+
+/*  1 */	o_absargset,
+/*  2 */	o_add,
+/*  3 */	o_addassign,
+/*  4 */	o_doaddpipe,
+/*  5 */	o_allappend,
+
+/*  6 */	o_allredir,
+/*  7 */	o_and,
+/*  8 */	o_append,
+/*  9 */	o_assign,
+/* 10 */	o_biff,
+
+/* 11 */	o_call,
+/* 12 */	0,		/* The CASE operand is never executed.*/
+/* 13 */	o_chsign,
+/* 14 */	o_concat,
+/* 15 */	0,		/* The DEFAULT operand is never executed. */
+
+/* 16 */	o_div,
+/* 17 */	o_divassign,
+/* 18 */	o_doend,
+/* 19 */	o_eq,
+/* 20 */	o_exec,
+
+/* 21 */	o_dofscan,
+/* 22 */	o_dofscanf,
+/* 23 */	o_ge,
+/* 24 */	o_dogoto,
+/* 25 */	o_dogetpipe,
+
+/* 26 */	o_gt,
+/* 27 */	o_immed,
+/* 28 */	o_indirabsset,
+/* 29 */	o_indirposset,
+/* 30 */	o_indxincr,
+
+/* 31 */	o_inspect,
+/* 32 */	o_intrinsic,
+/* 33 */	o_le,
+/* 34 */	o_lt,
+/* 35 */	o_mul,
+
+/* 36 */	o_mulassign,
+/* 37 */	o_ne,
+/* 38 */	o_not,
+/* 39 */	o_or,
+/* 40 */	o_osesc,
+
+/* 41 */	o_posargset,
+/* 42 */	o_dopow,
+/* 43 */	o_doprint,
+/* 44 */	o_pushconst,
+/* 45 */	o_pushindex,
+
+/* 46 */	o_pushparam,
+/* 47 */	o_redir,
+/* 48 */	o_redirin,
+/* 49 */	o_rmpipes,
+/* 50 */	o_doreturn,
+
+/* 51 */	o_doscan,
+/* 52 */	o_doscanf,
+/* 53 */	o_sub,
+/* 54 */	o_subassign,
+/* 55 */	o_doswitch,
+
+/* 56 */	o_swoff,
+/* 57 */	o_swon,
+/* 58 */	o_fixlanguage,
+/* 59 */	o_gsredir,
+/* 60 */	o_catassign,
+};
diff --git a/pkg/vocl/opcodes.h b/pkg/vocl/opcodes.h
new file mode 100644
index 00000000..ce40b762
--- /dev/null
+++ b/pkg/vocl/opcodes.h
@@ -0,0 +1,127 @@
+/*
+ * OPCODES.H -- This structure is a template for each instruction in the
+ * dictionary.  C_opcode is a constant, from below, and is an index into
+ * opcodetbl[]; c_length is the total length, including the opcode, in # of
+ * integers; the address of c_args will be the address of the first argument
+ * (or if there is just one, it IS the first argument).
+ *
+ * The intent is to allow invoking the opcode with
+ * 	(*opcodetbl[cp->c_opcode]) (&cp->c_args)
+ *	where cp is a ptr to struct codeentry.
+ */
+
+struct codeentry {
+	memel c_opcode;		/* opcodetbl index; see below		*/
+	memel c_scriptln;	/* script line of opcode instruction	*/
+	memel c_length;		/* total length in memory elements	*/
+	memel c_args;		/* addr of this is addr of first arg	*/
+};
+
+#define	SZ_CE		4	/* size of codeentry			*/
+
+
+extern void (*opcodetbl[])();
+
+/* manifest constant opcodes used in c_opcode.
+ * value is index into opcodetbl[].
+ */
+
+#define	ABSARGSET	1
+#define	ADD		2
+#define	ADDASSIGN	3
+#define	ADDPIPE		4
+#define	ALLAPPEND 	5
+
+#define	ALLREDIR	6
+#define	AND		7
+#define	APPENDOUT	8
+#define	ASSIGN		9
+#define	BIFF		10
+
+#define	CALL		11
+#define CASE		12
+#define	CHSIGN		13
+#define	CONCAT		14
+#define DEFAULT		15
+
+#define	DIV		16
+#define DIVASSIGN	17
+#define	END		18
+#define	EQ		19
+#define	EXEC		20
+
+#define FSCAN		21
+#define FSCANF		22
+#define	GE		23
+#define	GOTO		24
+#define	GETPIPE		25
+
+#define	GT		26
+#define	IMMED		27
+#define	INDIRABSSET	28
+#define	INDIRPOSSET	29
+#define INDXINCR	30
+
+#define	INSPECT		31
+#define	INTRINSIC	32
+#define	LE		33
+#define	LT		34
+#define	MUL		35
+
+#define	MULASSIGN	36
+#define	NE		37
+#define	NOT		38
+#define	OR		39
+#define	OSESC		40
+
+#define	POSARGSET	41
+#define	POW		42
+#define	PRINT		43
+#define	PUSHCONST	44
+#define	PUSHINDEX	45
+
+#define	PUSHPARAM	46
+#define	REDIR		47
+#define	REDIRIN		48
+#define	RMPIPES		49
+#define	RETURN		50
+
+#define	SCAN		51
+#define	SCANF		52
+#define	SUB		53
+#define	SUBASSIGN	54
+#define	SWITCH		55
+
+#define	SWOFF		56
+#define	SWON		57
+#define	FIXLANGUAGE	58
+#define	GSREDIR		59
+#define	CATASSIGN	60
+
+
+#ifdef OP_DEBUG
+/* Opcodes string definitions for debug output.
+ */
+static char *opstrings[] = {
+    "ABSARGSET",   "ADD",       "ADDASSIGN",    "ADDPIPE",      "ALLAPPEND",
+    "ALLREDIR",    "AND",       "APPENDOUT",    "ASSIGN",       "BIFF",
+    "CALL",        "CASE",      "CHSIGN",       "CONCAT",       "DEFAULT",
+    "DIV",         "DIVASSIGN", "END",          "EQ",           "EXEC",
+    "FSCAN",       "FSCANF",    "GE",           "GOTO",         "GETPIPE",
+    "GT",          "IMMED",     "INDIRABSSET",  "INDIRPOSSET",  "INDXINCR",
+    "INSPECT",     "INTRINSIC", "LE",           "LT",           "MUL",
+    "MULASSIGN",   "NE",        "NOT",          "OR",           "OSESC",
+    "POSARGSET",   "POW",       "PRINT",        "PUSHCONST",    "PUSHINDEX",
+    "PUSHPARAM",   "REDIR",     "REDIRIN",      "RMPIPES",      "RETURN",
+    "SCAN",        "SCANF",     "SUB",          "SUBASSIGN",    "SWITCH",
+    "SWOFF",       "SWON",      "FIXLANGUAGE",  "GSREDIR",      "CATASSIGN",
+    ""
+};
+
+#define op2str(op) 	((char *)(opstrings[op-1] ? opstrings[op-1] : ""))
+
+#else
+
+#define op2str(op) 	(" ")
+
+#endif
diff --git a/pkg/vocl/operand.c b/pkg/vocl/operand.c
new file mode 100644
index 00000000..6c3a73af
--- /dev/null
+++ b/pkg/vocl/operand.c
@@ -0,0 +1,411 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "errs.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "mem.h"
+#include "task.h"		/* to get currentask for prop		*/
+#include "construct.h"
+#include "eparam.h"
+#include "proto.h"
+
+
+/*
+ * OPERAND -- Primitives for operations upon operands, as used on the
+ * operand stack (runtime arithmetic).
+ */
+
+extern int cldebug;
+extern char *truestr;
+extern char *falsestr;
+extern char *nullstr;
+extern char *indefstr;
+extern char *indeflc;
+extern char *eofstr;
+extern char *epsilonstr;
+
+
+/* SPROP -- Format the value of a parameter into the output string.
+ */
+void 
+sprop (register char *outstr, register struct operand *op)
+{
+	register int type;
+	char	*index();
+
+	if (opundef (op))
+	    cl_error (E_IERR, "can not print an undefined operand");
+	if (opindef (op)) {
+	    strcpy (outstr, indefstr);
+	    return;
+	}
+
+	type = op->o_type & OT_BASIC;
+	switch (type) {
+	case OT_BOOL:
+	    sprintf (outstr, op->o_val.v_i == NO ? falsestr : truestr);
+	    break;
+	case OT_INT:
+	    sprintf (outstr, "%d", op->o_val.v_i);
+	    break;
+	case OT_REAL:
+	    /* unix's %g suppresses '.' if no fractional part */
+	    sprintf (outstr, "%g", op->o_val.v_r);
+	    if (index (outstr, '.') == NULL)
+		strcat (outstr, ".");
+	    break;
+	case OT_STRING:
+	    strcpy (outstr, op->o_val.v_s);
+	    break;
+	default:
+	    /* cannot happen because there are only 2 bits for 4 types.
+	    cl_error (E_IERR, e_badsw, type, "fprop()");
+	     */
+	    ;
+	}
+}
+
+
+/* SPPARVAL -- Print value field of a parameter into a string.
+ */
+void 
+spparval (char *outstr, struct param *pp)
+{
+	struct	operand o;
+
+	if (!(pp->p_valo.o_type & OT_UNDEF)) {
+	    paramget (pp, FN_VALUE); 
+	    o = popop();
+	    sprop (outstr, &o);
+	} else
+	    outstr[0] = '\0';
+}
+
+
+/* Print an operand on stream fp.
+ * o_val is printed with proper format; no trailing nl.
+ * handle indefinite and abort on undefined.
+ */
+void 
+fprop (FILE *fp, struct operand *op)
+{
+	/* Use MAXPROMPT to give greatest length we expect to print.
+	 */
+	char	outstr[MAXPROMPT+1], *out;
+	char	newstr[SZ_LINE], *new;
+
+	sprop (outstr, op);
+
+	/* Convert embedded newlines to \n.
+	 */
+	new = newstr;
+	out = outstr;
+	for (;  *out != '\0' && ((new-newstr) < SZ_LINE-1 );  out++, new++)  {
+	    if (*out == '\n') {
+		*new++ = '\\';
+		*new = 'n';
+	    } else {
+		*new = *out;
+	    }
+	}
+	*new = '\0';
+
+	fputs (newstr, fp);
+	if (ferror (fp))
+	    cl_error (E_IERR, "write error within fprop()");
+}
+
+
+/* print operand, using fprop, to our t_stdout.
+ */
+void 
+oprop (struct operand *op)
+{
+	fprop (currentask->t_stdout, op);
+}
+
+
+/* print operand, using fprintf, to currentask.
+ */
+void 
+prop (struct operand *op)
+{
+	fprop (currentask->t_out, op);
+}
+
+
+/* pop the top element, which must be of type string, and use it as the
+ *   name of a parameter which is then found and pushed.
+ * call error() if popped op is not a string; DO NOT CAST into string.
+ */
+void 
+opindir (void)
+{
+	struct operand nameop;
+	struct param *indirpp;
+	char *pk, *t, *p, *f;
+
+	nameop = popop();
+	if ((nameop.o_type & OT_BASIC) != OT_STRING)
+	    cl_error (E_IERR, "non-string operand seen by opindir()");
+	breakout (nameop.o_val.v_s, &pk, &t, &p, &f);
+	indirpp = paramsrch (pk, t, p);
+	validparamget (indirpp, *f);
+}
+
+
+/* Pop top operand and replace it with one cast to type newtype.
+ * Newtype is assumed to not have OT_INDEF or OT_UNDEF set.
+ * Call error() if trying to convert strings to something else unless
+ * it is a length 1 string conversion to integer which we take to be
+ * conversion from char to int.
+ *
+ * Do nothing if already the correct type, regardless of whether it is indef
+ *   or undef.
+ * N.B. we use intimate knowledge of the stack layout to do the simple cases.
+ */
+void 
+opcast (int newtype)
+{
+	struct operand o, result;
+	struct operand *op;
+
+	/* Do nothing if already the correct type,
+	 * regardless of whether it is indef or undef.
+	 */
+	op = (struct operand *) &stack[stack[topos]+1];
+	if ((op->o_type & OT_BASIC) == newtype)
+	    return;
+
+	o = popop();
+	result.o_type = newtype;
+
+	if (opindef (&o)) {
+	    /* manufacture another indefinite but with the new type */
+	    setopindef (&result);
+	    goto pushresult;
+	}
+
+	switch (newtype) {
+	default:
+	    /* Coerce all unknowns to type integer.  Actually this cannot
+	     * happen since the 4 types are encoded in 2 bits.
+	     */
+	    newtype = OT_INT;
+	    /* continue... */
+
+	case OT_BOOL:
+	    /* Coercion of booleans is not permitted */
+	    if (o.o_type != OT_BOOL)
+		cl_error (E_UERR,
+		    "Non-boolean operand used where boolean expected");
+	    break;
+
+	case OT_INT:
+	    switch (o.o_type) {
+	    case OT_BOOL:
+		cl_error (E_UERR, "Attempt to coerce a boolean to an integer");
+	    case OT_INT:
+		result.o_val.v_i = o.o_val.v_i;
+		break;
+	    case OT_REAL:
+		result.o_val.v_i = o.o_val.v_r;
+		break;
+	    case OT_STRING:
+		if (*o.o_val.v_s != '\0'  &&  *(o.o_val.v_s+1) == '\0')
+		    result.o_val.v_i = (int) *o.o_val.v_s;
+		else
+		    cl_error (E_UERR, e_nostrcnv);
+		break;
+	    default:
+		goto err;
+	    }
+	    break;
+
+	case OT_REAL:
+	    switch (o.o_type) {
+	    case OT_BOOL:
+		cl_error (E_UERR, "Attempt to coerce a boolean to a real");
+	    case OT_INT:
+		result.o_val.v_r = o.o_val.v_i;
+		break;
+	    case OT_REAL:
+		result.o_val.v_r = o.o_val.v_r;
+		break;
+	    case OT_STRING:
+		cl_error (E_UERR, e_nostrcnv);
+	    default:
+		goto err;
+	    }
+	    break;
+
+	case OT_STRING: {
+	    char numstr[SZ_LINE];
+	    switch (o.o_type) {
+	    case OT_BOOL:
+		result.o_val.v_s =
+			o.o_val.v_i == NO ? falsestr : truestr;
+		break;
+	    case OT_INT:
+		sprintf (numstr, "%d", o.o_val.v_i);
+		result.o_val.v_s = numstr;
+		break;
+	    case OT_REAL:
+		sprintf (numstr, "%g", o.o_val.v_r);
+		result.o_val.v_s = numstr;
+		break;
+	    case OT_STRING:
+		strcpy (numstr, o.o_val.v_s);
+		result.o_val.v_s = numstr;
+		break;
+	    default: goto err;
+	    }
+
+	    /* Must do pushop here to use numstr */
+	    pushop (&result);
+	    return;
+
+	    } /* end case OT_STRING */
+	}
+
+pushresult:
+	pushop (&result);
+	return;
+
+err:
+	cl_error (E_IERR, e_badsw, o.o_type, "opcast()");
+}
+
+
+/* MAKEOP -- Read through string s and create and return an operand of given
+ * type.  Type must be strictly OT_BASIC.  See the various cases for
+ * considerations unique to each.  Set OT_UNDEF if string does not look like
+ * it is the correct type or it is null length; set OT_INDEF if s is the
+ * indefstr..  Null length strings of type OT_STRING are not considered
+ * undefined, however.
+ */
+struct operand 
+makeop (char *str, int type)
+{
+	register char *s, *ip;
+	register char c;
+	char	*index(), *format;
+	char	hexnum[MAX_DIGITS];
+	char	firstchar;
+	struct	operand o;
+
+	maybeindex = 0;
+	s = str;
+	if (type & ~OT_BASIC)
+	    cl_error (E_IERR, e_badsw, type, "makeop()");
+
+	/* Leading whitespace is ignored except in strings. */
+	o.o_type = type;
+	if (type != OT_STRING)
+	    while (*s == ' ' || *s == '\t')
+		s++;
+
+	if (type != OT_STRING && 
+		(!strcmp (indefstr, s) || !strcmp (indeflc, s))) {
+	    setopindef (&o);
+	    return (o);
+	}
+	if (*s == '\0' && type != OT_STRING) {
+	    setopundef (&o);
+	    return (o);
+	}
+
+	switch (type) {
+	case OT_BOOL:
+	    /* s is converted, IN PLACE, to lower case */
+	    makelower (s);
+	    /* Accept either "y" or "yes", "n" or "no" */
+	    if (((s[0] == truestr[0]) && (s[1] == '\0')) ||
+		(strcmp (s, truestr) == 0))
+		o.o_val.v_i = YES;
+	    else if (((s[0] == falsestr[0]) && (s[1] == '\0')) ||
+		(strcmp (s, falsestr) == 0))
+		o.o_val.v_i = NO;
+	    else
+		setopundef (&o);
+	    break;
+
+	case OT_INT:
+	    /* trailing 'b' or 'B' means convert as octal.
+	     * trailing 'x' or 'X' means convert as hex.
+	     * Set format to appropriate scanf format.  Note we must test
+	     * for hex number first, since 'b' is legal in hex numbers.
+	     */
+	    firstchar = *s;
+	    if (*s != '\''  &&  *s != '"')
+	 	makelower (s);
+
+	    if (index (s, 'x') != NULL) {
+		strcpy (hexnum, "0x");
+		strcat (hexnum, s);
+		format = "%x";
+	    } else if (index (s, 'b') != NULL) {
+		format = "%o";
+	    } else
+		format = "%d";
+
+	    if (sscanf (s, format, &o.o_val.v_i) != 1) {
+		/* Check if string has exactly one character.
+		 * Use firstchar because it hasn't been forced to lower case.
+		 */
+		if (*s  && !(*(s+1)) )
+		    o.o_val.v_i = firstchar;
+		/* Quoted character? */
+		else if ( (*s == '\''  ||  *s == '"')  &&  (*s == *(s+2) ) &&
+		  !(*(s+3)) )
+		    o.o_val.v_i = *(s+2);
+		else
+		    setopundef (&o);
+	    }
+
+	    break;
+
+	case OT_REAL: {
+	    /* If there is only a single colon this might be
+	     * an array index range.  If so set flag.
+	     * Check for decimal point after first colon also.
+	     */
+	    char *colon;
+
+	    if ( (colon=index (s, ':') ) != NULL) {
+		if (index (colon+1, ':') == NULL  &&
+		  index (colon+1, '.') == NULL)
+		    maybeindex++;
+
+		o = sexa (s);
+	    } else if (sscanf (s, "%lf", &o.o_val.v_r) != 1)
+		setopundef (&o);
+	    break;
+	}
+	case OT_STRING:
+	    /* set v_s to s and strip off any surrounding quotes.
+	     * trailing " or ' will be reset, IN-PLACE, to '\0'.
+	     */
+	    ip = s;
+	    c = *ip++;
+	    if (c == '\'' || c == '"') {
+		while (*ip)
+		    ip++;
+		if (*--ip == c) {
+		    s++;		/* skip leading quote		*/
+		    *ip = '\0';		/* remove trailing quote	*/
+		}
+	    }
+	    o.o_val.v_s = s;
+	}
+
+	return (o);
+}
diff --git a/pkg/vocl/operand.h b/pkg/vocl/operand.h
new file mode 100644
index 00000000..b178a20a
--- /dev/null
+++ b/pkg/vocl/operand.h
@@ -0,0 +1,264 @@
+/*
+ * OPERAND.H -- Definition of an operand, defined operation codes and function
+ * type declarations.
+ */
+
+/* ----------
+ * union of all possible fundamentally allowed data types in an operand
+ */
+union value {
+	int v_i;		/* integer, also doubles as boolean */
+	double v_r;		/* floating real; all assumed double precision*/
+	char *v_s;		/* char string	*/
+	struct arr_desc	*v_a;	/*  Array of int, double or string.	*/
+};
+
+struct operand {
+	short o_type;		/* need 16 bits; see type codes below	*/
+	union value o_val;
+};
+
+union arrhead {
+	int	*a_i;		/* Pointer to ints (or bools).	*/
+	double	*a_r;		/* Pointer to reals.		*/
+	char	**a_s;		/* Pointer to strings.		*/
+};
+
+struct arr_desc {
+	union arrhead a_ptr;	/* Pointer to elements in array.*/
+	int	a_dim;		/* Dimensionality of array.	*/
+	short	a_len;		/* Length of first dimension.	*/
+	short	a_off;		/* Offset of first dimension.	*/
+};
+/* Note that in an multi-dimensional array a_len and a_off will
+ * be repeated for each dimension.
+ */
+
+
+/* this should be the size of operand IN INTS so that the instruction
+ * pointer instptr and operand stack index topos can be properly manipulated.
+ */
+#define	OPSIZ	btoi (sizeof (struct operand))
+
+
+/* ----------
+ * return value of operand *o.
+ * not useful for strings as cannot include v_s in this.
+ * note that both OT_INT and OT_BOOL use v_i.
+ * we assume that o_type only includes OT_BASIC bits.
+ */
+#define	VALU(o)	(((o)->o_type == OT_REAL) ? (o)->o_val.v_r : (o)->o_val.v_i)
+
+
+/* ----------
+ * o_type flag defn's; also used in p_type, see param.h.
+ * the value of o_type&OT_BASIC is the basic type of the operand. there is
+ * no such thing as an undefined type, only an undefined value.
+ * an operand's o_value is unused if OT_INDEF or UNDEF is set.
+ */
+#define	OT_BOOL		0	/* actually stored as an int, 0 or 1	*/
+#define	OT_INT		1	/* ints store least 16 bits		*/
+#define	OT_REAL		2	/* no float/double distinction		*/
+#define	OT_STRING	3	/* any kind of in-core char storage	*/
+#define	OT_BASIC	03	/* mask to get only the type bits	*/
+
+#define	OT_INDEF	004	/* value is undefined (not an err)	*/
+#define	OT_UNDEF	010	/* value is just not known (an err)	*/
+
+
+/* test and set functions for indefinite and undefined operands.
+ * note that the basic type is not disturbed during setting.
+ */
+#define	opindef(op)	(((op)->o_type & OT_INDEF) != 0)
+#define	opundef(op)	(((op)->o_type & OT_UNDEF) != 0)
+#define	setopindef(op)	((op)->o_type |= OT_INDEF)
+#define	setopundef(op)	((op)->o_type |= OT_UNDEF)
+
+
+/* ----------
+ * binary operations, handled by binop().
+ * if these are each in numeric order, the switches in binop(), unop(), etc
+ * will be compiled as jump tables.
+ */
+#define	OP_ADD		1
+#define	OP_SUB		2
+#define	OP_MUL		3
+#define	OP_DIV		4
+#define	OP_POW		5	/* power, as in a**x			*/
+#define	OP_MAX		6
+#define	OP_MIN		7
+#define	OP_MOD		8
+#define	OP_ATAN2	9	/* arctangent with two args		*/
+#define	OP_DATAN2	10	/* arctangent with result in degrees	*/
+#define	OP_FPEQUAL	11	/* floating point comparison		*/
+#define OP_HYPOT	12	/* euclidean distance			*/
+#define OP_BAND		13	/* bitwise AND operator			*/
+#define OP_BOR		14	/* bitwise OR operator			*/
+#define OP_BXOR		15	/* bitwise XOR operator			*/
+
+#define	OP_CONCAT	16	/* string concatenatation		*/
+#define OP_RADIX	17	/* string = radix (decimal, newradix)	*/
+#define OP_STRIDX	18	/* first occurrence of a char in str	*/
+#define OP_STRLDX	19	/* last occurrence of a char in str	*/
+#define OP_STRSTR	20	/* first occurrence of str1 in str2	*/
+#define OP_STRLSTR	21	/* last occurrence of str1 in str2	*/
+#define OP_STRDIC	22	/* index of string in a dictionary	*/
+
+
+/* binary logical expressions, handled by binexp();
+ * uses o_val.v_i as boolean result
+ */
+#define	OP_LT		1
+#define	OP_GT		2
+#define	OP_LE		3
+#define	OP_GE		4
+#define	OP_EQ		5
+#define	OP_NE		6
+#define	OP_OR		7
+#define	OP_AND		8
+
+/* unary expressions, handled by unexp(); interprets o_val as boolean */
+#define	OP_TRUE		1	/* sets o_val to 1			*/
+#define	OP_FALSE	2	/*  "        "   0			*/
+#define	OP_NOT		3	/* sets non-0 o_val to 0, 0 to 1	*/
+
+/* unary operations, handled by unop() */
+#define	OP_ABS		1	/* absolute value			*/
+#define	OP_ACCESS	2	/* does named file exist		*/
+#define OP_ACOS		3	/* inverse cosine			*/
+#define OP_ASIN		4	/* inverse sine				*/
+#define OP_BNOT		5	/* bitwise NOT operator			*/
+#define	OP_COS		6	/* cosine				*/
+#define	OP_DACOS	7	/* inverse cosine (output in degrees)	*/
+#define	OP_DASIN	8	/* inverse sine (output in degrees)	*/
+#define	OP_DCOS		9	/* cosine (arg in degrees)		*/
+#define	OP_DSIN		10	/* sine (arg in degrees)		*/
+#define	OP_DTAN		11	/* tangent (arg in degrees)		*/
+#define	OP_DEFPAC	12	/* is named package loaded		*/
+#define	OP_DEFPAR	13	/* is named parameter defined		*/
+#define	OP_DEFTASK	14	/* is named task defined		*/
+#define	OP_DEFVAR	15	/* does environment variable exist	*/
+#define OP_DEG		16	/* convert to degrees			*/
+#define	OP_ENVGET	17	/* get environment variable defn	*/
+#define	OP_EXP		18	/* natural antilog, as in e ** x	*/
+#define	OP_FRAC		19	/* fractional part of a real number	*/
+#define	OP_IMACCESS	21	/* does named image exist		*/
+#define	OP_INT		22	/* coerce to int			*/
+#define OP_ISINDEF	23	/* is value INDEF			*/
+#define	OP_LOG		24	/* natural logarithm			*/
+#define	OP_LOG10	25	/* decimal logarithm			*/
+#define	OP_MINUS	26	/* unary negation			*/
+#define	OP_MKTEMP	27	/* make unique file name		*/
+#define	OP_NINT		28	/* return nearest integer (round)	*/
+#define	OP_OSFN		29	/* convert vfn to OS filename		*/
+#define OP_RAD		30	/* convert to radians			*/
+#define OP_REAL		31	/* coerce to real			*/
+#define	OP_SIGN		32	/* sign					*/
+#define	OP_SIN		33	/* sine					*/
+#define	OP_SQRT		34	/* square root				*/
+#define	OP_STR		35	/* coercion to type string		*/
+#define OP_STRLEN	36	/* length of a string constant		*/
+#define OP_STRLWR	37	/* convert string to lower case		*/
+#define OP_STRSUB	38	/* string substitution			*/
+#define OP_STRUPR	39	/* convert string to upper case		*/
+#define	OP_TAN		40	/* tangent				*/
+
+/* Multiple operators, handled by intrfun() directly */
+#define OP_ERRPOP	50	/* pop the error handler		*/
+#define OP_ERRPEEK	51	/* peek at error flag			*/
+#define OP_ERRMSG	52	/* return the error message		*/
+#define OP_ERRCODE	53	/* return the error code		*/
+#define OP_ERRTASK	54	/* return task which posted error	*/
+#define	OP_NSCAN	55	/* number of items conv. in last SCAN	*/
+#define	OP_SUBSTR	56	/* extract substring			*/
+#define OP_TRIM		57	/* trim both sides of a string		*/
+#define OP_TRIML	58	/* trim left side of a string		*/
+#define OP_TRIMR	59	/* trim right side of a string		*/
+
+
+/* VOClient operators, handled by vocop() */
+#define OP_INITVOC      100     /* initialize VO Client                 */
+#define OP_CLOSEVOC     101     /* close VO Client                      */
+#define OP_RESTARTVOC   102     /* restart VO Client                    */
+
+#define OP_CONESVC      110     /* call a Cone service                  */
+#define OP_SIAPSVC      111     /* call a SIAP service                  */
+#define OP_RECCNT       112     /* get count of result records          */
+#define OP_GETREC       113     /* get specified record number          */
+#define OP_GETDATA      114     /* get specified record number          */
+#define OP_GETSTR       115     /* get specified record number          */
+#define OP_GETINT       116     /* get specified record number          */
+#define OP_GETDBL       117     /* get specified record number          */
+
+#define OP_ATTRCNT      120     /* get count record attributes          */
+#define OP_ATTRNAME     121     /* get attribute name by index          */
+#define OP_INTATTR      122     /* get attribute (int)                  */
+#define OP_FLOATATTR    123     /* get attribute (real)                 */
+#define OP_STRATTR      124     /* get attribute (string)               */
+#define OP_DATASET      125     /* get dataset                          */
+#define OP_ATTRSCAN     126     /* get attribute value                  */
+
+#define OP_REGSEARCH    130     /* search the Registry                  */
+#define OP_REGSVCSEARCH 131     /* search the Registry by svctype       */
+#define OP_REGCOUNT     132     /* get count of Resource records        */
+#define OP_REGBPASS     133     /* set bandpass constraint 		*/
+#define OP_REGSVC       134     /* set serviceType constraint 		*/
+#define OP_REGCONTENT   135     /* set contentLevel constraint 		*/
+#define OP_REGVALUE     136     /* get entity value of Resource         */
+#define OP_REGRESOLVER  137     /* resolve shortname/ivorn to attr      */
+#define OP_NRESOLVED    138     /* number of resolved resources         */
+
+#define OP_VALIDOBJ     140     /* validate and object in VO Client     */
+#define OP_VOCREADY     141     /* verify VO Client is ready            */
+
+#define OP_SAMP		150     /* SAMP master command			*/
+#define OP_SAMPIMLOAD	151     /* image.load.fits              	*/
+#define OP_SAMPTBLVOT	152     /* table.load.votable           	*/
+#define OP_SAMPTBLFITS	153     /* table.load.fits              	*/
+#define OP_SAMPSPECLOAD	154     /* spectrum.load.ssa-generic    	*/
+#define OP_SAMPBIBLOAD	155     /* bibcode.load				*/
+#define OP_SAMPRESLOAD	156     /* voresource.loadlist			*/
+
+#define OP_SAMPTBLROW	157     /* table.highlight.row          	*/
+#define OP_SAMPSELRLIST	158     /* table.select.rowList         	*/
+#define OP_SAMPPOINTAT	159     /* coord.pointAt.sky            	*/
+#define OP_SAMPCMDEXEC	160     /* client.cmd.exec			*/
+#define OP_SAMPENVGET	161     /* client.env.get			*/
+#define OP_SAMPENVSET	162     /* client.env.set			*/
+#define OP_SAMPPARAMGET	163     /* client.param.get			*/
+#define OP_SAMPPARAMSET	164     /* client.param.set			*/
+
+#define OP_SAMPHANDLER	170     /* add a user-defined handler		*/
+#define OP_SAMPHUBACC	171     /* check on hub access			*/
+#define OP_SAMPACCESS	172     /* check an external application	*/
+#define OP_SAMPSTATUS	173     /* set/print samp status		*/
+#define OP_SAMPMETA	174     /* declare app metadata			*/
+#define OP_SAMPNAME	175     /* set/print application name		*/
+
+
+
+
+
+/* These area used by intrinsic() to categorize the various opcodes.
+ * The lower OP_BITS encode the specific function, while bits above that
+ * encode the category.  Thus, none of the OP_XXX codes above may use more
+ * than OP_BITS, ie, be larger than OP_MASK.
+ */
+#define	OP_BITS		8
+#define	OP_MASK		255	/* could be 2**OP_BITS-1 if C had **	*/
+#define	UNOP		(1<<OP_BITS)
+#define	BINOP		(2<<OP_BITS)
+#define	MULTOP		(3<<OP_BITS)
+#define	VOCOP		(4<<OP_BITS)
+#define	SAMPOP		(5<<OP_BITS)
+
+
+#define	INTWIDTH	15	/* approx max chars in a printed integer*/
+#define	REALWIDTH	25	/* approx max chars in a printed real	*/
+
+extern char *truestr, *falsestr;
+
+struct operand popop(), pushop();
+struct operand makeop();
+struct operand readlist();	/* read and return operand from list	*/
+struct operand sexa();		/* convert n:n:n string to sexagesimal	*/
diff --git a/pkg/vocl/param.c b/pkg/vocl/param.c
new file mode 100644
index 00000000..82fe325b
--- /dev/null
+++ b/pkg/vocl/param.c
@@ -0,0 +1,1397 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "mem.h"
+#include "task.h"
+#include "errs.h"
+#include "clmodes.h"
+#include "construct.h"
+#include "proto.h"
+
+
+/*
+ * PARAM -- Operations upon parameters.
+ */
+
+extern int cldebug;
+extern char *undefval;
+extern char *nullstr;
+extern char *eofstr;
+extern char *indefstr;
+extern char *indeflc;
+
+XINT parhead;			/* dict index of first pfile 		*/
+
+
+#define	INDEX_OFFSET	0	/* Offsets using index list.		*/
+#define DIRECT_OFFSET	1	/* Offsets put on stack directly.	*/
+int	mode_offset = INDEX_OFFSET;
+
+char	*loc_field = "Attempt to access undefined field in local variable %s.\n";
+
+/* PARAMFIND -- Search for a parameter with the given name off pfile *pfp.
+ * If name is null, then search for one in n'th pos, counting from 0.
+ *   not counting M_HIDDEN params.
+ * Return NULL if cannot find one with given name or at given position
+ *   or ERR if allowing abbreviations and pname is ambiguous.
+ * Never return ERR if looking for a positional arg; some callers of paramfind()
+ *   Depend on this and don't check for ERR; beware if change it.
+ */
+struct param *
+paramfind (struct pfile *pfp, char *pname, int pos, int exact)
+{
+	register char first_char;
+	register struct	param *pp;
+	struct	ltask *ltp;
+
+	if (pfp == NULL)
+	    return (NULL);
+
+	if (cldebug) {
+	    eprintf ("paramfind() looking down pfile `%s'/%x for ",
+		(ltp = pfp->pf_ltp) ? ltp->lt_lname : "", pfp);
+	    if (pname != NULL && *pname != '\0')
+		eprintf ("`%s'\n", pname);
+	    else
+		eprintf ("position %d\n", pos);
+	}
+
+	/* Check for both ways "name may be null" */
+	if (pname == NULL || *pname == '\0') {
+
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+		if (!(pp->p_mode & M_HIDDEN) && pos-- == 0)
+		    return (pp);
+
+	} else if (abbrev() && !exact) {
+	    /* Settle for abbreviation of name */
+	    struct param *candidate;
+	    int n;
+
+	    candidate = NULL;
+	    n = strlen (pname);
+	    first_char = pname[0];
+
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		if (*pp->p_name == first_char)
+		    if (!strncmp (pp->p_name, pname, n)) {
+			if (pp->p_name[n] == '\0')
+			    return (pp);			 /* exact hit */
+			if (candidate == NULL)
+			    candidate = pp;
+			else
+			    candidate = (struct param *) ERR;
+		    }
+		}
+
+	    return (candidate);
+
+	} else {
+	    /* Name must be exact. */
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		if (!strcmp (pp->p_name, pname))
+		    return (pp);
+	    }
+	}
+	
+	return (NULL);
+}
+
+
+/* PARAMSET -- Pop top operand and assign to given field of param *pp,
+ *   with possible type conversion via opcast() to pp->p_type.
+ *   Be darn sure to pop an operand in all cases!
+ * All preallocated string storage ends with null; take care to preserve this
+ *   by never copying into full length. assigning into the name of a
+ *   list-structured param closes the file if it's open and clears EOF.
+ *   We don't check if the popped op is undefined.
+ *
+ * Parameter indirection complicates setting the p_value, p_min, and p_max
+ *   fields (the only fields for which indirection is permitted).  When one
+ *   of these fields is indirect it is a string valued operand containing
+ *   as value a string of the form ")indirparam".  Hence, the value, min, or
+ *   max field may be of type string while the parameter itself (p_type) is
+ *   of some other datatype.  Indirection will be overriden if the operand
+ *   to be set is a data value rather than an indirect reference string.
+ *   If the operand is a data value the parameter field may change its datatype.
+ *   If the operand is an indirect reference the field must already be of type
+ *   string with sufficient string storage allocated for the new string.
+ *   String storage must be allocated when the pfile is loaded.
+ *
+ * Enumerated types are implemented as a string of | separated fields
+ *   stored in the p_min field.  The p_min field must have been set to some
+ *   string value when the pfile was loaded or storage will not have been
+ *   allocated.  While the enumerated type is supported only for string valued
+ *   params, integers may be stored as strings in a string valued parameter
+ *   to permit enumerating the legal values of an integer parameter, e.g.:
+ *
+ *	order of interpolator (3|5|7) (5):
+ */
+void 
+paramset (register struct param *pp, int field)
+{
+	struct	operand o;
+	int	bastype;	/* OT_BASIC portion of p_type		*/
+	int	valtype;	/* OT_BASIC type of current value	*/
+	int	optype;		/* OT_BASIC type of operand		*/
+	int	arrflag;	/* Array indicator.			*/
+	int	list;		/* set if p->p_type & PT_LIST		*/
+	int	len;		/* max length of storage, if in-line	*/
+
+	o = popop();
+
+	list = pp->p_type & PT_LIST;
+	arrflag = pp->p_type & PT_ARRAY;
+	bastype = pp->p_type & OT_BASIC;
+	valtype = pp->p_valo.o_type & OT_BASIC;
+	optype  = o.o_type & OT_BASIC;
+
+	/* Check if unauthorized access to local variable.
+	 */
+	if (pp->p_mode&M_LOCAL  &&  field != FN_VALUE  &&  field != FN_NULL)
+	    cl_error (E_UERR, loc_field, pp->p_name);
+
+	/* If a CL parameter, value may need parsing to set some internal
+	 * variables (logging, eparam, etc.).  Take care of this before
+	 * changing the value of the parameter, in case the new value is
+	 * illegal.
+	 */
+	if (pp->p_flags & P_CL)
+	    parse_clmodes (pp, &o);
+
+	switch (field) {
+	case FN_NAME:
+	    cl_error (E_UERR,
+		"may not change name of parameter `%s'", pp->p_name);
+	case FN_TYPE:
+	    cl_error (E_UERR,
+		"may not change type of parameter `%s'", pp->p_name);
+
+	case FN_MODE: 
+	    if (optype != OT_STRING)
+		cl_error (E_UERR, "modes are strings");
+	    if (opindef (&o))
+		cl_error (E_UERR, "tried to set mode of `%s' to %s",
+		    pp->p_name, indefstr);
+	    o.o_type = pp->p_mode;		/* reuse briefly as a temp */
+	    if ((pp->p_mode = scanmode (o.o_val.v_s)) == ERR) {
+		pp->p_mode = o.o_type;		/* restore from temp	*/
+		cl_error (E_UERR, "bad mode string `%s'", o.o_val.v_s);
+	    }
+	    break;
+		
+	case FN_NULL:
+	case FN_VALUE:
+	    /* Assigning into a list param closes an existing file,
+	     * changes the name of the list file, and clears P_LEOF.
+	     */
+	    if (list) {
+		closelist (pp);
+		pp->p_flags &= ~P_LEOF;
+	    }
+
+	    /* If parameter indirection is in effect the datatype of the value
+	     * field will be string, while the parameter type itself may be
+	     * any datatype.  If we are overriding redirection with a real
+	     * value for the parameter then the datatype of p_valo may change.
+	     */
+	    if (!list  &&  bastype != OT_STRING &&
+		(valtype != OT_STRING || optype != OT_STRING)) {
+		/* Set nonstring datatype.
+		 */
+		if (optype != bastype) {
+		    pushop (&o);
+		    opcast (bastype);
+		    o = popop();
+		}
+
+		if (!arrflag)
+		    pp->p_valo = o;
+		else {
+		    /* We must generate reference to appropriate value. */
+		    int	  offset;
+		    int   *p_i;
+		    double *p_r;
+		    
+		    offset = getoffset (pp);
+
+		    if (bastype == OT_BOOL  ||  bastype == OT_INT) {
+			p_i = pp->p_aval.a_i + offset;
+			*p_i = o.o_val.v_i;
+		    } else if (bastype == OT_REAL) {
+			p_r = pp->p_aval.a_r + offset;
+			*p_r = o.o_val.v_r;
+		    }
+		}
+		break;	/* break from switch */
+	    }
+
+	    len = pp->p_lenval;
+	    if (optype != OT_STRING) {
+		pushop (&o);
+		opcast (bastype);
+		o = popop();
+	    }
+
+	    if (bastype == OT_STRING  &&  arrflag) {
+		char	**p_s;
+		int	offset;
+
+		offset = getoffset (pp);
+		p_s = pp->p_aval.a_s + offset;
+		strncpy (*p_s, o.o_val.v_s, len-1);
+		break /* out of switch */;
+	    }
+
+	    pp->p_valo.o_type = o.o_type;
+	    if (!opindef (&o))
+		strncpy (pp->p_val.v_s, o.o_val.v_s, len-1);
+	    break;
+
+	case FN_MIN:				 /* minimum */
+	    if (bastype == OT_BOOL ||
+		pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET))
+		cl_error (E_UERR, e_nominmax);
+
+	    /* If string type and no values were enumerated in the pfile,
+	     * no storage will have been allocated in the min field for the
+	     * enumeration list and we must abort.  Otherwise space is avail
+	     * for PF_SZMINSTR chars.
+	     */
+	    if (bastype == OT_STRING && pp->p_flags & P_UMIN)
+		cl_error (E_UERR, "string storage not allocated for p_min");
+
+	    if (bastype == OT_STRING ||
+		(valtype == OT_STRING && optype == OT_STRING)) {
+		if (optype != OT_STRING) {
+		    pushop (&o);
+		    opcast (OT_STRING);
+		    o = popop();
+		}
+
+		if (opindef (&o))
+		    pp->p_flags |= P_IMIN;
+		else {
+		    strncpy (pp->p_min.v_s, o.o_val.v_s, PF_SZMINSTR-1);
+		    pp->p_flags &= ~(P_IMIN|P_UMIN);
+		    pp->p_mino.o_type = o.o_type;
+		}
+
+	    } else {
+		if (optype != bastype) {
+		    pushop (&o);
+		    opcast (bastype);
+		    o = popop();
+		}
+		pp->p_mino = o;
+		if (opindef (&o))
+		    pp->p_flags |= P_IMIN;
+		else {
+		    pp->p_min = o.o_val;
+		    pp->p_flags &= ~(P_IMIN|P_UMIN);
+		}
+	    }
+	    break;
+
+	case FN_MAX:				 /* maximum */
+	    if (bastype == OT_BOOL || 
+		(bastype == OT_STRING && !(pp->p_type & PT_FILNAM))) {
+		cl_error (E_UERR, e_nominmax);
+	    }
+
+	    if (pp->p_type & PT_FILNAM) {
+		pushop (&o);
+		opcast (OT_STRING);
+		o = popop();
+		if (opindef (&o))
+		    pp->p_flags |= P_IMAX;
+		else {
+		    strncpy (pp->p_max.v_s, o.o_val.v_s, PF_SZMAXSTR-1);
+		    pp->p_flags &= ~(P_IMAX|P_UMAX);
+		    pp->p_maxo.o_type = o.o_type;
+		}
+
+	    } else {
+		pushop (&o);
+		opcast (bastype);
+		o = popop();
+		pp->p_maxo = o;
+		if (opindef (&o))
+		    pp->p_flags |= P_IMAX;
+		else {
+		    pp->p_max = o.o_val;
+		    pp->p_flags &= ~(P_IMAX|P_UMAX);
+		}
+	    }
+	    break;
+
+	case FN_PROMPT:		/* the prompt string; length <= before */
+	    pushop (&o);
+	    opcast (OT_STRING);
+	    o = popop();
+	    if (opindef (&o))
+		*pp->p_prompt = '\0';
+	    else {
+		len = strlen (pp->p_prompt);
+		strncpy (pp->p_prompt, o.o_val.v_s, len - 1);
+	    }
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, field, "paramset()");
+	}
+}
+
+
+/* VALIDPARAMGET -- Push given field of param onto stack.  Read next entry
+ * in file if list-structured.  If getting FN_NULL, query if in query mode
+ * or if pp is out of range.  Call error if return value would be undefined.
+ */
+void 
+validparamget (register struct param *pp, int field)
+{
+	struct operand o;
+
+	paramget (pp, field);
+	o = popop();
+	if (opundef(&o))
+	    cl_error (E_UERR,
+	    "The requested field of parameter `%s' is undefined", pp->p_name);
+	if (field == FN_NULL && pp->p_flags & P_LEOF)
+	    cl_error (E_UERR, "EOF from list param `%s' in expression",
+		pp->p_name);
+	pushop (&o);
+}
+
+
+/* PARAMGET -- Push given field of param onto stack.  Read next entry in file
+ * if list-structured.  If getting FN_NULL, query if in query mode or if pp
+ * is out of range.  Value returned may be undefined.
+ */
+void 
+paramget (register struct param *pp, int field)
+{
+	char	mode[5];	/* used to turn bits into string	*/
+	struct	operand result;
+	char	buf[20];	/* to stuff the expanded type in	*/
+	char 	*bp;
+	int	bastype;
+	int	arrflag;
+
+	bastype = pp->p_type & OT_BASIC;
+	arrflag = pp->p_type & PT_ARRAY;
+
+	/* Check if unauthorized access to local variable.
+	 */
+	if (pp->p_mode&M_LOCAL  &&  field != FN_VALUE  &&  field != FN_NULL)
+	    cl_error (E_UERR, loc_field, pp->p_name);
+
+	switch (field) {
+	case FN_NAME:
+	    result.o_type = OT_STRING;
+	    result.o_val.v_s = pp->p_name;
+	    break;
+
+	case FN_TYPE:
+	    result.o_type = OT_STRING;
+	    switch (pp->p_type & OT_BASIC) {
+	    case OT_STRING:
+		result.o_val.v_s = "s";
+		break;
+	    case OT_INT:
+		result.o_val.v_s = "i";
+		break;
+	    case OT_REAL:
+		result.o_val.v_s = "r";
+		break;
+	    case OT_BOOL:
+		result.o_val.v_s = "b";
+		break;
+	    default:
+		result.o_val.v_s = "?";
+		break;
+	    }
+	    break;
+
+	case FN_XTYPE:
+	    result.o_type = OT_STRING;
+
+	    bp = buf;
+	    if (pp->p_type & PT_LIST)
+	        *bp++ = '*';
+	    else if (arrflag)
+	        *bp++ = 'a';
+
+	    switch (bastype) {
+	    case OT_BOOL:
+	        *bp++ = 'b';
+	        break;
+	    case OT_INT:
+	        *bp++ = 'i';
+	        break;
+	    case OT_REAL:
+	        *bp++ = 'r';
+	        break;
+	    case OT_STRING:
+	        *bp++ = 's';
+	        break;
+	    }
+
+	    /* Overwrite the string descriptor that appears with PT_FILNAM,
+	     * PT_STRUCT and the cursors.
+	     */
+	    if (pp->p_type & PT_FILNAM) {
+	    	    *--bp = 'f';
+	        if (pp->p_type & PT_FBIN)
+		    *++bp = 'b';
+	        if (pp->p_type & PT_FNOE)
+		    *++bp = 'n';
+	        if (pp->p_type & PT_FER)
+		    *++bp = 'r';
+	        if (pp->p_type & PT_FTXT)
+		    *++bp = 't';
+	        if (pp->p_type & PT_FEW)
+		    *++bp = 'w';
+	        *++bp = '\0';
+
+	    } else if (pp->p_type & PT_STRUCT) {
+	        strcpy (--bp, "struct");
+	    } else if (pp->p_type & PT_GCUR) {
+	        strcpy (--bp, "gcur");
+	    } else if (pp->p_type & PT_IMCUR) {
+	        strcpy (--bp, "imcur");
+	    } else if (pp->p_type & PT_UKEY) {
+	        strcpy (--bp, "ukey");
+	    } else if (pp->p_type & PT_PSET) {
+	        strcpy (--bp, "pset");
+	    } else
+	        *bp = '\0';
+
+	    *bp = '\0';
+
+	    result.o_val.v_s = buf;
+	    break;
+
+
+	case FN_MODE:
+	    makemode (pp, mode);
+	    result.o_type = OT_STRING;
+	    result.o_val.v_s = mode;
+	    break;
+
+	case FN_NULL:
+	    /* Without an explicit field we give the meaningful "worth"
+	     * of the param, which is not necessarilly the 4th param field.
+	     * If PT_LIST, read entry from list.
+	     */
+	    if (effmode (pp) & M_QUERY) {
+		/* Just query to get result. */
+		query (pp);
+		result = popop();
+	    } else {
+		/* Use pp to get result; query if not in range.
+		 */
+		if (pp->p_type & PT_LIST) {
+		    result = readlist (pp);		/* may set P_LEOF  */
+		} else if (arrflag) {
+		    /* If an array get appropriate value.
+		     */
+		    int offset;
+
+		    offset = getoffset(pp);
+		    result.o_type = bastype;
+		    if (bastype == OT_BOOL  ||  bastype == OT_INT)
+			result.o_val.v_i = *(pp->p_aval.a_i + offset);
+		    else if (bastype == OT_REAL)
+			result.o_val.v_r = *(pp->p_aval.a_r + offset);
+		    else if (bastype == OT_STRING)
+			result.o_val.v_s = *(pp->p_aval.a_s + offset);
+		} else
+		    result = pp->p_valo;
+
+		/* Do not range check if we have an indirect reference.
+		 */
+		if (!((result.o_type & OT_BASIC) == OT_STRING &&
+		    *result.o_val.v_s == PF_INDIRECT))
+		    if (!(pp->p_flags & P_LEOF) && !inrange (pp, &result)) {
+			query (pp);
+			result = popop();
+		    }
+	    }
+	    break;
+
+	case FN_VALUE:
+	    /* Explicit reference to the "value" field means return the
+	     * value, or if indirect, the file name for the indirection.
+	     */
+	    if (arrflag) {
+		int offset;
+
+		offset = getoffset(pp);
+		result.o_type = bastype;
+		if (bastype == OT_BOOL  ||  bastype == OT_INT)
+		    result.o_val.v_i = *(pp->p_aval.a_i + offset);
+		else if (bastype == OT_REAL)
+		    result.o_val.v_r = *(pp->p_aval.a_r + offset);
+		else if (bastype == OT_STRING)
+		    result.o_val.v_s = *(pp->p_aval.a_s + offset);
+	    } else
+	    	result = pp->p_valo;
+	    break;
+
+	case FN_LENGTH:
+	    result.o_type = OT_INT;
+	    result.o_val.v_i = pp->p_lenval;
+	    break;
+
+	case FN_MIN:
+	    if (pp->p_flags & P_UMIN)
+		setopundef (&result);
+	    else if (pp->p_flags & P_IMIN)
+		setopindef (&result);
+	    else
+		result = pp->p_mino;
+	    break;
+
+	case FN_MAX:
+	    if (pp->p_flags & P_UMAX)
+		setopundef (&result);
+	    else if (pp->p_flags & P_IMAX)
+		setopindef (&result);
+	    else
+		result = pp->p_maxo;
+	    break;
+
+	case FN_PROMPT:
+	    result.o_type = OT_STRING;
+	    result.o_val.v_s = pp->p_prompt;
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, field, "paramget()");
+	}
+
+	/* Parameter indirection.  If the value of the parameter is given as
+	 * ")paramspec" use the value of the referenced parameter.  Multiple
+	 * levels of indirection are permitted.
+	 */
+	if ((result.o_type & OT_BASIC) == OT_STRING &&
+	    *result.o_val.v_s == PF_INDIRECT) {
+
+	    char	redir[SZ_FNAME];
+	    struct	param *np;
+	    char	*pk, *t, *p, *f;
+
+	    strncpy (redir, &result.o_val.v_s[1], SZ_FNAME-1);
+	    redir[SZ_FNAME-1] = EOS;
+	    breakout (redir, &pk, &t, &p, &f);
+
+	    /* Task "_" is shorthand for the name of the current package.  */
+	    if (((t == NULL || *t == EOS) && *redir == '.') ||
+		strcmp (t, "_") == 0)
+		t = pp->p_pfp->pf_ltp->lt_pkp->pk_name;
+
+	    np = paramsrch (pk, t, p);
+	    if (np == pp)
+		cl_error (E_UERR, "self referential indirection on param `%s'",
+		    pp->p_name);
+	    paramget (np, *f);
+
+	} else {
+	    /* Check for indefinite values. */
+	    if (arrflag && (field == FN_VALUE || field == FN_NULL)) {
+		if ((result.o_type == OT_BOOL || result.o_type == OT_INT) &&
+		    result.o_val.v_i == INDEFL) {
+
+		    setopindef (&result);
+
+		} else if (result.o_type == OT_REAL &&
+		    result.o_val.v_r == INDEFR) {
+
+		    setopindef (&result);
+		}
+
+            } else if ((result.o_type & OT_BASIC) == OT_STRING) {
+                char *ip = result.o_val.v_s;
+
+		/* Check for an escaped string indirection, e.g. "\)param".
+		** If we have one, remove the escape char from the result
+		** string.
+		*/
+                if (*ip == '\\' && *(ip+1) == PF_INDIRECT)
+                    strcpy (ip, &result.o_val.v_s[1]);
+
+	    }
+
+	    pushop (&result);
+	}
+}
+
+
+/* MAKEMODE -- Fill in characters of string s according to which mode bits
+ * are on in param pp.  S should be at least 5 characters long, in the
+ * (impossible) worse case.
+ */
+void 
+makemode (struct param *pp, char *s)
+{
+	register int m = pp->p_mode;
+
+	if (m & M_AUTO)
+	    *s++ = PF_AUTO;
+	if (m & M_QUERY)
+	    *s++ = PF_QUERY;
+	if (m & M_HIDDEN)
+	    *s++ = PF_HIDDEN;
+	if (m & M_LEARN)
+	    *s++ = PF_LEARN;
+	*s = '\0';
+}
+
+
+/* NEWPARAM -- Allocate a new, empty, param on the dictionary and link in
+ *   at end of list of params off pfile *pfp.  Put the new entry at the end of
+ *   the list and update pfp->pf_lastpp.
+ * This is so as to preserve the order in which the params were added to allow
+ *   positional argument matching.
+ * Null out all unused fields except the three union values.
+ */
+struct param *
+newparam (struct pfile *pfp)
+{
+	register struct param *newpp;
+
+	newpp = (struct param *) memneed (PARAMSIZ);
+
+	if (pfp->pf_pp == NULL)
+	    pfp->pf_lastpp = pfp->pf_pp = newpp;
+	else {
+	    pfp->pf_lastpp->p_np = newpp;
+	    pfp->pf_lastpp = newpp;
+	}
+
+	newpp->p_pfp = pfp;
+	newpp->p_flags = newpp->p_type = newpp->p_mode = 0;
+	newpp->p_valo.o_type = newpp->p_mino.o_type = newpp->p_maxo.o_type = 0;
+	newpp->p_name = newpp->p_prompt = nullstr;
+	newpp->p_listval = NULL;
+	newpp->p_listfp = NULL;
+	newpp->p_lenval = 0;
+	newpp->p_np = NULL;
+
+	return (newpp);
+}
+
+
+/* PARAMSRCH -- Hunt for and return pointer to param in given package and ltask.
+ * If no ltask specified, use standard search path, ie, check the params for
+ *   the current ltask, then the current package, then the cl.
+ * Else find pfile for the given ltask, reading it in if it's not in core.
+ *   do not accept the ltask name if it's not defined.
+ * If the param is list-structured, open the list file if it isn't already
+ *   and P_LEOF is not set; thus, paramget() should close the list file
+ *   and set P_LEOF when it sees EOF and leave it set so we can't open
+ *   it again.  Do done of this if we just want the .value field.
+ * If dealing with a task that has no param file, try to satisfy the request
+ *   from positional args.  If that fails, make one that will query.
+ *   Positional args were made named $n by posargset, or the like, and are
+ *   accessed by name.  A named reference returns the next (as counted in
+ *   pf_n) positional arg so two references by the same name will not return
+ *   the same value.  However, if there are no more positional args, then
+ *   one is made and will cause a query to the same param on each reference.
+ * Call error() and do not return if cannot find it.
+ */
+struct param *
+paramsrch (char *pkname, char *ltname, char *pname)
+{
+	register struct param *pp;
+	struct	pfile *pfp;
+	struct	param *lookup_param();
+
+	/* First search for a regular parameter.  If this fails then we 
+	 * handle the case when currentask has no pfile.
+	 */
+	pp = lookup_param (pkname, ltname, pname);
+
+	if (currentask->t_pfp->pf_flags & PF_FAKE) {
+	    if (((XINT)pp == ERR || pp == NULL) && *pname != '$') {
+		/* If dealing with a task that has no param file, try to
+		 * satisfy the request from positional args.  If that fails,
+		 * make one that will query.
+		 */
+		pfp = currentask->t_pfp;
+		pp = paramfind (pfp, (char *)NULL, pfp->pf_n++, NO);
+
+		if (pp == NULL) {
+		    pp = newfakeparam (pfp, pname, 0, OT_STRING, SZ_FNAME);
+		    pp->p_mode |= M_QUERY;
+
+		    /* If, instead, we query and set P_OK, a prompt will not
+		     * be generated again if the same param is rereferenced.
+		     * That's great but problem is that satisfying from
+		     * positional args cannot work like this since the name
+		     * isn't saved.
+		    query (pp);
+		    popop();  
+		    pp->p_flags |= P_OK;
+		     */
+		}
+	    }
+	}
+
+	if ((XINT)pp == ERR)
+	    cl_error (E_UERR, e_nopfile, ltname);
+	if (pp == NULL)
+	    cl_error (E_UERR, e_pnonexist, pname);
+
+	return (pp);
+}
+
+
+/* DEFPAR -- Determine if the named parameter exists.  Name may include
+ * package, task and param names, task and param names, or just the param name,
+ * with appropriate searching as necessary.  False is returned if either the
+ * task has no param file or the param does not exist.
+ */
+int 
+defpar (char *param_spec)
+{
+	char	sbuf[SZ_LINE];
+	char	*pkname, *ltname, *pname, *junk;
+
+	strcpy (sbuf, param_spec);
+	breakout (sbuf, &pkname, &ltname, &pname, &junk);
+
+	switch ((XINT) lookup_param (pkname, ltname, pname)) {
+	case NULL:
+	case ERR:
+	    return (NO);
+	default:
+	    return (YES);
+	}
+}
+
+
+/* DEFVAR -- Determine if the named environment variable exists.
+ */
+int 
+defvar (char *envvar)
+{
+	char	sbuf[SZ_LINE];
+
+	if (c_envfind (envvar, sbuf, SZ_LINE) <= 0)
+	    return (NO);
+	else
+	    return (YES);
+}
+
+
+/* LOOKUP_PARAM -- Hunt for and return pointer to param in given package
+ *   and ltask.  If task does not have param file, NULL is returned.  If pfile
+ *   exists but is not loaded, it is loaded before searching for parameter.
+ *   Returns valid pp if sucessful;  NULL if param file exists but contains no
+ *   such param, and ERR if there is no param file.
+ * All other problems (package, task unknown or ambiguous) result in an abort.
+ * Called by PARAMSRCH and by DEFPAR.
+ */
+struct param *
+lookup_param (char *pkname, char *ltname, char *pname)
+{
+	register struct param *pp;
+	register struct package *pkp;
+	register struct ltask *ltp;
+	struct	pfile *pfp;
+	struct	pfile *pfiles[64];
+	struct	param *candidate;
+	int	ambig, npfiles, i;
+
+	pp = NULL;
+
+	if (*ltname == '\0') {
+	    /* No ltask or package given so check standard places.  If the
+	     * current task is cl the search order is curpack,cl.  Otherwise,
+	     * the search order is curtask,package,cl, where `package' is
+	     * the package to which the current task belongs, NOT the current
+	     * package.  The current task is the task which is currently
+	     * executing; while a task is executing, any psets referenced
+	     * by the main task pfile are loaded and linked into a list off
+	     * the main pfile.  Note that this also hold for the pkg pfile,
+	     * since the pkg-task is always executing while any tasks therein
+	     * are executing (unless the pkg script exits with a keep()).
+	     */
+	    npfiles = 0;
+	    if (currentask->t_ltp == firstask->t_ltp) {
+		/* The current task is the cl() task.
+		 */
+		pfiles[npfiles++] = NULL;
+		pfiles[npfiles++] = curpack->pk_pfp;
+
+	    } else {
+		/* The current task is a normal compiled or script task.
+		 * Search the main pfile for the task, any pset-files
+		 * referenced by the main pfile, and lastly the package pfile
+		 * and any pset-files referenced by the package pfile.
+		 */
+		struct  pfile *pfp_head[2];
+		int     i;
+
+		pfp_head[0] = currentask->t_pfp;
+		pfp_head[1] = currentask->t_ltp->lt_pkp->pk_pfp;
+
+		for (i=0;  i <= 1;  i++)
+		    if ((pfp = pfp_head[i]) != NULL) {
+			pfiles[npfiles++] = pfp;
+			if (pfp->pf_flags & PF_PSETREF) {
+			    while ( (pfp = pfp->pf_npset) ) {
+				pfiles[npfiles++] = pfp;
+				if (npfiles >= 62)
+				    cl_error (E_IERR,
+					"lookup_param: too many pfiles");
+			    }
+			}
+		    }
+	    }
+
+	    pfiles[npfiles++] = firstask->t_pfp;	/* firstask == cl */
+
+	    /* Search for the named parameter in all the pfiles in the search
+	     * path.  If an exact match is found in any pfile we are done.
+	     * If abbreviations are enabled and a non-unique abbreviation is
+	     * indicated, keep searching pfiles and abort only if an exact
+	     * match is not found in some other pfile.
+	     */
+	    candidate = NULL;
+	    ambig = 0;
+	    for (i=0;  i < npfiles;  i++) {
+		pfp = pfiles[i];
+		if (pfp != NULL && (pp = paramfind(pfp, pname,0,NO)) != NULL) {
+		    if ((XINT)pp == -1) {
+			ambig++;
+		    } else if (!strcmp (pp->p_name, pname)) {
+			ambig = 0;
+			break;			/* exact match */
+		    } else if (candidate != NULL && candidate != pp) {
+			ambig++;
+		    } else {
+			candidate = pp;
+		    }
+		}
+	    }
+
+	    if (ambig)
+		cl_error (E_UERR, e_pambig, pname, "<searchpath>");
+	    else if (pp == NULL)
+		pp = candidate;
+
+	} else {
+	    if (*pkname != '\0') {
+		/* If the package name is given, search only that package.
+		 */
+		pkp = pacfind (pkname);
+		if ((XINT)pkp == ERR)
+		    cl_error (E_UERR, e_pckambig, pkname);
+		if (pkp == NULL)
+		    cl_error (E_UERR, e_pcknonexist, pkname);
+
+		/* Search for ltask; it must exist and the given name must
+		 * be an unambiguous abbreviation.
+		 */
+		ltp = ltaskfind (pkp, ltname, 1);
+		if (ltp == NULL)
+		    cl_error (E_UERR, e_tnonexist, ltname);
+		if ((XINT)ltp == ERR)
+		    cl_error (E_UERR, e_tambig, ltname);
+
+	    } else {
+		/* Ltask name given but not package name.  Do circular search
+		 * for ltask; abort if not found or ambiguous.
+		 */
+		ltp = ltasksrch ("", ltname);
+	    }
+
+	    /* Get param file pointer and find parameter.  Return ERR if no
+	     * pfile.
+	     */
+	    if ((pfp = pfilefind (ltp)) == NULL) {
+		if (ltp->lt_flags & LT_PFILE)
+		    pfp = pfileload (ltp);
+		else				/* no pfile */
+		    return ((struct param *)ERR);
+	    }
+	    pp = paramfind (pfp, pname, 0, NO);
+	    if ((XINT)pp == ERR)
+		cl_error (E_UERR, e_pambig, pname, ltp->lt_lname);
+	}
+
+	return (pp);
+}
+
+
+/* PRINTPARAM -- Convert the info in param pp to text and print it on
+ * file fp.  Return ERR if have a write error, else OK.
+ * Don't write M_FAKE params unless we are writing to stderr.
+ * Put quotes around strings; convert escape chars into escape sequences.
+ * Don't call error() so caller can have a chance to close the file.
+ */
+int 
+printparam (struct param *pp, register FILE *fp)
+{
+	register int type, bastype;
+	register char *bp;
+	char	*index();
+	char	buf[20];
+	int	arrflag;
+	int	size_arr=0;
+	int	i;		/* a misc variable.	*/
+
+	if ((pp->p_mode & M_FAKE) && fp != stderr)
+	    return (OK);
+
+	type = pp->p_type;
+	bastype = type & OT_BASIC;
+	arrflag = type & PT_ARRAY;
+
+
+	/* NAME */
+	fputs (pp->p_name, fp);
+	fputc (PF_DELIM, fp);
+
+
+	/* TYPE */
+	bp = buf;
+	if (type & PT_LIST)
+	    *bp++ = '*';
+	else if (arrflag)
+	    *bp++ = 'a';
+
+	switch (bastype) {
+	case OT_BOOL:
+	    *bp++ = 'b';
+	    break;
+	case OT_INT:
+	    *bp++ = 'i';
+	    break;
+	case OT_REAL:
+	    *bp++ = 'r';
+	    break;
+	case OT_STRING:
+	    *bp++ = 's';
+	    break;
+	}
+
+	/* Overwrite the string descriptor that appears with PT_FILNAM,
+	 * PT_STRUCT and the cursors.
+	 */
+	if (type & PT_FILNAM) {
+		*--bp = 'f';
+	    if (type & PT_FBIN)
+		*++bp = 'b';
+	    if (type & PT_FNOE)
+		*++bp = 'n';
+	    if (type & PT_FER)
+		*++bp = 'r';
+	    if (type & PT_FTXT)
+		*++bp = 't';
+	    if (type & PT_FEW)
+		*++bp = 'w';
+	    *++bp = '\0';
+
+	} else if (type & PT_STRUCT) {
+	    strcpy (--bp, "struct");
+	} else if (type & PT_GCUR) {
+	    strcpy (--bp, "gcur");
+	} else if (type & PT_IMCUR) {
+	    strcpy (--bp, "imcur");
+	} else if (type & PT_UKEY) {
+	    strcpy (--bp, "ukey");
+	} else if (type & PT_PSET) {
+	    strcpy (--bp, "pset");
+	} else
+	    *bp = '\0';
+
+	fputs (buf, fp);
+	fputc (PF_DELIM, fp);
+
+
+	/* MODE */
+	makemode (pp, buf);
+	fputs (buf, fp);
+	fputc (PF_DELIM, fp);
+
+	/* VALUE.
+	 * Set i if pp is a struct or cursor.
+	 * Print the max length of structs or cursors even if they are not
+	 *   defined.
+	 */
+	i = type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY);
+	if (opindef(&pp->p_valo) && !i) {
+	    fputs (indefstr, fp);
+	} else if (opundef(&pp->p_valo) && !i) {
+	    ;
+	} else if (type & (PT_LIST|PT_FILNAM|PT_PSET)) {
+	    /* Put quotes around string, may contain special chars */
+	    qputs (pp->p_val.v_s, fp);
+	} else if (bastype == OT_STRING && !arrflag) {
+	    if (i)
+		/* -1 to allow for +1 added for \0 in addparam(). */
+		fprintf (fp, "%d", pp->p_lenval - 1);
+	    else {
+		/* Quote string, may contain special chars */
+		qputs (pp->p_val.v_s, fp);
+	    }
+	} else if (arrflag) {
+	    /* Print array descriptor info, and get size of array for
+	     * printing values later.
+	     */
+	    int		dim, d;
+	    short	*lenoff;
+
+	    size_arr = 1;
+	    dim = pp->p_val.v_a->a_dim;
+	    lenoff = & (pp->p_val.v_a->a_len) ;
+	    fprintf (fp,"%d,", dim);
+	    for (d=0; d<2*dim; d++) {
+		if (d%2 == 0)
+		    size_arr *= *lenoff;
+		fprintf(fp, "%d,", *lenoff++);
+	    }
+
+	    /* Terminate the line. */
+	    fprintf(fp, "\\\n");
+	
+	} else 
+	    fprop (fp, &pp->p_valo);
+
+	if (!arrflag)
+	    fputc (PF_DELIM, fp);
+
+	/* MINIMUM.
+	 * Set i if this param has a min/max field. reuse in max printing.
+	 */
+	i = (bastype != OT_BOOL &&
+	    !(type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET)));
+	if (pp->p_flags & P_IMIN)
+	    fputs (indefstr, fp);
+	else if (pp->p_flags & P_UMIN)
+	    ;
+	else if (i)
+	    fprop (fp, &pp->p_mino);
+	fputc (PF_DELIM, fp);
+
+
+	/* MAXIMUM */
+	if (pp->p_flags & P_IMAX)
+	    fputs (indefstr, fp);
+	else if (pp->p_flags & P_UMAX)
+	    ;
+	else if (i)
+	    fprop (fp, &pp->p_maxo);
+	fputc (PF_DELIM, fp);
+
+
+	/* PROMPT. */
+	if (*pp->p_prompt != '\0')
+	    qputs (pp->p_prompt, fp);
+	if (!arrflag)
+	    fputc ('\n', fp);
+	else
+	    fprintf (fp, ",\\\n");
+
+	/* Structs and cursors get printed on their own line.
+	 */
+	if (!(type & PT_LIST) &&
+	    (type&(PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY))) {
+
+	    if (opindef (&pp->p_valo))
+		fputs (indefstr, fp);
+	    else if (opundef (&pp->p_valo))
+		;
+	    else
+		fputs (pp->p_val.v_s, fp);
+	    fputc ('\n', fp);
+	}
+
+	if (arrflag) {
+	    /* For a first approximation use a fixed number of
+	     * values per line.
+	     */
+	    int    count=0, lcount=0, n_per=0, *p_i= (int *) NULL;
+	    double *p_r= (double *) NULL;
+	    char   **p_s = NULL;
+
+	    if (bastype == OT_BOOL) {
+		n_per = 20;
+		p_i = pp->p_aval.a_i;
+	    } else if (bastype == OT_INT) {
+		n_per = 10;
+		p_i = pp->p_aval.a_i;
+	    } else if (bastype == OT_REAL) {
+		n_per = 4;
+		p_r = pp->p_aval.a_r;
+	    } else if (bastype == OT_STRING) {
+		n_per = 2;
+		p_s = pp->p_aval.a_s;
+	    }
+
+	    count = 0;
+	    lcount = 0;
+
+	    for (; count<size_arr; count++, lcount++) {
+		if (lcount > n_per) {
+		    fprintf(fp, "\\\n");
+		    lcount = 0;
+		}
+		if (bastype == OT_BOOL) {
+		    if (*p_i != INDEFL) {
+			if (*p_i++)
+			    fprintf (fp, "yes");
+			else
+			    fprintf (fp, "no");
+		    } else
+			p_i++;
+
+		} else if (bastype == OT_INT) {
+		    if (*p_i == INDEFL)
+			p_i++;
+		    else
+		        fprintf (fp, "%d", *p_i++);
+
+		} else if (bastype == OT_REAL) {
+		    if (*p_r == INDEFR)
+			p_r++;
+		    else
+			fprintf (fp, "%g", *p_r++);
+
+		} else if (bastype == OT_STRING) {
+		    /* The undefined string is the null string, so
+		     * we needn't check for it.
+		     */
+		    qputs (*p_s++, fp);
+		}
+
+		if (count < size_arr-1)
+		    fprintf (fp, ",");
+		else
+		    fprintf (fp, "\n");
+	    }
+	}
+
+	if (ferror (fp))
+	    return (ERR);
+
+	return (OK);
+}
+
+
+/* QPUTS -- Print a string on the output stream, converting all recognized
+ * control characters (newline, tab, and string delimiters) into escape
+ * sequences, so that they can later be read back in unmodified.
+ */
+void 
+qputs (register char *str, register FILE *fp)
+{
+	register char	ch;
+
+	fputc ('"', fp);
+	while ((ch = *str++) != '\0') {
+	    switch (ch) {
+	    case '\n':
+		fputs ("\n", fp);		/* avoid super long lines */	
+		break;
+	    case '\t':
+		fputs ("\\t", fp);
+		break;
+	    case '\r':
+		fputs ("\\r", fp);
+		break;
+	    case '\f':
+		fputs ("\\f", fp);
+		break;
+	    case '\\':
+		fputc ('\\', fp);
+		ch = *str++;
+		fputc (ch, fp);
+		break;
+	    case '\'':
+		fputs ("\\'", fp);
+		break;
+	    case '"':
+		fputs ("\\\"", fp);
+		break;
+	    default:
+		fputc (ch, fp);
+	    }
+	}
+	fputc ('"', fp);
+}
+
+
+/* PVALDEFINED -- Decide whether string s is indefinite (one of indefstr or
+ * indeflc) or undefined (s == undefval), and set pp->p_type bits accordingly.
+ * Return YES if neither of these conditions exist, else NO.  Note that
+ * the null string a null string per se does not qualify as an undefined
+ * value.
+ */
+int 
+pvaldefined (struct param *pp, char *s)
+{
+	int val;
+
+	val = NO;
+	if (s == NULL || s == undefval)
+	    setopundef (&pp->p_valo);
+	else if (!strcmp (s, indefstr) || !strcmp (s, indeflc))
+	    setopindef (&pp->p_valo);
+	else
+	    val = YES;
+	return (val);
+}
+
+
+/* NEWFAKEPARAM -- Make a fake parameter off pfp.  Use newparam to actually
+ *   allocate space.  If name is NULL, name the parameter $pos, else name it
+ *   name.  Add one to pos because users see names as one-indexed.
+ * Type of param is type; if OT_STRING allocation is for SZ_FNAME characters.
+ * Check for pos > 99 as we only allowing room for 2 digits in $name for.
+ * Check for both kinds of null strings, just in case.
+ */
+struct param *
+newfakeparam (
+    struct pfile *pfp,
+    char *name,
+    int pos,
+    int type,
+    int string_len	/* if new param is type string, size of string */
+)
+{
+	register struct param *pp;
+
+	pp = newparam (pfp);
+	if (name == NULL || *name == '\0') {
+	    if (++pos > 99)
+		cl_error (E_UERR, "too many fake positional params");
+	    pp->p_name = memneed (btoi(4)); /* need room for "$nn\0"  */
+	    sprintf (pp->p_name, "$%d", pos);
+	} else
+	    pp->p_name = comdstr (name);
+
+	if (cldebug)
+	    eprintf ("adding fake param `%s', type code %d\n",
+		pp->p_name, type);
+
+	type &= OT_BASIC;
+	pp->p_valo.o_type = type;
+	pp->p_mino.o_type = type;
+	pp->p_maxo.o_type = type;
+
+	if (type == OT_STRING) {
+	    /* Allocate specified amount of space, add the eos and init
+	     * max length.  Other types need no initialization.
+	     */
+	    pp->p_val.v_s = memneed (btoi(string_len+1));
+	    pp->p_val.v_s[string_len] = '\0';  /* the permanent eos. */
+	    pp->p_lenval = string_len+1;
+	}
+
+	pp->p_type = type;
+	pp->p_valo.o_type = OT_UNDEF;
+	pp->p_mode = M_FAKE;
+	pp->p_flags = (P_UMIN|P_UMAX);
+
+	return (pp);
+}
+
+
+/* GETOFFSET -- Getoffset returns the offset from the beginning of the array
+ * for using the index values stored on the stack.
+ */
+int 
+getoffset (struct param *pp)
+{
+	int	dim, offset, index;
+	short	*plen, *poff, len, off;
+
+	if (mode_offset == DIRECT_OFFSET) {
+	    n_indexes--;
+	    if (n_indexes < 0)
+		cl_error(E_UERR, e_indexunf);
+	    offset = pop() ;
+	    mode_offset = INDEX_OFFSET;
+
+	} else {
+	    dim = pp->p_val.v_a->a_dim;
+	    plen = &(pp->p_val.v_a->a_len) ;
+	    poff = plen + 1;
+
+	    offset = 0;
+
+	    while (dim-- > 0) {
+		len = *(plen + 2*dim);
+		off = *(poff + 2*dim);
+
+		if (offset > 0)
+		    offset *= len;
+
+		n_indexes--;
+		if (n_indexes < 0)
+		    cl_error(E_UERR, e_indexunf);
+
+		index = pop();
+
+
+		if (index < off  ||  index > off+len-1)
+		    cl_error(E_UERR, "Array subscript error.  Index %d is %d.",
+		      dim+1, index);
+		offset += index-off;
+
+	    }
+	}
+
+	return (offset);
+}
+
+
+/* OFFSETMODE -- Offsetmode() permits the user to choose whether to calculate
+ * the offsets using an index list, or to push the offset onto the stack
+ * directly.
+ */
+void 
+offsetmode (int mode)
+{
+	if (mode)
+	    mode_offset = DIRECT_OFFSET;
+	else
+	    mode_offset = INDEX_OFFSET;
+}
+
+
+/* SIZE_ARRAY -- Get the number of elements in an array.
+ */
+int 
+size_array (struct param *pp)
+{
+	int dim, d, size;
+	short *len;
+
+	size = 1;
+
+	if (pp->p_type & PT_ARRAY ) {
+	    dim = pp->p_val.v_a->a_dim;
+	    len = &(pp->p_val.v_a->a_len) ;
+
+	    for (d=0;  d < dim;  d++)
+		size *= *(len+2*d);
+	}
+
+	return (size);
+}
diff --git a/pkg/vocl/param.h b/pkg/vocl/param.h
new file mode 100644
index 00000000..4e9d8118
--- /dev/null
+++ b/pkg/vocl/param.h
@@ -0,0 +1,220 @@
+/*
+ * PARAM.H -- In-core broken-out form of parameter file ("pfile") entry.
+ * main line is a list of pfile structs, one per parameter file, starting
+ * at parhead; these each head a list of params found in that file.
+ *
+ * USES operand.h and config.h
+ */
+
+/* ----------
+ * reference chart showing how
+ * the bits in p_type are set and the p_val/p_min/p_max fields are used for
+ * various kinds of parameter "type" specs possible in a parameter file.
+ 
+
+all legal p_type bit	val/min/max fields: which v_x and its meaning
+   combinations								spec as
+OT_XXXX  PT_XXXX							written
+B I R S  L F S/C A	p_val		p_min		p_max		in file
+- - - -  - -  -  -      --------------- --------------- --------------- -------
+x			v_i, bool	-		-		b
+  x			v_i, int	v_i, min val	v_i, max val	i
+    x			v_r, real	v_r, min val	v_r, max val	r
+      x			v_s, string	-		v_i, max length	s
+x		 x      v_a, bool arr.  -		-		ab
+  x		 x	v_a, int arr.   v_i, min val	v_i, max val	ai
+    x		 x	v_a, real arr.	v_r, min val.	v_r, max val	ar
+      x		 x	v_a, str. arr.	-		v_i, max length as
+x        x		v_s, fname	-				*b
+  x      x		v_s, fname	v_i, min val*	v_i, max val*	*i
+    x    x		v_s, fname	v_r, min val*	v_r, max val*	*r
+      x  x		v_s, fname	-		-		*s
+      x    x		v_s, fname	v_s, min fname	v_s, max fname	f
+      x  x x		v_s, fname	v_s, min fname*	v_s, max fname*	*f
+      x       x		v_s, struct	-		v_i, max length	struct
+      x  x    x		v_s, fname	-				*struct
+
+
+Notes:
+1) S/C refers to any one of PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET; their
+   param representation is identical.  Similarly, the file spec "struct" may
+   be gcur, imcur, pset, ukey, or pset.
+2) * min/max applies to contents of list file after it is read and converted
+   to the given base type, not to p_val.
+3) "fname" means exactly MAXFILNAM chars are allocated, in-line, with
+   the parameter regardless of how many are used. there is a permanent '\0'
+   at v_s[MAXFILNAM-1].
+4) note that PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET|PT_FILNAM all imply
+   OT_STRING but that, among these, only PT_FILNAM have ranges.  They may be
+   considered qualifiers of OT_STRING.
+5) the max length of a list entry is always MAXLIN.
+6) these are not all the same as in the parameter file, such as struct
+   length being stored in p_max. these must be properly placed when handling
+   *.field param requests and when printing the in-core param structs back out.
+7) min and max fields for arrays refer to all elements within the array.
+8) only the scalar types bool, int, real and string may be arrays, and
+   arrays may not be list-directed.
+9) for a string array, the array is a list of pointers.
+*/
+
+#define PF_INDIRECT	')'	/* indirection metacharacter, ")param"	*/
+#define	PF_DELIM	','	/* field delimiter within pfile		*/
+#define	PF_MAXLIN	(132+2)	/* max pfile line length, plus \n \0	*/
+#define	PF_COMMENT	'#'	/* starts a line of comment		*/
+#define	PF_NFIELDS	7	/* number of fields in a pfile line	*/
+#define	PF_NOSTRUCT	'*'	/* next line is NOT struct initialization*/
+#define	PF_SZMINSTR	160	/* p_min field for string type params	*/
+#define	PF_SZMAXSTR	64	/* p_max field for string type params	*/
+
+struct param {
+	char	*p_name;	/* name of parameter			*/
+	struct	pfile *p_pfp;	/* pointer back to pfile		*/
+	int	p_type;		/* type bits; see below			*/
+	int	p_mode;		/* bit-packed mode fields. see below.	*/
+	struct	operand p_valo;	/* value; or length if struct, file if list*/
+	struct	operand p_mino;	/* p_val min and 			*/
+	struct	operand p_maxo;	/*       max values			*/
+	char	*p_prompt;	/* prompt string			*/
+	FILE	*p_listfp;	/* if PT_LIST: fp of list file, if open	*/
+	char	*p_listval;	/* buffer for list element (SZ_LINE)	*/
+	struct	param *p_np;	/* pointer to next param, or NULL	*/
+	short	p_flags;	/* see p_flags below			*/
+	short	p_lenval;	/* buflen of p_valo.o_val.v_s if string	*/
+};
+
+/* Shorthand for referencing the values of the value, min, and max
+ * fields.  e.g.  p_val.v_s = *char
+ */
+#define	p_val		p_valo.o_val
+#define	p_min		p_mino.o_val
+#define	p_max		p_maxo.o_val
+#define p_aval		p_valo.o_val.v_a->a_ptr
+
+
+/* names of bits in p_type.
+ * these describe more information about the parameter.
+ * lower 4 bits are same as for operands; see operand.h.
+ */
+#define	PT_LIST		0000020	/* values are in a file, not in pfile	*/
+#define	PT_FILNAM	0000040	/* string is a bonafide filename	*/
+#define	PT_STRUCT	0000100	/* used for structs			*/
+#define	PT_GCUR		0000200	/* graphics cursor values structure	*/
+#define	PT_IMCUR	0000400	/* image cursor values structure	*/
+#define	PT_UKEY		0001000	/* user keystroke values sructure	*/
+#define	PT_PSET		0002000	/* parameter set pointer parameter	*/
+
+/* attributes if PT_FILNAM */
+#define	PT_FER		0004000	/* file must exist and be readable	*/
+#define	PT_FEW		0010000	/*            "           writable	*/
+#define	PT_FNOE		0020000	/* file must not exist			*/
+#define	PT_FTXT		0040000	/* file is a text file			*/
+#define	PT_FBIN		0100000	/*      "    binary  "			*/
+
+#define PT_ARRAY	0200000	/* parameter is an array		*/
+
+/* names of mode bits in p_mode.
+ */
+#define	M_AUTO		0001	/* auto mode: be as quiet as possible	*/
+#define	M_QUERY		0002	/* query: ask user about value		*/
+#define	M_HIDDEN	0004	/* hidden: param normally not visible	*/
+#define	M_LEARN		0010	/* learn: write out local copy when done*/
+#define	M_MENU		0020	/* menu: call eparam at exec time	*/
+#define	M_FAKE		0040	/* never flush this param to a pfile	*/
+#define M_LOCAL		0100	/* Local var, not param.		*/
+
+
+/* p_flags bits. 
+ * misc characteristics of the parameter.
+ * see pfilecopy() and pfcopyback() for details of P_SET/CLSET/QUERY.
+ */
+#define	P_IMIN		0001	/* min value is indefinite		*/
+#define	P_UMIN		0002	/* min value is undefined		*/
+#define	P_IMAX		0004	/* max value is indefinite		*/
+#define	P_UMAX		0010	/* max value is undefined		*/
+#define	P_LEOF		0020	/* set when see eof on list file	*/
+#define	P_SET		0040	/* set in explicit assignment statement	*/
+#define	P_CLSET		0100	/* set on command line of task		*/
+#define	P_QUERY		0200	/* set from a query			*/
+#define P_CL		0400	/* parameter is a CL parameter		*/
+
+/* mode code letters in param file; recognized in either case */
+#define	PF_AUTO		'a'
+#define	PF_QUERY	'q'
+#define	PF_HIDDEN	'h'
+#define	PF_LEARN	'l'
+#define	PF_MENU		'm'
+
+/* ----------
+ * one per loaded parameter file.
+ * the ltask at ltp is used to get the param file's name (ltp->lt_lname),
+ * its directory (osdir(lt_pname)), and package prefix (lt_pkp->pk_name).
+ * pf_n use varies. always incremented for each command line argument set by
+ *   posargset, etal. LT_BUILTIN tasks then use it directly to determine how
+ *   many params there are since $nargs is not added in that case. other
+ *   PF_FAKE pfiles use it to create $nargs then reset it to 0 and use it
+ *   to count each unmatched param reference that is satisfied by a postional
+ *   arg (see paramsrch). Other than to set $nargs, it is unused by tasks that
+ *   do not have fake pfiles.
+ * N.B. the way restor() is written, it is important that a param list is
+ * never created with some params above and some below its task's topd.
+ */
+struct pfile {
+	struct	pfile *pf_npf;		/* ptr to next pfile, else NULL	*/
+	struct	pfile *pf_oldpfp;	/* ptr to old pfile, if copy	*/
+	struct	ltask *pf_ltp;		/* ptr to this pfile's ltask	*/
+	struct	pfile *pf_npset;	/* ptr to next pset in group	*/
+	struct	param *pf_psetp;	/* ptr to pset-param if pset	*/
+	struct	param *pf_pp;		/* ptr to first params 		*/
+	struct	param *pf_lastpp;	/* last param off pfile		*/
+	short	pf_n;			/* no. of params; see above	*/
+	short	pf_flags;		/* see flags below		*/
+	char	pf_pfilename[SZ_FNAME+1];	/* file to be updated	*/
+};
+
+/* pf_flags */
+#define	PF_UPDATE	001	/* at least one param has P_SET set	*/
+#define	PF_FAKE		002	/* made on the fly for an ltask without
+				 * a pfile. should never be written out.
+				 */
+#define	PF_COPY		004	/* this is only the working copy of tasks
+				 * pfile; it is never to be written out.
+				 */
+#define	PF_PSETREF	010	/* pfile contains a pset parameter	*/
+
+/* size of param and pfile structs, IN INTS, for proper dictionary control.
+ */
+#define	PARAMSIZ	btoi (sizeof (struct param))
+#define	PFILESIZ	btoi (sizeof (struct pfile))
+
+/* Variable types used in parsing of declaration types.
+ */
+#define V_BOOL		0
+#define V_INT		1
+#define V_REAL		2
+#define V_STRING	3
+#define V_GCUR		4
+#define V_IMCUR		5
+#define V_UKEY		6
+#define V_PSET		7
+#define V_STRUCT	8
+#define	V_FILE		9
+
+
+char	*nextfield();		/* cracks next pfile line field		*/
+char	*makelower();		/* upper to lower, in place and return	*/
+
+struct	param *paramfind();	/* searches for a param on a given pfile*/
+struct	param *paramsrch();	/* search, make sure param is there	*/
+struct	param *lookup_param();	/* search standard path for a param	*/
+struct	param *newparam();	/* allocate and link a new param	*/
+struct	param *addparam();	/* make a new param off given pfile	*/
+struct	param *newfakeparam();	/* add a fake param to pfile		*/
+struct	pfile *pfilesrch();	/* read named pfile or ltask pfile	*/
+struct	pfile *pfileload();	/* load pfile for ltask into memory	*/
+struct	pfile *pfileread();	/* read and make params from a pfile	*/
+struct	pfile *pfilefind();	/* look for pfile with given name	*/
+struct	pfile *newpfile();	/* add a new pfile off parhead		*/
+struct	pfile *pfilecopy();	/* make an in-core copy of a pfile	*/
+
+int	defpar();		/* determine whether param exists	*/
+int	defvar();		/* determine whether envvar exists	*/
diff --git a/pkg/vocl/pfiles.c b/pkg/vocl/pfiles.c
new file mode 100644
index 00000000..08de7aa9
--- /dev/null
+++ b/pkg/vocl/pfiles.c
@@ -0,0 +1,1968 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_finfo
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "errs.h"
+#include "operand.h"
+#include "mem.h"
+#include "param.h"
+#include "task.h"
+#include "grammar.h"
+#include "proto.h"
+
+
+/*
+ * PFILES -- Parameter file access procedures.
+ */
+
+extern	int cldebug;
+extern	char *undefval;
+extern	char *nullstr;
+extern	char *indefstr, *indeflc;
+extern	FILE *yyin;
+char	*uparmdir = UPARM;
+long	filetime();
+static	void mapname();
+
+
+/* NEWPFILE -- Allocate a new pfile on the dictionary and link in at parhead.
+ * Set pfp->pf_ltp to ltp.  Null out all unused fields.  Call error() and don't
+ * return if not enough core.
+ */
+struct pfile *
+newpfile (
+    struct ltask *ltp		/* ltask descriptor */
+)
+{
+	register struct pfile *pfp, *head_pfp;
+
+	pfp = (struct pfile *) memneed (PFILESIZ);
+	head_pfp = reference (pfile, parhead);
+	if (head_pfp >= pfp)
+	    cl_error (E_IERR, "in newpfile: parhead exceeds topd");
+
+	pfp->pf_npf = reference (pfile, parhead);
+	parhead = dereference (pfp);
+
+	pfp->pf_pp = NULL;
+	pfp->pf_oldpfp = NULL;
+	pfp->pf_npset = NULL;
+	pfp->pf_psetp = NULL;
+	pfp->pf_ltp = ltp;
+	pfp->pf_flags = 0;
+	pfp->pf_n = 0;
+
+	return (pfp);
+}
+
+
+/* PFILEUNLINK -- Unlink a pfile from the pfile list.
+ */
+void 
+pfileunlink (
+    register struct pfile *pfp	/* pfile to be unlinked	*/
+)
+{
+	register struct pfile *npf;
+
+	if ((npf = reference (pfile, parhead)) == pfp)
+	    parhead = dereference (pfp->pf_npf);
+	else {
+	    while (npf && npf->pf_npf != pfp)
+		npf = npf->pf_npf;
+	    if (npf) {
+		if (pfp->pf_npf == npf)
+		    cl_error (E_IERR, "in pfileunlink: circular reference");
+		else
+		    npf->pf_npf = pfp->pf_npf;
+	    }
+	}
+}
+
+
+/* PFILEFIND -- Search the list of loaded pfiles for the pfile for a particular
+ * ltask.  Return pfile pointer or NULL.   Note that all loaded pfiles are
+ * linked on a single list regardless of which package or task they belong to.
+ */
+struct pfile *
+pfilefind (
+    register struct ltask *ltp		/* ltask descriptor */
+)
+{
+	register struct pfile *pfp;
+
+	for (pfp = reference (pfile, parhead);  pfp != NULL;  pfp = pfp->pf_npf)
+	    if (pfp->pf_ltp == ltp)
+		return (pfp);
+
+	return (NULL);
+}
+
+
+/* PFILESRCH -- Given a pfile filename or the pathname of an ltask which
+ * has a pfile, allocate a pfile descriptor and read the pfile into that
+ * descriptor.
+ */
+struct pfile *
+pfilesrch (
+    char *pfilepath		/* filename or ltask pathname	*/
+)
+{
+	struct	pfile *pfp;
+
+	if (cldebug)
+	    eprintf ("pfilesrch %s\n", pfilepath);
+
+	if (is_pfilename (pfilepath)) {
+	    if ((pfp = pfileread (NULL, pfilepath, 0)) == NULL)
+		cl_error (E_UERR, e_badpfile, pfilepath);
+	    strcpy (pfp->pf_pfilename, pfilepath);
+	    return (pfp);
+
+	} else {
+	    char    *x1, *pk, *t, *x2;
+	    struct  ltask *ltp;
+
+	    breakout (pfilepath, &x1, &pk, &t, &x2);
+	    ltp = ltasksrch (pk, t);
+	    if (!(ltp->lt_flags & LT_PFILE))
+		cl_error (E_UERR, e_nopfile, ltp->lt_lname);
+	    if ((pfp = pfilefind (ltp)) != NULL)
+		return (pfp);			/* already in core.	*/
+
+	    return (pfileload (ltp));
+	}
+}
+
+
+/* PFILELOAD -- Load the pfile for the ltask pointed to by ltp.  The input
+ * pfile may be the source package pfile (read only), the users UPARM copy
+ * of the package pfile, or a named user pfile in the case of a pset-task
+ * reference.  Save the filename where the pfile is to be updated in the
+ * pfile descriptor, for later use by pfileupdate().  Pfiles are always
+ * updated in UPARM, except in the case of named pfiles, which are updated
+ * in place.
+ */
+struct pfile *
+pfileload (
+    register struct ltask *ltp		/* ltask descriptor */
+)
+{
+	static	long sys_ftime = 0;
+	register struct	task *tp;
+	register struct	param *pp;
+	char	usr_pfile[SZ_FNAME+1];
+	char	pkg_pfile[SZ_FNAME+1];
+	char	pkgdir[SZ_FNAME+1];
+	long	usr_ftime, pkg_ftime;
+	char	*ltname, *pkname;
+	struct	pfile *pfp;
+	char	*sval;
+
+	if (cldebug)
+	    eprintf ("pfileload, task %s\n", ltp->lt_lname);
+
+	/* If the ltask operand is a PSET task, the parameter file to be
+	 * read is controlled by the value of a pset parameter of the same
+	 * name as the ltask, in the main parameter set of the most recently
+	 * executed task which includes that pset parameter.  If no running
+	 * task references the PSET task then we use the pfile of the PSET
+	 * task itself, i.e., we have a conventional task.param parameter
+	 * reference.
+	 *
+	 * If we make it through this block of code without reading a named
+	 * pfile and exiting, either nothing has happened (the pset was not
+	 * redirected), or the pset was redirected to a different ltask and
+	 * we are still faced with the equivalent problem of mapping an ltp
+	 * into a pfp, but this time without the compilication of PSET
+	 * indirection.
+	 */
+	if (ltp->lt_flags & LT_PSET) {
+            /* Don't use newtask if it is pointing beyond end of stack. */
+            tp = (newtask < (struct task *)&stack[topcs]) ? currentask:newtask;
+
+            for (  ;  tp != firstask;  tp = next_task(tp)) {
+		pfp = tp->t_pfp;
+		if (!pfp || !(pfp->pf_flags & PF_PSETREF))
+		    continue;
+
+		/* Search pfile of currently executing task.
+		 */
+		for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np)
+		    if (pp->p_type & PT_PSET)
+			if (!strcmp (pp->p_name, ltp->lt_lname)) {
+			    /* Found pset parameter with same name as ltask.
+			     */
+			    if (opundef (&pp->p_valo))
+				sval = "";
+			    else
+				sval = pp->p_val.v_s;
+
+			    if (*sval == EOS) {
+				; /* Null string - no indirection */
+			    } else if (is_pfilename (sval)) {
+				/* Named pfile */
+				if ((pfp = pfileread (ltp, sval, 0)) != NULL)
+				    return (pfp);
+				else
+				    cl_error (E_UERR, e_badpfile, sval);
+			    } else {
+				/* Must be a reference to another task */
+				char    *x1, *pk, *t, *x2;
+
+				breakout (sval, &x1, &pk, &t, &x2);
+				ltp = ltasksrch (pk, t);
+				if (!(ltp->lt_flags & LT_PFILE))
+				    cl_error (E_UERR, e_nopfile, ltp->lt_lname);
+			    }
+
+			    goto epset_;
+			}
+	    }
+	}
+epset_:
+	ltname = ltp->lt_lname;
+	pkname = ltp->lt_pkp->pk_name;
+
+	/* Determine the UPARM filename of the pfile. */
+	mkpfilename (usr_pfile, uparmdir, pkname, ltname, ".par");
+
+	/* As an optimization, all the checking for filetimes, file sizes,
+	 * and out of date pfiles is only performed once when a file is
+	 * first accessed.  Once a valid up to date UPARM version of a pfile
+	 * is obtained a bit is set in the ltask descriptor and thereafter
+	 * we need only read the UPARM version of the pfile and exit.  If a
+	 * problem occurs reading the pfile, or if the pfile is unlearned,
+	 * the bit is cleared and all the checking and initialization is
+	 * repeated.
+	 */
+	if (ltp->lt_flags & LT_UPFOK)
+	    if ((pfp = pfileread (ltp, usr_pfile, 1)) != NULL)
+		return (pfp);
+
+	/* Get modification (creation) time of usr pfile and filename and
+	 * modification time of pkg pfile.  Look for a .par version of the
+	 * pkg pfile, and if not found, a .cl version (procedure script).
+	 */
+	usr_ftime = filetime (usr_pfile, "c");
+	c_fnldir (ltp->lt_pname, pkgdir, SZ_FNAME);
+
+	mkpfilename (pkg_pfile, pkgdir, pkname, ltname, ".par");
+	if ((pkg_ftime = filetime (pkg_pfile, "m")) <= 0) {
+	    mkpfilename (pkg_pfile, pkgdir, pkname, ltname, ".cl");
+	    if ((pkg_ftime = filetime (pkg_pfile, "m")) <= 0)
+		cl_error (E_UERR, e_nopfile, ltname);
+	}
+
+	/* Get the date when the iraf system was last installed or updated.
+	 * This is indicated by the modify time of the special file hlib$utime,
+	 * which is touched during the system installation process.  The file
+	 * may actually be newer than the date of system update/install but
+	 * that is harmless.
+	 */
+	if (sys_ftime <= 0)
+	    sys_ftime = filetime ("hlib$utime", "m");
+
+	/* If the system was installed more recently than the package pfile
+	 * was modified, use the system modify time instead.
+	 */
+	if (sys_ftime > 0)
+	    if (sys_ftime > pkg_ftime)
+		pkg_ftime = sys_ftime;
+
+	if (usr_ftime > 0) {
+	    /* We have a user (UPARM) version of the pfile.  If it is newer
+	     * than the pkg pfile, use it, else read the pkg pfile and merge
+	     * the param values from the user pfile into the new pkg pfile.
+	     */
+	    if (usr_ftime>pkg_ftime && (pfp=pfileread(ltp,usr_pfile,1)) != NULL)
+		ltp->lt_flags |= LT_UPFOK;
+	    else {
+		if ((pfp = pfileread (ltp, pkg_pfile, 0)) == NULL)
+		    cl_error (E_UERR, e_badpfile, pkg_pfile);
+		pfilemerge (pfp, usr_pfile);
+		strcpy (pfp->pf_pfilename, usr_pfile);
+	    }
+	} else {
+	    /* No user pfile; read pkg pfile.
+	     */
+	    if ((pfp = pfileread (ltp, pkg_pfile, 0)) == NULL) {
+		FILE   *fp;
+		if (!is_pfilename (pkg_pfile))
+		    if ((fp = fopen (pkg_pfile, "r")) != NULL) {
+			if (!procscript (fp))
+			    cl_error (E_UERR, e_nopfile, ltname);
+			fclose (fp);
+		    }
+		cl_error (E_UERR, e_badpfile, pkg_pfile);
+	    } else
+		strcpy (pfp->pf_pfilename, usr_pfile);
+	}
+
+	return (pfp);
+}
+
+
+/* PFILEMERGE -- Merge the parameter values from the named (old user) pfile
+ * into a loaded parameter set.
+ */
+int 
+pfilemerge (
+    struct pfile *npf,			/* loaded parameter set	*/
+    char *opfile			/* old parameter file	*/
+)
+{
+	register struct param *o_pp, *n_pp, *l_pp;
+	int	bastype;
+	XINT	save_topd;
+	struct	pfile *opf;
+	struct	ltask *ltp;
+
+	if (cldebug)
+	    eprintf ("pfilemerge, task %s, pfile %s\n",
+		(ltp = npf->pf_ltp) ? ltp->lt_lname : "", opfile);
+
+	/* Open old pfile. */
+	save_topd = topd;
+	if ((opf = pfileread (npf->pf_ltp, opfile, 0)) == NULL)
+	    return (ERR);
+
+	/* For each parameter in the old pfile, locate the corresponding
+	 * parameter in the new pfile and copy the value.  No other fields
+	 * of the parameter structure are copied.
+	 */
+	for (n_pp = NULL, o_pp = opf->pf_pp;  o_pp;  o_pp = o_pp->p_np) {
+	    /* Circular search, starting at position of last parameter.
+	     */
+	    n_pp = ((l_pp = n_pp) != NULL) ? n_pp->p_np : npf->pf_pp;
+	    while (n_pp != l_pp) {
+		if (n_pp == NULL)
+		    n_pp = npf->pf_pp;
+		else if (strcmp (n_pp->p_name, o_pp->p_name) == 0)
+		    break;
+		else
+		    n_pp = n_pp->p_np;
+	    }
+
+	    /* If parameter not in new param set or the datatypes do not
+	     * match, skip this parameter.
+	     */
+	    if (n_pp == l_pp)
+		continue;
+	    if (n_pp->p_type != o_pp->p_type)
+		continue;
+
+	    bastype = (n_pp->p_type & OT_BASIC);
+
+	    /* Copy value */
+	    n_pp->p_valo.o_type = o_pp->p_valo.o_type;
+
+	    /* Handle arrays. */
+	    /* The array descriptors should remain the same, only
+	     * the stored values could change.
+	     */
+	    if (n_pp->p_type & PT_ARRAY) {
+		int	dim, d, size_arr;
+		short	*lenoff;
+
+		/* Get size of array. */
+		dim = n_pp->p_val.v_a->a_dim;
+		lenoff = &(n_pp->p_val.v_a->a_len);
+		size_arr = 1;
+		if (bastype == OT_REAL)
+		    size_arr = 2;
+		for (d=0;  d < dim;  d++)
+		    size_arr *= *(lenoff + 2*d);
+
+		if (bastype != OT_STRING) {
+		    int     *p, *q;
+		    p = o_pp->p_aval.a_i;
+		    q = n_pp->p_aval.a_i;
+		    for (d=0;  d < size_arr;  d++)
+			*q++ = *p++;
+		} else {
+		    char     **p, **q;
+		    p = o_pp->p_aval.a_s;
+		    q = n_pp->p_aval.a_s;
+		    for (d=0;  d < size_arr;  d++)
+			strcpy (*q++, *p++);
+		}
+
+	    } else if (!(o_pp->p_valo.o_type & (OT_INDEF|OT_UNDEF))) {
+		if (((o_pp->p_valo.o_type & OT_BASIC) == OT_STRING) &&
+		   (n_pp->p_val.v_s != NULL)) {
+		   strncpy (n_pp->p_val.v_s, o_pp->p_val.v_s, n_pp->p_lenval-1);
+		} else
+		    n_pp->p_valo.o_val = o_pp->p_valo.o_val;
+	    }
+	}
+
+	npf->pf_flags |= PF_UPDATE;
+
+	/* Unlink scratch pfile descriptor and return dictionary space.
+	 */
+	pfileunlink (opf);
+	topd = save_topd;
+
+	return (OK);
+}
+
+
+/* PFILEUPDATE -- Update a parameter set in the pfile from which it was
+ * originally read.  Nothing is done unless the parameter set has been
+ * modified and needs updating, or if we have a fake (in-core) parameter set.
+ */
+void 
+pfileupdate (
+    struct pfile *pfp		/* parameter file descriptor */
+)
+{
+	if ((pfp->pf_flags & (PF_FAKE|PF_UPDATE)) != PF_UPDATE)
+	    return;
+
+	if (cldebug)
+	    eprintf ("pfileupdate %s\n", pfp->pf_pfilename);
+	
+	/* Do not update the CL parameter file; we always read the system
+	 * cl.par file upon startup.
+	 */
+	if (pfp->pf_ltp == firstask->t_ltp)
+	    return;
+
+	pfilewrite (pfp, pfp->pf_pfilename);
+	pfp->pf_flags &= ~PF_UPDATE;
+
+	if (pfp->pf_ltp)
+	    pfp->pf_ltp->lt_flags |= LT_UPFOK;
+}
+
+
+/* PFILEREAD -- Allocate a pfile descriptor and read the named pfile into it.
+ * The input file may be either a parameter file or a CL procedure script.
+ */
+struct pfile *
+pfileread (
+    struct ltask *ltp,		/* associated ltask		*/
+    char *pfilename,		/* parameter file filename	*/
+    int checkmode		/* check for "mode" parameter	*/
+)
+{
+	register char	*ip;
+	char	buf[SZ_LINE+1];
+	struct	pfile *pfp;
+	struct	param *pp;
+	int	nerrs, gotmode, status, oldlines;
+	FILE	*fp, *yysave;
+	XINT	save_topd;
+
+	if (cldebug)
+	    eprintf ("pfileread, task %s, pfile %s\n",
+		ltp ? ltp->lt_lname : "", pfilename);
+
+	if ((fp = fopen (pfilename, "r")) == NULL)
+	    return (NULL);
+
+	save_topd = topd;
+	pfp = newpfile (ltp);
+	strcpy (pfp->pf_pfilename, pfilename);
+
+	nerrs = 0;
+	gotmode = 0;
+
+	if (is_pfilename (pfilename)) {
+	    /* Pfile has ".par" filename extension, format is a simple
+	     * list of parameter structs, one parameter per line.
+	     */
+	    while (fgets (buf, PF_MAXLIN, fp) != NULL) {
+		/* Skip comment lines and blank lines.
+		 */
+		for (ip=buf;  (*ip == ' ' || *ip == '\t');  ip++)
+		    ;
+		if (*ip == PF_COMMENT || *ip == '\n')
+		    continue;
+
+		if ((pp = addparam (pfp, ip, fp)) == NULL)
+		    nerrs++;
+		else if (!strcmp (pp->p_name, "mode")) {
+		    if (gotmode) {
+			eprintf ("more than one `mode' param\n");
+			nerrs++;
+		    } else
+			gotmode++;
+		}
+	    }
+
+	    /* When a pfile is udpated in uparm a "mode" parameter is
+	     * always written out as the last parameter to mark the end of
+	     * the parameter list.  If checkmode is enabled and the mode
+	     * parameter is not seen, this indicates the the pfile has
+	     * been truncated and should not be used.
+	     */
+	    if (nerrs > 0 || ferror(fp) || (checkmode && !gotmode))
+		goto error_;
+
+	} else if (procscript (fp)) {
+	    extern int yyparse ();
+
+	    /* Parse the declarations section of a procedure script.
+	     * The procscript() call leaves us positioned to the procedure
+	     * statement.
+	     */
+	    parse_state = PARSE_PARAMS;
+	    parse_pfile = pfp;
+	    yysave = yyin;
+	    yyin = fp;
+
+	    /* Fool the parser into believing we are at the
+	     * beginning of a script for any error messages
+	     * which come out.
+	     */
+	    oldlines = newtask->t_scriptln;
+	    newtask->t_scriptln = 0;
+
+	    status = yyparse();
+
+	    /* Reset the parse state in case we are in a free script.  */
+	    parse_state = PARSE_FREE;
+	    newtask->t_scriptln = oldlines;
+	    yyin = yysave;
+
+	    if (status) 
+		goto error_;
+
+	    if (paramfind (pfp, "mode", 0, YES) == NULL)
+		gotmode = NO;
+	    else
+		gotmode = YES;
+	} else
+	    goto error_;
+
+	/* Count the number of parameters.  If there are no parameters we
+	 * probably have a zero length file, which is an error.
+	 */
+	for (status=0, pp=pfp->pf_pp;  pp;  pp=pp->p_np)
+	    status++;
+	if (status == 0)
+	    goto error_;
+
+	/* Add `mode' param.  Get the value from the current package
+	 * or from the CL if there is no package pfile.
+	 */
+	if (gotmode == 0) {
+	    struct param *qq;
+
+	    /* Allocate the param with "ql" as the ultimate default.
+	     */
+	    pp = addparam (pfp, "mode,s,h,ql\n", fp);
+
+	    if (curpack != NULL) {
+		if (curpack->pk_pfp != NULL) {
+		    qq = paramfind (curpack->pk_pfp, "mode", 0, YES);
+		    if (qq != NULL && qq != (struct param *)ERR) {
+			strcpy (pp->p_val.v_s, qq->p_val.v_s);
+			gotmode++;
+		    }
+		}
+	    }
+	}
+
+	if (gotmode == 0)	/* CL--This should rarely be needed */
+	    if (firstask->t_modep != NULL)
+		strcpy (pp->p_val.v_s, firstask->t_modep->p_val.v_s);
+
+	fclose (fp);
+	return (pfp);
+
+error_:
+	fclose (fp);
+	pfileunlink (pfp);
+	topd = save_topd;
+	return (NULL);
+}
+
+
+/* PFILEWRITE -- Write out the parameters for given pfile into a file.
+ * Any existing file is silently clobbered.  The filename extension is
+ * always ".par".
+ */
+int 
+pfilewrite (
+    struct pfile *pfp,		/* pfile descriptor	*/
+    char *pfilename		/* file to be written	*/
+)
+{
+	register char	*ip, *op, *dot;
+	char	pfname[SZ_PATHNAME+1];
+	struct	param *pp;
+	int	nparams;
+	FILE	*fp;
+
+	if (cldebug)
+	    eprintf ("pfilewrite %s\n", pfilename);
+
+	/* Copy the filename, changing the extension to .par if necessary.
+	 */
+	for (dot=NULL, ip=pfilename, op=pfname;  (*op = *ip++);  op++)
+	    if (*op == '.')
+		dot = op;
+	strcpy (dot ? dot : op, ".par");
+
+	if (cldebug)
+	    eprintf ("writing pfile `%s'\n", pfname);
+
+	/* Delete any existing pfile before updating.
+	 */
+	c_delete (pfname);
+
+	/* Disable interrupts while updating the pfile to eliminate the
+	 * possibility of file truncation.  The "mode" parameter is always
+	 * written last to mark the end of a valid pfile.
+	 */
+	intr_disable();
+	nparams = 0;
+
+	if ((fp = fopen (pfname, "w")) == NULL)
+	    eprintf ("Unable to open parameter file `%s'.\n", pfname);
+	else {
+	    struct param *modepp = NULL;
+	    for (pp = pfp->pf_pp;  pp != NULL;  pp = pp->p_np) {
+		if (!(pp->p_mode & M_LOCAL)) {
+		    if (!strcmp (pp->p_name, "mode")) {
+			modepp = pp;
+		    } else if (printparam (pp, fp) == ERR) {
+			fclose (fp);
+			cl_error (E_IERR|E_P,
+			    "Error writing local pfile `%s'", pfname);
+		    } else
+			nparams++;
+		}
+	    }
+
+	    if (modepp) {
+		printparam (modepp, fp);
+		nparams++;
+	    }
+	    fclose (fp);
+	}
+
+	intr_enable();
+	return (nparams);
+}
+
+
+/* PFILEINIT -- Initialize or "unlearn" a pfile.  Look for user version of
+ * pfile in uparm; if found, delete it.  If pfile is loaded, unlink from
+ * pfile list.  Fix up flag bits in ltask descriptor.  We are called from
+ * "unlearn" to restore the package default parameters for an ltask or package.
+ */
+int 
+pfileinit (struct ltask *ltp)
+{
+	struct	task *tp;
+	struct	pfile *pfp;
+	char	pfilename[SZ_FNAME];	/* user pfile			*/
+	char	pkgdir[SZ_FNAME+1];
+	char	*ltname;		/* name of the new pfile	*/
+	char	*pkname;		/* name of its package		*/
+	int	running;
+
+	if (cldebug)
+	    eprintf ("unlearn pfile for task %s\n", ltp->lt_lname);
+
+	ltname = ltp->lt_lname;
+	pkname = ltp->lt_pkp->pk_name;
+
+	/* Determine if the pfile belongs to a loaded package or to a task
+	 * which is currently executing.
+	 */
+	running = 0;
+	if (ltp->lt_flags & LT_DEFPCK)
+	    running++;
+	else {
+	    for (tp=currentask;  tp <= firstask;  tp = next_task(tp))
+		if (tp->t_ltp == ltp) {
+		    running++;
+		    break;
+		}
+	}
+
+	/* Delete any "learned" copy of the pfile in uparm. */
+	mkpfilename (pfilename, uparmdir, pkname, ltname, ".par");
+	c_delete (pfilename);
+
+	/* Clear the flag that says we have a valid user param file. */
+	ltp->lt_flags &= ~(LT_UPFOK);
+
+	/* See if the pfile is in core; if so, unlink all copies.  If the
+	 * pfile belongs to a currently executing task we can't unlink it,
+	 * so reset the parameter values to the system defaults instead.
+	 */
+	while ((pfp = pfilefind (ltp)) != NULL)
+	    if (running) {
+		c_fnldir (ltp->lt_pname, pkgdir, SZ_FNAME);
+		mkpfilename (pfilename, pkgdir, pkname, ltname, ".par");
+		pfilemerge (pfp, pfilename);
+		pfp->pf_flags &= ~PF_UPDATE;
+		if (ltp->lt_flags & LT_DEFPCK)
+		    break;
+	    } else
+		pfileunlink (pfp);
+
+	return (OK);
+}
+
+
+/* IS_PFILENAME -- Test whether a string is a pfile filename, i.e., whether
+ * or not the string has a ".par" extension.
+ */
+int 
+is_pfilename (char *opstr)
+{
+	register char	*ip;
+	char	*dot;
+
+	/* If the named object has a ".par" extension we assume it is a
+	 * pfile filename, otherwise we assume it is an ltask pathname.
+	 */
+	for (ip=opstr, dot=NULL;  *ip;  ip++)
+	    if (*ip == '.')
+		dot = ip;
+
+	return (dot && strcmp (dot, ".par") == 0);
+}
+
+
+/* MKPFILENAME -- Generate a parameter file name, given a directory prefix
+ * the names of the package and ltask, and the filename extension.  The form
+ * of the filename depends upon whether the pfile is to be stored in UPARM.
+ * UPARM pfile names have the form "uparm$ // pakltask.par", where `pak' is
+ * the package prefix, consisting of the first LEN_PKPREFIX-1 characters of
+ * the package name plus the final character, and `ltask' is the ltask name
+ * squeezed to LEN_PFILENAME characters.  If not writing to UPARM, we just
+ * use the full filename.
+ */
+void 
+mkpfilename (
+    char *buf,			/* receives output filename	*/
+    char *dir,			/* dir name or prefix		*/
+    char *pkname,		/* package name			*/
+    char *ltname,		/* ltask name			*/
+    char *extn			/* filename extension		*/
+)
+{
+	char	temp[SZ_FNAME+1];
+
+	strcpy (buf, dir);		/* start with directory name	*/
+
+	if (strcmp (dir, uparmdir) == 0) {
+	    strcat (buf, "$");
+	    mapname (pkname, temp, LEN_PKPREFIX);
+	    strcat (buf, temp);
+	    mapname (ltname, temp, LEN_PFILENAME);
+	    strcat (buf, temp);
+	} else
+	    strcat (buf, ltname);
+
+	strcat (buf, extn);		/* add extension for pfile	*/
+}
+
+
+/* MAPNAME -- Apply the N+1 mapping convention (first N-1 plus last chars)
+ * to generate a name no longer than N characters.  Returns the number of
+ * characters generated.
+ */
+static void
+mapname (char *in, char *out, int maxlen)
+{
+	register int ip, op;
+
+	ip = 0;
+	op = 0;
+	while (op < maxlen-1 && (out[op++] = in[ip++]) != '\0')
+	    ;
+	if (out[op-1] != '\0') {	/* append last char	*/
+	    if (in[ip] != '\0') {
+		while (in[ip] != '\0')
+		    ip++;
+		out[op++] = in[ip-1];
+	    }
+	    out[op++] = '\0';
+	}
+}
+
+
+/* FILETIME -- Get the time of creation or of last modify of a file.  If the
+ * file does not exist or cannot be accessed zero is returned.
+ */
+long 
+filetime (
+    char *fname,			/* file name		*/
+    char *timecode		/* "c" or "m"		*/
+)
+{
+	struct	_finfo fi;
+	extern int c_finfo();
+
+	if (c_finfo (fname, &fi) == ERR)
+	    return (0L);
+	else {
+	    switch (*timecode) {
+	    case 'c':
+		return (fi.fi_ctime);
+	    case 'm':
+		return (fi.fi_mtime);
+	    default:
+		return (0L);
+	    }
+	}
+}
+
+
+/* PFILECOPY -- Make a new copy of paramfile at pfp for a new task.  Command
+ * line changes, queries and assignments are done to this copy.  Link in the
+ * usual fashion off parhead.  Copy all the parameters as well, taking care to
+ * make new copies of strings and setting pointers in new params to their own
+ * copies.  Return pointer to new entry; no error return.
+ * Reset P_CLSET, P_SET and P_QUERY flags so pfcopyback() can tell whether
+ *   these events happened for this particular run of the task.
+ */
+struct pfile *
+pfilecopy (register struct pfile *pfp)
+{
+	register struct param *pp, *newpp;
+	struct	pfile *newpfp;
+	int	bastype;
+
+	if (cldebug) {
+	    if (pfp->pf_ltp)
+		eprintf ("copying pfile for `%s'\n", pfp->pf_ltp->lt_lname);
+	    else
+		eprintf ("copying pfile `%s'\n", pfp->pf_pfilename);
+	}
+
+	newpfp = newpfile (pfp->pf_ltp);
+	for (pp = pfp->pf_pp;  pp;  pp = pp->p_np) {
+
+	    /* Allocate new parameter */
+	    newpp = newparam (newpfp);
+	    bastype = pp->p_type & OT_BASIC;
+
+	    /* COPY VALUE */
+
+	    newpp->p_valo = pp->p_valo;
+
+	    /* Handle arrays. */
+	    if (pp->p_type & PT_ARRAY) {
+		struct arr_desc *parrd, *qarrd;
+		int	size_arr;
+		short	*lenoff, *qlenoff;
+		int	dim, d, *pval, *qval;
+
+		parrd = pp->p_val.v_a;
+		dim = parrd->a_dim;
+		size_arr = 1;
+
+		lenoff = &(parrd->a_len) ;
+		for (d=0;  d < dim;  d++)
+		    size_arr *= *(lenoff + 2*d);
+		if (bastype == OT_REAL)
+		    size_arr *= 2;
+
+		/* Ready to allocate new descriptor and data block */
+		qarrd = (struct arr_desc *)memneed (2 + dim);
+		newpp->p_val.v_a = qarrd;
+
+		qarrd->a_ptr.a_i = (int *) memneed(size_arr);
+
+		qarrd->a_dim = dim;
+		qlenoff = &(qarrd->a_len);
+		for (d=0; d<2*dim; d++)
+		    *qlenoff++ = *lenoff++;
+
+		if (bastype != OT_STRING) {
+		    /* If not string then copy values across. */
+
+		    pval = parrd->a_ptr.a_i;
+		    qval = qarrd->a_ptr.a_i;
+		    for (d=0;  d < size_arr;  d++)
+			*qval++ = *pval++;
+
+		} else {
+		    /* Copy strings one by one. */
+
+		    int     len;
+		    char    **p, **q;
+
+		    if (pp->p_maxo.o_type == OT_INT)
+			len = pp->p_maxo.o_val.v_i;
+		    else
+			len = SZ_FNAME;
+
+		    p = parrd->a_ptr.a_s;
+		    q = qarrd->a_ptr.a_s;
+		    for (d=0;  d < size_arr;  d++) {
+			*q = memneed (btoi(len));
+			strncpy (*q++, *p++, len-1);
+			*(q+len-1) = '\0' ;
+		    }
+		}
+
+	    } else if ((pp->p_valo.o_type & OT_BASIC) == OT_STRING) {
+		/* Regular (i.e. scalar) strings.
+		 */
+		newpp->p_val.v_s = memneed (btoi(pp->p_lenval));
+		strncpy (newpp->p_val.v_s, pp->p_val.v_s, pp->p_lenval-1);
+	    }
+
+	    /* COPY MIN */
+	    newpp->p_mino = pp->p_mino;
+	    if ((pp->p_mino.o_type & OT_BASIC) == OT_STRING &&
+		!(pp->p_flags & P_UMIN)) {
+		newpp->p_min.v_s = memneed (btoi (PF_SZMINSTR));
+		strncpy (newpp->p_min.v_s, pp->p_min.v_s, PF_SZMINSTR-1);
+	    }
+
+	    /* COPY MAX */
+	    newpp->p_maxo = pp->p_maxo;
+	    if ((pp->p_maxo.o_type & OT_BASIC) == OT_STRING &&
+		!(pp->p_flags & P_UMAX)) {
+		newpp->p_max.v_s = memneed (btoi (PF_SZMAXSTR));
+		strncpy (newpp->p_max.v_s, pp->p_max.v_s, PF_SZMAXSTR-1);
+	    }
+
+	    /* COPY PROMPT */
+	    newpp->p_prompt = comdstr (pp->p_prompt);
+
+	    /* Copy all the easy entries last; we made it! */
+	    newpp->p_name = pp->p_name;
+	    newpp->p_type = pp->p_type;
+	    newpp->p_mode = pp->p_mode;
+	    newpp->p_flags = pp->p_flags & ~(P_CLSET|P_QUERY|P_SET);
+	    newpp->p_listfp = pp->p_listfp;
+	    newpp->p_listval = pp->p_listval;
+	    newpp->p_lenval = pp->p_lenval;
+	}
+
+	newpfp->pf_oldpfp = pfp;
+	strcpy (newpfp->pf_pfilename, pfp->pf_pfilename);
+	newpfp->pf_flags = (pfp->pf_flags & PF_PSETREF);
+	newpfp->pf_flags |= PF_COPY;
+
+	return (newpfp);
+}
+
+
+/* PFCOPYBACK -- Copy the contents of each param that is to be changed
+ *   permanently in the given pfile to the corresponding param in original
+ *   pfile.  Once thus copied, they are considered permanently changed since
+ *   restor() will write out to their pfile.  Call the target pfile pft.
+ * Copy only those params for which P_SET is set or for which P_QUERY or
+ *   P_CLSET is set provided learn mode is on and the param is not M_HIDDEN.
+ *   Since P_SET was cleared by pfilecopy(), it can only be set in the copy
+ *   if it was set since the task started.
+ * Set PF_UPDATE in pft if, in fact, any copying took place.
+ * Don't copy at all if the working file is not a copy; this is primarily
+ *   to stop the final copy on eof from the first cl and as a nice safety chk.
+ * N.B. we assume pff was made from pft with pfilecopy() and so the params are
+ *   in the same order; we also assume none were added.
+ *
+ * N.B. After copying, unlink the copy pfile from the pfile list, to insure
+ *   that hidden params modified on the command line are not preserved after
+ *   termination of a task which called KEEP.  Restor() will not lop off the
+ *   dead pfile if it is below the new topd set by keep.
+ */
+void 
+pfcopyback (struct pfile *pff)
+{
+	register struct param *pt, *pf;
+	struct	pfile *pft;
+	int	bastype;
+	int	pfflags;
+	int	copy;			/* set if a real copy occurred	*/
+	int	learn;			/* set if learn is on 		*/
+
+	if (cldebug)
+	    eprintf ("pfcopyback %s\n", pff->pf_pfilename);
+
+	if (!(pff->pf_flags & PF_COPY))
+	    return;
+	pft = pff->pf_oldpfp;
+
+	learn = effmode ((struct param *) NULL) & M_LEARN;
+	copy = 0;
+
+	for (pt=pft->pf_pp, pf=pff->pf_pp;  pf&&pt;  pt=pt->p_np, pf=pf->p_np) {
+	    pfflags = pf->p_flags;
+
+	    /* Always copy back the list file pointer else the list file, if
+	     * opened during task execution, will not be closed.
+	     */
+	    pt->p_listfp = pf->p_listfp;
+
+	    /* Copy param back if it was set in an explicit assignment,
+	     * or if it was set in a query or on the command line, and we are
+	     * in learn mode, and the parameter is not hidden.
+	     */
+	    if (!((pfflags & P_SET) || ((pfflags&(P_QUERY|P_CLSET)) && learn &&
+		!(pf->p_mode & M_HIDDEN))))
+		continue;
+
+	    bastype = pt->p_type & OT_BASIC;
+	    copy++;
+
+	    /* Don't bother copying name since it couldn't have changed.
+	     * Other fields copy directly.
+	     */
+	    pt->p_type = pf->p_type;
+	    pt->p_mode = pf->p_mode;
+
+	    /* Use all new flags bits but discard CLSET and QUERY and merge
+	     * SET with its original state so either it or the copy can
+	     * cause a permanent change to the parameter.
+	     */
+	    pt->p_flags &= P_SET;
+	    pt->p_flags |= pfflags & ~(P_CLSET|P_QUERY);
+
+	    /* Copy value */
+	    pt->p_valo.o_type = pf->p_valo.o_type;
+
+	    /* Handle arrays. */
+	    /* The array descriptors should remain the same, only
+	     * the stored values could change.
+	     */
+	    if (pt->p_type&PT_ARRAY) {
+		int	dim, d, size_arr;
+		short	*lenoff;
+
+		/* Get size of array. */
+		dim = pt->p_val.v_a->a_dim;
+		lenoff = &(pt->p_val.v_a->a_len);
+		size_arr = 1;
+		if (bastype  ==  OT_REAL)
+		    size_arr = 2;
+		for (d=0; d<dim; d++)
+		    size_arr *= *(lenoff + 2*d);
+
+		if (bastype != OT_STRING) {
+		    int	*p, *q;
+		    p = pf->p_aval.a_i;
+		    q = pt->p_aval.a_i;
+		    for (d=0; d<size_arr; d++)
+			*q++ = *p++;
+		} else {
+		    char **p, **q;
+		    p = pf->p_aval.a_s;
+		    q = pt->p_aval.a_s;
+		    for (d=0; d<size_arr; d++)
+			strcpy(*q++, *p++) ;
+		}
+
+	    } else if (!(pf->p_valo.o_type & (OT_INDEF|OT_UNDEF))) {
+		if (((pf->p_valo.o_type & OT_BASIC) == OT_STRING) &&
+		   (pt->p_val.v_s != NULL)) {
+		    strncpy (pt->p_val.v_s, pf->p_val.v_s, pf->p_lenval-1);
+		} else
+		    pt->p_valo.o_val = pf->p_valo.o_val;
+	    }
+		
+	    /* Copy min */
+	    if (!(pf->p_flags & P_UMIN)) {
+		pt->p_mino.o_type = pf->p_mino.o_type;
+		if ((pf->p_mino.o_type & OT_BASIC) == OT_STRING &&
+		    pt->p_min.v_s != NULL)
+		    strncpy (pt->p_min.v_s, pf->p_min.v_s, PF_SZMINSTR-1);
+		else
+		    pt->p_mino.o_val = pf->p_mino.o_val;
+	    }
+
+	    /* Copy max */
+	    if (!(pf->p_flags & P_UMAX)) {
+		pt->p_maxo.o_type = pf->p_maxo.o_type;
+		if ((pf->p_maxo.o_type & OT_BASIC) == OT_STRING &&
+		    pt->p_max.v_s != NULL)
+		    strncpy (pt->p_max.v_s, pf->p_max.v_s, PF_SZMAXSTR-1);
+		else
+		    pt->p_maxo.o_val = pf->p_maxo.o_val;
+	    }
+	}
+
+	if (copy) {
+	    if (cldebug) {
+		if (pff->pf_ltp) {
+		    eprintf ("copied back pfile for `%s'\n",
+			pff->pf_ltp->lt_lname);
+		} else
+		    eprintf ("copied back pfile `%s'\n", pff->pf_pfilename);
+	    }
+	    pft->pf_flags |= PF_UPDATE;
+	}
+
+	/* Unlink pfile to ensure that it never gets reused.
+	 */
+	pfileunlink (pff);
+}
+
+
+/* ADDPARAM -- Allocate a new param off *pfp and fill with fields derived
+ *   from line buf.
+ * Buf should have trailing '\n' '\0' as per fgets.
+ * Set UNDEF for those fields that are left blank, INDEF for those fields
+ *   so indicating.
+ * FP is used to read a structure, cursor, long quoted string, or arrays.
+ * Return pointer to new param if ok, else NULL.  In order to handle multiple
+ *   errors while reading a param file, we print informative info directly
+ *   here with eprintf.  This avoids calling error() and gives us a chance
+ *   to handle a file with multiple errors and find many of them in one pass.
+ * Besides pfileread(), we are also called from various other places, such as
+ *   execnewtask(), to add such parameters as $nargs and mode.
+ */
+struct param *
+addparam (struct pfile *pfp, char *buf, FILE *fp)
+{
+	static char *minfields =
+		"must specify at least name,type,mode for `%s'\n";
+	static char *nominmax =
+		"ranges not allowed for struct/cursor/string/bool param `%s'\n";
+	static char *umquotes =
+		"unmatched quotes in %s field for `%s'\n";
+
+	register struct param *pp; /* new param being filled up		*/
+	register char *s;	/* pointer to compiled string.		*/
+	char	*pnamehold;	/* param's name as soon as we know it	*/
+	int	len;		/* used to measure string lengths	*/
+	int	bastype;	/* OT_BASIC part of type as soon as know*/
+	int	arrflag;	/* Is param an array?			*/
+	struct arr_desc *parrd;	/* Pointer to array descriptor.		*/
+	int	size_arr=0;	/* Size of array.			*/
+	extern double atof();
+	char	**tbuf;
+
+	pp = newparam (pfp);
+
+	/* P_NAME */
+
+	pnamehold = "<no name>";
+	tbuf = &buf;
+	if ((s = nextfield (tbuf, fp)) == NULL) {
+	    eprintf (minfields, pnamehold);
+	    return (NULL);
+	} else if (s == (char *)ERR) {
+	    eprintf (umquotes, "name", pnamehold);
+	    return (NULL);
+	} else
+	    pnamehold = pp->p_name = s;
+
+
+	/* P_TYPE */
+
+	if ((s = nextfield (tbuf, fp)) == NULL) {
+	    eprintf (minfields, pnamehold);
+	    return (NULL);
+	} else if (s == (char *)ERR) {
+	    eprintf (umquotes, "type", pnamehold);
+	    return (NULL);
+	} else {
+	    if (strcmp (s, "pset") == 0)
+		pfp->pf_flags |= PF_PSETREF;
+	    if ((pp->p_type = scantype (s)) == ERR) {
+		eprintf (" in `%s'\n", pnamehold);
+		return (NULL);
+	    }
+	}
+	bastype = pp->p_type & OT_BASIC;
+	arrflag = pp->p_type & PT_ARRAY;
+
+
+	/* P_MODE */
+
+	if ((s = nextfield (tbuf, fp)) == NULL) {
+	    eprintf (minfields, pnamehold);
+	    return (NULL);
+	} else if (s == (char *)ERR) {
+	    eprintf (umquotes, "mode", pnamehold);
+	    return (NULL);
+	} else if ((pp->p_mode = scanmode (s)) == ERR) {
+	    eprintf (" in `%s'\n", pnamehold);
+	    return (NULL);
+	}
+
+
+	/* P_VAL */
+
+	pp->p_valo.o_type = bastype;
+
+	if ((s = nextfield (tbuf, fp)) == (char *)ERR) {
+	    eprintf (umquotes, "value", pnamehold);
+	    return (NULL);
+	}
+
+	if (pp->p_type & (PT_LIST|PT_FILNAM|PT_PSET)) {
+	    pp->p_val.v_s = memneed (btoi(SZ_FNAME));
+	    pp->p_val.v_s[SZ_FNAME-1] = '\0';
+	    pp->p_lenval = SZ_FNAME;
+
+	    if (pvaldefined (pp, s)) {
+	        char  *p;
+
+		/* Change a whitespace-only filename into a null string; this
+		 * makes it easier for users to check null filenames in 
+		 * scripts.  It makes sense anyway since these are invalid
+		 * filenames.
+		 */
+		p = s;
+	        while (*p == ' ' || *p == '\t')
+		    p++;
+		if (*p == '\0' || *p == '\n')
+		    pp->p_val.v_s[0] = '\0';
+		else
+		    strncpy (pp->p_val.v_s, s, SZ_FNAME-1);
+	    } else
+		*pp->p_val.v_s = '\0';
+
+	    if (pp->p_type & PT_LIST)
+		pp->p_listval = memneed (btoi(SZ_LINE));
+	    pp->p_valo.o_type = OT_STRING;
+
+	} else if (pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY)) {
+
+	    /* Non-list structs read next line and store at p_val.v_s
+	     *   unless the length field begins with a PF_NOSTRUCT.
+	     * The storage allocated in the dictionary, and pointed to by
+	     *   p_val.v_s, is the max of the number in the value field and
+	     *   the length of the structure init string, on the next line.
+	     *   it is an error for the init string to be longer than the
+	     *   length given, if any, or for either to be greater than
+	     *   SZ_LINE-2.
+	     * SZ_LINE-2 is the default length if neither a len not init is
+	     *   given.
+	     * OT_INDEF/UNDEF refer to p_val; p_lenval always set to length
+	     *   (max length) of value string if value is a string.
+	     * Nextfield() compiles the length spec into the dictionary;
+	     *   it's short and not worth trying to dig out...
+	     */
+
+	    int readinit = 0;  		 	/* 1 if init is in next ln */
+
+	    if (s == NULL) {
+		readinit++;
+		len = SZ_LINE-1;			/* supply default */
+	    } else {
+		if (*s == PF_NOSTRUCT)
+		    s++;
+		else
+		    readinit++;
+
+		len = atoi (s);
+		if (len <= 0)
+		    len = SZ_LINE-1;			/* supply default */
+		else if (len > SZ_LINE-1) {
+		    eprintf ("`%s' struct lengths limited to %d\n",
+			pnamehold, SZ_LINE-1);
+		    return (NULL);
+		}
+	    }
+	    len++;				/* allow for \0 */
+
+	    if (readinit) {
+		/* Initialize with next line.  Lots of pathology here...
+		 */
+		char initbuf[SZ_LINE];
+		int initlen;
+
+		if (fgets (initbuf, SZ_LINE, fp) == NULL) {
+		    eprintf ("`%s' has no initialized\n",
+			pnamehold);
+		    return (NULL);
+		}
+
+		initlen = strlen (initbuf); /* includes \n, if present */
+
+		if (initbuf[initlen-1] == '\n')
+		    initbuf[initlen-1] = '\0';
+		else {
+		    int c;
+		    eprintf ("`%s' initialization too long\n",
+			pnamehold);
+		    while ((c = fgetc(fp)) != '\n' && c != EOF)
+			;
+		    return (NULL);
+		}
+
+		if (initlen > len) {
+		    eprintf ("initialization for `%s' > %d\n",
+			pnamehold, len-1);
+		    return (NULL);
+		}
+
+		pp->p_val.v_s = memneed (btoi (len));
+		if (pvaldefined (pp, initbuf))
+		    strcpy (pp->p_val.v_s, initbuf);
+
+	    } else {
+		/* Allocate space but don't init from next line.
+		 */
+		pp->p_val.v_s = memneed (btoi (len));
+	    }
+
+	    pp->p_val.v_s[len-1] = '\0';	 /* the permanent eos */
+	    pp->p_lenval = len;
+	    pp->p_valo.o_type = OT_STRING;
+
+	} else if ((bastype == OT_STRING ||
+	    (s != NULL && *s == PF_INDIRECT)) && !arrflag) {
+
+	    /* Strings are stored like structs, but are inited from s.
+	     * OT_INDEF/UNDEF refer to p_val.
+	     */
+	    if (pvaldefined (pp, s)) {
+		/* String was something conventional.  If shorter than SZ_LINE
+		 * call memneed() again to increase the dictionary space. This
+		 * ASSUMES that nothing called memneed() since nextfield() did.
+		 */
+		pp->p_valo.o_type = OT_STRING;
+		len = strlen (s) + 1;		/* allow for eos */
+		if (len < SZ_LINE) {
+		    memneed (btoi(SZ_LINE) - btoi(len));
+		    len = SZ_LINE;
+		}
+	    } else {
+		/* Either no string was given or it was INDEF/UNDEF.
+		 */
+		len = SZ_LINE;
+		s = memneed (btoi (len));
+	    }
+
+	    pp->p_val.v_s = s;
+	    pp->p_val.v_s[len-1] = '\0'; /* add the permanent eos */
+	    pp->p_maxo.o_type = OT_INT;
+	    pp->p_lenval = len;
+
+	} else if (arrflag) {
+	    /* For arrays get the array definition block */
+
+	    int		dim, it;	/* Dimensionality of array.	*/
+	    short	itemp;		/* Length and offsets of array.	*/
+	    short	*lenoff;	/* Pointer to length or offset. */
+	    int		d;
+
+	    /* Dimensionality. */
+	    if (s == NULL) {
+		eprintf ("Dimensionality not specified for %s.\n", pnamehold);
+		return (NULL);
+	    }
+	    if (ck_atoi (s, &dim) == ERR) {	/* Convert to integer. */
+		eprintf ("Non-integer dimensionality for %s.\n", pnamehold);
+	        return (NULL);
+	    }
+	    if (dim <= 0) {			/* Dimensionality > 0 ? */
+		eprintf ("Dimensionality not positive for %d.\n", pnamehold);
+		return (NULL);
+	    }
+
+	    /* Get space for array descriptor. */
+	    parrd = (struct arr_desc *) memneed (2 + dim);
+	    size_arr = 1;
+	    if (bastype == OT_REAL)		/* Doubles take 2 INT's. */
+		size_arr = 2;
+	    
+	    parrd->a_dim = dim;
+	    lenoff = &(parrd->a_len);
+	    
+
+	    /* Lengths and offsets.
+	     */
+	    for (d=0;  d < 2*dim;  d++) {
+		if ((s = nextfield (tbuf, fp)) == NULL) {
+		    eprintf ("Dimensions not specified for %s.\n", pnamehold);
+		    return (NULL);
+		}
+
+		if (ck_atoi (s, &it) == ERR) {	/* Convert to integer. */
+		    eprintf ("Integer length/offset required for %s.\n",
+			pnamehold);
+		    return (NULL);
+	        }
+
+		itemp = it;
+		if ((d%2 == 0)  &&  itemp<=0) {/* Length < 0 ? */
+		    eprintf ("Illegal negative dimension for %s.\n", pnamehold);
+		    return (NULL);
+		}
+
+		*lenoff++ = itemp;
+		if (d%2 == 0)
+		    size_arr = itemp * size_arr;
+
+	    }
+	    /* Get the space for the array. */
+	    parrd->a_ptr.a_i = (int *) memneed(size_arr);
+
+	    /* The "value" of the parameter is a pointer to the
+	     * array descriptor.
+	     */
+	    pp->p_valo.o_val.v_a = parrd;
+	    pp->p_valo.o_type = PT_ARRAY|bastype;
+
+	} else {
+	    /* Simple non-string type.
+	     */
+	    if (pvaldefined (pp, s))
+		pp->p_valo = makeop (s, pp->p_type & OT_BASIC);
+	}
+
+
+	/* P_MIN */
+
+	pp->p_mino.o_type = bastype;
+
+	if ((s = nextfield (tbuf, fp)) == (char *)ERR) {
+	    eprintf (umquotes, "minimum", pnamehold);
+	    return (NULL);
+	}
+
+	if (s != NULL && *s != '\0') {
+	    if (bastype == OT_BOOL ||
+		pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET)) {
+		eprintf (nominmax, pnamehold);
+		return (NULL);
+	    } else if (!strcmp(s,indefstr) || !strcmp(s,indeflc)) {
+		pp->p_flags |= P_IMIN; 
+	    } else if (bastype == OT_STRING || *s == PF_INDIRECT) {
+		/* Filename, enumerated string, or indirect reference.
+		 */
+		pp->p_mino.o_type = OT_STRING;
+		pp->p_min.v_s = memneed (btoi(PF_SZMINSTR));
+		pp->p_min.v_s[PF_SZMINSTR-1] = '\0';
+		strncpy (pp->p_min.v_s, s, PF_SZMINSTR-1);
+	    } else {
+		/* Type is equivalent to a simple non-string wrt mins.
+		 */
+		pp->p_mino = makeop (s, pp->p_type & OT_BASIC);
+	    }
+	} else
+	    pp->p_flags |= P_UMIN;
+
+
+	/* P_MAX */
+
+	pp->p_maxo.o_type = bastype;
+
+	if ((s = nextfield (tbuf, fp)) == (char *)ERR) {
+	    eprintf (umquotes, "maximum", pnamehold);
+	    return (NULL);
+	}
+
+	if (s != NULL && *s != '\0') {
+	    if (bastype == OT_BOOL ||
+		pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET)) {
+		eprintf (nominmax, pnamehold);
+		return (NULL);
+	    } else if (!strcmp(s,indefstr) || !strcmp(s,indeflc)) {
+		pp->p_flags |= P_IMAX;
+	    } else if (bastype == OT_STRING || *s == PF_INDIRECT) {
+		/* Filename, enumerated string, or indirect reference.
+		 */
+		pp->p_maxo.o_type = OT_STRING;
+		pp->p_max.v_s = memneed (btoi(PF_SZMAXSTR));
+		pp->p_max.v_s[PF_SZMAXSTR-1] = '\0';
+		strncpy (pp->p_max.v_s, s, PF_SZMAXSTR-1);
+	    } else {
+		/* Type is equivalent to a simple non-string wrt mins.
+		 */
+		pp->p_maxo = makeop (s, pp->p_type & OT_BASIC);
+	    }
+	} else
+	    pp->p_flags |= P_UMAX;
+
+
+	/* P_PROMPT */
+
+	if ((s = nextfield (tbuf, fp)) == (char *)ERR) {
+	    eprintf (umquotes, "prompt", pnamehold);
+	    return (NULL);
+	}
+
+	pp->p_prompt = (s == NULL) ? nullstr : s;
+
+
+	/* ARRAY INITIALIZATION */
+
+	if (arrflag) {
+	    int     i, len=0;
+
+	    /* First initialize all fields, since we do not
+	     * require initialization of the entire array.
+	     */
+	    if (bastype == OT_BOOL || bastype == OT_INT) {
+		int	*p;
+		p = pp->p_aval.a_i;
+		for (i=0;  i < size_arr;  i++)
+		    *p++ = INDEFL;
+
+	    } else if (bastype == OT_REAL) {
+		double	*p;
+		size_arr = size_arr / 2;
+		p = pp->p_aval.a_r;
+		for (i=0;  i < size_arr;  i++)
+		    *p++ = INDEFR;
+
+	    } else {				/* Strings. */
+		char	**p;
+
+		/* Check if max_length specified in p_max.
+		 */
+		if (pp->p_maxo.o_type == OT_INT)
+		    len = pp->p_max.v_i;
+		else
+		    len = SZ_FNAME;
+		pp->p_lenval = len;
+
+		/* Set up indef strings.
+		 */
+		p = pp->p_aval.a_s;
+		for (i=0;  i < size_arr;  i++) {
+		    *p = (char *) memneed (btoi (len) );
+		    strcpy(*p, INDEFSTR);
+		    *(*p + len - 1) = '\0';
+		    p++;
+		}
+	    }
+
+	    /* Now get any initialization which may be present.
+	     * If we reach the end of the parameter before the
+	     * array is filled it is not an error and the
+	     * values are left with defaults. Values can be
+	     * skipped with successive commas.
+	     */
+	    for (i=0; i<size_arr; i++) {
+		if ((s = nextfield (tbuf, fp)) == NULL)
+		    break;
+		if (s == (char *) ERR) {
+		    eprintf (umquotes, pnamehold);
+		    return (NULL);
+		}
+
+		/* If the field was empty a pointer to the external
+		 * string undefval was returned.
+		 */
+		if (s == undefval)
+		    continue;
+
+		if (bastype == OT_BOOL) {
+		    makelower(s);
+		    if (strcmp(s, "no") )
+			*(pp->p_aval.a_i + i) = 1;
+		    else
+			*(pp->p_aval.a_i + i) = 0;
+		} else if (bastype == OT_INT) {
+		    *(pp->p_aval.a_i + i) = atoi(s);
+		} else if (bastype == OT_REAL) {
+		    *(pp->p_aval.a_r + i) = atof(s);
+		} else {
+		    char *dest;
+		    dest = *(pp->p_aval.a_s + i) ;
+		    strncpy (dest, s, len-1);
+		}
+	    }
+	}
+
+	/* Is there still more.
+	 */
+	if (nextfield (tbuf, fp) != NULL) {
+	    eprintf ("too many fields for `%s'\n", pnamehold);
+	    return (NULL);
+	}
+
+	/* Got through whole line without errors.
+	 */
+	return (pp);
+}
+
+
+/* CK_ATOI -- Check a string for non-numerics before conversion.
+ */
+int 
+ck_atoi (char *str, int *val)
+{
+	char	*s;
+
+	s = str;
+	while (*s == ' ' || *s == '\t')
+	    s++;
+
+	if (*s == '-')
+	    s++;
+
+	while (*s)
+	   if (!isdigit(*s++))
+		return (ERR);
+
+	*val = atoi(str);
+	return (0);
+}
+
+
+/* NEXTFIELD -- Compile the next field of a paramfile line into the dictionary
+ *   and return a pointer to the new entry.
+ * PP is the address of a pointer to the start of a param field. skip leading
+ *   blanks and handle quoted strings. strings ending in \ are continued after
+ *   absorbing both the \ and the newline. strings ending with just newlines
+ *   will contain the newline. the string may be delimited by ' or ".
+ * The callers pointer, *pp, will be set to the beginning of the next field.
+ * FP is a file pointer, needed if the field is quoted and extends to another
+ *   lines.
+ * The field must be part of a line read with fgets (buf, SZ_LINE, fp); we
+ *   rely on the max length as well as the trailing \n\0 sequence.
+ * Return NULL if no further fields, ERR if don't find closing quote,
+ *   else pointer to field as compiled in dictionary.  If the field was
+ *   empty return a pointer to the string "undefval".
+ */
+char *
+nextfield (char **pp, FILE *fp)
+{
+	static char readbuf[SZ_LINE];
+	register char c, *p;	/* fast references to field	 	*/
+	char	buf[SZ_LINE];	/* working scratch buffer		*/
+	char	*bp = buf;	/* pointer into scratch buffer		*/
+	char	*start = NULL;	/* start of compiled string in dictnry	*/
+	char	quote;		/* set to opening quote; go until match	*/
+
+	p = *pp;
+	if (p == NULL)
+	    return (NULL);
+
+	/* Skip white space at beginning.  This may include one or
+	 * more newlines if they are prefixed by a '\\'.
+	 */
+	forever {
+	    while (*p == ' ' || *p == '\t') 
+		p++;
+	    if (*p == '\\' && *(p+1) == '\n') {
+		if (fgets (readbuf, SZ_LINE, fp) == NULL)
+		    return ((char *) ERR);
+		p = readbuf;
+		continue;
+	    } else
+		break;
+	}
+
+	c = *p;
+
+	if (c == '\0' || c == '\n') {
+	    *pp = NULL;
+	    return (NULL);
+	}
+
+	if (c == '\'' || c == '"') {
+	    quote = c;
+	    p++;
+
+	    forever {
+		c = *p++;
+		if (c == '\n') {
+		    *bp++ = c;
+		    continue;
+		} else if (c == '\\') {
+		    switch (c = *p++) {
+		    case '\n':
+			continue;
+		    case 'n':
+			*bp++ = '\n';
+			break;
+		    case 't':
+			*bp++ = '\t';
+			break;
+		    case 'r':
+			*bp++ = '\r';
+			break;
+		    case 'f':
+			*bp++ = '\f';
+			break;
+		    case '\'':
+		    case '"':
+			*bp++ = c;
+			break;
+		    default:
+			*bp++ = '\\';		/* preserve esc seq.	*/
+			*bp++ = c;
+			break;
+		    }
+		} else if (c == '\0' || c == quote) {
+		    *bp = '\0';
+		    if (start == NULL)
+			start = comdstr (buf);
+		    else
+			catdstr (start, buf);
+
+		    if (c == quote)
+			break;
+		    else {
+			if (fgets (readbuf, SZ_LINE, fp) == NULL)
+			    return ((char *)ERR);
+			p = readbuf;
+			bp = buf;
+		    }
+		} else
+		    *bp++ = c;
+	    }
+	    *bp++ = '\0';
+
+	    /* Skip any white space.  We assume that we needn't skip
+	     * lines here.
+	    while (*p == ' ' || *p == '\t')
+		*p++;
+	     */
+	    while (*p == ' ' || *p == '\t')
+		p++;
+
+	    c = *p;
+
+	} else {
+	    /* Unquoted string.
+	     * Changed 2/15/85 by TAM.
+	     * This code is no longer seen by quoted strings
+	     */
+	    while (*p != '\0' &&  *p != '\n' &&  *p != ',' && *p != '#') {
+		c = *p;
+
+		/* Allow multi-line definitions by ignoring newlines
+		 * prefixed by backslash.
+		 */
+	 	if (c == '\\' && *(p+1) == '\n') {
+		    if (fgets (readbuf, SZ_LINE, fp) == NULL)
+			return ((char *)ERR);
+		    p = readbuf;
+		    continue;
+		} else
+		    *bp++ = c;
+
+		p++;
+	    }
+	}
+
+	/* Get rid of comments after the field. */
+	if (*p == '#')
+	    while (*p != '\0')
+		p++;
+
+	c = *p;
+
+	/* At this point we must be at a field terminator, i.e.
+	 * comma, newline or null.
+	 */
+	if (c != ',' && c != '\n' && c != '\0')
+	    return ((char *)ERR);
+
+
+	/* if stopped due to \n or , skip over it.
+	 * set caller's pointer to start of next field.
+	 * if we've not already compiled a string, compile this field.
+	 */
+	if (c == '\n' || c == ',')
+	    p++;
+
+	if (start == NULL) {
+	    if (bp == buf) {
+		/* The field was empty (i.e., ",,").  Return point to the
+		 * null string "undefval" to flag value as undefined.
+		 */
+		start = undefval;
+	    } else {
+		*bp = '\0';
+		start = comdstr (buf);
+	    }
+	    *pp = p;
+	} else if (*pp != NULL)
+	    *pp = p;
+
+	return (start);
+}
+
+
+/* MAKELOWER -- Convert, in-place, any upper case characters in the string
+ * cp to lower.  Using isupper and tolower is fast and portable, but making
+ * simple range test and subtraction will save the table space if you know
+ * you have ASCII.
+ */
+char *
+makelower (register char *cp)
+{
+	char *start = cp;
+	register char c;
+
+	while ((c = *cp) != '\0') {
+	    if ('A' <= c && c <= 'Z')
+		*cp = c + ('a' - 'A');
+	    cp++;
+	}
+
+	return (start);
+}
+
+
+/* SCANMODE -- Read through string s and build up an int full of M_XXX type
+ *   mode bits.  Return it if ok, else ERR.
+ * We write a diagnostic with eprint() if ERR but not a '\n' so
+ *   caller can include more info if necessary.
+ * N.B. we assume ERR doesn't map into a reasonable set of flags.
+ */
+int 
+scanmode (char *s)
+{
+	register int mode = 0;
+	register char *str, *ip, *op;
+	static	char *badstr = "bad mode string `%s'";
+	char	strings[4][25];
+	int	i, n;
+	char *index();
+
+	str = s;
+	if (index (str, ',') != NULL || index (str, '+') != NULL) {
+	    if (*str == '"' || *str == '\'')
+		str++;
+
+	    /* Break str into alpha strings separated by '+', ' ', or ','.
+	     * We will not see any more than 4 such strings.
+	     */
+	    for (n=0, ip=str;  n < 4;  n++) {
+		while (*ip == ' ' || *ip == '\t')
+		    ip++;
+		for (op=strings[n];  (*op = *ip++) != '\0';  op++)
+		    if (!isalpha (*op)) {
+			*op = '\0';
+			break;
+		    }
+	    }
+	    if (n == 0 || n == 5) {
+		eprintf (badstr, str);
+		return (ERR);
+	    }
+
+	    for (i=0;  i < n;  i++) {
+		str = strings[i];
+		makelower (str);
+		if (!strcmp (str, "auto") || !strcmp (str, "a"))
+		    mode |= M_AUTO;
+		else if (!strcmp (str, "hidden") || !strcmp (str, "h"))
+		    mode |= M_HIDDEN;
+		else if (!strcmp (str, "learn") || !strcmp (str, "l"))
+		    mode |= M_LEARN;
+		else if (!strcmp (str, "query") || !strcmp (str, "q"))
+		    mode |= M_QUERY;
+		else if (!strcmp (str, "menu") || !strcmp (str, "m"))
+		    mode |= M_MENU;
+		else {
+		    eprintf (badstr, str);	
+		    return (ERR);
+		}
+	    }
+
+	} else {
+	    for (ip=str;  *ip != '\0';  ip++) {
+		/* Handle the case of a set of qlha run together, as in
+		 * a parameter file spec.
+		 */
+		switch (*ip) {
+		case PF_AUTO: case PF_AUTO - ('a' - 'A'):
+		    mode |= M_AUTO;
+		    break;
+		case PF_HIDDEN: case PF_HIDDEN - ('a' - 'A'):
+		    mode |= M_HIDDEN;
+		    break;
+		case PF_LEARN: case PF_LEARN - ('a' - 'A'):
+		    mode |= M_LEARN;
+		    break;
+		case PF_QUERY: case PF_QUERY - ('a' - 'A'):
+		    mode |= M_QUERY;
+		    break;
+		case PF_MENU: case PF_MENU - ('a' - 'A'):
+		    mode |= M_MENU;
+		    break;
+		default:
+		    eprintf ("Bad mode spec `%c' in `%s'\n", *ip, str);
+		    return (ERR);
+		}
+	    }
+	}
+
+	return (mode);
+}
+
+
+/* SCANTYPE -- Read through string s and build up an int full of OT_XXX and
+ * PT_XXX type bits.  Return it if ok, else ERR.
+ * OT_ bits are not unique so be a bit carefile.
+ * we write a diagnostic with eprint() if ERR but not a '\n' so
+ *   caller can include more info if necessary.
+ * N.B. hope ERR doesn't map into a reasonable set of flags.
+ */
+int 
+scantype (register char *s)
+{
+	static char *badtype =  "bad type spec `%c'";
+	static char *cnfltype = "conflicting type spec `%c'";
+	register int type;
+
+	type = 0;
+
+	if (*s == '*') {
+	    type |= PT_LIST;
+	    s++;
+	}
+
+	if (*s == 'a' || *s == 'A') {
+	    if (type & PT_LIST) {	/* No list structured arrays. */
+		eprintf (cnfltype, *s);
+		return (ERR);
+	    }
+	    s++;
+	    type |= PT_ARRAY;
+	}
+
+	if (s[1] == '\0') {
+	    switch (*s) {
+	    case 'b': case 'B': type |= OT_BOOL; break;
+	    case 'i': case 'I': type |= OT_INT; break;
+	    case 'r': case 'R': type |= OT_REAL; break;
+	    case 's': case 'S': type |= OT_STRING; break;
+	    case 'f': case 'F': type |= (PT_FILNAM|OT_STRING); break;
+	    default: eprintf (badtype, *s);
+		return (ERR);
+	    }
+
+	} else if (*s == 'f') {
+	    type |= (PT_FILNAM + OT_STRING);
+	    while (*++s != '\0')
+		switch (*s) {
+		case 'b': case 'B': type |= PT_FBIN; break;
+		case 'n': case 'N': type |= PT_FNOE; break;
+		case 'r': case 'R': type |= PT_FER; break;
+		case 't': case 'T': type |= PT_FTXT; break;
+		case 'w': case 'W': type |= PT_FEW; break;
+		default: eprintf (badtype, *s);
+		    return (ERR);
+		}
+	} else if (!strcmp (makelower (s), "struct")) {
+	    type |= (PT_STRUCT|OT_STRING);
+	} else if (!strcmp (makelower (s), "gcur")) {
+	    type |= (PT_GCUR|OT_STRING);
+	} else if (!strcmp (makelower (s), "imcur")) {
+	    type |= (PT_IMCUR|OT_STRING);
+	} else if (!strcmp (makelower (s), "ukey")) {
+	    type |= (PT_UKEY|OT_STRING);
+	} else if (!strcmp (makelower (s), "pset")) {
+	    type |= (PT_PSET|OT_STRING);
+	} else {
+	    eprintf (badtype, *s);
+	    return (ERR);
+	}
+
+	return (type);
+}
diff --git a/pkg/vocl/prcache.c b/pkg/vocl/prcache.c
new file mode 100644
index 00000000..cf6db5a1
--- /dev/null
+++ b/pkg/vocl/prcache.c
@@ -0,0 +1,708 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_error
+#define	import_finfo
+#define	import_prstat
+#include <iraf.h>
+
+#include "config.h"
+#include "errs.h"
+#include "task.h"
+#include "operand.h"
+#include "proto.h"
+
+
+/*
+ * PRCACHE -- To minimize spawns, we maintain a cache of processes.  Each
+ *   process may contain any number of tasks.  Zero or one tasks may be active
+ *   in a process at a given time.  A process is spawned and added to the
+ *   cache when a task therein needs to be run.  A process is terminated when
+ *   its cache slot is needed by another process or when the cache is flushed.
+ *   Error recovery does not normally result in process termination, even when
+ *   the error is initiated by a task resident in the process.
+ *
+ *     pid = pr_connect (process, command, &in,&out, tin,tout,terr, timeit)
+ *        pr_disconnect (pid)
+ *	        pr_lock (pid)
+ *	      pr_unlock (pid)
+ *         pr_dumpcache (pid, break_locks)
+ *	       pr_chdir (pid, newdir)
+ *	      pr_envset (pid, envvar, valuestr)
+ *   pid = pr_cachetask (ltname)
+ *  pid = pr_pnametopid (pname)
+ *         pr_listcache (fp)
+ *	    pr_setcache (sz_prcache)
+ *      pno = pr_getpno ()
+ *        pr_prunecache (pno)
+ *
+ * The PR_CONNECT procedure executes an ltask resident in an external compiled
+ *   process.  A process spawn occurs only if the process is not found in
+ *   the cache or is not idle.  PR_DISCONNECT should be called when the ltask
+ *   terminates to signal that the process is idle.  Processes may be locked
+ *   in the cache, but this facility must be used with great discretion as
+ *   it defeats the purpose of the cache and may lead to lockout.
+ *
+ * A process is passed the environment list and the name of the current working
+ *   directory when it is spawned.  New SET environment declarations or chdir
+ *   directives may be passed to all processes in the cache without flushing
+ *   and refilling the cache, using the PR_CHDIR and PR_ENVSET commands.
+ * Pseudofile i/o (xmit and xfer) is handled automatically by the system.
+ *   Our function here is to connect the pseudofile streams of the ltask
+ *   up to real streams at connect() time, via calls to c_prredir().
+ *
+ * The size of the cache is a runtime time parameter controlled by the CL
+ *   parameter `szprcache'.  The default value of this is set either in
+ *   cl$cl.par or in hlib$clpackage.par, hence may vary from site to site
+ *   or even from host to host.
+ */
+
+extern	int	cldebug;
+extern	int	cltrace;
+
+typedef	XINT (*PFI)();
+
+struct process {
+	int	pr_pid;			/* process id of subprocess	*/
+	long	pr_time;		/* time when process executed	*/
+	short	pr_flags;		/* flag bits			*/
+	short	pr_pno;			/* prcache process number	*/
+	FILE	*pr_in, *pr_out;	/* in, out IPC channels		*/
+	struct	process *pr_up;		/* up link (toward head)	*/
+	struct	process *pr_dn;		/* down link (toward tail)	*/
+	char	pr_name[SZ_PATHNAME+1];	/* filename of process		*/
+};
+
+#define	P_ACTIVE	01		/* task in process is in use	*/
+#define P_LOCKED	02		/* process is locked in cache	*/
+
+#define	pr_idle(pr)	(((pr)->pr_flags&P_ACTIVE)==0)
+#define	pr_busy(pr)	(((pr)->pr_flags&(P_ACTIVE|P_LOCKED))!=0)
+
+int	pr_pno = 1;			/* incremented for each connect	*/
+int	sz_prcache = 2;			/* nprocess slots in cache	*/
+struct	process pr_cache[MAXSUBPROC];
+struct	process *pr_head = NULL, *pr_tail = NULL;
+extern	char *findexe();
+
+static void pr_pdisconnect (struct process *pr);
+static void pr_tohead (struct process *pr);
+static void pr_totail (struct process *pr);
+static void pr_unlink (struct process *pr);
+
+
+
+/* PR_CONNECT -- Run a task resident in an external process.  Look in the cache
+ * for the named process; if not found or already active, spawn the process
+ * and add it to the cache.  Send the startup message to the child to start
+ * the task in execution.  The startup message specifies the name of the task
+ * to be run, whether timing is desired, and any i/o redirection desired.
+ * The input and output IPC file pointers are returned to the caller.
+ *
+ * TODO: This procedure was designed to minimize the changes to the high level
+ * code, and is not done right.  Formatting of the startup command should be
+ * done in a procedure within this package, rather than at the high level,
+ * and should support i/o redirection to named files for (greatly) increased
+ * efficiency of pipes.
+ */
+int 
+pr_connect (
+    char *process,			/* filename of process		*/
+    char *command,			/* IRAF Main command		*/
+    FILE **in,
+    FILE **out,			/* IPC channels (output)	*/
+    FILE *t_in,
+    FILE *t_out,
+    FILE *t_err,		/* task stdin,out,err (input)	*/
+    FILE *t_gr,
+    FILE *t_im,
+    FILE *t_pl,		/* task graphics streams	*/
+    int timeit				/* if !0, time command		*/
+)
+{
+	register int	pid;
+
+	/* Connect subprocess. */
+	if ((pid = pr_pconnect (process, in, out)) == NULL)
+	    c_erract (EA_ERROR);
+
+
+	/* Set default redirection of the standard i/o streams.
+	 */
+	c_prredir (pid, STDIN,    fileno(t_in));
+	c_prredir (pid, STDOUT,   fileno(t_out));
+	c_prredir (pid, STDERR,   fileno(t_err));
+ 	c_prredir (pid, STDGRAPH, fileno(t_gr));
+ 	c_prredir (pid, STDIMAGE, fileno(t_im));
+ 	c_prredir (pid, STDPLOT,  fileno(t_pl));
+
+	/* Send startup message. */
+	if (timeit)
+	    fputc ('$', *out);
+	fputs (command, *out);
+	fflush (*out);
+
+	if (cldebug)
+	    eprintf ("connect: *in, *out, t_in, t_out: %d %d %d %d\n",
+		*in, *out, t_in, t_out);
+	if (cltrace) {
+	    d_fmtmsg (stderr, "\t    ", command, 80 - 13);
+	    eprintf ("\t--------------------------------\n");
+	}
+
+	return (pid);
+}
+
+
+/* PR_DISCONNECT -- Called when a task resident in an external process
+ * terminates; also called during error recovery, e.g., following X_IPC.
+ * Our only function for normal task termination is to clear the active flag.
+ * Until the active flag is cleared the process cannot be reused nor terminated.
+ */
+void 
+pr_disconnect (
+    int pid			/* process id returned by connect	*/
+)
+{
+	struct process *pr;
+
+	pr_checkup();
+	for (pr=pr_head;  pr != NULL;  pr = pr->pr_dn) {
+	    if (pr->pr_pid == pid) {
+		pr->pr_flags &= ~P_ACTIVE;
+		return;
+	    }
+	}
+}
+
+
+/* PR_PCONNECT -- Run a task resident in an external process.  Look in the cache
+ * for the named process; if not found or already active, spawn the process
+ * and add it to the cache.  Return the process id and file pointers to the
+ * IPC channels to the caller.
+ */
+int 
+pr_pconnect (
+    char *process,			/* filename of process		*/
+    FILE **in,
+    FILE **out			/* IPC channels (output)	*/
+)
+{
+	struct process *pr;
+	struct	process *pr_findproc();
+	struct	_finfo fi;
+	int	fd_in, fd_out;
+	extern  int c_finfo (char *name, struct _finfo *fi);
+
+	if (pr_head == NULL)
+	    pr_initcache();
+	else
+	    pr_checkup();
+
+	/* Search the cache to see if the process is already connected and
+	 * inactive.  If the process is found idling in the cache, relink it
+	 * at the head of the cache list, otherwise disconnect the inactive
+	 * process nearest the tail of the list and spawn the new one to
+	 * replace it.  The cached entry is automatically invalidated if the
+	 * corresponding executable file has been modified (e.g., relinked),
+	 * provided the process is not currently busy.  A process is considered
+	 * busy if it is active or if it is locked in the cache.
+	 */
+	fi.fi_mtime = 0;
+	if ((pr = pr_findproc (process)) != NULL && !pr_busy(pr)) {
+	    if (c_finfo (process, &fi) == ERR || fi.fi_mtime > pr->pr_time) {
+		pr_pdisconnect (pr);
+		pr = NULL;
+	    }
+	}
+
+	if (pr != NULL)
+	    pr_tohead (pr);
+	else {
+	    /* Get process slot. */
+	    for (pr=pr_tail;  pr != NULL;  pr=pr->pr_up)
+		if (!pr_busy(pr)) {
+		    if (pr->pr_pid != NULL)
+			pr_pdisconnect (pr);
+		    break;
+		}
+	    if (pr == NULL)
+		cl_error (E_UERR, "process cache deadlock");
+	    pr_tohead (pr);
+
+	    /* Spawn subprocess.  Turn off interrupts during process startup
+	     * to avoid crashing the IPC protocol.
+	     */
+	    if (cltrace)
+		eprintf ("\t----- connect to %s -----\n", process);
+	    intr_disable();
+	    if ((pr->pr_pid = c_propen (process, &fd_in, &fd_out)) == NULL) {
+		intr_enable();
+		return (NULL);
+	    }
+	    intr_enable();
+
+	    if (fi.fi_mtime == 0)
+		if (c_finfo (process, &fi) == ERR)
+		    fi.fi_mtime = 0;
+
+	    pr->pr_time = fi.fi_mtime;
+	    pr->pr_in  = FDTOFP (fd_in);
+	    pr->pr_out = FDTOFP (fd_out);
+	    pr->pr_flags = 0;
+	    pr->pr_pno = pr_getpno();
+	    strcpy (pr->pr_name, process);
+	}
+
+	pr->pr_flags |= P_ACTIVE;
+	*in  = pr->pr_in;
+	*out = pr->pr_out;
+
+	return (pr->pr_pid);
+}
+
+
+/* PR_PDISCONNECT -- Remove a process from the process cache.  Processes are
+ * disconnected when pushed out of the cache or when the cache is flushed.
+ */
+void 
+pr_pdisconnect (struct process *pr)
+{
+	/* Ignore attempts to dump active processes.  This might happen
+	 * when an active process executes a command which calls dumpcache.
+	 */
+	if (pr == NULL || pr->pr_pid == NULL || pr_busy(pr))
+	    return;
+
+	if (cltrace)
+	    eprintf ("\t----- disconnect %s -----\n", pr->pr_name);
+
+	/* Command child process to exit, close down communications.  This
+	 * closes the IPC files as well as the terminating the process.
+	 */
+	c_prclose (pr->pr_pid);
+
+	/* Clear process table entry and move process to tail of list.
+	 */
+	pr->pr_pid = 0;
+	pr_totail (pr);
+}
+
+
+/* PR_SETCACHE -- Set the size of the process cache.  This is automatically
+ * called whenever the value of the parameter cl.szprcache is set.  Changing
+ * the cache size on an active cache causes the cache to be flushed and all
+ * locked processes to be reconnected.
+ */
+void 
+pr_setcache (int new_szprcache)
+{
+	struct	process *pr;
+	char	pname[MAXSUBPROC][SZ_PATHNAME+1];
+	int	nprocs=0, pid, i;
+	FILE	*fdummy;
+
+	if (pr_head == NULL)
+	    pr_initcache();
+	else {
+	    /* Get the names of any processes currently locked into the cache,
+	     * then dump the cache.
+	     */
+	    for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+		if (pr->pr_pid != NULL && (pr->pr_flags & P_LOCKED))
+		    strcpy (pname[nprocs++], pr->pr_name);
+	    pr_dumpcache (0, 1);
+	}
+
+	/* Set the new value of sz_prcache. */
+	sz_prcache = new_szprcache;
+	if (sz_prcache < 2)
+	    sz_prcache = 2;
+	else if (sz_prcache > MAXSUBPROC)
+	    sz_prcache = MAXSUBPROC;
+
+	/* Relink the empty cache for sz_prcache cache slots. */
+	pr_initcache();
+
+	/* Attempt to recache the formerly locked processes.  There must be
+	 * at least one empty slot left for new subprocesses.
+	 */
+	if (nprocs+1 > sz_prcache)
+	    nprocs = sz_prcache-1;
+
+	for (i=0;  i < nprocs;  i++) {
+	    pid = pr_connect (findexe(NULL,pname[i]), "\n", &fdummy, &fdummy,
+		stdin, stdout, stderr, 0,0,0, 0);
+	    pr_disconnect (pid);
+	    pr_lock (pid);
+	}
+}
+
+
+/* PR_FINDPROC -- Search the cache for the named process.  Skip active
+ * processes.
+ */
+struct process *
+pr_findproc (char *process)
+{
+	struct	process *pr;
+
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+	    if (pr->pr_pid != NULL && pr_idle(pr))
+		if (strcmp (process, pr->pr_name) == 0)
+		    return (pr);
+
+	return (NULL);
+}
+
+
+/* PR_CACHETASK -- Cache the process containing the named logical task.
+ * If the process is already connected merely returns its pid, else connect
+ * the process and return its pid.
+ */
+int 
+pr_cachetask (
+    char *ltname		/* logical task name	*/
+)
+{
+	register int  pid;
+	struct	ltask *ltp;
+	FILE	*fdummy;
+
+	ltp = ltasksrch ("", ltname);
+	if (ltp->lt_flags & (LT_SCRIPT|LT_BUILTIN))
+	    return (ERR);
+	if ((pid = pr_pnametopid(findexe(ltp->lt_pkp,ltp->lt_pname))) == NULL) {
+	    pid = pr_connect (findexe(ltp->lt_pkp,ltp->lt_pname), "\n", &fdummy,
+		&fdummy, stdin, stdout, stderr, 0,0,0, 0);
+	    pr_disconnect (pid);
+	}
+
+	return (pid);
+}
+
+
+/* PR_LOCK -- Lock a connect process in the cache.  Must be used with caution
+ * as deadlock may occur.  Locked processes are also not disconnected by
+ * pr_dumpcache, which may not be what is desired.
+ */
+void 
+pr_lock (
+    register int pid			/* process id			*/
+)
+{
+	struct process *pr;
+
+	if (pid != NULL)
+	    for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+		if (pr->pr_pid == pid) {
+		    pr->pr_flags |= P_LOCKED;
+		    break;
+		}
+}
+
+
+/* PR_UNLOCK -- Unlock a process, allowing it to be disconnected either when
+ * forced out of the cache by another disconnect, or by a dumpcache.
+ *
+ * This function is currently unused.
+ */
+int 
+pr_unlock (
+    register int pid			/* process id			*/
+)
+{
+	struct process *pr;
+
+	if (pid != NULL)
+	    for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+		if (pr->pr_pid == pid)
+		    return (pr->pr_flags &= ~P_LOCKED);
+
+	return (ERR);
+}
+
+
+/* PR_LISTCACHE -- Info command, used to display the contents of the process
+ * cache.  Format:  pid [RH][L] process_name
+ */
+void 
+pr_listcache (
+    FILE *fp			/* output file		*/
+)
+{
+	register struct process *pr;
+
+	pr_checkup();
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+	    if (pr->pr_pid) {
+		int	os_pid;
+		char	nodename[SZ_FNAME+1];
+		char	out[100];
+
+		/* Print out pid in both decimal and hex, since the host
+		 * system might need either.  Also print the VOS pid since
+		 * that is what is needed for flprcache (although flprcache
+		 * will accept a task name instead).  Note that c_kimapchan
+		 * must be called to get the host PID if networking is in use.
+		 */
+		os_pid = c_kimapchan (pr->pr_pid, nodename, SZ_FNAME);
+		sprintf (out, "[%02d] %s!%d(%xX)",
+		    pr->pr_pid, nodename, os_pid, os_pid);
+		fprintf (fp, "    %-32s %c%c %s\n",
+		    out,
+		    (pr->pr_flags&P_ACTIVE) ? 'R' : 'H',
+		    (pr->pr_flags&P_LOCKED) ? 'L' : ' ',
+		    pr->pr_name);
+
+	    } else {
+		fprintf(fp, "%12d", 0);
+		fputc ('\n',fp);
+	    }
+}
+
+
+/* PR_DUMPCACHE -- Disconnect the named process, or disconnect all processes
+ * currently running in the cache, and clear the process tables.  A count of
+ * the number of active processes not disconnected is returned as the function
+ * value.  Locks may be forced if desired, i.e., when dumping the cache prior
+ * to process termination.
+ */
+void 
+pr_dumpcache (int pid, int break_locks)
+{
+	register struct	process *pr;
+	register int	n;
+
+	pr_checkup();
+
+	/* Do not traverse list using list pointers, because the first
+	 * pr_disconnect will leave process pr at the tail of the list,
+	 * causing premature termination.
+	 */
+	for (pr=pr_cache, n=sz_prcache;  --n >= 0;  pr++)
+	    if ((pid == 0 && pr->pr_pid) || (pid == pr->pr_pid)) {
+		if (break_locks && pr_idle(pr))
+		    pr->pr_flags &= ~P_LOCKED;
+		pr_pdisconnect (pr);
+	    }
+
+	if (break_locks)
+	    pr_pno = 1;
+}
+
+
+/* PR_PRUNECACHE -- Disconnect all processes currently running in the cache
+ * for which the process number is greater than that given, i.e., which were
+ * connected since the given PNO was assigned.  Locked processes are not
+ * affected.
+ */
+void 
+pr_prunecache (int pno)
+{
+	register struct	process *pr;
+	register int	n;
+
+	pr_checkup();
+
+	/* Do not traverse list using list pointers, because the first
+	 * pr_disconnect will leave process pr at the tail of the list,
+	 * causing premature termination.
+	 */
+	for (pr=pr_cache, n=sz_prcache;  --n >= 0;  pr++)
+	    if (pr->pr_pid && pr->pr_pno > pno)
+		pr_pdisconnect (pr);
+}
+
+
+/* PR_GETPNO -- Get the next process number.  These are supposed to be returned
+ * in time order.  If 10 million processes are spawned without setcache being
+ * called, the counter might wrap around, but that does not seem likely and is
+ * harmless in any case.
+ */
+int 
+pr_getpno (void)
+{
+	return (pr_pno++);
+}
+
+
+/* PR_PNAMETOPID -- Lookup the named process in the cache and return the pid
+ * if found, NULL otherwise.
+ */
+int 
+pr_pnametopid (char *pname)
+{
+	register struct process *pr;
+
+	pr_checkup();
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn)
+	    if (strcmp (pr->pr_name, pname) == 0)
+		return (pr->pr_pid);
+
+	return (NULL);
+}
+
+
+/* PR_CHDIR -- Change the current working directory of a child process, or
+ * of all connected but idle processes if pid=0.
+ */
+void 
+pr_chdir (register int pid, char *newdir)
+{
+	register struct process *pr;
+
+	pr_checkup();
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn) {
+	    if (pr->pr_pid == NULL || !pr_idle(pr))
+		continue;
+	    else if (pid == NULL || pr->pr_pid == pid)
+		c_prchdir (pr->pr_pid, newdir);
+	}
+}
+
+
+/* PR_ENVSET -- Set the value of an environment variable in a child process,
+ * or in all connected but idle processes if pid=0.
+ */
+void 
+pr_envset (register int pid, char *envvar, char *valuestr)
+{
+	register struct process *pr;
+
+	pr_checkup();
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn) {
+	    if (pr->pr_pid == NULL || !pr_idle(pr))
+		continue;
+	    else if (pid == NULL || pr->pr_pid == pid)
+		c_prenvset (pr->pr_pid, envvar, valuestr);
+	}
+}
+
+
+/* PR_CHECKUP -- Check on the status of all connected child processes to see
+ * if any have died.  If a process has died we must disconnect the process
+ * to free file descriptors and the process cache slot.
+ */
+void 
+pr_checkup (void)
+{
+	register struct	process *pr;
+	register int	n;
+
+	/* Do not traverse list using list pointers, because the first
+	 * pr_disconnect will leave process pr at the tail of the list,
+	 * causing premature termination.
+	 */
+	for (pr=pr_cache, n=sz_prcache;  --n >= 0;  pr++) {
+	    if (pr->pr_pid != NULL) {
+		if (c_prstati (pr->pr_pid, PR_STATUS) == P_DEAD) {
+		    pr->pr_flags = 0;
+		    pr_pdisconnect (pr);
+		}
+	    }
+	}
+}
+
+
+/* ONIPC -- Call this when get a signal that indicates a write to an IPC
+ * channel with no reader.  We are called after the system X_IPC handler
+ * has been called to cleanup the internal process tables and file system,
+ * disabling any further output to the process.
+ */
+/* ARGSUSED */
+void 
+onipc (
+    int *vex,			/* virtual exception code	*/
+    PFI *next_handler		/* next handler to be called	*/
+)
+{
+	register struct	process *pr;
+
+	for (pr=pr_head;  pr != NULL;  pr=pr->pr_dn) {
+	    if (pr->pr_pid != NULL) {
+		if (c_prstati (pr->pr_pid, PR_STATUS) == P_DEAD)
+		    break;
+	    }
+	}
+
+	cl_error (E_UERR, "Abnormal termination of child process '%s'",
+	    pr ? pr->pr_name : "??");
+}
+
+
+/* PR_INITCACHE -- Initialize the process cache, i.e., set up the queue for the
+ * first time.  The minimum cache size is 2.
+ */
+void 
+pr_initcache (void)
+{
+	register struct process *pr;
+	register int	n;
+
+	for (pr=pr_cache, n=MAXSUBPROC;  --n >= 0;  pr++) {
+	    pr->pr_pid = 0;
+	    pr->pr_flags = 0;
+	    pr->pr_pno = 0;
+	    pr->pr_in = pr->pr_out = NULL;
+	    pr->pr_up = pr->pr_dn = NULL;
+	}
+
+	pr_head = pr_tail = pr_cache;
+	for (n=1;  n < sz_prcache;  n++)
+	    pr_tohead (&pr_cache[n]);
+
+	pr_pno = 1;
+}
+
+
+/* PR_TOHEAD -- Relink a process at the head of the cache list.
+ */
+static void 
+pr_tohead (struct process *pr)
+{
+	if (pr_head != pr) {
+	    pr_unlink (pr);
+	    pr->pr_dn = pr_head;
+	    pr->pr_up = NULL;
+	    pr_head->pr_up = pr;
+	    pr_head = pr;
+	}
+}
+
+
+/* PR_TOTAIL -- Relink a process at the tail of the cache list.
+ */
+static void 
+pr_totail (struct process *pr)
+{
+	if (pr_tail != pr) {
+	    pr_unlink (pr);
+	    pr->pr_up = pr_tail;
+	    pr->pr_dn = NULL;
+	    pr_tail->pr_dn = pr;
+	    pr_tail = pr;
+	}
+}
+
+
+/* PR_UNLINK -- Unlink a process from the list.
+ */
+static void 
+pr_unlink (struct process *pr)
+{
+	if (pr->pr_up) {
+	    (pr->pr_up)->pr_dn = pr->pr_dn;
+	    if (pr == pr_tail)
+		pr_tail = pr->pr_up;
+	}
+
+	if (pr->pr_dn) {
+	    (pr->pr_dn)->pr_up = pr->pr_up;
+	    if (pr == pr_head)
+		pr_head = pr->pr_dn;
+	}
+}
diff --git a/pkg/vocl/proto.h b/pkg/vocl/proto.h
new file mode 100644
index 00000000..46121786
--- /dev/null
+++ b/pkg/vocl/proto.h
@@ -0,0 +1,447 @@
+/* binop.c */
+extern char *strint(register char *s, int side);
+extern void binop(int opcode);
+extern void binexp(int opcode);
+/* bkg.c */
+extern void bkg_init(char *bcs);
+extern void bkg_spawn(char *cmd);
+extern void bkg_wait(register int job);
+extern void bkg_kill(int job);
+extern void bkg_jobstatus(struct _iobuf *fp, int job);
+extern int bkg_jobactive(int job);
+extern void bkg_update(int pmsg);
+extern int bkg_wfservice(int job);
+extern void bkg_delfiles(int job);
+extern void bkg_startup(char *bkgfile);
+extern void bkg_abort(void);
+extern char *wbkgfile(int jobno, char *cmd, char *fname);
+extern void rbkgfile(char *bkgfile);
+/* builtin.c */
+extern void clbye(void);
+extern void cllogout(void);
+extern void clclbye(void);
+extern void clcache(void);
+extern void cl_locate(char *task_spec, int first_only);
+extern void clwhich(void);
+extern void clwhereis(void);
+extern void clflprcache(void);
+extern void flpr_task(char *task);
+extern void clprcache(void);
+extern void clgflush(void);
+extern void clchdir(void);
+extern void clback(void);
+extern void clerror(void);
+extern void clhelp(void);
+extern void clallhelp(void);
+extern void clhistory(void);
+extern void dotrace(void);
+extern void clehistory(void);
+extern void clservice(void);
+extern void clkeep(void);
+extern void clkill(void);
+extern void cleparam(void);
+extern void cllparam(void);
+extern void cldparam(void);
+extern void clpack(void);
+extern void clcurpack(void);
+extern void clpkg(void);
+extern void lapkg(void);
+extern void clprint(void);
+extern void clfprint(void);
+extern void do_clprint(char *dest);
+extern void clprintf(void);
+extern void clscans(void);
+extern void clscanf(void);
+extern void clputlog(void);
+extern void clset(void);
+extern void clreset(void);
+extern void clshow(void);
+extern void clstty(void);
+extern void cltask(int redef);
+extern void clrtask(void);
+extern void clntask(void);
+extern void clforeign(void);
+extern void clunlearn(void);
+extern void clupdate(void);
+extern void clhidetask(void);
+extern void clwait(void);
+extern void cljobs(void);
+extern void clfunc(void);
+extern void clbeep(void);
+extern void cltime(void);
+extern void clclear(void);
+extern void clsleep(void);
+extern void cledit(void);
+extern void clallocate(void);
+extern void cldeallocate(void);
+extern void cldevstatus(void);
+extern void clerrpsh(void);
+extern void clerreset(void);
+extern void clonerror(void);
+extern void setbuiltins(register struct package *pkp);
+extern void newbuiltin(struct package *pkp, char *lname, void (*fp)(void), int flags, char *ftprefix, int redef);
+extern int mkarglist(register struct pfile *pfp, char *args, char *argp[]);
+extern void pushfparams(register struct param *pp);
+extern void pushbparams(struct param *pp);
+extern void pushbpvals(struct param *pp);
+extern int nargs(struct pfile *pfp);
+extern void keep(register struct task *tp);
+/* clprintf.c */
+extern void u_eprintf(char *fmt, ...);
+extern int oprintf(char *fmt, ...);
+extern int tprintf(char *fmt, ...);
+extern int prparamval(struct param *pp, struct _iobuf *fp);
+extern int strsort(char *list[], int nstr);
+extern int qstrcmp(char *a, char *b);
+extern int strtable(struct _iobuf *fp, char *list[], int nstr, int first_col, int last_col, int maxch, int ncol);
+/* clsystem.c */
+extern void clsystem(char *cmd, struct _iobuf *taskout, struct _iobuf *taskerr);
+/* compile.c */
+extern int compile(int opcode, ...);
+extern int comstr(register char *s, memel *loc);
+extern char *comdstr(char *s);
+extern void catdstr(char *es, char *ns);
+/* debug.c */
+extern void d_asmark(void);
+extern void d_assemble(void);
+extern void d_stack(register XINT locpc, int ss, int endpc);
+extern int d_instr(struct _iobuf *fp, char *prefix, register XINT locpc);
+extern void d_d(void);
+extern void d_p(void);
+extern void d_t(void);
+extern void d_l(void);
+extern void d_f(void);
+extern void d_on(void);
+extern void d_off(void);
+extern void d_trace(int value);
+extern void e_dumpop(void);
+extern void d_fmtmsg(struct _iobuf *fp, char *prefix, char *message, int width);
+extern void d_prof(void);
+/* decl.c */
+extern int getlimits(char *pname, int n, int *i1, int *i2);
+extern int get_dim(char *pname);
+extern int maketype(int type, int list);
+extern void do_arrayinit(struct param *pp, int nval, int nindex);
+extern void do_scalarinit(struct param *pp, int inited);
+extern int scanftype(struct param *pp, struct operand *o);
+extern int c_scanmode(struct param *pp, struct operand *o);
+extern int scanlen(struct param *pp, struct operand *o);
+extern int scanmin(struct param *pp, struct operand *o);
+extern int scanenum(register struct param *pp, register struct operand *o);
+extern int scanmax(struct param *pp, struct operand *o);
+extern void proc_params(int npar);
+extern struct param *initparam(struct operand *op, int isparam, int type, int list);
+extern int procscript(struct _iobuf *fp);
+extern int skip_to(struct _iobuf *fp, char *key);
+extern void do_option(struct param *pp, struct operand *oo, struct operand *o);
+/* edcap.c */
+extern void edtinit(void);
+extern void edtexit(void);
+extern char *host_editor(char *editor);
+extern void get_editor(char *editor);
+extern int what_cmd(int first_char);
+extern int cmd_match(char *cstring, int nchars);
+extern void show_editorhelp(void);
+/* eparam.c */
+extern int epset(char *pset);
+extern int e_makelist(struct pfile *pfileptr);
+extern int e_testtop(int cur, int new);
+extern int e_repaint(void);
+extern int e_pheader(struct pfile *pfp, int cmdline, int maxcol);
+extern int e_drawkey(void);
+extern int e_encode_vstring(struct param *pp, char *outbuf);
+extern int e_check_vals(char *string);
+extern int e_undef(register char *s);
+extern int e_rpterror(char *errstr);
+extern int e_clrerror(void);
+extern char *e_getfield(register char *ip, char *outstr, int maxch);
+extern int e_moreflag(register int topkey);
+extern int e_scrollit(void);
+extern int edit_history_directive(char *args, char *new_cmd);
+extern int editstring(char *string, int eparam);
+extern int e_ttyinit(void);
+extern int e_colon(void);
+extern int e_psetok(char *pset);
+extern int e_puterr(char *errmsg);
+extern int e_ttyexit(void);
+extern int e_moveup(int eparam);
+extern int e_movedown(int eparam);
+extern char *e_tonextword(register char *ip);
+extern char *e_toprevword(char *ip, char *string);
+extern int e_ctrl(char *cap);
+extern int e_goto(int col, int line);
+extern int e_putline(char *stwing);
+extern int e_clear(void);
+extern int e_clrline(void);
+extern int e_display(char *string, int sline, int scol);
+extern int e_displayml(char *string, int sline, int scol, int ccol);
+/* errs.c */
+extern void cl_error(int errtype, char *diagstr, ...);
+extern void erract_init(void);
+/* exec.c */
+extern void run(void);
+extern void callnewtask(char *name);
+extern void execnewtask(void);
+extern void mk_startupmsg(struct task *tp, char *cmd, int maxch);
+extern char *findexe(struct package *pkg, char *pkg_path);
+extern void set_clio(register struct task *newtask);
+extern struct param *ppfind(struct pfile *pfp, char *tn, char *pn, int pos, int abbrev);
+extern void psetreload(struct pfile *main_pfp, struct param *psetp);
+extern void iofinish(register struct task *tp);
+extern void restor(struct task *tp);
+extern void oneof(void);
+extern void printcall(struct _iobuf *fp, struct task *tp);
+extern void print_call_line(struct _iobuf *out, int line, char *fname, int flags);
+extern void killtask(register struct task *tp);
+/* globals.c */
+/* gquery.c */
+extern char *gquery(struct param *pp, char *string);
+extern char *minmax(register struct param *pp);
+extern char *enumin(register struct param *pp);
+/* gram.c */
+extern int yywrap(void);
+extern void yyerror(char *s);
+extern void rerun(void);
+extern int crackident(char *s);
+extern XINT addconst(char *s, int t);
+extern void listparams(struct pfile *pfp);
+extern void pretty_param(struct param *pp, struct _iobuf *fp);
+extern void dumpparams(struct pfile *pfp);
+extern void show_param(struct ltask *ltp, struct param *pp, struct _iobuf *fp);
+extern void listhelp(struct package *pkp, int show_invis);
+extern void listallhelp(int show_invis);
+extern void breakout(char *full, char **pk, char **t, char **p, char **f);
+extern int fieldcvt(register char *f);
+extern int keyword(register char *tbl[], register char *s);
+extern void intrfunc(char *fname, int nargs);
+extern struct operand sexa(char *s);
+extern void sexa_to_index(double r, int *i1, int *i2);
+extern char *addpipe(void);
+extern char *getpipe(void);
+extern void delpipes(register int npipes);
+extern char *pipefile(int pipecode);
+extern void loopincr(void);
+extern void loopdecr(void);
+extern void setswitch(void);
+extern int in_switch(void);
+extern void caseset(memel *parg, int ncaseval);
+extern struct label *setlabel(struct operand *name);
+extern struct label *getlabel(struct operand *name);
+extern void setigoto(int loc);
+extern void unsetigoto(int loc);
+extern int make_imloop(int i1, int i2);
+extern int y_typedef(char *key);
+extern void p_position(void);
+/* history.c */
+extern int yy_getc(struct _iobuf *fp);
+extern void yy_startblock(int logflag);
+extern char *curcmd(void);
+extern int get_command(struct _iobuf *fp);
+extern int process_history_directive(char *directive, char *new_command_block);
+extern int search_history(char *directive, char *new_command_block);
+extern int stredit(char *edit_directive, char *in_text, char *out_text);
+extern int expand_history_macros(char *in_text, char *out_text);
+extern int get_arglist(char *cmdblk, char *argp[]);
+extern void put_history(char *command);
+extern int get_history(int record, char *command, int maxch);
+extern void fetch_history(char *recptr, char *command, int maxch);
+extern char *find_history(int record);
+extern void show_history(struct _iobuf *fp, int max_commands);
+extern void pprompt(register char *string);
+extern void get_prompt(register char *string);
+extern void put_logfile(char *command);
+extern int open_logfile(char *fname);
+extern void close_logfile(char *fname);
+extern void reset_logfile(void);
+extern void print_command(register struct _iobuf *fp, char *command, char *marg1, char *marg2);
+extern char *today(void);
+extern int what_record(void);
+extern void putlog(struct task *tp, char *usermsg);
+/* lexicon.c */
+extern int yylex(void);
+extern int lexicon(void);
+extern int lexinit(void);
+/* lists.c */
+extern struct operand readlist(struct param *pp);
+extern void closelist(register struct param *pp);
+/* main.c */
+extern int cmain_(int *prtype, short *bkgfile, short *cmd);
+extern int clexit(void);
+extern int clshutdown(void);
+extern char *memneed(int incr);
+extern int onint(int *vex, int (**next_handler)(void));
+extern int intr_disable(void);
+extern int intr_enable(void);
+extern int intr_reset(void);
+extern int onerr(void);
+extern int cl_amovi(register int *ip, register int *op, register int len);
+/* modes.c */
+extern int effmode(struct param *pp);
+extern int taskmode(register struct task *tp);
+extern void query(struct param *pp);
+extern char *nextstr(char **pbuf, struct _iobuf *fp);
+extern char *nxtchr(char *p, struct _iobuf *fp);
+extern void pquery(register struct param *pp, struct _iobuf *fp);
+extern char *bkg_query(char *obuf, int maxch, register struct param *pp);
+extern void service_bkgquery(int bkgno);
+extern void get_bkgqfiles(int bkgno, int pid, char *bkg_query_file, char *query_response_file);
+extern int inrange(register struct param *pp, register struct operand *op);
+extern int range_check(struct param *pp);
+extern void setclmodes(struct task *tp);
+extern void parse_clmodes(struct param *pp, struct operand *newval);
+extern int abbrev(void);
+extern void poffset(int off);
+/* opcodes.c */
+extern void o_undefined(void);
+extern void o_absargset(memel *argp);
+extern void o_add(void);
+extern void o_addassign(memel *argp);
+extern void o_allappend(void);
+extern void o_allredir(void);
+extern void o_and(void);
+extern void o_append(void);
+extern void o_assign(memel *argp);
+extern void o_biff(memel *argp);
+extern void o_call(memel *argp);
+extern void o_chsign(void);
+extern void o_concat(void);
+extern void o_div(void);
+extern void o_doend(void);
+extern void o_divassign(memel *argp);
+extern void o_catassign(memel *argp);
+extern void o_eq(void);
+extern void o_exec(void);
+extern void o_ge(void);
+extern void o_dogoto(memel *argp);
+extern void o_gt(void);
+extern void o_indirabsset(memel *argp);
+extern void o_indirposset(memel *argp);
+extern void o_indxincr(memel *argp);
+extern void o_inspect(memel *argp);
+extern void o_intrinsic(memel *argp);
+extern void o_le(void);
+extern void o_lt(void);
+extern void o_mul(void);
+extern void o_mulassign(memel *argp);
+extern void o_ne(void);
+extern void o_not(void);
+extern void o_or(void);
+extern void o_osesc(memel *argp);
+extern void o_posargset(memel *argp);
+extern void o_dopow(void);
+extern void o_doprint(void);
+extern void o_immed(void);
+extern void o_pushconst(memel *argp);
+extern void o_pushindex(int *mode);
+extern void o_pushparam(memel *argp);
+extern void o_redir(void);
+extern void o_redirin(void);
+extern void o_gsredir(memel *argp);
+extern void o_doaddpipe(memel *argp);
+extern void o_dogetpipe(memel *argp);
+extern void o_rmpipes(memel *argp);
+extern void o_doreturn(void);
+extern void o_doscan(void);
+extern void o_doscanf(void);
+extern void o_dofscan(void);
+extern void o_dofscanf(void);
+extern void o_sub(void);
+extern void o_subassign(memel *argp);
+extern void o_doswitch(int *jmpdelta);
+extern void o_swoff(memel *argp);
+extern void o_swon(memel *argp);
+extern void o_fixlanguage(void);
+/* operand.c */
+extern void sprop(register char *outstr, register struct operand *op);
+extern void spparval(char *outstr, struct param *pp);
+extern void fprop(struct _iobuf *fp, struct operand *op);
+extern void oprop(struct operand *op);
+extern void prop(struct operand *op);
+extern void opindir(void);
+extern void opcast(int newtype);
+extern struct operand makeop(char *str, int type);
+/* param.c */
+extern struct param *paramfind(struct pfile *pfp, char *pname, int pos, int exact);
+extern void paramset(register struct param *pp, int field);
+extern void validparamget(register struct param *pp, int field);
+extern void paramget(register struct param *pp, int field);
+extern void makemode(struct param *pp, char *s);
+extern struct param *newparam(struct pfile *pfp);
+extern struct param *paramsrch(char *pkname, char *ltname, char *pname);
+extern int defpar(char *param_spec);
+extern int defvar(char *envvar);
+extern struct param *lookup_param(char *pkname, char *ltname, char *pname);
+extern int printparam(struct param *pp, register struct _iobuf *fp);
+extern void qputs(register char *str, register struct _iobuf *fp);
+extern int pvaldefined(struct param *pp, char *s);
+extern struct param *newfakeparam(struct pfile *pfp, char *name, int pos, int type, int string_len);
+extern int getoffset(struct param *pp);
+extern void offsetmode(int mode);
+extern int size_array(struct param *pp);
+/* pfiles.c */
+extern struct pfile *newpfile(struct ltask *ltp);
+extern void pfileunlink(register struct pfile *pfp);
+extern struct pfile *pfilefind(register struct ltask *ltp);
+extern struct pfile *pfilesrch(char *pfilepath);
+extern struct pfile *pfileload(register struct ltask *ltp);
+extern int pfilemerge(struct pfile *npf, char *opfile);
+extern void pfileupdate(struct pfile *pfp);
+extern struct pfile *pfileread(struct ltask *ltp, char *pfilename, int checkmode);
+extern int pfilewrite(struct pfile *pfp, char *pfilename);
+extern int pfileinit(struct ltask *ltp);
+extern int is_pfilename(char *opstr);
+extern void mkpfilename(char *buf, char *dir, char *pkname, char *ltname, char *extn);
+extern long filetime(char *fname, char *timecode);
+extern struct pfile *pfilecopy(register struct pfile *pfp);
+extern void pfcopyback(struct pfile *pff);
+extern struct param *addparam(struct pfile *pfp, char *buf, struct _iobuf *fp);
+extern int ck_atoi(char *str, int *val);
+extern char *nextfield(char **pp, struct _iobuf *fp);
+extern char *makelower(register char *cp);
+extern int scanmode(char *s);
+extern int scantype(register char *s);
+/* prcache.c */
+extern int pr_connect(char *process, char *command, struct _iobuf **in, struct _iobuf **out, struct _iobuf *t_in, struct _iobuf *t_out, struct _iobuf *t_err, struct _iobuf *t_gr, struct _iobuf *t_im, struct _iobuf *t_pl, int timeit);
+extern void pr_disconnect(int pid);
+extern int pr_pconnect(char *process, struct _iobuf **in, struct _iobuf **out);
+extern void pr_setcache(int new_szprcache);
+extern int pr_cachetask(char *ltname);
+extern void pr_lock(register int pid);
+extern int pr_unlock(register int pid);
+extern void pr_listcache(struct _iobuf *fp);
+extern void pr_dumpcache(int pid, int break_locks);
+extern void pr_prunecache(int pno);
+extern int pr_getpno(void);
+extern int pr_pnametopid(char *pname);
+extern void pr_chdir(register int pid, char *newdir);
+extern void pr_envset(register int pid, char *envvar, char *valuestr);
+extern void pr_checkup(void);
+extern void pr_initcache(void);
+/* scan.c */
+extern void cl_scan(int nargs, char *source);
+extern void cl_scanf(char *format, int nargs, char *input);
+extern int get_nscanval(void);
+extern void lentst(char *buf);
+/* stack.c */
+extern void pushmem(memel v);
+extern memel popmem(void);
+extern void ppushmem(register memel p);
+extern struct operand pushop(struct operand *op);
+extern struct operand popop(void);
+extern struct task *pushtask(void);
+extern struct task *poptask(void);
+/* task.c */
+extern struct ltask *cmdsrch(char *pkname, char *ltname);
+extern struct ltask *ltasksrch(char *pkname, char *ltname);
+extern struct ltask *_ltasksrch(char *pkname, char *ltname, struct package **o_pkp);
+extern struct package *pacfind(char *name);
+extern int defpac(char *pkname);
+extern struct ltask *ltaskfind(struct package *pkp, char *name, int enable_abbreviations);
+extern int deftask(char *task_spec);
+extern void taskunwind(void);
+extern struct ltask *addltask(struct package *pkp, char *ptname, char *ltname, int redef);
+extern struct ltask *newltask(register struct package *pkp, char *lname, char *pname, struct ltask *oldltp);
+extern struct package *newpac(char *name, char *bin);
+/* unop.c */
+extern void unop(int opcode);
+extern void unexp(int opcode);
diff --git a/pkg/vocl/samp.c b/pkg/vocl/samp.c
new file mode 100644
index 00000000..5ff235b1
--- /dev/null
+++ b/pkg/vocl/samp.c
@@ -0,0 +1,667 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/**
+ *  SAMP.C -- Interface routines for the client and server side of the 
+ *  SAMP messaging commands.
+ */
+
+#include <string.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <unistd.h>
+#include <signal.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <readline/readline.h>		/* to install rl_event_hook	*/
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_prstat
+#define import_xwhen
+#include <iraf.h>
+
+#include "config.h"			/* CL declarations		*/
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "clsamp.h"
+
+
+/* To disable all messaging
+#define	SAMP_DISABLE	1
+*/
+
+
+XINT    samp            	= -1;   /* samp handle                  */
+
+pid_t	cl_pid			= 0;	/* local interface variables	*/
+int	samp_registered		= 0;
+int	samp_trace		= 0;
+int	samp_quiet		= 0;
+char    samp_cmd[SZ_CMDBLK];
+
+extern int     optbl[];
+extern char   *ifnames[];
+
+
+/**
+ *  MType Handler Declarations	
+ */
+int 	cl_genericHandler ();
+int 	cl_cmdExecHandler (char *cmd);
+int 	cl_envSetHandler (char *name, char *value);
+int 	cl_envGetHandler (char *name, char *value, int maxch);
+int 	cl_paramSetHandler (char *name, char *value);
+int 	cl_paramGetHandler (char *name, char *value, int maxch);
+int 	cl_pingHandler (char *sender);
+int 	cl_imgLoadHandler (char *url, char *imgId, char *name);
+int 	cl_tblLoadHandler (char *url, char *tblId, char *name);
+
+int 	cl_sampInit (void);
+int 	cl_sampStart (void);
+int 	cl_sampStop (void);
+
+void    sampio_handler (int signum);		/* I/O handlers		*/
+int	samp_rl_hook (void);
+
+
+Handler userHandlers[MAX_HANDLERS];     /* user-defined handlers        */
+int     numHandlers             = 0;    /* Num user-defined handlers    */
+
+
+extern	XINT	samp;				/* SAMP handle 		*/
+extern  pthread_mutex_t samp_mutex;		/* global data mutex	*/
+extern  int     rl_done;
+
+extern	char   *voGetStrArg ();
+
+
+
+
+/**
+ *  CL_SAMPINIT -- Initialize the SAMP interface.
+ */
+int
+cl_sampInit ()
+{
+    cl_pid = getpid ();				/* initialize		*/
+    memset (samp_cmd, 0, SZ_CMDBLK);	
+    memset (userHandlers, 0, (MAX_HANDLERS * sizeof(Handler)));
+
+#ifdef SAMP_DISABLE
+return 0;
+#endif
+
+    /*  Install a SIGIO handler so the samp handler can notify the main
+     *  CL thread of pending input from the samp clients.
+     */
+    signal (SIGIO, &sampio_handler);
+    rl_event_hook = samp_rl_hook;
+
+
+    /*  Initialize the SAMP interface.
+    */
+    samp = sampInit ("IRAF", "VO/IRAF v2.16 CL");
+
+    /*  Set up some local metadata values.
+     */
+    samp_Metadata (samp, "author.name",   "Mike Fitzpatrick, NOAO"); 
+    samp_Metadata (samp, "author.email",  "fitz@noao.edu"); 
+    samp_Metadata (samp, "samp.icon.url", 
+	"http://iraf.noao.edu/images/iraf-icon.gif");
+    samp_Metadata (samp, "samp.description.html", 
+	"http://iraf.noao.edu/voiraf/clsamp.html");
+
+
+    /*  Subscribe to various message types.
+     */
+    samp_Subscribe (samp, "samp.app.ping",        cl_pingHandler);
+    samp_Subscribe (samp, "samp.app.event.*",     NULL);
+    samp_Subscribe (samp, "samp.hub.event.*",     NULL);
+
+    samp_Subscribe (samp, "image.load.fits",      cl_imgLoadHandler);
+    samp_Subscribe (samp, "table.load.fits",      cl_tblLoadHandler);
+    samp_Subscribe (samp, "table.load.votable",   cl_tblLoadHandler);
+
+    samp_Subscribe (samp, "client.cmd.exec",      cl_cmdExecHandler);
+    samp_Subscribe (samp, "client.param.set",     cl_paramSetHandler);
+    samp_Subscribe (samp, "client.param.get",     cl_paramGetHandler);
+    samp_Subscribe (samp, "client.env.set",       cl_envSetHandler);
+    samp_Subscribe (samp, "client.env.get",       cl_envGetHandler);
+
+    return (0);
+}
+
+
+/**
+ *  CL_SAMPSTART -- Start up the samp messaging.
+ */
+int
+cl_sampStart (void)
+{
+#ifdef SAMP_DISABLE
+return 0;
+#endif
+
+    if (samp > 0) {
+	sampVerbose (samp, 0);
+        sampStartup (samp);
+	sampVerbose (samp, 1);
+        samp_registered = samp_hubActive (samp);
+    }
+
+    return (0);
+}
+
+
+/**
+ *  CL_SAMPSTOP - Stop SAMP communications, but we'll reinitialize the
+ *  the interface.
+ */
+int
+cl_sampStop ()
+{
+    samp_registered = 0;
+    if (samp >= 0) {
+ 	if (sampShutdown (samp) < 0)
+            cl_error (E_UERR, "Error shutting down SAMP messaging\n");
+	/* 
+	sampClose (samp);
+	cl_sampInit (); 
+	*/
+    }
+
+    return (0);
+}
+
+
+/*****************************************************************************/
+
+
+/* CL_SAMP -- SAMP master command.
+ *
+ *	samp [on|off|restart]			start/stop SAMP messaging
+ *	samp status
+ *
+ *	samp handler  [ <mtype> <cmd> ]
+ *	samp access   [ <appName> ]
+ *	samp meta     [ <param> <value> ]
+ *	samp trace    [ <state> ]
+ *
+ *	samp send         <mtype> [<arg>] ...
+ *	samp exec         <cmd>
+ *	samp setparam     <param> <val>
+ *	samp getparam     <param>
+ *	samp setenv       <envvar> <val>
+ *	samp getenv       <envvar>
+ *
+ *	samp loadImage    <file>|<url> [id] [name]
+ *	samp loadVOTable  <file>|<url> [id] [name]
+ *	samp loadFITS     <file>|<url> [id] [name]
+ *	samp pointAt      <ra> <dec>
+ *	samp showRow	  <tblId> <url> <row>
+ *	samp selectRow    <tblId> <url> <row>,<row>,....
+ */
+void
+cl_Samp (void)
+{
+    register struct pfile *pfp;
+    char  *cmd = NULL;
+    int    numargs = 0;
+    extern int nargs ();
+
+#ifdef SAMP_DISABLE
+return;
+#endif
+
+    pfp = newtask->t_pfp;
+    numargs = nargs (pfp);
+
+
+    if (numargs > 0) {
+        pushbparams (pfp->pf_pp);
+
+        popop();                        /* discard the $1       	    */
+        cmd = voGetStrArg ();		/* first arg is the subcommand	    */
+
+
+	if (samp_trace)
+	    fprintf (stderr, "cl_Samp: numargs=%d  samp=%d  cmd='%s'\n", 
+		numargs, samp, cmd);
+
+	    
+	/*  If the samp interface isn't enabled, and we want something more
+	 *  than the status, start the samp interface.
+	 */
+	if (!samp_registered && strncasecmp (cmd, "off", 3) == 0)
+	     return;
+	if (!samp_registered && 
+	    (strncasecmp (cmd, "status", 4) != 0 &&
+	     strncasecmp (cmd, "hubaccess", 7) != 0 &&
+	     strncasecmp (cmd, "quiet", 4) != 0 &&
+	     strncasecmp (cmd, "noquiet", 4) != 0 &&
+	     strncasecmp (cmd, "handler", 4) != 0 &&
+	     strncasecmp (cmd, "trace", 4) != 0)) {
+	    	cmd_sampStart ();
+
+		if (! samp_hubActive (samp)) {
+		    oprintf ("Error: Hub is not active.\n");
+		    return;
+		}
+	}
+
+
+	if (strncasecmp ("status", cmd, 4) == 0) {		/* STATUS     */
+            oprintf ("%s\n", ((samp >= 0 && samp_registered) ? "on" : "off"));
+
+	} else if (strncasecmp ("help", cmd, 4) == 0) {		/* HELP       */
+	    goto help_;
+
+	} else if (strncasecmp ("on", cmd, 2) == 0 || 		/* ON/START   */
+	    strncasecmp ("start", cmd, 5) == 0) {
+	        if (!samp_hubActive (samp))
+		    cmd_sampStart ();
+
+                oprintf ("%s\n", (samp_hubActive (samp) ? "on" : "off"));
+
+	} else if (strncasecmp ("off", cmd, 3) == 0 || 		/* OFF/STOP   */
+	    strncasecmp ("stop", cmd, 5) == 0) {
+	        if (samp_registered)
+	            cmd_sampStop ();
+                oprintf ("%s\n", (samp_hubActive (samp) ? "on" : "off"));
+
+	} else if (strncasecmp ("restart", cmd, 4) == 0) {	/* RESTART    */
+	    cmd_sampRestart ();
+	    if (samp_registered && !samp_quiet)
+                oprintf ("ok\n");
+
+	} else if (strncasecmp ("quiet", cmd, 5) == 0) {	/* QUIET      */
+	    samp_quiet = 1;
+	} else if (strncasecmp ("noquiet", cmd, 7) == 0) {	/* NOQUIET    */
+	    samp_quiet = 0;
+
+	} else if (strncasecmp ("hubaccess", cmd, 7) == 0) {	/* HUBACCESS  */
+            int res, verb = sampVerbose (samp, -1);
+	    sampVerbose (samp, 0);
+            res = samp_Ping (samp, "Hub");
+	    if (!samp_quiet)
+                oprintf ("%s\n", ((res > 0) ? "yes" : "no"));
+	    sampVerbose (samp, verb);
+
+	} else if (strncasecmp ("access", cmd, 4) == 0) {	/* ACCESS     */
+            int res = cmd_sampAccess(numargs - 1);
+	    if (numargs - 1 && !samp_quiet) 
+                oprintf ("%s\n", (res ? "yes" : "no"));
+
+	} else if (strncasecmp ("handler", cmd, 4) == 0) {	/* HANDLER    */
+ 	    int stat = cmd_sampAddHandler (numargs - 1);
+	    if (!samp_quiet && stat < 0)
+                oprintf ("err\n");
+
+	} else if (strncasecmp ("trace", cmd, 4) == 0) {	/* TRACE      */
+ 	    int stat = cmd_sampDbg (numargs - 1);
+	    if (!samp_quiet)
+                oprintf ("%s\n", (stat ? "on" : "off"));
+
+	} else if (strncasecmp ("name", cmd, 4) == 0) {		/* NAME       */
+	    if (cmd_sampName (numargs - 1) && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("meta", cmd, 4) == 0) {		/* META       */
+	    if (cmd_sampMetadata (numargs - 1) && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("send", cmd, 4) == 0) {		/* SEND       */
+	    if (cmd_sampSend (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("exec", cmd, 4) == 0) { 	/* EXEC       */
+	    if (cmd_sampExec (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("pointAt", cmd, 4) == 0) { 	/* POINTAT    */
+	    if (cmd_sampPointAt (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("setenv", cmd, 4) == 0) {	/* SETENV     */
+	    if (cmd_sampEnvSet (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("getenv", cmd, 4) == 0) {	/* GETENV     */
+	    char *val = cmd_sampEnvGet (numargs - 1);
+	    if (val && !samp_quiet)
+		oprintf ("%s\n", val);
+
+	} else if (strncasecmp ("setparam", cmd, 4) == 0) {	/* SETPARAM   */
+	    if (cmd_sampParamSet (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("getparam", cmd, 4) == 0) {	/* GETPARAM   */
+	    char *val = cmd_sampParamGet (numargs - 1);
+	    if (val && !samp_quiet)
+		oprintf ("%s\n", val);
+
+	} else if (strncasecmp ("showRow", cmd, 5) == 0) {	/* SHOWROW    */
+	    if (cmd_sampShowRow (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("loadImage", cmd, 6) == 0) {	/* IMAGE      */
+	    if (cmd_sampLoadImage (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("loadVOTable", cmd, 6) == 0) {	/* VOTABLE    */
+	    if (cmd_sampLoadVOTable (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("loadFITS", cmd, 6) == 0) {	/* FITS       */
+	    if (cmd_sampLoadFITS (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+
+	} else if (strncasecmp ("selectRows", cmd, 6) == 0) {	/* SELECT     */
+	    if (cmd_sampSelectRowList (numargs - 1) >= 0 && !samp_quiet)
+		oprintf ("ok\n");
+	} else {
+	    oprintf ("Unknown command '%s'\n", cmd);
+	}
+
+    } else {
+help_: 								/*  USAGE     */
+	oprintf ("Samp Command Help:\n\n"
+    	    "    samp status\n"
+    	    "    samp help\n"
+    	    "    samp on|start\n"
+    	    "    samp off|stop\n"
+    	    "    samp restart\n"
+    	    "    samp trace 		[<value>]\n"
+    	    "    samp access 	[<appName>]\n"
+    	    "    samp hubaccess\n"
+    	    "    samp quiet\n"
+    	    "    samp noquiet\n"
+    	    "    samp handler	[<mtype> <cmd>]\n"
+    	    "    samp meta		[<param> <value>]\n"
+	    "    \n"
+	    "    The following commands will be broadcast to all clients\n"
+	    "    unless an argument of the form 'to=<appName>' is present.\n"
+	    "    \n"
+    	    "    samp send		<mtype> [<args> ....]\n"
+    	    "    samp exec		<cmd>\n"
+    	    "    samp pointAt	<ra> <dec>\n"
+    	    "    samp setenv		<name> <value>\n"
+    	    "    samp getenv		<name>\n"
+    	    "    samp setparam	<name> <value>\n"
+    	    "    samp getparam	<name>\n"
+    	    "    samp loadImage	<url> [id=<id>] [name=<name>]\n"
+    	    "    samp loadVOTable	<url> [id=<id>] [name=<name>]\n"
+    	    "    samp loadFITS	<url> [id=<id>] [name=<name>]\n"
+    	    "    samp showRow	[<tblID>] [<url>] <row>\n"
+    	    "    samp selectRows	[<tblID>] [<url>] <row>,<row>,....\n"
+	    "    \n"
+	);
+    }
+}
+
+
+
+/*****************************************************************************
+ *  Utility procedures.
+ ****************************************************************************/
+
+/**
+ *  SAMPIO_HANDLER -- Signal handler for the SIGIO signal sent by the 
+ *  remote application.
+ */
+void
+sampio_handler (int signum)
+{
+    int  len = strlen (samp_cmd);
+
+    if (signum == SIGIO) {
+        if (len) {
+	    char  *ip, *op, buf[SZ_CMDBLK];
+
+	    /* Extract the first line for printing.
+	     */
+	    memset (buf, 0, SZ_CMDBLK);
+	    for (ip=samp_cmd, op=buf; *ip && *ip != '\n'; ip++, op++) {
+		*op = *ip;
+		if (*ip == '%') { 	    /* escape for printing	*/
+		    op++, *op = '%';
+		}
+	    }
+
+            oprintf (buf);		    /* write it to the cmdline 	*/
+            fflush (stdout);
+        }
+    }
+}
+
+
+/**
+ *  SAMP_RL_HOOK -- Event hook function for the readline() interface.  This
+ *  procedure is installed when we open the SAMP interface and is called
+ *  occassionally from readline(), allowing us to use alternate input for
+ *  the command line.
+ */
+int
+samp_rl_hook (void)
+{
+    /* rl_set_keyboard_input_timeout (333333); */
+    rl_done = (samp_cmd[0] ? 1 : 0);
+
+    return ( rl_done );
+}
+
+
+/**
+ *  GET_SAMP_COMMAND -- Get the next line from the SAMP command buffer.
+ */
+int
+get_samp_command (char *cmdbuf, int maxch)
+{
+    char *nl;
+    int   stat = 0;
+
+
+    memset (cmdbuf, 0, maxch);
+    strcpy (cmdbuf, samp_cmd);
+    nl = strchr (cmdbuf, (int)'\n');
+    if ( nl ) {
+	*nl = '\0';				/* kill the newline	    */
+
+	/*  cmdbuf now contains the next line of input.  Shift the rest
+	 *  of samp_cmd to the beginning of the array.
+	 */
+        memset (samp_cmd, 0, SZ_CMDBLK);
+        strcpy (samp_cmd, ++nl);
+	stat = 1;
+    } else
+        memset (samp_cmd, 0, SZ_CMDBLK);
+
+    return (stat);
+}
+
+
+
+/**
+ *  SAMPOP --  Process a SAMP request as a builtin CL function.
+ */
+int
+sampop (int opcode, int op_index, int nargs)
+{
+    int     op = optbl[op_index];	
+    int	    debug = 0;
+
+
+    if (debug)
+	printf ("sampop:  opcode=%d  index=%d  nargs=%d\n", 
+	    opcode, op_index, nargs);
+	
+
+    /*  If the samp interface isn't enabled, and we want something more
+     *  than the status, start the samp interface.
+     */
+    if (!samp_registered && 
+	opcode != OP_SAMP && opcode != OP_SAMPSTATUS &&
+	opcode != OP_SAMPHUBACC && opcode != OP_SAMPACCESS) {
+            cmd_sampStart ();
+
+	    if (! samp_hubActive (samp)) {
+		oprintf ("Error: Hub is not active.\n");
+		return 0;
+	    }
+	}
+
+
+    switch (opcode) {
+    case OP_SAMP: 	
+/*  FIXME
+	cl_Samp (); 
+*/
+	break;
+
+    case OP_SAMPSTATUS:
+	if (nargs > 1)
+            cl_error (E_UERR, "usage: sampStatus ([on|off|restart])");
+	else
+	    func_sampStatus (nargs);
+	break;
+
+    case OP_SAMPNAME:
+	if (nargs > 1)
+            cl_error (E_UERR, "usage: sampName ([name])");
+	else
+	    func_sampName (nargs);
+	break;
+
+    case OP_SAMPMETA:
+	if (nargs > 2)
+            cl_error (E_UERR, "usage: sampMeta ([[param [, value]]])");
+	else
+	    func_sampMetadata (nargs);
+	break;
+
+    case OP_SAMPHANDLER:              	/* add/print user handlers   	*/
+	if (nargs > 2)
+            cl_error (E_UERR, "usage: sampHandler ( [mtype, cmd])");
+	else
+	    func_sampAddHandler (nargs);
+	break;
+
+    case OP_SAMPHUBACC:              	/* check on a running Hub       */
+	if (nargs > 0)
+            cl_error (E_UERR, "usage: sampHubAccess ()");
+	else
+	    func_sampHubAccess (nargs);
+	break;
+
+    case OP_SAMPACCESS:              	/* check on an external app     */
+	if (nargs < 1 || nargs > 1)
+            cl_error (E_UERR, "usage: sampAccess (appName)");
+	else
+	    func_sampAccess (nargs);
+	break;
+
+    case OP_SAMPIMLOAD:               	/* image.load.fits              */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, 
+		"usage: sampLoadImage (file|url [, recip [, tag ] ])\n");
+	else
+	    func_sampLoadImage (nargs);
+	break;
+
+    case OP_SAMPTBLVOT:               	/* table.load.votable           */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, 
+		"usage: sampLoadImage (file|url [, recip [, tag ] ])\n");
+	else
+	    func_sampLoadVOTable (nargs);
+	break;
+
+    case OP_SAMPTBLFITS:              	/* table.load.fits              */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, 
+		"usage: sampLoadFITS (file|url [, recip [, tag ] ])\n");
+	else
+	    func_sampLoadFITS (nargs);
+	break;
+
+    case OP_SAMPTBLROW:               	/* table.highlight.row          */
+	if (nargs < 3)
+            cl_error (E_UERR, "usage: sampShowRow (tblId, url, row[, to])");
+	else
+	    func_sampShowRow (nargs);
+	break;
+    case OP_SAMPSELRLIST:             	/* table.select.rowList         */
+	if (nargs < 3)
+            cl_error (E_UERR, 
+		"usage: sampSelectRowList (tblId, url, rowlist[, to])");
+	else
+	    func_sampSelectRowList (nargs);
+	break;
+    case OP_SAMPPOINTAT:              	/* coord.pointAt.sky            */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, "usage: sampPointAt (ra, dec)");
+	else
+	    func_sampPointAt (nargs);
+	break;
+
+    case OP_SAMPCMDEXEC:              	/* client.cmd.exec              */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, "usage: sampCmdExec (cmd[, to])");
+	else
+	    func_sampCmdExec (nargs);
+	break;
+    case OP_SAMPENVGET:              	/* client.env.get               */
+	if (nargs < 1 || nargs > 2)
+            cl_error (E_UERR, "usage: sampEnvGet (param[, to])");
+	else
+	    func_sampEnvGet (nargs);
+	break;
+    case OP_SAMPENVSET:              	/* client.env.set               */
+	if (nargs < 2 || nargs > 3)
+            cl_error (E_UERR, "usage: sampEnvGet (param, val[, to])");
+	else
+	    func_sampEnvSet (nargs);
+	break;
+    case OP_SAMPPARAMGET:              	/* client.param.get             */
+	if (nargs < 1 || nargs > 2)
+            cl_error (E_UERR, "usage: sampParamGet (param[, to])");
+	else
+	    func_sampParamGet (nargs);
+	break;
+    case OP_SAMPPARAMSET:              	/* client.param.set             */
+	if (nargs < 2 || nargs > 3)
+            cl_error (E_UERR, "usage: sampParamGet (param, val[, to])");
+	else
+	    func_sampParamSet (nargs);
+	break;
+
+    case OP_SAMPSPECLOAD:              	/* spectrum.load.ssa-generic    */
+        cl_error (E_UERR, "specLoad: not yet implemented");
+	break;
+    case OP_SAMPRESLOAD:               	/* voresource.loadlist.*        */
+        cl_error (E_UERR, "specResourceLoad: not yet implemented");
+	break;
+    case OP_SAMPBIBLOAD:               	/* bibcode.load                 */
+	if (nargs < 1 || nargs > 2)
+            cl_error (E_UERR, "usage: sampBibcodeLoad (bibcode[, to])");
+	else
+	    func_sampBibcodeLoad (nargs);
+	break;
+
+    default:
+	/*  Should never get here .....
+	 */
+    	cl_error (E_IERR, e_badsw, op, "sampop has invalid intrfunc()");
+        break;
+    }
+
+    return (OK);
+}
diff --git a/pkg/vocl/sampCmd.c b/pkg/vocl/sampCmd.c
new file mode 100644
index 00000000..79d39e0d
--- /dev/null
+++ b/pkg/vocl/sampCmd.c
@@ -0,0 +1,973 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/**
+ *  SAMPCMD.C -- Procedures for the 'samp' user command.
+ */
+
+#include <string.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <signal.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <readline/readline.h>		/* to install rl_event_hook	*/
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"			/* CL declarations		*/
+#include "operand.h"
+#include "task.h"
+#include "errs.h"
+#include "param.h"
+#include "clsamp.h"
+
+
+extern pid_t   cl_pid;
+extern char    samp_cmd[SZ_CMDBLK];
+extern char   *ifnames[];
+extern Handler userHandlers[];
+extern int     numHandlers;
+extern int     samp_registered;
+extern int     optbl[];
+
+extern	XINT	samp;				/* SAMP handle 		*/
+extern  pthread_mutex_t samp_mutex;		/* global data mutex	*/
+
+extern	char   *voGetStrArg ();
+
+int 	cl_sampStart (void);
+int 	cl_sampStop (void);
+
+
+
+
+/*****************************************************************************/
+
+
+
+/* SAMPDBG -- Toggle the XML-RPC tracing flag.
+ */
+int
+cmd_sampDbg (int nargs)
+{
+    struct operand o;
+    static int sampDebug = 0;
+    extern int samp_trace;
+
+
+    if (nargs  > 0) {
+        popop();                            	/* discard the $1       */
+        o = popop();
+        if (o.o_type != OT_INT)
+            cl_error (E_UERR, "samp trace arg should be an integer");
+        sampDebug = o.o_val.v_i;
+
+    } else					/* toggle it		*/
+        sampDebug = (sampDebug+1) % 2;
+
+    unsetenv ("XMLRPC_TRACE_XML");
+    if (sampDebug) {
+	  setenv ("XMLRPC_TRACE_XML", "1", 1);
+    }
+    samp_trace = sampDebug;
+
+    return (sampDebug);
+}
+
+
+/* CMD_SAMPADDHANDLER -- Set (or print) the user-defined handlers.
+ */
+int
+cmd_sampAddHandler (int nargs)
+{
+    if (nargs > 0) {
+	static char m[SZ_LINE], c[SZ_LINE];
+        char  *mtype = m, *cmd = c, *arg1 = NULL, *arg2 = NULL;
+        int    i, res = -1;
+
+	memset (mtype, 0, SZ_LINE);
+	memset (cmd, 0, SZ_LINE);
+
+        popop();                            	/* discard the $1       */
+        arg1 = mtype = voGetStrArg ();
+	if (nargs > 1) {
+            popop();                            /* discard the $2       */
+            arg2 = cmd   = voGetStrArg ();
+	}
+
+	if (strncasecmp (arg1, "del", 3) == 0) {
+            /*  Delete the handler, return (0 = OK, -1 = Error)
+	     */
+            return ((res = cl_delUserHandler (arg2)));
+
+	} else {
+            /*  Add the handler, return (0 = OK, -1 = Error)
+	     */
+            return ((res = cl_addUserHandler (mtype, cmd)));
+	}
+
+    } else { 			/*  list currently defined handlers  	*/
+        int    i;
+
+	if (numHandlers == 0)
+	    oprintf ("No SAMP handlers defined\n");
+	else {
+	    for (i=0; i < numHandlers; i++)
+	        oprintf ("%-20.20s %s\n", 
+		    userHandlers[i].mtype, userHandlers[i].cmd);
+	}
+        return (0);				/* 0 = OK, -1 = Error	*/
+    }
+}
+
+
+/* CMD_SAMPDELHANDLER -- Delete a user-defined handler.
+ */
+int
+cmd_sampDelHandler (int nargs)
+{
+    if (nargs > 0) {
+	static char m[SZ_LINE];
+        char  *mtype = m;
+        int    res = -1;
+
+	memset (mtype, 0, SZ_LINE);
+
+        popop();                            	/* discard the $1       */
+        mtype = voGetStrArg ();
+
+        /*  Delete the handler.
+	 */
+        return ((res = cl_delUserHandler (mtype)));
+
+    } else { 			/*  list currently defined handlers  	*/
+	int  i;
+
+	for (i=0; i < numHandlers; i++) {
+            memset (userHandlers[i].mtype, 0, SZ_FNAME);
+            memset (userHandlers[i].cmd, 0, SZ_FNAME);
+	}
+	numHandlers = 0;
+
+        return (0);				/* 0 = OK, -1 = Error	*/
+    }
+}
+
+
+/* CMD_SAMPACCESS -- Require an external application to be registered.  We 
+ * don't attempt to start the application ourselves, we simply report on 
+ * whether it is currently available.
+ */
+int
+cmd_sampAccess (int nargs)
+{
+    char   *appName = NULL, *app = NULL;
+    int     i, found = 0, len = 0;
+
+
+    if (nargs > 0) {
+	extern XINT  samp;
+        XINT clients;
+	char   *pubId = NULL;
+	extern char *samp_getStringFromList(), *samp_app2id();
+
+        popop();                            	/* discard the $1       */
+        appName = voGetStrArg ();
+	if (strcasecmp ("hub", appName) == 0) 
+	    pubId = "hub";
+	else 
+	    pubId =  samp_app2id (samp, appName);
+
+	/*  Search the list for a matching appName
+	 */
+        clients = samp_GetRegisteredClients (samp);
+        for (i=0; i < samp_listLen (clients); i++) {
+	    app = samp_getStringFromList (clients, i);
+	    len = min (strlen (pubId), strlen (app));
+            if (strncasecmp (pubId, app, len) == 0) {
+		found = 1;
+		break;
+	    }
+	}
+        samp_freeList (clients);
+
+	if (appName)  
+	    free ((void *) appName);
+    } else 
+	samp_listClients (samp);
+
+    return (found);
+}
+
+
+/* CMD_SAMPNAME -- Set (or print) a current SAMP application name.
+ */
+int
+cmd_sampName (int nargs)
+{
+    char   *name = NULL;
+    extern  XINT  samp;
+
+
+    if (nargs > 0) {
+        popop();                            	/* discard the $1       */
+        name = voGetStrArg ();
+
+        samp_Metadata (samp, "samp.name", name);
+	samp_DeclareMetadata (samp);
+
+	if (name)  
+	    free ((void *) name);
+	return (1);
+
+    } else {			/*  list currently defined metadata  	*/
+	samp_printMetadata (samp, "samp.name");
+	oprintf ("\n");
+	return (0);
+    }
+}
+
+
+/* CMD_SAMPMETADATA -- Set (or print) a current SAMP metadata parameters.
+ */
+int
+cmd_sampMetadata (int nargs)
+{
+    char   *param = NULL, *value = NULL;
+    extern  XINT  samp;
+
+
+    if (nargs > 0) {
+        popop();                            	/* discard the $1       */
+        param = voGetStrArg ();
+        popop();                            	/* discard the $2       */
+        value   = voGetStrArg ();
+
+        samp_Metadata (samp, param, value);
+	samp_DeclareMetadata (samp);
+
+	if (param)  
+	    free ((void *) param);
+	if (value)  
+	    free ((void *) value);
+	return (1);
+
+    } else {			/*  list currently defined metadata  	*/
+	samp_printMetadata (samp, NULL);
+	return (0);
+    }
+}
+
+
+/* CMD_SAMPRESTART -- Restart the SAMP connection.
+ */
+void
+cmd_sampRestart (void)
+{
+    cmd_sampStop ();
+    cmd_sampStart ();
+}
+
+
+/* CMD_SAMPSTART -- Register with the SAMP Hub and begin messaging.
+ */
+void
+cmd_sampStart (void)
+{
+    extern XINT  samp;
+
+    if (samp >= 0 && !samp_registered)
+	cl_sampStart ();
+    else
+	cmd_sampRestart();			/*  disconnect and restart  */
+}
+
+
+/* CMD_SAMPSTOP -- UnRegister from the SAMP Hub and stop messaging.
+ */
+void
+cmd_sampStop (void)
+{
+    extern  XINT  samp;
+
+    if (samp >= 0 && samp_registered) {
+        samp_registered = 0;
+	cl_sampStop ();
+    }
+}
+
+
+/*  CMD_SAMPSEND -- Send a generic message.  The format of a message on the 
+ *  cmdline must be:
+ *
+ *	cl> sampSend <mtype> [to=<appName>] [<param>=<value> .....]
+ *
+ *  If there is no 'to' argument the message will be broadcast to all
+ *  recipients, otherwise this is expected to be the name of the receiving
+ *  application.  The mtype and parameters may correspond to well-known
+ *  message type, in which case this is a low-level interface to sending
+ *  those messages.  However, this method can also be used to send arbitrary
+ *  messages using private mtypes.
+ */
+#define	MAX_ARGS	32
+
+int
+cmd_sampSend (int nargs)
+{
+    char   *mtype = NULL, *to = "all", *nam = NULL, *val = NULL;
+    char   *args[MAX_ARGS];
+    int    i, stat = -1;
+    struct operand o;
+
+
+    if (nargs > 0) {
+	/*  Simple, first argument has to be the mtype.
+	 */
+        o = popop();                           	/* discard the $1           */
+        mtype = voGetStrArg ();
+
+	memset (args, 0, (MAX_ARGS * sizeof(char *)));
+	for (i=1; i < nargs; i++) {
+            o = popop();                       	/* param nam  or $N	    */
+	    nam = o.o_val.v_s;
+
+            o = popop();                       	/* param nam  or $N	    */
+            val = o.o_val.v_s;
+
+	    if (strcmp (nam, "to") == 0)
+		to = val;		/* special case for recipient       */
+	    else {
+		args[i-1] = calloc (1, SZ_LINE);;
+		sprintf (args[i-1], "%s=%s", nam, val);
+	    }
+	}
+
+	stat = samp_sendGeneric (samp, to, mtype, args);
+
+	for (i=0; i < (nargs - 1); i++)
+	    if (args[i]) 
+		free ((void *) args[i]);
+
+	if (stat < 0)				/* error return		 */
+            cl_error (E_UERR, samp_getErr (samp));
+
+    } else
+        cl_error (E_UERR, "sampSend: No message specified\n");
+
+    return (stat);
+}
+
+
+/*****************************************************************************
+ *  SAMP builtin function definitions.  These are client-side commands.
+ ****************************************************************************/
+
+/**
+ *  SAMP_LOADIMAGE -- Send a 'image.load.fits' message to other clients.
+ */
+
+int
+cmd_sampLoadImage (int nargs)
+{
+    char   to[SZ_LINE], url[SZ_LINE], name[SZ_LINE], id[SZ_LINE], *arg;
+    char   what[SZ_LINE], osfn[SZ_PATHNAME], *ip, *op;
+    int    i, stat = ERR;
+    struct operand o;
+    extern XINT samp;
+
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (url,  0, SZ_LINE);
+	memset (name, 0, SZ_LINE);
+	memset (id,   0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                      	/* discard the $N       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+		strcpy (to, arg);
+	    else if (strcmp (o.o_val.v_s, "id") == 0)
+		strcpy (id, arg);
+	    else if (strcmp (o.o_val.v_s, "name") == 0)
+		strcpy (name, arg);
+	    else
+		strcpy (what, arg);
+
+	    if (arg) free ((void *) arg);
+	}
+
+	/*  Convert logical paths (e.g. dev$foo.fits) to host file URIs.
+	 */
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+            strcpy (url, what);
+        } else {
+	    /* Need to construct a complete path name here.
+	     */
+            c_fpathname (what, osfn, SZ_PATHNAME);
+	    if ((ip = strchr (osfn, (int) '!'))) {
+		for (op = osfn, ip++; *ip; ) 	/* skip 'node!' prefix	*/
+		    *op++ = *ip++;
+		*op = '\0';
+	    }
+            sprintf (url, "file://%s", osfn);
+        }
+
+        stat = samp_imageLoadFITS (samp, to, url, id, name);
+	if (stat < 0)				/* error return		 */
+            cl_error (E_UERR, samp_getErr (samp));
+
+    } else
+        cl_error (E_UERR, "imageLoad: invalid number of arguments\n");
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_LOADFITS -- Send a 'table.load.fits' message to other clients.
+ */
+
+int
+cmd_sampLoadFITS (int nargs)
+{
+    char   to[SZ_LINE], url[SZ_LINE], name[SZ_LINE], id[SZ_LINE], *arg;
+    char   what[SZ_LINE], osfn[SZ_PATHNAME], *ip, *op;
+    int    i, stat = ERR;
+    struct operand o;
+    extern XINT samp;
+
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (url,  0, SZ_LINE);
+	memset (name, 0, SZ_LINE);
+	memset (id,   0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                      	/* discard the $N       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+		strcpy (to, arg);
+	    else if (strcmp (o.o_val.v_s, "id") == 0)
+		strcpy (id, arg);
+	    else if (strcmp (o.o_val.v_s, "name") == 0)
+		strcpy (name, arg);
+	    else
+		strcpy (what, arg);
+
+	    if (arg) free ((void *) arg);
+	}
+
+	/*  Convert logical paths (e.g. dev$foo.fits) to host file URIs.
+	 */
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+            strcpy (url, what);
+        } else {
+	    /* Need to construct a complete path name here.
+	     */
+            c_fpathname (what, osfn, SZ_PATHNAME);
+	    if ((ip = strchr (osfn, (int) '!'))) {
+		for (op = osfn, ip++; *ip; ) 	/* skip 'node!' prefix	*/
+		    *op++ = *ip++;
+		*op = '\0';
+	    }
+            sprintf (url, "file://%s", osfn);
+        }
+
+        stat = samp_tableLoadFITS (samp, to, url, id, name);
+	if (stat < 0)				/* error return		 */
+            cl_error (E_UERR, samp_getErr (samp));
+
+    } else
+        cl_error (E_UERR, "loadFITS: invalid number of arguments\n");
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_LOADVOTABLE -- Send a 'table.load.votable' message to other clients.
+ */
+
+int
+cmd_sampLoadVOTable (int nargs)
+{
+    char   to[SZ_LINE], url[SZ_LINE], name[SZ_LINE], id[SZ_LINE], *arg;
+    char   what[SZ_LINE], osfn[SZ_PATHNAME], *ip, *op;
+    int    i, stat = ERR;
+    struct operand o;
+    extern XINT samp;
+
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (url,  0, SZ_LINE);
+	memset (name, 0, SZ_LINE);
+	memset (id,   0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                      	/* discard the $N       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+		strcpy (to, arg);
+	    else if (strcmp (o.o_val.v_s, "id") == 0)
+		strcpy (id, arg);
+	    else if (strcmp (o.o_val.v_s, "name") == 0)
+		strcpy (name, arg);
+	    else
+		strcpy (what, arg);
+
+	    if (arg) free ((void *) arg);
+	}
+
+	/*  Convert logical paths (e.g. dev$foo.fits) to host file URIs.
+	 */
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+            strcpy (url, what);
+        } else {
+	    /* Need to construct a complete path name here.
+	     */
+            c_fpathname (what, osfn, SZ_PATHNAME);
+	    if ((ip = strchr (osfn, (int) '!'))) {
+		for (op = osfn, ip++; *ip; ) 	/* skip 'node!' prefix	*/
+		    *op++ = *ip++;
+		*op = '\0';
+	    }
+            sprintf (url, "file://%s", osfn);
+        }
+
+        stat = samp_tableLoadVOTable (samp, to, url, id, name);
+	if (stat < 0)				/* error return		 */
+            cl_error (E_UERR, samp_getErr (samp));
+
+    } else
+        cl_error (E_UERR, "loadVOTable: invalid number of arguments\n");
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_EXEC -- Send a 'client.cmd.exec' message to other clients.
+ *
+ *  Usage:   sampExec ()
+ *
+ *  Examples:
+ */
+
+int
+cmd_sampExec (int nargs)
+{
+    char   *nam=NULL, *val=NULL, cmd[SZ_CMDBLK], to[SZ_LINE];
+    int    i, stat = OK;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	for (i=0; i < nargs; i++) {
+            o = popop ();
+            val = voGetStrArg ();
+
+	    if (o.o_val.v_s[0] == '$')
+	        strcpy (cmd, val);
+	    else
+		strcpy (to, val);
+
+	    if (val) free ((void *) val);
+	}
+
+	stat = samp_cmdExec (samp, to, cmd);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampExec: no command specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_ENVSET -- Send a 'client.env.set' message to other clients.
+ *
+ *  Usage:   sampEnvSet ()
+ *
+ *  Examples:
+ */
+
+int
+cmd_sampEnvSet (int nargs)
+{
+    char   name[SZ_LINE], val[SZ_LINE], to[SZ_LINE], *arg = NULL;
+    int    i, stat = OK;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (name, 0, SZ_LINE);
+	memset (val, 0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                            /* discard the $1       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (name[0] == NULL)
+                strcpy (name, arg);
+	    else {
+		if (val[0]) 
+		    strcat (val, "\\ ");
+                strcat (val, arg);
+	    }
+
+	    if (arg)  free ((void *) arg);
+	}
+
+	if (!name[0] || !val[0]) {
+            cl_error (E_UERR, "sampEnvSet: no variable or value specified\n");
+	    stat = ERR;
+	} else 
+	    stat = samp_envSet (samp, to, name, val);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampEnvSet: no param or value specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_ENVGET -- Send a 'client.env.get' message to other clients.
+ *
+ *  Usage:   sampEnvGet ()
+ *
+ *  Examples:
+ */
+
+char *
+cmd_sampEnvGet (int nargs)
+{
+    char   name[SZ_LINE], to[SZ_LINE], *val = NULL, *arg = NULL;
+    int    i;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (name, 0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                            /* discard the $1       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (name[0] == NULL)
+                strcpy (name, arg);
+
+	    if (arg)  free ((void *) arg);
+	}
+
+	val = samp_envGet (samp, to, name);
+
+    } else 			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampEnvGet: no name specified\n");
+
+    return (val);
+}
+
+
+/**
+ *  SAMP_PARAMSET -- Send a 'client.param.set' message to other clients.
+ *
+ *  Usage:   sampParamSet ()
+ *
+ *  Examples:
+ */
+
+int
+cmd_sampParamSet (int nargs)
+{
+    char   name[SZ_LINE], val[SZ_LINE], to[SZ_LINE], *arg = NULL;
+    int    i, stat = OK;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (name, 0, SZ_LINE);
+	memset (val, 0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                            /* discard the $1       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (name[0] == NULL)
+                strcpy (name, arg);
+	    else {
+		if (val[0]) 
+		    strcat (val, "\\ ");
+                strcat (val, arg);
+	    }
+
+	    if (arg)  free ((void *) arg);
+	}
+
+	if (!name[0] || !val[0]) {
+            cl_error (E_UERR, "sampParamSet: no param or value specified\n");
+	    stat = ERR;
+	} else 
+	    stat = samp_paramSet (samp, to, name, val);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampParamSet: no param or value specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_PARAMGET -- Send a 'client.param.get' message to other clients.
+ *
+ *  Usage:   sampParamGet ()
+ *
+ *  Examples:
+ */
+
+char *
+cmd_sampParamGet (int nargs)
+{
+    char   name[SZ_LINE], to[SZ_LINE], *val = NULL, *arg = NULL;
+    int    i;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (name, 0, SZ_LINE);
+
+	for (i=0; i < nargs; i++) {
+            o = popop();                            /* discard the $1       */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (name[0] == NULL)
+                strcpy (name, arg);
+
+	    if (arg)  free ((void *) arg);
+	}
+
+	val = samp_paramGet (samp, to, name);
+
+    } else 			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampParamGet: no name specified\n");
+
+    return (val);
+}
+
+
+/**
+ *  SAMP_SHOWROW -- Send a 'table.highlight.row' message to other clients.
+ *
+ *  Usage:   sampShowRow ()
+ *
+ *  Examples:
+ */
+
+int
+cmd_sampShowRow (int nargs)
+{
+    char   tblid[SZ_LINE], url[SZ_LINE], to[SZ_LINE], *arg = NULL;
+    int    i, stat = OK, row = -1;
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (tblid, 0, SZ_LINE);
+	memset (url, 0, SZ_LINE);
+	for (i=0; i < nargs; i++) {
+            o = popop();                       /* discard the $1        */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (isdigit(arg[0]))
+		row = atoi (arg);
+	    else if (strstr (arg, "://"))		/* url		*/
+                strcpy (url, arg);
+	    else if (tblid[0] == NULL && url[0])
+                strcpy (tblid, arg);
+	    else
+                strcpy (url, arg);
+
+	    if (arg) free ((void *) arg);
+	}
+
+	stat = samp_tableHighlightRow (samp, to, tblid, url, row);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampShowRow: no command specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_SELECTROWLIST -- Send a 'table.select.rowList' message to other 
+ *  clients.
+ *
+ *  Usage:   sampSelectRowList ()
+ *
+ *  Examples:
+ */
+
+#define	MAX_ROWSELECT		1024
+
+int
+cmd_sampSelectRowList (int nargs)
+{
+    char   tblid[SZ_LINE], url[SZ_LINE], to[SZ_LINE], *arg = NULL;
+    int    i, nrows = 0, stat = OK, rows[MAX_ROWSELECT];
+    struct operand o;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	memset (tblid, 0, SZ_LINE);
+	memset (url, 0, SZ_LINE);
+	for (i=0; i < nargs; i++) {
+            o = popop();                       /* discard the $1        */
+            arg = voGetStrArg ();
+
+	    if (strcmp (o.o_val.v_s, "to") == 0)
+                strcpy (to, arg);
+	    else if (isdigit(arg[0])) {
+		/*  Need to decode array/range strings here.     -- FIXME --
+		 */
+		char *ip, *n;
+
+		for (ip=arg, n=arg, nrows=0; n; ip=n ) {
+		    if ( (n = strchr (ip, (int) ',')) )
+			*n++ = '\0';
+		    rows[nrows++] = atoi (ip);
+		}
+
+	    } else if (strstr (arg, "://"))		/* url		*/
+                strcpy (url, arg);
+	    else if (tblid[0] == NULL && url[0])
+                strcpy (tblid, arg);
+	    else
+                strcpy (url, arg);
+
+	    if (arg) free ((void *) arg);
+	}
+
+	stat = samp_tableSelectRowList (samp, to, tblid, url, rows, nrows);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampShowRow: no command specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+/**
+ *  SAMP_POINTAT -- Send a 'coords.pointAt.sky' message to other clients.
+ *
+ *  Usage:   sampPointAt ()
+ *
+ *  Examples:
+ *    samp pointat 187.5 33.4				# args in degrees
+ *    samp pointat (12:30:00 * 15) 33:24		# sexagesimal hms
+ *    samp pointat 187.5 33.4 to=aladin			# directed msg
+ *
+ */
+
+int
+cmd_sampPointAt (int nargs)
+{
+    char   *arg = NULL, to[SZ_LINE];
+    int    i, stat = OK;
+    float  ra=-1.0, dec=0.0;
+    extern XINT  samp;
+
+    if (nargs > 0) {
+        strcpy (to, "all");
+	for (i=0; i < nargs; i++) {
+            popop();                            /* discard the $N       */
+            arg = voGetStrArg ();
+
+	    if (isalpha ((int) arg[0]))		/* recipient arg	*/
+        	strcpy (to, arg);
+	    else if (ra < 0)			/* not initialized yts	*/
+	        ra = atof (arg);
+	    else
+	        dec = atof (arg);
+
+	    if (arg) free ((char *) arg);
+	}
+
+	stat = samp_coordPointAtSky (samp, to, ra, dec);
+
+    } else {			/*  list currently defined metadata  	*/
+        cl_error (E_UERR, "sampPointAt: no command specified\n");
+	stat = ERR;
+    }
+
+    return (stat);
+}
+
+
+
+
+/******************************************************************************
+ **
+ **  			    Not Yet Implemented
+ **
+ *****************************************************************************/
+/**
+ *  SAMP_SPECLOAD -- Send a 'spec.load.ssa-generic' message to other clients.
+ */
+
+int
+cmd_sampSpecLoad (int nargs)
+{
+    return (0);
+}
+
+
+/**
+ *  SAMP_BIBCODELOAD -- Send a 'bibcode.load' message to other clients.
+ */
+
+int
+cmd_sampBibcodeLoad (int nargs)
+{
+    return (0);
+}
+
diff --git a/pkg/vocl/sampDecl.h b/pkg/vocl/sampDecl.h
new file mode 100644
index 00000000..fdecf2cb
--- /dev/null
+++ b/pkg/vocl/sampDecl.h
@@ -0,0 +1,438 @@
+/**
+ *  SAMPDECL.H -- SAMP interface method declarations.
+ *
+ *  @brief      SAMP interface method declarations.
+ *
+ *  @file       sampDecl.h
+ *  @author     Mike FItzpatrick
+ *  @date       8/10/11
+ */
+
+
+
+typedef  XINT   handle_t;            	/** generic object handle 	    */
+typedef  int    Map;                    /** SAMP Map datatype 	    	    */
+typedef  int    List;                   /** SAMP List datatype 	    	    */
+typedef  int    Msg;                    /** SAMP Msg datatype 	    	    */
+typedef  int    Param;                  /** SAMP Param datatype 	    */
+typedef  char  *String;                 /** SAMP String datatype            */
+
+#define  SZ_NAME             256        /** size of a file path 	    */
+#define  SZ_LINE             256        /** size of a text line 	    */
+#define  SZ_SECRET           64         /** size of secret string 	    */
+#define  SZ_DESC             8192       /** len of a description 	    */
+#define  SZ_URL              1024       /** len of a URL 		    */
+#define  SZ_CMD              1024       /** len of a command 	    	    */
+
+#define  MAX_SAMPS           16         /** max clients allowed 	    */
+#define  MAX_HUBS            16         /** max hubs allowed 	    	    */
+#define  MAX_MDATTRS         32         /** max metadata attrs 	    	    */
+#define  MAX_SUBS            256        /** max subscriptions allowed       */
+#define  MAX_CLIENTS         32         /** max number of clients 	    */
+#define  MAX_ROWS            256        /** max rows to highlight  	    */
+
+
+/**
+ *  Application (and Hub) metadata.
+ */
+typedef struct {
+    char      name[SZ_LINE];		/** name			    */
+    char      desc[SZ_DESC];		/** descriptive text		    */
+    char      iconURL[SZ_URL];		/** icon URL			    */
+    char      docURL[SZ_URL];		/** documentation URL		    */
+
+    char     *descHTML;			/** descriptive text (HTML)	    */
+
+    int	      nkeys;			/** number of meta keys		    */
+    char     *aKey[MAX_MDATTRS];	/** attr keyword		    */
+    char     *aVal[MAX_MDATTRS];	/** attr value			    */
+} appMD, *appMDP;
+
+
+/**
+ *  Message subscription.
+ */
+typedef struct {
+    char  mtype[SZ_LINE];		/** mtype string		    */
+    int   (*userFunc)(void *p); 	/** user handler function           */
+					/** samp handler function           */
+    int   (*sampFunc)(char *sid, char *sender, char *msgid, Map map);       	
+} Subs, *SubsP;
+
+
+/**
+ *  Registered Client name mappings.
+ */
+typedef struct {
+    char  pubId[SZ_NAME];		/** public name			    */
+    char  name[SZ_NAME];		/** app name			    */
+} Client, *ClientP;
+
+ 
+/**
+ *  Hub description.  Our application connects to this hub by default, but
+ *  the structure will be valid for any Hub.
+ */
+typedef struct {
+    char      appName[SZ_LINE];		/** application name		    */
+    char      appVer[SZ_LINE];		/** application version		    */
+    char      description[SZ_LINE];	/** descriptive text		    */
+
+    appMD     meta;			/** metadata			    */
+
+    char      secret[SZ_SECRET];	/** registration string		    */
+    char      url[SZ_URL];		/** Hub service endpoint	    */
+    char      version[SZ_NAME];		/** Hub version string		    */
+
+    int	      id;			/** Hub XML-RPC connection	    */
+
+    char      appId[SZ_NAME];		/** client key			    */
+    char      privateKey[SZ_LINE];	/** client key value		    */
+    char      hubId[SZ_LINE];		/** Hub id value		    */
+    char      selfId[SZ_LINE];		/** Client id value		    */
+    char      timeout[SZ_NAME];		/** Sync msg timeout (str)	    */
+
+    void     *samp;			/** back pointer		    */
+} Hub, *HubP;
+
+
+/**
+ *  SAMP application description.  By default this describes our app by
+ *  may be used to store information about other apps in the network as
+ *  well.
+ */
+typedef struct {
+    char      appName[SZ_NAME];		/** application name		    */
+    char      appVer[SZ_LINE];		/** application version		    */
+    char      description[SZ_NAME];	/** application description	    */
+
+    char      errortxt[SZ_LINE];	/** last msh error string	    */
+
+    appMD     meta;			/** metadata			    */
+
+    pthread_t svrThread;		/** server thread number	    */
+
+					/** default user handler	    */
+    int   (*defaultUserFunc)(char *sender, char *msgid, Map map);       	
+
+    Subs      subs[MAX_SUBS];		/** message subscriptions	    */
+    int	      nsubs;			/** number of subscriptions	    */
+
+    Client    clients[MAX_CLIENTS];	/** samp clients		    */
+    int	      nclients;			/** number of samp clients	    */
+
+    int	      serverTid;		/** samp server threadId	    */
+    int	      serverPort;		/** samp server port		    */
+
+    Hub      *hub;			/** Hub connection 		    */
+    handle_t  hubHandle;		/** Hub handle alias 		    */
+    int       hubThreadID;		/** Hub thread id 		    */
+
+    int	      active;			/** is interface active		    */
+    int	      msgMode;			/** (a)synch message mode	    */
+    int	      handlerMode;		/** CBR / CBV for user handlers     */
+
+    FILE     *logfd;			/** log file descriptor		    */
+    int	      debug;			/** debug flag			    */
+    int	      trace;			/** trace flag			    */
+} Samp, *SampP;
+
+
+#define MSG_SYNC	0
+#define MSG_ASYNC	1
+#define MSG_NOTIFY	2
+#define DEF_CALLMODE	MSG_ASYNC
+
+
+
+/**
+ *   Prototype declarations.
+ */
+
+/******************************************************************************
+ **  Public Interface Methods
+ *****************************************************************************/
+
+/*  samp.c -- Methods called by user apps to initialize the interface.
+ */
+handle_t  sampInit (String appName, String description);
+void 	  samp_Metadata (handle_t handle, String field, String value);
+void 	  samp_Subscribe (handle_t handle, String mtype, void *func);
+void 	  samp_Unsubscribe (handle_t handle, String mtype);
+int  	  sampStartup (handle_t handle);
+int  	  sampShutdown (handle_t handle);
+void 	  sampClose (handle_t handle);
+
+void 	  samp_setSyncMode (handle_t handle);
+void 	  samp_setASyncMode (handle_t handle);
+void 	  samp_setNotifyMode (handle_t handle);
+void 	  samp_setCallByRef (handle_t handle);
+void 	  samp_setCallMode (handle_t handle, int mode);
+
+void 	  samp_setReplyCallback (handle_t handle, int *func);
+void 	  samp_setResponseCallback (handle_t handle, int *func);
+void      samp_setTimeout (handle_t handle, int timeout);
+void      samp_setAppName (handle_t handle, String name);
+void      samp_setAppVersion (handle_t handle, String version);
+
+void 	  samp_defaultReplyHandler (handle_t handle);
+void 	  samp_deaultfResponseHandler (handle_t handle);
+int 	  samp_replyStatus (handle_t handle);
+
+int  	  samp_mapClients (handle_t handle);
+int  	  samp_listClients (handle_t handle);
+int  	  samp_addClient (handle_t handle, String name, String id);
+int  	  samp_removeClient (handle_t handle, String id);
+
+Map	  samp_getOKMap (void);
+Map	  samp_getNullMap (void);
+
+
+/*  sampCommands.c -- Methods called to send messages to the Hub.
+ */
+int 	samp_Register (handle_t handle);
+int 	samp_UnRegister (handle_t handle);
+int 	samp_DeclareMetadata (handle_t handle);
+int 	samp_Ping (handle_t handle, String appName);
+Map 	samp_GetMetadata (handle_t handle, String pubId);
+int 	samp_DeclareSubscriptions (handle_t handle);
+Map     samp_GetSubscriptions (handle_t handle, String pubId);
+List 	samp_GetRegisteredClients (handle_t handle);
+List 	samp_GetSubscribedClients (handle_t handle, String mtype);
+
+
+/*  sampMType.c -- Methods called to send messages to other apps.
+ */
+int 	samp_tableLoadVOTable (handle_t handle, String recip, String url, 
+		String tableId, String name);
+int 	samp_tableLoadFITS (handle_t handle, String recip, String url, 
+		String tableId, String name);
+int 	samp_imageLoadFITS (handle_t handle, String recip, String url, 
+		String imageId, String name);
+
+int 	samp_tableHighlightRow (handle_t handle, String recip, String tableId, 
+		String url, int row);
+int 	samp_tableSelectRowList (handle_t handle, String recip, String tableId, 
+		String url, int rows[], int nrows);
+int 	samp_coordPointAtSky (handle_t handle, String recip, 
+		float ra, float dec);
+int 	samp_specLoadSSAGeneric (handle_t handle, String recip, String url, 
+		Map meta, String spectrumId, String name);
+
+int     samp_cmdExec (handle_t handle, String recip, String cmd);
+char   *samp_envGet (handle_t handle, String recip, String name);
+int 	samp_envSet (handle_t handle, String recip, String name, String value);
+char   *samp_paramGet (handle_t handle, String recip, String name);
+int 	samp_paramSet(handle_t handle, String recip, String name, String value);
+int 	samp_bibLoad (handle_t handle, String recip, String bibcode);
+int 	samp_resourceLoad (handle_t handle, String recip, String type, 
+		String name, Map resMap);
+
+int 	samp_sendGeneric (handle_t handle, String recip, String mtype, 
+		String args[]);
+int 	samp_sendMsg (handle_t handle, String recip, Map msg);
+
+
+
+/*  sampClient.c -- Low-level methods to send messages.
+ */
+void    samp_notify (handle_t handle, String recipId, Map msg);
+List    samp_notifyAll (handle_t handle, Map msg);
+String  samp_call (handle_t handle, String recipId, String tag, Map msg);
+int     samp_callAll (handle_t handle, String msg_tag, Map msg);
+int     samp_callAndWait (handle_t handle, String recipId, String msg_tag, 
+				Map msg);
+int  	samp_Reply (handle_t handle, String msg_id, Map resp);
+
+String 	samp_clientName (handle_t handle, String pubId);
+int	samp_setErr (handle_t handle, Map resp);
+String  samp_getErr (handle_t handle);
+
+
+/*  sampMethods.c -- SAMP methods implemented by a callable client.
+ */
+int 	samp_receiveCall (void *data);
+int 	samp_receiveNotification (void *data);
+int 	samp_receiveResponse (void *data);
+
+
+/*  sampHandlers.c -- Handlers to responses from the message.
+ */
+void 	samp_setUserHandler (handle_t handle, String mtype, void *func);
+void 	samp_setSampHandler (handle_t handle, String mtype, void *func);
+void   *samp_getUserHandler (String mtype);
+void   *samp_getSampHandler (String mtype);
+void    samp_execUserHandler (String mtype, String sender, 
+		String msg_id, Map params);
+
+int     samp_genericMsgHandler (String sender, String mtype, String msg_id, 
+		Map msg_map);
+
+int 	samp_PingHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_StatusHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+
+int 	samp_imLoadHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_tbLoadHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_tbLoadFITSHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_tbLoadVOTHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_specLoadHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_specSSAHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+
+int 	samp_tbHighlightHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_tbSelectHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_pointAtHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_bibcodeHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+
+int 	samp_cmdExecHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_envGetHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_envSetHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_paramGetHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int 	samp_paramSetHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+
+int 	samp_resLoadHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_resConeHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_resSiapHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_resSsapHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_resTapHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+int     samp_resVOSpaceHandler (String sender, String mtype, String msg_id,
+		Map msg_map);
+
+void    samp_printMessage (String mtype, String sender, String msg_id, 
+		Map params);
+
+void    samp_printMap (String name, Map map);
+int 	samp_nullResponse (void *data);
+int 	samp_testEcho (void *data);
+
+
+
+/******************************************************************************
+ **  Internal Interface Methods
+ *****************************************************************************/
+
+/*  sampHub.c
+ */
+handle_t  samp_hubOpen (Samp *samp);
+int 	  samp_hubClose (handle_t handle);
+List 	  samp_getAvailableHubs (handle_t handle);
+char     *samp_getActiveHubName (handle_t handle);
+int 	  samp_getActiveHub (handle_t handle);
+int 	  samp_hubInit (handle_t samp, char *appName, char *descr);
+
+int	  samp_processHubEvent (String mtype, Map params);
+int	  samp_hubEvent (String mtype);
+
+int 	  samp_hubRegister (Hub *hub);
+int 	  samp_hubUnRegister (Hub *hub);
+int 	  samp_hubSendShutdown (Hub *hub);
+int	  samp_hubSetXmlrpcCallback (Hub *hub);
+int 	  samp_hubPing (Hub *hub);
+int 	  samp_hubDeclareMetadata (Hub *hub);
+int 	  samp_hubDeclareSubscriptions (Hub *hub);
+
+
+/* sampList.c
+*/
+handle_t  samp_newList ();
+void 	  samp_freeList (List list);
+int 	  samp_listLen (List list);
+
+void 	  samp_setStringInList (List list, char *value);
+void 	  samp_setMapInList (List list, Map map);
+void 	  samp_setListInList (List list1, List list2);
+void 	  samp_setIntInList (List list, int value);
+void 	  samp_setFloatInList (List list, float value);
+
+char     *samp_getStringFromList (List list, int index);
+Map 	  samp_getMapFromList (List list, int index);
+List 	  samp_getListFromList (List list, int index);
+int 	  samp_getIntFromList (List list, int index);
+float 	  samp_getFloatFromList (List list, int index);
+
+
+/* sampMap.c
+*/
+handle_t  samp_newMap (void);
+void 	  samp_freeMap (Map map);
+
+int       samp_getMapSize (Map map);
+char     *samp_getMapKey (Map map, int index);
+char     *samp_getMapVal (Map map, int index);
+
+void 	  samp_setStringInMap (Map map, char *key, char *value);
+void 	  samp_setMapInMap (Map map1, char *key, Map map2);
+void 	  samp_setListInMap (Map map, char *key, List list);
+void 	  samp_setIntInMap (Map map, char *key, int value);
+void 	  samp_setFloatInMap (Map map, char *key, float value);
+
+char     *samp_getStringFromMap (Map map, char *key);
+Map 	  samp_getMapFromMap (Map map, char *key);
+List 	  samp_getListFromMap (Map map, char *key);
+int 	  samp_getIntFromMap (Map map, char *key);
+float 	  samp_getFloatFromMap (Map map, char *key);
+
+
+/* sampMsg.c
+ */
+Msg 	  samp_newMsg (void);
+void 	  samp_freeMsg (Msg msg);
+void 	  samp_msgMType (Msg msg, String mtype);
+void 	  samp_msgParam (Msg msg, Param param);
+char     *samp_msgTag (void);
+
+
+/* sampParam.c
+ */
+Param 	  samp_newParam (void);
+void 	  samp_freeParam (Param param);
+Param 	  samp_paramInit (Msg msg);
+void 	  samp_addStringParam (Msg msg, char *keyw, String val);
+void 	  samp_addMapParam (Msg msg, char *keyw, Map val);
+void 	  samp_addListParam (Msg msg, char *keyw, List val);
+void 	  samp_addIntParam (Msg msg, char *keyw, int val);
+void 	  samp_addFloatParam (Msg msg, char *keyw, float val);
+int 	  samp_paramLen (Msg msg);
+
+
+/* sampLog.c
+*/
+void 	  sampLog (handle_t handle, char *format, ...);
+void 	  sampTrace (handle_t handle, char *format, ...);
+
+
+/*  sampUtil.c
+ */
+handle_t  samp_newHandle (void *ptr);
+void 	  samp_freeHandle (handle_t handle);
+
+handle_t  samp_P2H (void *ptr);
+void     *samp_H2P (handle_t handle); 
+
+char     *samp_app2id (handle_t handle, char *appName);
+char     *samp_id2app (handle_t handle, char *pubId);
+
+int	  samp_serverPort (void);
+void	  samp_printMetadata (handle_t handle, char *name);
+char	 *samp_getMetadata (handle_t handle, char *name);
diff --git a/pkg/vocl/sampFuncs.c b/pkg/vocl/sampFuncs.c
new file mode 100644
index 00000000..0823d5d0
--- /dev/null
+++ b/pkg/vocl/sampFuncs.c
@@ -0,0 +1,1186 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/**
+ *  SAMP.C -- Interface routines for the client and server side of the 
+ *  SAMP messaging commands.
+ */
+
+#include <string.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <readline/readline.h>		/* to install rl_event_hook	*/
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_prstat
+#define import_xwhen
+#include <iraf.h>
+
+#include "config.h"			/* CL declarations		*/
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "clsamp.h"
+
+
+extern pid_t cl_pid;
+extern int   samp_registered;
+extern char  samp_cmd[SZ_CMDBLK];
+
+extern int   optbl[];
+extern char *ifnames[];
+
+extern Handler userHandlers[];
+extern int     numHandlers;
+
+extern	XINT	samp;				/* SAMP handle 		*/
+extern  pthread_mutex_t samp_mutex;		/* global data mutex	*/
+
+extern	char   *voGetStrArg ();
+
+
+
+
+/*****************************************************************************/
+
+
+
+/* SAMPDBG -- Toggle the XML-RPC tracing flag.
+ *
+ * Usage:   cl> =sampDbg (ival)			# explicitly set debug value
+ *          cl> =sampDbg ()			# toggle debug value
+ */
+void
+func_sampDbg (void)
+{
+    register struct pfile *pfp;
+    struct operand o;
+    static int sampDebug = 0;
+    extern int nargs();
+
+
+    pfp = newtask->t_pfp;
+    if (nargs (pfp) > 0) {
+        pushbparams (pfp->pf_pp);
+        popop();                            	/* discard the $1       */
+        o = popop();
+        if (o.o_type != OT_INT)
+            cl_error (E_UERR, "samp trace arg should be an integer");
+        sampDebug = o.o_val.v_i;
+
+    } else					/* toggle it		*/
+        sampDebug = (sampDebug+1) % 2;
+
+    unsetenv ("XMLRPC_TRACE_XML");
+    if (sampDebug)
+	  setenv ("XMLRPC_TRACE_XML", "1", 1);
+
+    o.o_type = OT_BOOL;
+    o.o_val.v_i = sampDebug;
+    pushop (&o);
+}
+
+
+/* SAMPSTATUS -- Print or set the status of the samp interface.
+ */
+void
+func_sampStatus (int nargs)
+{
+    char   *arg = NULL;
+    int     i, stat = samp_registered, len = 0;
+    struct  operand o;
+
+
+    if (nargs > 0) {
+
+        arg = voGetStrArg ();
+
+	if (strcasecmp ("on", arg) == 0 || 
+	    strcasecmp ("start", arg) == 0) {
+                if (!samp_hubActive (samp))
+                    cmd_sampStart ();
+                if (samp_registered && samp_hubActive (samp))
+                    stat = 1;
+
+	} else if (strcasecmp ("off", arg) == 0 || 
+	    strcasecmp ("stop", arg) == 0) {
+                if (samp_registered)
+                    cmd_sampStop ();
+		stat = samp_registered;
+
+	} else if (strcasecmp ("restart", arg) == 0) {
+	    cmd_sampRestart ();
+	    stat = samp_registered;
+	}
+
+	if (arg)  free ((void *) arg);
+    }
+
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat ? "on" : "off");
+    pushop (&o);
+}
+
+
+/* SAMPHUBACCESS -- Check to see if a Hub is running and available.
+ */
+void
+func_sampHubAccess (int nargs)
+{
+    struct  operand o;
+    int     found = 0, verb;
+    char   *home = envget ("HOME");
+    char   path[SZ_LINE];
+
+    if (samp >= 0) {
+        verb = sampVerbose (samp, -1);
+        sampVerbose (samp, 0);
+	memset (path, 0, SZ_LINE);
+	sprintf (path, "%s/.samp", home);
+	found = (c_access (path, 0, 0) == YES);
+        sampVerbose (samp, verb);
+    }
+
+    o.o_type = OT_BOOL;
+    o.o_val.v_i = found;
+    pushop (&o);
+}
+
+
+/* SAMPACCESS -- Require an external application to be registered.  We don't
+ * attempt to start the application ourselves, we simply report on whether
+ * it is currently available.
+ */
+void
+func_sampAccess (int nargs)
+{
+    char   *appName = NULL, *app = NULL;
+    int     i, found = 0, len = 0;
+    struct  operand o;
+
+    if (nargs > 0) {
+        XINT clients;
+	char   *pubId = NULL;
+	extern char *samp_getStringFromList(), *samp_app2id();
+
+        appName = voGetStrArg ();
+	if (strcasecmp ("hub", appName) == 0) 
+	    pubId = "hub";
+	else 
+	    pubId =  samp_app2id (samp, appName);
+
+	/*  Search the list for a matching appName
+	 */
+        clients = samp_GetRegisteredClients (samp);
+        for (i=0; i < samp_listLen (clients); i++) {
+	    app = samp_getStringFromList (clients, i);
+	    len = min (strlen (pubId), strlen (app));
+            if (strncasecmp (pubId, app, len) == 0) {
+		found = 1;
+		break;
+	    }
+	}
+        samp_freeList (clients);
+
+    } else 
+        cl_error (E_UERR, "Application name must be specifified");
+
+    o.o_type = OT_BOOL;
+    o.o_val.v_i = found;
+    pushop (&o);
+}
+
+
+/* SAMPNAME -- Set (or print) a current SAMP application name.
+ */
+void
+func_sampName (int nargs)
+{
+    char   *name = NULL, res[SZ_LINE];
+    struct operand o;
+
+    if (nargs == 1) {
+        name  = voGetStrArg ();
+
+        samp_Metadata (samp, "samp.name", name);
+	samp_DeclareMetadata (samp);
+
+        /* Push the result operand on the stack.
+         */
+	strcpy (res, name);
+        o.o_type = OT_STRING;
+        o.o_val.v_s = res;
+        pushop (&o);
+
+	if (name)  free ((void *) name);
+
+    } else if (nargs == 0) {	/*  list currently defined metadata  	*/
+	extern  XINT  samp;
+	char  *v = NULL;
+
+        /* Push the result operand on the stack.
+         */
+        v = samp_getMetadata(samp, "samp.name");
+        o.o_type = OT_STRING;
+        o.o_val.v_s = v;
+        pushop (&o);
+
+    } else
+        cl_error (E_UERR, "usage: sampName ([name])");
+}
+
+
+/* SAMPMETADATA -- Set (or print) a current SAMP metadata parameters.
+ */
+void
+func_sampMetadata (int nargs)
+{
+    char   *param = NULL, *value = NULL;
+    struct operand o;
+
+    if (nargs == 2) {
+        value  = voGetStrArg ();	/* ars on stack in reverse order */
+        param  = voGetStrArg ();
+
+        samp_Metadata (samp, param, value);
+	samp_DeclareMetadata (samp);
+
+	if (param)  free ((void *) param);
+	if (value)  free ((void *) value);
+
+        /* Push the result operand on the stack.
+         */
+        o.o_type = OT_STRING;
+        o.o_val.v_s = "ok";
+        pushop (&o);
+
+    } else if (nargs == 1) {	/*  list currently defined metadata  	*/
+        param  = voGetStrArg ();
+	samp_printMetadata (samp, param);
+
+    } else
+        cl_error (E_UERR, "usage: sampMetadata ([ [name], [value] ])");
+}
+
+
+/* CL_SAMPRESTART -- Restart the SAMP connection.
+ */
+void
+func_sampRestart (void)
+{
+    cmd_sampStop ();
+    cmd_sampStart ();
+}
+
+
+/* SAMPSTART -- Register with the SAMP Hub and begin messaging.
+ */
+void
+func_sampStart (void)
+{
+    if (!samp_registered) {
+        cmd_sampStart ();
+        samp_registered = 1;
+    } else
+	cmd_sampRestart();			/*  disconnect and restart  */
+}
+
+
+/* SAMPSTOP -- UnRegister from the SAMP Hub and stop messaging.
+ */
+void
+func_sampStop (void)
+{
+    if (samp_registered) {
+        samp_registered = 0;
+	cmd_sampStop ();
+    }
+}
+
+
+/*  SAMPSEND -- Send a generic message.  The format of a message on the 
+ *  cmdline must be:
+ *
+ *	cl> sampSend <mtype> [to=<appName>] [<param>=<value> .....]
+ *
+ *  If there is no 'to' argument the message will be broadcast to all
+ *  recipients, otherwise this is expected to be the name of the receiving
+ *  application.  The mtype and parameters may correspond to well-known
+ *  message type, in which case this is a low-level interface to sending
+ *  those messages.  However, this method can also be used to send arbitrary
+ *  messages using private mtypes.
+ */
+#define	MAX_ARGS	32
+
+void
+func_sampSend (void)
+{
+    register struct pfile *pfp;
+    char   *mtype = NULL, *to = "all", *nam = NULL, *val = NULL;
+    char   *args[MAX_ARGS];
+    int    i, stat, numArgs;
+    struct operand o;
+    extern int nargs();
+
+
+    pfp = newtask->t_pfp;
+    numArgs = nargs (pfp);
+    if (numArgs > 0) {
+        pushbparams (pfp->pf_pp);
+
+	/*  Simple, first argument has to be the mtype.
+	 */
+        o = popop();                           	/* discard the $1       */
+        mtype = voGetStrArg ();
+
+	memset (args, 0, (MAX_ARGS * sizeof(char *)));
+	for (i=1; i < numArgs; i++) {
+            o = popop();                       	/* param nam  or $N	*/
+	    nam = o.o_val.v_s;
+
+            o = popop();                       	/* param nam  or $N	*/
+            val = o.o_val.v_s;
+
+	    if (strcmp (nam, "to") == 0)
+		to = val;
+	    else {
+		args[i-1] = calloc (1, SZ_LINE);;
+		sprintf (args[i-1], "%s=%s", nam, val);
+	    }
+	}
+
+	stat = samp_sendGeneric (samp, to, mtype, args);
+
+	for (i=0; i < (numArgs - 1); i++) {
+	    if (args[i]) 
+		free ((void *) args[i]);
+	}
+
+    } else
+        cl_error (E_UERR, "sampSend: No message specified\n");
+
+    /*  Push the result on the stack.
+     */
+    o.o_type = OT_BOOL;
+    o.o_val.v_i = stat;
+    pushop (&o);
+}
+
+
+
+/*****************************************************************************
+ *  SAMP builtin function definitions.  These are client-side commands.
+ ****************************************************************************/
+
+/**
+ *  SAMP_HANDLER -- Add a user-defined handler to a specific mtype.
+ *
+ *  Usage:   sampHandler (mtype, cmd)
+ *
+ *  Examples:
+ */
+
+void
+func_sampAddHandler (int nargs)
+{
+    char   *mtype, *cmd, *arg1, *arg2;
+    int    i, res = -1;
+    struct operand o;
+
+
+    o.o_type = OT_STRING;
+
+    if (nargs == 2) {
+        arg2 = voGetStrArg ();		/* args on stack in reverse order */
+        arg1 = voGetStrArg ();
+
+	if (strncasecmp (arg1, "del", 3) == 0) {
+	    /*  samp handler delete foo.bar
+	     */
+            mtype = arg2;
+            res   = cl_delUserHandler (mtype); /*  add the handler	  */
+
+	} else {
+	    /* samp handler foo.bar "cmd $arg"
+	     */
+            cmd   = arg2;		/* args on stack in reverse order */
+            mtype = arg1;
+            res   = cl_addUserHandler (mtype, cmd); /*  add the handler	  */
+	}
+	if (arg1)  free ((void *) arg1);
+	if (arg2)  free ((void *) arg2);
+
+        o.o_val.v_s = (res < 0 ? "error" : "ok");
+
+    } else if (nargs == 1) {
+        arg1 = mtype = voGetStrArg ();
+
+	if (strncasecmp (arg1, "del", 3) == 0) {
+            int  i;
+
+            for (i=0; i < numHandlers; i++) {
+                memset (userHandlers[i].mtype, 0, SZ_FNAME);
+                memset (userHandlers[i].cmd, 0, SZ_FNAME);
+            }
+            numHandlers = 0;
+
+	} else {
+            for (i=0; i < numHandlers; i++) {
+	        /*  See if a handler is already defined for the given mtype.
+	         */
+	        if (strcmp (userHandlers[i].mtype, mtype) == 0) {
+		    res = OK;
+		    break;
+	        }
+	    }
+	}
+        o.o_val.v_s = (res < 0 ? "" : userHandlers[i].cmd);
+
+    } else {                    /*  list currently defined handlers     */
+	if (numHandlers == 0)
+	    oprintf ("No SAMP handlers defined\n");
+	else {
+            for (i=0; i < numHandlers; i++)
+                oprintf ("%-20.20s %s\n", 
+		    userHandlers[i].mtype, userHandlers[i].cmd);
+	}
+        o.o_val.v_s = "ok";
+    }
+    
+    pushop (&o); 		/* push the result operand on the stack   */
+}
+
+
+/**
+ *  SAMP_LOADIMAGE -- Send a 'image.load.fits' message to other clients.
+ *
+ *  Usage:   sampLoadImage (file|url [, to [, name [, tag ]]])
+ *
+ *  Examples:
+ *
+ *  1) Broadcast the message to all subscribed clients:
+ * 
+ *	cl> = sampLoadImage ("http://iraf.noao.edu/votest/sif.fits")
+ *	ok
+ *
+ *  2) Send the message to a named client:
+ * 
+ *	cl> = sampLoadImage ("data$foo.fits", "aladin")
+ *	ok
+ *
+ *  3) Load the image with a given name:
+ * 
+ *	cl> = sampLoadImage ("/data/image001.fits", "aladin", "image1")
+ *	ok
+ *
+ *  If a message is sent to a named client that either isn't connected or
+ *  returns an error, our result is the error string.  On success, the string
+ *  "ok" will be returned.  It is not considered an error if a broadcast 
+ *  results in no clients actually receiving the message.
+ */
+
+void
+func_sampLoadImage (int nargs)
+{
+    char      *what=NULL, *name=NULL, *tag=NULL, *to=NULL;
+    char      url[SZ_PATHNAME+1], osfn[SZ_PATHNAME+1];
+    struct    operand o;
+
+
+    /* Parse any remaining (optional) arguments.  Remember that the args are
+     * on the stack in the reverse order!  The 1st arg is required and will 
+     * be either an ivo: identifier or is presumed to be the ShortName.
+     */
+    switch (nargs) {
+    case 4: 
+        tag = voGetStrArg ();
+	/*  fall thru */
+    case 3: 
+        name = voGetStrArg ();
+	/*  fall thru */
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru */
+    case 1: 
+        what = voGetStrArg ();
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+	    strcpy (url, what);
+	} else {
+	    c_fmapfn (what, osfn, SZ_PATHNAME);
+	    if (c_access (osfn, READ_ONLY, 0) == NO) {
+        	cl_error (E_UERR, "Cannot access image '%s'", what);
+		return;
+	    }
+	    sprintf (url, "file://%s", osfn);
+	}
+	break;
+
+    default:
+        cl_error (E_UERR, "sampImLoad: invalid number of arguments\n");
+	return;
+    }
+
+    if (name == NULL) name = strdup (what);
+    if (tag  == NULL) tag  = strdup ("foo");
+    if (to   == NULL) to   = strdup ("all");
+
+
+    /*  Send the message.
+     */
+    o.o_type = OT_STRING;
+    if (samp_imageLoadFITS (samp, to, url, tag, name) != 0)
+        o.o_val.v_s = "ok";
+    else
+        o.o_val.v_s = samp_getErr (samp);
+ 
+    /* Push the result operand on the stack.
+     */
+    pushop (&o);
+
+    /* Clean up and return.				FIXME
+     */
+    if (tag)  free ((char *) tag);
+    if (name) free ((char *) name);
+    if (what) free ((char *) what);
+    if (to)   free ((char *) to);
+}
+
+
+/**
+ *  SAMP_LOADFITS -- Send a 'table.load.fits' message to other clients.
+ *
+ *  Usage:   sampLoadFITS (file|url [, to [, name [, tag ]]])
+ *
+ *  Examples:
+ *
+ *  1) Broadcast the message to all subscribed clients:
+ * 
+ *	cl> = sampLoadFITS ("http://iraf.noao.edu/votest/sif.fits")
+ *	ok
+ *
+ *  2) Send the message to a named client:
+ * 
+ *	cl> = sampLoadFITS ("data$foo.fits", "aladin")
+ *	ok
+ *
+ *  3) Load the image with a given name:
+ * 
+ *	cl> = sampLoadFITS ("/data/image001.fits", "aladin", "image1")
+ *	ok
+ *
+ *  If a message is sent to a named client that either isn't connected or
+ *  returns an error, our result is the error string.  On success, the string
+ *  "ok" will be returned.  It is not considered an error if a broadcast 
+ *  results in no clients actually receiving the message.
+ */
+
+void
+func_sampLoadFITS (int nargs)
+{
+    char      *what=NULL, *name=NULL, *tag=NULL, *to=NULL;
+    char      url[SZ_PATHNAME+1], osfn[SZ_PATHNAME+1];
+    struct    operand o;
+
+
+    /* Parse any remaining (optional) arguments.  Remember that the args are
+     * on the stack in the reverse order!  The 1st arg is required and will 
+     * be either an ivo: identifier or is presumed to be the ShortName.
+     */
+    switch (nargs) {
+    case 4: 
+        tag = voGetStrArg ();
+	/*  fall thru */
+    case 3: 
+        name = voGetStrArg ();
+	/*  fall thru */
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru */
+    case 1: 
+        what = voGetStrArg ();
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+	    strcpy (url, what);
+	} else {
+	    c_fmapfn (what, osfn, SZ_PATHNAME);
+	    if (c_access (osfn, READ_ONLY, 0) == NO) {
+        	cl_error (E_UERR, "Cannot access image '%s'", what);
+		return;
+	    }
+	    sprintf (url, "file://%s", osfn);
+	}
+	break;
+
+    default:
+        cl_error (E_UERR, "sampImLoad: invalid number of arguments\n");
+	return;
+    }
+
+    if (name == NULL) name = strdup (what);
+    if (tag  == NULL) tag  = strdup ("foo");
+    if (to   == NULL) to   = strdup ("all");
+
+
+    /*  Send the message.
+     */
+    o.o_type = OT_STRING;
+    if (samp_tableLoadFITS (samp, to, url, tag, name) != 0)
+        o.o_val.v_s = "ok";
+    else
+        o.o_val.v_s = samp_getErr (samp);
+ 
+    /* Push the result operand on the stack.
+     */
+    pushop (&o);
+
+    /* Clean up and return.
+     */
+    if (tag)  free ((char *) tag);
+    if (name) free ((char *) name);
+    if (what) free ((char *) what);
+    if (to)   free ((char *) to);
+}
+
+
+/**
+ *  SAMP_LOADVOTABLE -- Send a 'table.load.votable' message to other clients.
+ *
+ *  Usage:   sampLoadVOTable (file|url [, to [, name [, tag ]]])
+ *
+ *  Examples:
+ *
+ *  1) Broadcast the message to all subscribed clients:
+ * 
+ *	cl> = sampLoadFITS ("http://iraf.noao.edu/votest/sif.fits")
+ *	ok
+ *
+ *  2) Send the message to a named client:
+ * 
+ *	cl> = sampLoadFITS ("data$foo.fits", "aladin")
+ *	ok
+ *
+ *  3) Load the image with a given name:
+ * 
+ *	cl> = sampLoadFITS ("/data/image001.fits", "aladin", "image1")
+ *	ok
+ *
+ *  If a message is sent to a named client that either isn't connected or
+ *  returns an error, our result is the error string.  On success, the string
+ *  "ok" will be returned.  It is not considered an error if a broadcast 
+ *  results in no clients actually receiving the message.
+ */
+
+void
+func_sampLoadVOTable (int nargs)
+{
+    char      *what=NULL, *name=NULL, *tag=NULL, *to=NULL;
+    char      url[SZ_PATHNAME+1], osfn[SZ_PATHNAME+1];
+    struct    operand o;
+
+
+    /* Parse any remaining (optional) arguments.  Remember that the args are
+     * on the stack in the reverse order!  The 1st arg is required and will 
+     * be either an ivo: identifier or is presumed to be the ShortName.
+     */
+    switch (nargs) {
+    case 4: 
+        tag = voGetStrArg ();
+	/*  fall thru */
+    case 3: 
+        name = voGetStrArg ();
+	/*  fall thru */
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru */
+    case 1: 
+        what = voGetStrArg ();
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+	    strcpy (url, what);
+	} else {
+	    c_fmapfn (what, osfn, SZ_PATHNAME);
+	    if (c_access (osfn, READ_ONLY, 0) == NO) {
+        	cl_error (E_UERR, "Cannot access file '%s'", what);
+		return;
+	    }
+	    sprintf (url, "file://%s", osfn);
+	}
+	break;
+
+    default:
+        cl_error (E_UERR, "sampLoadVOTable: invalid number of arguments\n");
+	return;
+    }
+
+    if (name == NULL) name = strdup (what);
+    if (tag  == NULL) tag  = strdup ("foo");
+    if (to   == NULL) to   = strdup ("all");
+
+
+    /*  Send the message.
+     */
+    o.o_type = OT_STRING;
+    if (samp_tableLoadVOTable (samp, to, url, tag, name) != 0)
+        o.o_val.v_s = "ok";
+    else
+        o.o_val.v_s = samp_getErr (samp);
+ 
+    /* Push the result operand on the stack.
+     */
+    pushop (&o);
+
+    /* Clean up and return.
+     */
+    if (tag)  free ((char *) tag);
+    if (name) free ((char *) name);
+    if (what) free ((char *) what);
+    if (to)   free ((char *) to);
+}
+
+
+/**
+ *  SAMP_SHOWROW -- Send a 'table.highlight.row' message to other clients.
+ *
+ *  Usage:   sampShowRow (url, id, row [, to])
+ */
+
+void
+func_sampShowRow (int nargs)
+{
+    register int i, row=0, stat = 0;
+    char   *to=NULL, *srow=NULL, *what=NULL, *tblId=NULL;
+    char   osfn[SZ_PATHNAME],  url[SZ_URL];
+    struct operand o;
+
+
+    memset (url, 0, SZ_URL);
+    switch (nargs) {
+    case 4: 
+        to = voGetStrArg ();
+	/*  fall thru */
+    case 3: 
+	row = atoi ((srow = voGetStrArg ()));
+	/*  fall thru */
+    case 2: 
+        tblId = voGetStrArg ();
+	/*  fall thru */
+    case 1: 
+        what = voGetStrArg ();
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+	    strcpy (url, what);
+	} else {
+	    c_fmapfn (what, osfn, SZ_PATHNAME);
+	    if (c_access (osfn, READ_ONLY, 0) == NO) {
+        	cl_error (E_UERR, "Cannot access file '%s'", what);
+		return;
+	    }
+	    sprintf (url, "file://%s", osfn);
+	}
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampShowRow (url, tblId, row[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    stat = samp_tableHighlightRow (samp, to, tblId, url, row);
+
+    if (to)    free ((void *) to);
+    if (srow)  free ((void *) srow);
+    if (tblId) free ((void *) tblId);
+    if (what)  free ((void *) what);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_SELECTROWLIST -- Send a 'table.select.rowList' message to other 
+ *  clients.
+ *
+ *  Usage:   sampSelectRowList (url, id, row [, to])
+ */
+
+#define MAX_ROWSELECT           1024
+
+void
+func_sampSelectRowList (int nargs)
+{
+    int    i, nrows = 0, stat = 0, rows[MAX_ROWSELECT];
+    char   *to=NULL, *srow=NULL, *what=NULL, *tblId=NULL;
+    char   osfn[SZ_PATHNAME], url[SZ_URL], *ip, *n;
+    struct operand o;
+
+
+    memset (url, 0, SZ_URL);
+    switch (nargs) {
+    case 4: 
+        to = voGetStrArg ();
+	/*  fall thru */
+    case 3: 
+	srow = voGetStrArg ();
+	/*  fall thru */
+    case 2: 
+        tblId = voGetStrArg ();
+	/*  fall thru */
+    case 1: 
+        what = voGetStrArg ();
+        if (strncmp(what, "http:", 5) == 0 || strncmp(what, "file:", 5) == 0) {
+	    strcpy (url, what);
+	} else {
+	    c_fmapfn (what, osfn, SZ_PATHNAME);
+	    if (c_access (osfn, READ_ONLY, 0) == NO) {
+        	cl_error (E_UERR, "Cannot access file '%s'", what);
+		return;
+	    }
+	    sprintf (url, "file://%s", osfn);
+	}
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampShowRow (url, tblId, row[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    /* Convert the row list string into an int array.
+     */
+    for (ip=srow, n=srow, nrows=0; n; ip=n ) {
+        if ( (n = strchr (ip, (int) ',')) )
+            *n++ = '\0';
+        rows[nrows++] = atoi (ip);
+    }
+
+    stat = samp_tableSelectRowList (samp, to, tblId, url, rows, nrows);
+
+    if (to)    free ((void *) to);
+    if (srow)  free ((void *) srow);
+    if (tblId) free ((void *) tblId);
+    if (what)  free ((void *) what);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_POINTAT -- Send a 'coords.pointAt.sky' message to other clients.
+ *
+ *  Usage:   sampPointAt (ra, dec[, to])
+ */
+
+void
+func_sampPointAt (int nargs)
+{
+    register  int i, stat;
+    char   *arg = NULL, to[SZ_LINE];
+    float  ra = -1.0, dec = 0.0;
+    struct operand o;
+
+    if (nargs > 0) {
+	strcpy (to, "all");
+	for (i=0; i < nargs; i++) {
+            arg = voGetStrArg ();	/* args on stack in reverse order */
+
+            if (isalpha ((int) arg[0]))         /* recipient arg          */
+                strcpy (to, arg);
+            else if (ra < 0)                    /* not initialized yet    */
+                dec = atof (arg);
+            else
+                ra = atof (arg);
+
+            if (arg)  free ((char *) arg);
+	}
+
+        stat = samp_coordPointAtSky (samp, to, ra, dec);
+
+        /* Push the result operand on the stack.
+         */
+        o.o_type = OT_STRING;
+        o.o_val.v_s = (stat < 0 ? "error" : "ok");
+        pushop (&o);
+
+    } else
+        cl_error (E_UERR, "usage: sampPointAt (ra_deg, dec_deg)");
+}
+
+
+/**
+ *  SAMP_SPECLOAD -- Send a 'spec.load.ssa-generic' message to other clients.
+ *
+ *  Usage:   sampSpecLoad ()
+ */
+
+void
+func_sampSpecLoad (int nargs)
+{
+}
+
+
+/**
+ *  SAMP_BIBCODELOAD -- Send a 'bibcode.load' message to other clients.
+ *
+ *  Usage:   sampBibcodeLoad (bibcode[, to])
+ */
+
+void
+func_sampBibcodeLoad (int nargs)
+{
+    register int stat = 0;
+    char   *to=NULL, *bibcode=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        bibcode = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampShowRow (tblId, url, row[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    stat = samp_bibLoad (samp, to, bibcode);
+
+    if (to)      free ((void *) to);
+    if (bibcode) free ((void *) bibcode);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_CMDEXEC -- Send a 'client.cmd.exec' message to other clients.
+ *
+ *  Usage:   sampCmdExec (cmd[, to]))
+ */
+
+void
+func_sampCmdExec (int nargs)
+{
+    register int stat = 0;
+    char   *to=NULL, *cmd=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        cmd = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampCmdExec (cmd[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    stat = samp_cmdExec (samp, to, cmd);
+
+    if (to)   free ((void *) to);
+    if (cmd)  free ((void *) cmd);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_ENVGET -- Send a 'client.env.get' message to other clients.
+ *
+ *  Usage:   sampEnvGet (param[, to]))
+ */
+
+void
+func_sampEnvGet (int nargs)
+{
+    char   *res=NULL, *to=NULL, *param=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        param = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampEnvGet (param[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    res = samp_envGet (samp, to, param);
+
+    if (to)    free ((void *) to);
+    if (param) free ((void *) param);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = res;
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_ENVSET -- Send a 'client.env.set' message to other clients.
+ *
+ *  Usage:   sampEnvSet (param, val[, to]))
+ */
+
+void
+func_sampEnvSet (int nargs)
+{
+    register int stat = 0;
+    char   *res=NULL, *to=NULL, *param=NULL, *val=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 3: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 2: 
+        val = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        param = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampEnvSet (param, val[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    stat = samp_envSet (samp, to, param, val);
+
+    if (to)    free ((void *) to);
+    if (param) free ((void *) param);
+    if (val)   free ((void *) val);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_PARAMGET -- Send a 'client.param.get' message to other clients.
+ *
+ *  Usage:   sampParamGet (param[, to]))
+ */
+
+void
+func_sampParamGet (int nargs)
+{
+    char   *res=NULL, *to=NULL, *param=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 2: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        param = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampParamGet (param[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    res = samp_paramGet (samp, to, param);
+
+    if (to)    free ((void *) to);
+    if (param) free ((void *) param);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = res;
+    pushop (&o);
+}
+
+
+/**
+ *  SAMP_PARAMSET -- Send a 'client.param.set' message to other clients.
+ *
+ *  Usage:   sampParamSet (param, val[, to]))
+ */
+
+void
+func_sampParamSet (int nargs)
+{
+    register int stat = 0;
+    char   *res=NULL, *to=NULL, *param=NULL, *val=NULL;
+    struct operand o;
+
+
+    switch (nargs) {
+    case 3: 
+        to = voGetStrArg ();
+	/*  fall thru  */
+    case 2: 
+        val = voGetStrArg ();
+	/*  fall thru  */
+    case 1: 
+        param = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "usage: sampParamSet (param, val[, to])");
+	return;
+    }
+
+    if (!to)  to = strdup ("all");
+
+    stat = samp_paramSet (samp, to, param, val);
+
+    if (to)    free ((void *) to);
+    if (param) free ((void *) param);
+    if (val)   free ((void *) val);
+
+    /* Push the result operand on the stack.
+     */
+    o.o_type = OT_STRING;
+    o.o_val.v_s = (stat != 0 ? "ok" : samp_getErr(samp));
+    pushop (&o);
+}
diff --git a/pkg/vocl/sampHandlers.c b/pkg/vocl/sampHandlers.c
new file mode 100644
index 00000000..8e15898a
--- /dev/null
+++ b/pkg/vocl/sampHandlers.c
@@ -0,0 +1,515 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+/**
+ *  SAMPHANDLERS.C -- Mtype message handlers.
+ */
+
+#include <string.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <signal.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <readline/readline.h>		/* to install rl_event_hook	*/
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_prstat
+#define import_xwhen
+#include <iraf.h>
+
+#include "config.h"			/* CL declarations		*/
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "clsamp.h"
+
+
+
+extern Handler	userHandlers[];
+extern int	numHandlers;
+
+extern int   samp_registered;
+extern char  samp_cmd[SZ_CMDBLK];
+extern pid_t cl_pid;
+
+extern int   optbl[];
+extern char *ifnames[];
+
+
+
+/**
+ *  MType Handler Declarations	
+ */
+int 	cl_genericHandler (char *sender, char *mtype, char *msg_id, Map map);
+int 	cl_cmdExecHandler (char *cmd);
+int 	cl_envSetHandler (char *name, char *value);
+int 	cl_envGetHandler (char *name, char *value, int maxch);
+int 	cl_paramSetHandler (char *name, char *value);
+int 	cl_paramGetHandler (char *name, char *value, int maxch);
+int 	cl_pingHandler (char *sender);
+int 	cl_imgLoadHandler (char *url, char *imgId, char *name);
+int 	cl_tblLoadHandler (char *url, char *tblId, char *name);
+
+int     cl_addUserHandler (char *mtype, char *cmd);
+char   *cl_getUserHandler (char *mtype);
+
+void    str_replace (char **string, char *substr, char *replacement);
+int 	is_stdMType (char *mtype);
+
+extern	XINT	samp;				/* SAMP handle 		*/
+extern  pthread_mutex_t samp_mutex;		/* global data mutex	*/
+
+extern	char   *voGetStrArg ();
+
+
+
+
+
+/*****************************************************************************
+ *  Utility procedures.
+ ****************************************************************************/
+
+/**
+ *  CL_ADDUSERHANDLER -- Associate an mtype with a user-defined handler.
+ */
+int
+cl_addUserHandler (char *mtype, char *cmd)
+{
+    register int i = 0;
+    int   len = strlen (mtype);
+
+
+    /*  See if it's a generic message.
+     */
+    if (!is_stdMType (mtype)) {
+	extern XINT  samp;
+
+        strcpy (userHandlers[numHandlers].mtype, mtype);
+        strcpy (userHandlers[numHandlers].cmd, cmd);
+        numHandlers++;
+
+	samp_Subscribe (samp, mtype, cl_genericHandler);
+	samp_DeclareSubscriptions (samp);
+
+        return ( ((numHandlers < MAX_HANDLERS) ? 0 : -1) );
+    }
+
+    /* Check for an existing definition, if found, overwrite it.
+     */
+    for (i=0; i < numHandlers; i++) {
+	if (strncmp (mtype, userHandlers[i].mtype, len) == 0) {
+	    memset (userHandlers[i].cmd, 0, SZ_FNAME);
+	    strcpy (userHandlers[i].cmd, cmd);
+	    return (0);
+	}
+    }
+
+    /*  No handler found, so add it to the list.
+     */
+    strcpy (userHandlers[numHandlers].mtype, mtype);
+    strcpy (userHandlers[numHandlers].cmd, cmd);
+    numHandlers++;
+
+    return ( ((numHandlers < MAX_HANDLERS) ? 0 : -1) );
+}
+
+
+/**
+ *  CL_DELUSERHANDLER -- Delete a user-defined handler for the named mtype.
+ */
+int
+cl_delUserHandler (char *mtype)
+{
+    register int i = 0, j = 0;
+
+
+    if (mtype == NULL) {
+	/*  Delete all handlers.
+	 */
+        for (i=0; i < numHandlers; i++) {
+	    memset (userHandlers[i].mtype, 0, SZ_FNAME);
+	    memset (userHandlers[i].cmd, 0, SZ_FNAME);
+	}
+	numHandlers = 0;
+
+    } else {
+        int   len = strlen (mtype);
+
+        /* Check for an existing definition, if found, delete it.
+         */
+        for (i=0; i < numHandlers; i++) {
+	    if (strncmp (mtype, userHandlers[i].mtype, len) == 0) {
+	        /*  Found a match.
+	         */
+	        memset (userHandlers[i].mtype, 0, SZ_FNAME);
+	        memset (userHandlers[i].cmd, 0, SZ_FNAME);
+    	        for (j=i; j < numHandlers; j++) {
+		    /*  Shift remaining list.
+		     */
+	            strcpy (userHandlers[j].cmd, userHandlers[j+1].cmd);
+	            strcpy (userHandlers[j].mtype,userHandlers[j+1].mtype);
+    	        }
+
+	        numHandlers--;
+	    }
+        }
+    }
+
+    return (0);
+}
+
+
+/**
+ *  CL_GETUSERHANDLER -- Get any user-defined handler command for the given
+ *  mtype, or NULL of not found.  Match up to the length of the input mtype
+ *  to allow general matches, e.g. "image.load" instead of requiring the
+ *  full "image.load.fits".
+ */
+char *
+cl_getUserHandler (char *mtype)
+{
+    register int i = 0;
+    int   len = strlen (mtype);
+  
+    for (i=0; i < numHandlers; i++) {
+	if (strncmp (mtype, userHandlers[i].mtype, len) == 0) {
+	    return (userHandlers[i].cmd);
+	}
+    }
+
+    return (NULL);
+}
+
+
+
+
+/*****************************************************************************
+ *  SAMP message handlers, these are server-side commands.
+ ****************************************************************************/
+
+int
+cl_genericHandler (char *sender, char *mtype, char *msg_id, Map map)
+{
+    register int i, npars = 0;
+    char  *cmd, *key, *val;
+
+
+    /*  Check for a user-defined handler command.
+     */
+    if ( (cmd = cl_getUserHandler (mtype)) ) {
+        char   *newstr = calloc (1, SZ_CMDBLK);
+	char    arg[SZ_FNAME];
+
+        /*  Do any command string replacements.
+         */
+        npars = samp_getMapSize (map);
+        strcpy (newstr, cmd);
+        for (i=0; i < npars; i++ ) {
+	    key = (char *) samp_getMapKey (map, i);
+	    val = (char *) samp_getMapVal (map, i);
+
+	    memset (arg, 0, SZ_FNAME);
+	    sprintf (arg, "$%s", key);
+            str_replace (&newstr, arg, val);
+        }
+
+        /*  Execute as if it were sent as an exec message.
+         */
+        cl_cmdExecHandler (newstr);
+
+        free (newstr);
+
+    } else {
+        /* Nothing to do..... */
+    }
+
+    return (0);
+}
+
+
+int
+cl_cmdExecHandler (char *cmd)
+{
+    /*  Save the command to the buffer.
+     */
+    pthread_mutex_lock (&samp_mutex);
+    strcat (samp_cmd, cmd);
+    strcat (samp_cmd, "\n");
+    pthread_mutex_unlock (&samp_mutex);
+
+    /* Send the signal to the parent CL thread to notify it of the command.
+     */
+    kill (cl_pid, SIGIO);
+
+    return (0);
+}
+
+int
+cl_envSetHandler (char *name, char *value)
+{
+    c_envputs (name, value);
+    pr_envset (0, name, value);
+    if (strcmp ("erract", name) == 0)
+        erract_init();
+
+    return (0);
+}
+
+int
+cl_envGetHandler (char *name, char *value, int maxch)
+{
+    char *s = NULL;
+    char  val[SZ_LINE];
+
+    memset (val, 0, SZ_LINE);
+    if ((s = envget (name)))
+        strncpy (value, s, maxch);
+    else {
+        if (c_envfind (name, val, SZ_LINE) < 0)
+            strncpy (value, "INDEF", maxch);
+        else
+            strncpy (value, val, maxch);
+    }
+
+    return (0);
+}
+
+int
+cl_paramSetHandler (char *name, char *value)
+{
+    char *pk, *t, *p, *f;
+    struct param *pp;
+    struct operand o;
+    char  cmd[SZ_LINE], val[SZ_LINE];
+
+    breakout (name, &pk, &t, &p, &f);
+    strcpy (val, value);
+
+    /* We can't use paramsrch here because the string we are looking
+     * for might be a builtin or not exist, and paramsrch would fail
+     * to return a reply.
+     */
+    if (t[0] && deftask (t) == YES) {
+        if ((pp = lookup_param (pk, t, p))) {
+
+            if (*f == FN_NULL && (pp->p_type & PT_LIST)) {
+                /* Hitting EOF from a list is ok during an inspect stmt so avoid
+                 * so avoid using paramget() with its EOF error. readlist() may
+                 * set P_LEOF.
+                 */
+                o = readlist (pp);
+                if ((pp->p_flags & P_LEOF) || inrange (pp, &o))
+                    pushop (&o);
+                else
+                    query (pp);
+            } else
+                paramget (pp, FN_VALUE);/* get the parameter value field    */
+            o = popop();
+
+            /* Quote string params.
+             */
+            if ((o.o_type & OT_BASIC) == OT_STRING)
+	        sprintf (val, "\"%s\"", value);
+        }
+    }
+
+
+    /*  Cheat and make this a command string to be executed.
+     */
+    memset (cmd, 0, SZ_LINE);
+    sprintf (cmd, "%s = %s\n", name, val);
+
+    return ( cl_cmdExecHandler (cmd) );
+}
+
+int
+cl_paramGetHandler (char *name, char *value, int maxch)
+{
+    char *pk, *t, *p, *f;
+    struct param *pp;
+    struct operand o;
+
+    breakout (name, &pk, &t, &p, &f);
+    strncpy (value, "INDEF", maxch);
+
+    /* We can't use paramsrch here because the string we are looking
+     * for might be a builtin or not exist, and paramsrch would fail
+     * to return a reply.
+     */
+    if (t[0] && deftask (t) == NO)
+	return (0);
+    if (! (pp = lookup_param (pk, t, p)))
+	return (0);
+
+    if (*f == FN_NULL && (pp->p_type & PT_LIST)) {
+        /*  Hitting EOF from a list is ok during an inspect stmt so avoid
+         *  using paramget() with its EOF error. readlist() may set P_LEOF.
+         */
+        o = readlist (pp);
+        if ((pp->p_flags & P_LEOF) || inrange (pp, &o))
+            pushop (&o);
+        else
+            query (pp);
+    } else {
+        paramget (pp, FN_VALUE);	/* get the parameter value field    */
+        opcast (OT_STRING);		/* cast as a string		    */
+    }
+    o = popop();
+
+    memset (value, 0, maxch);
+    if ((o.o_type & OT_BASIC) == OT_STRING)
+        strncpy (value, o.o_val.v_s, maxch);
+    else
+        strncpy (value, "INDEF", maxch);
+
+    return (0);
+}
+
+int
+cl_pingHandler (char *sender)
+{
+    /*  no-op  */
+
+    return (0);
+}
+
+int
+cl_imgLoadHandler (char *url, char *imgId, char *name)
+{
+    char  *cmd = (char *) NULL;
+
+
+    /*  Check for a user-defined handler command.
+     */
+    if ( (cmd = cl_getUserHandler ("image.load.")) ) {
+ 	char   *newstr = calloc (1, SZ_CMDBLK);
+
+	/*  Do any command string replacements.
+	 */
+	strcpy (newstr, cmd);
+	str_replace (&newstr, "$url", url);
+	str_replace (&newstr, "$imageId", imgId);
+	str_replace (&newstr, "$name", name);
+
+	/*  Execute as if it were sent as an exec message. 
+	 */
+	cl_cmdExecHandler (newstr);
+
+ 	free (newstr);
+
+    } else {
+	/* Nothing to do..... */
+    }
+
+    return (0);
+}
+
+int
+cl_tblLoadHandler (char *url, char *tblId, char *name)
+{
+    char  *cmd = (char *) NULL;
+
+
+if (!url)
+    return (1);
+    /*  Check for a user-defined handler command.
+     */
+    if ( (cmd = cl_getUserHandler ("table.load.")) ) {
+ 	char   *newstr = calloc (1, SZ_CMDBLK);
+
+	/*  Do any command string replacements.
+	 */
+	strcpy (newstr, cmd);
+	str_replace (&newstr, "$url", url);
+	str_replace (&newstr, "$imageId", tblId);
+	str_replace (&newstr, "$name", name);
+
+	/*  Execute as if it were sent as an exec message. 
+	 */
+	cl_cmdExecHandler (newstr);
+
+ 	free (newstr);
+
+    } else {
+	/* Nothing to do..... */
+    }
+
+    return (0);
+}
+
+
+
+/******************************************************************************
+**  Local Utilities
+******************************************************************************/
+
+/**
+ *  STR_REPLACE --  Replace the input string, substituting 'replacement' for
+ *  all occurrances of 'substr'.  The input string is modified and is assumed
+ *  to be at least SZ_CMDBLK long.
+ */
+
+void
+str_replace (char **string, char *substr, char *replacement )
+{
+    char  *tok = (char *) NULL, *newstr = (char *) NULL, *str = *string;
+    int    n = 0;
+
+
+    for (n=0; n < MAX_SUBS; n++) {
+        tok = strstr (str, substr);		/* check for no subs	*/
+        if (tok == NULL) 
+	    break;
+
+        if ((newstr = calloc (1, SZ_CMDBLK)) == NULL)
+	    break;
+
+	/*  Do the replacements.
+	 */
+        memcpy (newstr, str, tok - str);	
+        memcpy (newstr + (tok - str), replacement, strlen(replacement));
+        memcpy (newstr + (tok - str) + strlen(replacement), 
+	    tok + strlen(substr), strlen(str) - strlen(substr) - 
+	    (tok - str));
+        memset (newstr + strlen(str) - strlen(substr) + strlen(replacement), 
+	    0, 1);
+
+        strcpy (*string, newstr);
+        free (newstr);
+    }
+}
+
+
+/**
+ * IS_STDMTYPE - See if the mtype is one of the well-known message type.
+ */
+int
+is_stdMType (char *mtype)
+{
+    int   i = 0, len = 0;
+    char *stdMTypes[] = {
+	  "samp.app.ping", 	"samp.app.status", 	"samp.hub.event.*",
+	  "table.load.fits", 	"table.load.votable", 	"table.highlight.row",
+	  "image.load.fits", 	"coord.pointAt.sky", 	"client.cmd.exec",
+	  "client.env.get", 	"client.env.set", 	"client.param.get",
+	  "client.param.set", 	"bibcode.load", 	"table.select.rowList",
+	  "voresource.loadlist",
+	  "spectrum.load.ssa-generic",
+	  NULL
+	};
+
+    for (i=0; stdMTypes[i]; i++) {
+	len = min (strlen (mtype), strlen (stdMTypes[i]));
+	if (strncasecmp (mtype, stdMTypes[i], len) == 0)
+	    return (1);
+    }
+    return (0);
+}
diff --git a/pkg/vocl/scan.c b/pkg/vocl/scan.c
new file mode 100644
index 00000000..db7f26ba
--- /dev/null
+++ b/pkg/vocl/scan.c
@@ -0,0 +1,342 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+/*
+ * SCAN -- free-format and formatted scan functions.
+ */
+
+extern	int cldebug;
+extern	char *nullstr;
+extern	char *eofstr;
+extern	char *indefstr;
+extern	char *indeflc;
+
+#define	MAXARGS 32
+static	int nscan_val=0;	/* value returned by NSCAN intrinsic	*/
+
+
+/* SCAN -- Perform the bulk of the scan,fscan intrinsic functions to do
+ * free-formatted reads into nargs params.  Formatting is done by makeop()
+ * according to the type of the corresponding destination param.
+ * Destination may be "stdout".
+ *
+ * Nargs is the number of operands on the stack we need to deal with.
+ *   They are all strings.  The scan procedure is actually called to
+ *   process calls to both the SCAN and FSCAN intrinsics.  If scan was
+ *   called, the argument "source" will be the string "stdin".  If source
+ *   is null, the source is given by the first operand on the stack; it
+ *   may be the special string "stdin".  Thereafter, there are exactly
+ *   nargs-1 string operands each of which is the name of a destination
+ *   parameter to be assigned.  The operand order must be such that the
+ *   first one popped is the name of the parameter to which the first field
+ *   of the scan line is to be assigned.
+ *
+ * EOF or OK is returned as the function value.  The number of items
+ *   successfully scanned is returned by a subsequent call to NSCAN().
+ *
+ * query if readlist yields undefined.
+ * error() may be called on various conditions.
+ */
+
+void 
+cl_scan (int nargs, char *source)
+{
+	char	buf[SZ_LINE];
+	char	*bp, *start, c;
+	char	*pk, *t, *p, *f;
+	char	field = '\0';
+	struct	operand o;
+	struct	param *pp;
+	int	eoftst;
+
+	eoftst = 0;
+
+	/* Fill buf with the line to be scanned.
+	 */
+	if (strcmp (source, "stdin") == 0) {
+	    /* Read from the standard input (SCAN call).
+	     */
+	    if (fgets (buf, SZ_LINE, currentask->t_stdin) == NULL)
+		eoftst++;
+	    else
+		lentst (buf);
+	    /* First arg is an output param, not source, so increment
+	     * nargs.
+	     */
+	    nargs++;
+
+	} else {
+	    /* Get source name from first operand (FSCAN call)
+	     */
+	    o = popop();
+	    if (!strcmp (o.o_val.v_s, "stdin") ||
+		!strcmp (o.o_val.v_s, "STDIN")) {
+
+		if (fgets (buf, SZ_LINE, currentask->t_stdin) == NULL)
+		    eoftst++;
+		else
+		    lentst (buf);
+
+	    } else {
+		breakout (o.o_val.v_s, &pk, &t, &p, &f);
+		pp = paramsrch (pk, t, p);
+		paramget (pp, *f);
+		opcast (OT_STRING);
+		o = popop();
+
+		if (pp->p_flags & P_LEOF)
+		    eoftst++;
+		else {
+		    if (opundef (&o)) {
+			query (pp);		/* pushes op */
+			opcast (OT_STRING);
+			o = popop();
+		    }
+		    strncpy (buf, o.o_val.v_s, SZ_LINE);
+		}
+	    }
+	}
+
+	if (eoftst) {
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = CL_EOF;
+	    while (nargs-- > 0)
+		popop();		/* flush op stack		*/
+	    pushop (&o);
+	    return;
+	}
+
+	/* Take each portion of buf and assign to the given parameter.
+	 */
+	bp = buf;
+	nscan_val = 0;
+
+	while (nargs-- > 0) {		/* get each destination name	*/
+	    o = popop();
+
+	    if (!strcmp (o.o_val.v_s, "stdout") ||
+		!strcmp (o.o_val.v_s, "STDOUT")) {
+		pp = NULL;
+	    } else {
+		breakout (o.o_val.v_s, &pk, &t, &p, &f);
+		field = *f;
+		pp = paramsrch (pk, t, p);	/* never returns NULL	*/
+	    }
+
+	    /* Assign rest of line if struct type parameter.  For simple
+	     * string or filename type params, the next whitespace delimited
+	     * word is broken out (see below).
+	     */
+	    if (pp != NULL &&
+		((pp->p_type & (PT_STRUCT|PT_IMCUR|PT_GCUR|PT_UKEY)) &&
+		!(pp->p_type & (PT_FILNAM|PT_PSET|PT_LIST)))) {
+
+		if (nargs != 0)
+		    cl_error (E_UERR,
+			"Struct type param must be final Scan argument");
+		start = bp;
+
+	    } else {
+		while (*bp == ' ' || *bp == '\t')
+		    bp++;
+		/* It is not an error if not all params can be filled by scan.
+		 * Simply break off scan, pop the unused args off the stack,
+		 * and return as the function value the number of items
+		 * sucessfully scanned.
+		 */
+		if (*bp == '\0')
+		    break;
+		start = bp;
+		for (c = *bp;  c!=' ' && c!='\t' && c!='\0';  c = *bp)
+		    bp++;
+		if (c != '\0')
+		    *bp++ = '\0';
+	    }
+
+	    if (pp == NULL)
+		fputs (start, currentask->t_stdout);
+	    else {
+		o = makeop (start, pp->p_type & OT_BASIC);
+		if (opundef (&o))
+		    break;		/* cannot convert as basic type	*/
+		pushop (&o);
+		paramset (pp, field);
+	    }
+
+	    nscan_val++;
+	}
+
+	/* If we broke out of the above loop because of an unsuccessful
+	 * conversion, we must pop the remaining unused operands off the stack.
+	 */
+	while (--nargs >= 0)
+	    popop();
+
+	o.o_type = OT_INT;
+	o.o_val.v_i = nscan_val;
+	pushop (&o);
+}
+
+
+/* CL_SCANF -- Formatted scan.  Like SCAN except that a C-scanf like format
+ * statement is used to decode the input text.
+ */
+void 
+cl_scanf (char *format, int nargs, char *input)
+{
+	int	nscan_val, eoftst, n;
+	char	*pk, *t, *p, *f;
+	struct	operand o;
+	char	buf[SZ_LINE];
+	char	*v[MAXARGS];
+	struct	param *pp;
+
+	eoftst = 0;
+
+	/* Fill buf with the line to be scanned.
+	 */
+	if (strcmp (input, "stdin") == 0) {
+	    /* Read from the standard input (SCANF).
+	     */
+	    if (fgets (buf, SZ_LINE, currentask->t_stdin) == NULL)
+		eoftst++;
+	    else
+		lentst (buf);
+	    /* First arg is an output param, not source, so increment nargs. */
+	    nargs++;
+
+	} else {
+	    /* Get source name from first operand (FSCANF).
+	     */
+	    o = popop();
+
+	    if (!strcmp (o.o_val.v_s, "stdin") ||
+		!strcmp (o.o_val.v_s, "STDIN")) {
+
+		if (fgets (buf, SZ_LINE, currentask->t_stdin) == NULL)
+		    eoftst++;
+		else
+		    lentst (buf);
+
+	    } else {
+		breakout (o.o_val.v_s, &pk, &t, &p, &f);
+		pp = paramsrch (pk, t, p);
+		paramget (pp, *f);
+		opcast (OT_STRING);
+		o = popop();
+
+		if (pp->p_flags & P_LEOF)
+		    eoftst++;
+		else {
+		    if (opundef (&o)) {
+			query (pp);		/* pushes op */
+			opcast (OT_STRING);
+			o = popop();
+		    }
+		    strncpy (buf, o.o_val.v_s, SZ_LINE);
+		}
+	    }
+	}
+
+	/* Check for EOF. */
+	if (eoftst) {
+	    o.o_type = OT_INT;
+	    o.o_val.v_i = CL_EOF;
+	    while (nargs-- > 0)
+		popop();		/* flush op stack		*/
+	    pushop (&o);
+	    return;
+	}
+
+	/* Process the stacked operands and build the argument list for
+	 * the scanf call.  Each argument pointer points directly to the
+	 * stored parameter value in the parameter descriptor.
+	 */
+	for (n=0;  --nargs >= 0;  n++) {
+	    /* Stacked operand is parameter name. */
+	    o = popop();
+	    breakout (o.o_val.v_s, &pk, &t, &p, &f);
+	    pp = paramsrch (pk, t, p);
+
+	    /* Add address of parameter value to argument list.  First set
+	     * the value with PARAMSET, to make sure that the pset knows
+	     * that the value has been modified.
+	     */
+	    switch (pp->p_valo.o_type & OT_BASIC) {
+	    case OT_BOOL:
+		o = makeop ("yes", OT_BOOL);  pushop (&o);
+		paramset (pp, FN_VALUE);
+		v[n] = (char *) &pp->p_valo.o_val.v_i;
+		break;
+	    case OT_INT:
+		o = makeop ("0", OT_INT);  pushop (&o);
+		paramset (pp, FN_VALUE);
+		v[n] = (char *) &pp->p_valo.o_val.v_i;
+		break;
+	    case OT_REAL:
+		o = makeop ("0", OT_REAL);  pushop (&o);
+		paramset (pp, FN_VALUE);
+		v[n] = (char *) &pp->p_valo.o_val.v_r;
+		break;
+	    case OT_STRING:
+		o = makeop ("", OT_STRING);  pushop (&o);
+		paramset (pp, FN_VALUE);
+		v[n] = (char *) pp->p_valo.o_val.v_s;
+		break;
+	    default:
+		cl_error (E_UERR, "scanf: cannot scan into %s\n", o.o_val.v_s);
+	    }
+	}
+
+	/* Perform the scan. */
+	nscan_val = sscanf (buf, format,
+	    v[ 0], v[ 1], v[ 2], v[ 3], v[ 4], v[ 5], v[ 6], v[ 7],
+	    v[ 8], v[ 9], v[10], v[11], v[12], v[13], v[14], v[15],
+	    v[16], v[17], v[18], v[19], v[20], v[21], v[22], v[23],
+	    v[24], v[25], v[26], v[27], v[28], v[29], v[30], v[31]);
+
+	o.o_type = OT_INT;
+	o.o_val.v_i = nscan_val;
+	pushop (&o);
+}
+
+
+/* GET_NSCANVAL -- Return the number of items successfully scanned in the
+ * last call to SCAN.
+ */
+int 
+get_nscanval (void)
+{
+	return (nscan_val);
+}
+
+
+/* LENTST -- Test that the scan line just read did not overflow the line
+ * buffer.
+ */
+void 
+lentst (char *buf)
+{
+	char	*index();
+	char	*bp;
+
+	bp = index (buf, '\n');
+	if (bp != NULL)
+	    *bp = '\0';
+	else
+	    cl_error (E_UERR, "scan limited to %d char lines", SZ_LINE-1);
+}
diff --git a/pkg/vocl/stack.c b/pkg/vocl/stack.c
new file mode 100644
index 00000000..37e45756
--- /dev/null
+++ b/pkg/vocl/stack.c
@@ -0,0 +1,213 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "proto.h"
+
+
+/*
+ * STACK -- "stack" is actually two stacks:
+ * starting at the top and growing downwards is the "control stack",
+ *   used for stacking compiler intermediates at compile time and the
+ *   running and any pending task structs at runtime.
+ * the other, called the "operand stack", starts at the bottom and grows up.
+ *   compiled code is put at its base and basos and topos are set when
+ *   compilation completes to just above the last instruction. at run-time,
+ *   starting at basos and growing upwards, it contains struct operands,
+ *   possibly a string if o_type == OT_STRING, and the index of the last
+ *   operand in a linked-list fashion; see pushop(). when runtime completes, 
+ *   its entire contents are disgarded by setting pc = bascode and starting new
+ *   code compilation.
+ *
+ * in both cases, the respective "top" values are the indices into "stack" that
+ *   were most recently last assigned. They are not related to the size of the
+ *   object on the stack but always refer simply to the last integer index.
+ *   valid topcs and topos always satisfy: 0 <= topos < topcs < STACKSIZ.
+ */
+
+memel stack[STACKSIZ];		/* control and operand stack combined	*/
+XINT topcs = STACKSIZ;		/* index of last cstack; grows downward	*/
+XINT topos = -1;		/* index of last ostack; grows upward	*/
+XINT basos = -1;		/* lowest legal index of operand stack	*/
+
+/* Push a memel value onto the control stack.  Return ERR if it would cause
+ * overflow, else OK.  The control stack is used by the parser during
+ * compilation.  If an error occurs during compilation, taskunwind() will
+ * call poptask() to pop tasks off the control stack.  We must be careful
+ * to avoid having the compiler temporaries interfere with task frames.
+ */
+void 
+pushmem (memel v)
+{
+	if (topcs - 1 > topos)
+	    stack[--topcs] = v;
+	else
+	    eprintf ("control stack overflow; topcs/topos = %d/%d\n",
+		    topcs, topos);
+}
+
+
+/* Pop top memory value off control stack and return it.
+ * ==> no real err return, although it is checked.
+ */
+memel 
+popmem (void)
+{
+	if (topcs < STACKSIZ)
+	    return (stack[topcs++]);
+	else {
+	    eprintf ("control stack underflow\n");
+	    return ((memel) ERR);
+	}
+}
+
+/* PPush pushes an element onto the stack, but leaves the top
+ * of the stack untouched.
+ */
+void 
+ppushmem (register memel p)
+{
+	register memel	q;
+
+	q = popmem();
+	pushmem(p);
+	pushmem(q);
+}
+
+
+/* push operand *op, string storage if o_type == OT_STRING, and last topos 
+ * onto operand stack.
+ * return copy of new operand so that its o.o_val.v_s will point to the
+ * stack-stored string; if not string, it will be same as the passed *op.
+ * call error() if overflow and DO NOT RETURN.
+ *
+ * N.B. opcast() uses this layout intimately.
+ *
+ *                   --------------
+ * (new) topos ->   | last topos   |
+ *		    |--------------|
+ *		    | possible     |
+ *		    | string       |
+ *		    | storage      |<-
+ *	 	    |--------------|  |
+ *		    |struct operand|  |
+ *		    | (o.o_val.v_s)|--
+ *		    |--------------|
+ * (last topos ->)  | last topos   |
+ *		    |--------------|
+ *			...
+ */
+struct operand 
+pushop (struct operand *op)
+{
+	struct operand  junk;
+
+	if (topos + OPSIZ+1 < topcs) {
+	    int		lasttopos = topos;
+	    struct	operand *dest;
+
+	    dest = (struct operand *) &stack[topos+1];
+	    *dest = *op;
+
+	    if (op->o_type == OT_STRING) {
+		int	len = btoi (strlen (op->o_val.v_s) + 1);
+		if (topos + OPSIZ+1 + len >= topcs)
+		    goto overflow;
+		dest->o_val.v_s = (char *) &stack[topos+OPSIZ+1];
+		strcpy (dest->o_val.v_s, op->o_val.v_s);
+		topos += len;
+	    }
+
+	    topos += OPSIZ+1;
+	    stack[topos] = lasttopos;
+
+	    return (*dest);
+	}
+
+overflow:
+	cl_error (E_IERR, e_soverflow, topcs, topos);
+	/* NOTREACHED */
+	return ((struct operand) junk);
+}
+
+/* pop top operand from stack and return copy of it. If type is string,
+ * be sure to use it before the next pushop() or the string will get clobbered.
+ * set topos to top of stack; see diagram with pushop().
+ * call error() and do not return if underflow.
+ */
+struct operand 
+popop (void)
+{
+	struct operand  junk;
+
+	if (topos > basos) {
+	    struct	operand *op;
+
+	    topos = stack[topos];
+	    op = (struct operand *) &stack[topos+1];
+	    return (*op);
+	}
+	cl_error (E_UERR, e_sunderflow);
+
+/* NOTREACHED */
+	return ((struct operand) junk);
+}
+
+
+/* Create a new, uninitialized, task on the control stack.  Call error()
+ * and don't return if overflow, else return pointer to new entry.  Save
+ * index of new task frame so that we don't get confused by temporaries
+ * left on the stack by the parser if error occurs during parsing.
+ */
+int last_task_frame;				/* for error recovery */
+
+struct task *
+pushtask (void)
+{
+	if (topcs - TASKSIZ  > topos) {
+	    topcs -= TASKSIZ;
+	    last_task_frame = topcs;
+	    return ((struct task *) &stack[topcs]);
+	} 
+	cl_error (E_UERR, "task stack overflow");	/* does not return */
+
+/* NOTREACHED */
+	return ((struct task *) NULL);
+}
+
+
+/* Increment topcs and return pointer to next task struct on control stack.
+ * (Top entry may be inspected with pushtask (poptask()) or with currentask.)
+ * Call error() and do not return on underflow.
+ */
+struct task *
+poptask (void)
+{
+	if (topcs <= STACKSIZ - TASKSIZ) {
+	    if (topcs < last_task_frame) {
+		/* If we get here, something has been pushed on the control
+		 * stack by pop() since the last task frame, which did not
+		 * get cleared off.  This may happen if error() is called
+		 * during compilation.
+		 */
+		topcs = last_task_frame;
+	    }
+	    topcs += TASKSIZ;
+	    last_task_frame = topcs;
+	    return ((struct task *) &stack[topcs]);
+	} 
+	cl_error (E_IERR, "Control stack underflow: topcs = %d", topcs);
+
+/* NOTREACHED */
+	return ((struct task *) NULL);
+}
diff --git a/pkg/vocl/tags b/pkg/vocl/tags
new file mode 100644
index 00000000..69a7f15a
--- /dev/null
+++ b/pkg/vocl/tags
@@ -0,0 +1,481 @@
+E_DEBUG	eparam.c	/^#define	E_DEBUG(str)	e_display(str,cmdline,1)   \//
+VALU	operand.h	/^#define	VALU(o)	(((o)->o_type == OT_REAL) ? (o)->o/
+YYBACKUP	ytab.c	/^#define YYBACKUP( newtoken, newvalue )\\$/
+YYRECOVERING	ytab.c	/^#define YYRECOVERING()	(!!yyerrflag)$/
+_bkgjob	bkg.c	/^struct _bkgjob {$/
+_input	scan.c	/^struct _input {$/
+_ltasksrch	task.c	/^_ltasksrch (pkname, ltname, o_pkp)$/
+abbrev	modes.c	/^abbrev ()$/
+addconst	gram.c	/^addconst (s, t)$/
+addltask	task.c	/^addltask (pkp, ptname, ltname, redef)$/
+addparam	pfiles.c	/^addparam (pfp, buf, fp)$/
+addpipe	gram.c	/^addpipe()$/
+arr_desc	operand.h	/^struct arr_desc {$/
+arrhead	operand.h	/^union arrhead {$/
+binexp	binop.c	/^binexp (opcode)$/
+binop	binop.c	/^binop (opcode)$/
+bkg_abort	bkg.c	/^bkg_abort()$/
+bkg_close	bkg.c	/^bkg_close (job, pmsg)$/
+bkg_delfiles	bkg.c	/^bkg_delfiles (job)$/
+bkg_init	bkg.c	/^bkg_init (bcs)$/
+bkg_jobactive	bkg.c	/^bkg_jobactive (job)$/
+bkg_jobstatus	bkg.c	/^bkg_jobstatus (fp, job)$/
+bkg_kill	bkg.c	/^bkg_kill (job)$/
+bkg_query	modes.c	/^bkg_query (obuf, maxch, pp)$/
+bkg_spawn	bkg.c	/^bkg_spawn (cmd)$/
+bkg_startup	bkg.c	/^bkg_startup (bkgfile)$/
+bkg_update	bkg.c	/^bkg_update (pmsg)$/
+bkg_wait	bkg.c	/^bkg_wait (job)$/
+bkg_wfservice	bkg.c	/^bkg_wfservice (job)$/
+bkgfilehdr	bkg.c	/^struct bkgfilehdr {$/
+breakout	gram.c	/^breakout (full, pk, t, p, f)$/
+btoi	mem.h	/^#define	btoi(x)	((int)((((x)+BPI-1)\/BPI))) \/* av/
+builtin	builtin.c	/^	static struct builtin {$/
+busy	bkg.c	/^#define	busy(job)	(jobtable[(job)-1].b_flags & J_R/
+c_main	main.c	/^c_main (prtype, bkgfile)$/
+c_scanmode	decl.c	/^c_scanmode (pp, o)$/
+callnewtask	exec.c	/^callnewtask (name)$/
+caseset	gram.c	/^caseset (parg, ncaseval)$/
+catdstr	compile.c	/^catdstr (es, ns)$/
+ck_atoi	pfiles.c	/^ck_atoi (str, val)$/
+cl_amovi	main.c	/^cl_amovi (ip, op, len)$/
+cl_error	errs.c	/^cl_error (va_alist)$/
+cl_scan	scan.c	/^cl_scan (nargs, source)$/
+cl_scanf	scan.c	/^cl_scanf (format, nargs, input)$/
+clallhelp	builtin.c	/^clallhelp()$/
+clallocate	builtin.c	/^clallocate()$/
+clback	builtin.c	/^clback()$/
+clbeep	builtin.c	/^clbeep()$/
+clbye	builtin.c	/^clbye()$/
+clcache	builtin.c	/^clcache ()$/
+clchdir	builtin.c	/^clchdir()$/
+clclbye	builtin.c	/^clclbye()$/
+clclear	builtin.c	/^clclear()$/
+clcurpack	builtin.c	/^clcurpack()$/
+cldeallocate	builtin.c	/^cldeallocate()$/
+cldevstatus	builtin.c	/^cldevstatus()$/
+cldparam	builtin.c	/^cldparam()$/
+cledit	builtin.c	/^cledit()$/
+clehistory	builtin.c	/^clehistory()$/
+cleparam	builtin.c	/^cleparam()$/
+clerror	builtin.c	/^clerror()$/
+clexit	main.c	/^clexit()$/
+clflprcache	builtin.c	/^clflprcache()$/
+clforeign	builtin.c	/^clforeign()$/
+clfprint	builtin.c	/^clfprint()$/
+clfunc	builtin.c	/^clfunc()$/
+clgflush	builtin.c	/^clgflush()$/
+clhelp	builtin.c	/^clhelp()$/
+clhidetask	builtin.c	/^clhidetask()$/
+clhistory	builtin.c	/^clhistory()$/
+cljobs	builtin.c	/^cljobs()$/
+clkeep	builtin.c	/^clkeep()$/
+clkill	builtin.c	/^clkill()$/
+cllogout	builtin.c	/^cllogout()$/
+cllparam	builtin.c	/^cllparam()$/
+clntask	builtin.c	/^clntask()$/
+close_logfile	history.c	/^close_logfile (fname)$/
+closelist	lists.c	/^closelist (pp)$/
+clpack	builtin.c	/^clpack()$/
+clpkg	builtin.c	/^clpkg()$/
+clprcache	builtin.c	/^clprcache()$/
+clprint	builtin.c	/^clprint()$/
+clprintf	builtin.c	/^clprintf()$/
+clputlog	builtin.c	/^clputlog()$/
+clreset	builtin.c	/^clreset()$/
+clrtask	builtin.c	/^clrtask()$/
+clscanf	builtin.c	/^clscanf()$/
+clscans	builtin.c	/^clscans()$/
+clservice	builtin.c	/^clservice()$/
+clset	builtin.c	/^clset()$/
+clshow	builtin.c	/^clshow()$/
+clsleep	builtin.c	/^clsleep()$/
+clstty	builtin.c	/^clstty()$/
+clsystem	clsystem.c	/^clsystem (cmd, taskout, taskerr)$/
+cltask	builtin.c	/^cltask (redef)$/
+cltime	builtin.c	/^cltime()$/
+clunlearn	builtin.c	/^clunlearn()$/
+clupdate	builtin.c	/^clupdate()$/
+clwait	builtin.c	/^clwait()$/
+cmd_match	edcap.c	/^cmd_match (cstring, nchars)$/
+cmdsrch	task.c	/^cmdsrch (pkname, ltname)$/
+codeentry	opcodes.h	/^struct codeentry {$/
+coderef	mem.h	/^#define	coderef(x)	((struct codeentry *)&stack[x])/
+comdstr	compile.c	/^comdstr (s)$/
+compile	compile.c	/^compile (opcode, args, args2)$/
+comstr	compile.c	/^comstr (s, loc)$/
+crackident	gram.c	/^crackident (s)$/
+curcmd	history.c	/^curcmd()$/
+d_alloc	builtin.c	/^struct d_alloc {$/
+d_d	debug.c	/^d_d()$/
+d_f	debug.c	/^d_f()$/
+d_l	debug.c	/^d_l()$/
+d_off	debug.c	/^d_off()$/
+d_on	debug.c	/^d_on()$/
+d_p	debug.c	/^d_p()$/
+d_stack	debug.c	/^d_stack (locpc, ss)$/
+d_t	debug.c	/^d_t()$/
+daddr	mem.h	/^#define	daddr(x)			(&dictionary[x])$/
+dd_f	debug.c	/^dd_f (msg, fname)$/
+defpac	task.c	/^defpac (pkname)$/
+defpar	param.c	/^defpar (param_spec)$/
+deftask	task.c	/^deftask (task_spec)$/
+delpipes	gram.c	/^delpipes (npipes)$/
+dereference	mem.h	/^#define	dereference(ptr) \\$/
+do_arrayinit	decl.c	/^do_arrayinit (pp, nval, nindex)$/
+do_clprint	builtin.c	/^do_clprint (dest)$/
+do_option	decl.c	/^do_option (pp, oo, o)$/
+do_scalarinit	decl.c	/^do_scalarinit (pp, inited)$/
+dtoi	mem.h	/^#define dtoi(x) ((int)(sizeof(double))\/(sizeof(me/
+dumpparams	gram.c	/^dumpparams (pfp)$/
+e_check_vals	eparam.c	/^e_check_vals (string)$/
+e_clear	eparam.c	/^e_clear()$/
+e_clrerror	eparam.c	/^e_clrerror ()$/
+e_clrline	eparam.c	/^e_clrline()$/
+e_colon	eparam.c	/^e_colon()$/
+e_ctrl	eparam.c	/^e_ctrl (cap)$/
+e_display	eparam.c	/^e_display (string, sline, scol)$/
+e_displayml	eparam.c	/^e_displayml (string, sline, scol, ccol)$/
+e_drawkey	eparam.c	/^e_drawkey()$/
+e_dumpop	debug.c	/^e_dumpop()$/
+e_encode_vstring	eparam.c	/^e_encode_vstring (pp, outbuf)$/
+e_getfield	eparam.c	/^e_getfield (ip, outstr, maxch)$/
+e_goto	eparam.c	/^e_goto (col, line)$/
+e_makelist	eparam.c	/^e_makelist (pfileptr)$/
+e_moreflag	eparam.c	/^e_moreflag (topkey)$/
+e_movedown	eparam.c	/^e_movedown (eparam)$/
+e_moveup	eparam.c	/^e_moveup (eparam)$/
+e_pheader	eparam.c	/^e_pheader (pfp, cmdline, maxcol)$/
+e_psetok	eparam.c	/^e_psetok (pset)$/
+e_puterr	eparam.c	/^e_puterr (errmsg)$/
+e_putline	eparam.c	/^e_putline (stwing)$/
+e_repaint	eparam.c	/^e_repaint()$/
+e_rpterror	eparam.c	/^e_rpterror (errstr)$/
+e_scrollit	eparam.c	/^e_scrollit()$/
+e_testtop	eparam.c	/^e_testtop (cur, new)$/
+e_tonextword	eparam.c	/^e_tonextword (ip)$/
+e_toprevword	eparam.c	/^e_toprevword (ip, string)$/
+e_ttyexit	eparam.c	/^e_ttyexit()$/
+e_ttyinit	eparam.c	/^e_ttyinit()$/
+e_undef	eparam.c	/^e_undef (s)$/
+echocmds	clmodes.h	/^#define	echocmds()	(clecho != NULL && \\$/
+edit_commands	eparam.h	/^struct edit_commands {$/
+edit_history_directive	eparam.c	/^edit_history_directive (args, new_cmd)$/
+editstring	eparam.c	/^editstring (string, eparam)$/
+edtexit	edcap.c	/^edtexit()$/
+edtinit	edcap.c	/^edtinit()$/
+effmode	modes.c	/^effmode (pp)$/
+enumin	gquery.c	/^enumin (pp)$/
+ep_context	eparam.h	/^struct ep_context {$/
+eparam	eparam.c	/^eparam (cx, update, nextcmd, nextpset)$/
+eprintf	clprintf.c	/^eprintf (va_alist)$/
+epset	eparam.c	/^epset (pset)$/
+execnewtask	exec.c	/^execnewtask ()$/
+execute	main.c	/^execute (mode)$/
+expand_history_macros	history.c	/^expand_history_macros (in_text, out_text)$/
+fetch_history	history.c	/^fetch_history (recptr, command, maxch)$/
+fieldcvt	gram.c	/^fieldcvt (f)$/
+filetime	pfiles.c	/^filetime (fname, timecode)$/
+find_history	history.c	/^find_history (record)$/
+findexe	exec.c	/^findexe (pkg, pkg_path)$/
+fprop	operand.c	/^fprop (fp, op)$/
+get_arglist	history.c	/^get_arglist (cmdblk, argp)$/
+get_bkgqfiles	modes.c	/^get_bkgqfiles (bkgno, pid, bkg_query_file, query_r/
+get_command	history.c	/^get_command (fp)$/
+get_dim	decl.c	/^get_dim (pname)$/
+get_editor	edcap.c	/^get_editor (editor)$/
+get_history	history.c	/^get_history (record, command, maxch)$/
+get_nscanval	scan.c	/^get_nscanval()$/
+getlabel	gram.c	/^getlabel (name)$/
+getlimits	decl.c	/^getlimits (pname, n, i1, i2)$/
+getoffset	param.c	/^getoffset(pp)$/
+getpipe	gram.c	/^getpipe()$/
+gquery	gquery.c	/^gquery (pp, string)$/
+host_editor	edcap.c	/^host_editor (editor)$/
+in_switch	gram.c	/^in_switch()$/
+initparam	decl.c	/^initparam (op, isparam, type, list)$/
+inrange	modes.c	/^inrange (pp, op)$/
+int	main.c	/^typedef	int (*PFI)();$/
+intr_disable	main.c	/^intr_disable()$/
+intr_enable	main.c	/^intr_enable()$/
+intr_reset	main.c	/^intr_reset()$/
+intrfunc	gram.c	/^intrfunc (fname, nargs)$/
+iofinish	exec.c	/^iofinish (tp)$/
+is_pfilename	pfiles.c	/^is_pfilename (opstr)$/
+keep	builtin.c	/^keep (tp)$/
+keeplog	clmodes.h	/^#define	keeplog()	(clkeeplog != NULL && \\$/
+keyword	gram.c	/^keyword (tbl, s)$/
+keywords	gram.c	/^	struct keywords {$/
+killtask	exec.c	/^killtask (tp)$/
+label	construct.h	/^struct	label {$/
+lapkg	builtin.c	/^lapkg()$/
+lentst	scan.c	/^lentst (buf)$/
+lex_clrcpumode	grammar.h	/^#define	lex_clrcpumode(fp)	((fp)->_fflags &= ~_LEX/
+lex_cpumodeset	grammar.h	/^#define	lex_cpumodeset(fp)	((fp)->_fflags & _LEXBI/
+lex_setcpumode	grammar.h	/^#define	lex_setcpumode(fp)	((fp)->_fflags |= _LEXB/
+lex_yylex	lexyy.c	/^lex_yylex(){$/
+lexicon	lexicon.c	/^lexicon()$/
+lexinit	lexicon.c	/^lexinit()$/
+lexmodes	clmodes.h	/^#define	lexmodes()	(cllexmodes != NULL && \\$/
+listallhelp	gram.c	/^listallhelp (show_invis)$/
+listhelp	gram.c	/^listhelp (pkp, show_invis)$/
+listparams	gram.c	/^listparams (pfp)$/
+log_background	clmodes.h	/^#define log_background() 	(cllogmode & LOG_BACKGRO/
+log_commands	clmodes.h	/^#define log_commands()		(cllogmode & LOG_COMMANDS)/
+log_errors	clmodes.h	/^#define log_errors() 		(cllogmode & LOG_ERRORS)$/
+log_trace	clmodes.h	/^#define log_trace() 		(cllogmode & LOG_TRACE)$/
+logfile	clmodes.h	/^#define	logfile() \\$/
+login	main.c	/^login ()$/
+logout	main.c	/^logout ()$/
+long	config.h	/^typedef memel unsigned long;	\/* type for dictiona/
+lookup_param	param.c	/^lookup_param (pkname, ltname, pname)$/
+loopdecr	gram.c	/^loopdecr()$/
+loopincr	gram.c	/^loopincr ()$/
+ltask	task.h	/^struct ltask {$/
+ltaskfind	task.c	/^ltaskfind (pkp, name, enable_abbreviations)$/
+ltasksrch	task.c	/^ltasksrch (pkname, ltname)$/
+make_imloop	gram.c	/^make_imloop (i1, i2)$/
+makelower	pfiles.c	/^makelower (cp)$/
+makemode	param.c	/^makemode (pp, s)$/
+makeop	operand.c	/^makeop (str, type)$/
+maketype	decl.c	/^maketype (type, list)$/
+map_escapes	edcap.c	/^map_escapes (input, output)$/
+mapname	pfiles.c	/^mapname (in, out, maxlen)$/
+memneed	main.c	/^memneed (incr)$/
+menus	clmodes.h	/^#define	menus()		(clmenus != NULL && \\$/
+minmax	gquery.c	/^minmax (pp)$/
+mk_startupmsg	exec.c	/^mk_startupmsg (tp, cmd, maxch)$/
+mkarglist	builtin.c	/^mkarglist (pfp, args, argp)$/
+mkpfilename	pfiles.c	/^mkpfilename (buf, dir, pkname, ltname, extn)$/
+nargs	builtin.c	/^nargs (pfp)$/
+newbuiltin	builtin.c	/^newbuiltin (pkp, lname, fp, flags, ftprefix, redef/
+newfakeparam	param.c	/^newfakeparam (pfp, name, pos, type, string_len)$/
+newltask	task.c	/^newltask (pkp, lname, pname, oldltp)$/
+newpac	task.c	/^newpac (name, bin)$/
+newparam	param.c	/^newparam (pfp)$/
+newpfile	pfiles.c	/^newpfile (ltp)$/
+next_task	task.h	/^#define next_task(tp)	((struct task *)((char *)tp /
+nextfield	pfiles.c	/^nextfield (pp, fp)$/
+nextstr	modes.c	/^nextstr (pbuf, fp)$/
+notify	clmodes.h	/^#define	notify()	(clnotify != NULL && \\$/
+nxtchr	modes.c	/^nxtchr (p, fp)$/
+o_absargset	opcodes.c	/^o_absargset (argp)$/
+o_add	opcodes.c	/^o_add ()$/
+o_addassign	opcodes.c	/^o_addassign (argp)$/
+o_allappend	opcodes.c	/^o_allappend ()$/
+o_allredir	opcodes.c	/^o_allredir ()$/
+o_and	opcodes.c	/^o_and ()$/
+o_append	opcodes.c	/^o_append()$/
+o_assign	opcodes.c	/^o_assign (argp)$/
+o_biff	opcodes.c	/^o_biff (argp)$/
+o_call	opcodes.c	/^o_call (argp)$/
+o_catassign	opcodes.c	/^o_catassign (argp)$/
+o_chsign	opcodes.c	/^o_chsign ()$/
+o_concat	opcodes.c	/^o_concat ()$/
+o_div	opcodes.c	/^o_div ()$/
+o_divassign	opcodes.c	/^o_divassign (argp)$/
+o_doaddpipe	opcodes.c	/^o_doaddpipe (argp)$/
+o_doend	opcodes.c	/^o_doend()$/
+o_dofscan	opcodes.c	/^o_dofscan()$/
+o_dofscanf	opcodes.c	/^o_dofscanf()$/
+o_dogetpipe	opcodes.c	/^o_dogetpipe (argp)$/
+o_dogoto	opcodes.c	/^o_dogoto (argp)$/
+o_dopow	opcodes.c	/^o_dopow ()$/
+o_doprint	opcodes.c	/^o_doprint()$/
+o_doreturn	opcodes.c	/^o_doreturn()$/
+o_doscan	opcodes.c	/^o_doscan()$/
+o_doscanf	opcodes.c	/^o_doscanf()$/
+o_doswitch	opcodes.c	/^o_doswitch (jmpdelta)$/
+o_eq	opcodes.c	/^o_eq ()$/
+o_exec	opcodes.c	/^o_exec ()$/
+o_fixlanguage	opcodes.c	/^o_fixlanguage()$/
+o_ge	opcodes.c	/^o_ge ()$/
+o_gsredir	opcodes.c	/^o_gsredir (argp)$/
+o_gt	opcodes.c	/^o_gt ()$/
+o_immed	opcodes.c	/^o_immed()$/
+o_indirabsset	opcodes.c	/^o_indirabsset (argp)$/
+o_indirposset	opcodes.c	/^o_indirposset (argp)$/
+o_indxincr	opcodes.c	/^o_indxincr (argp)$/
+o_inspect	opcodes.c	/^o_inspect (argp)$/
+o_intrinsic	opcodes.c	/^o_intrinsic (argp)$/
+o_le	opcodes.c	/^o_le ()$/
+o_lt	opcodes.c	/^o_lt ()$/
+o_mul	opcodes.c	/^o_mul()$/
+o_mulassign	opcodes.c	/^o_mulassign (argp)$/
+o_ne	opcodes.c	/^o_ne ()$/
+o_not	opcodes.c	/^o_not ()$/
+o_or	opcodes.c	/^o_or()$/
+o_osesc	opcodes.c	/^o_osesc (argp)$/
+o_posargset	opcodes.c	/^o_posargset (argp)$/
+o_pushconst	opcodes.c	/^o_pushconst (argp)$/
+o_pushindex	opcodes.c	/^o_pushindex (mode)$/
+o_pushparam	opcodes.c	/^o_pushparam (argp)$/
+o_redir	opcodes.c	/^o_redir ()$/
+o_redirin	opcodes.c	/^o_redirin ()$/
+o_rmpipes	opcodes.c	/^o_rmpipes (argp)$/
+o_sub	opcodes.c	/^o_sub()$/
+o_subassign	opcodes.c	/^o_subassign (argp)$/
+o_swoff	opcodes.c	/^o_swoff (argp)$/
+o_swon	opcodes.c	/^o_swon (argp)$/
+o_undefined	opcodes.c	/^o_undefined ()$/
+offsetmode	param.c	/^offsetmode (mode)$/
+oneof	exec.c	/^oneof()$/
+onerr	main.c	/^onerr()$/
+onint	main.c	/^onint (vex, next_handler)$/
+onipc	prcache.c	/^onipc (vex, next_handler)$/
+opcast	operand.c	/^opcast (newtype)$/
+open_logfile	history.c	/^open_logfile (fname)$/
+operand	operand.h	/^struct operand {$/
+opindef	operand.h	/^#define	opindef(op)	(((op)->o_type & OT_INDEF) != /
+opindir	operand.c	/^opindir()$/
+oprintf	clprintf.c	/^oprintf (va_alist)$/
+oprop	operand.c	/^oprop (op)$/
+opundef	operand.h	/^#define	opundef(op)	(((op)->o_type & OT_UNDEF) != /
+p_position	gram.c	/^p_position()$/
+pacfind	task.c	/^pacfind (name)$/
+package	task.h	/^struct package {$/
+param	param.h	/^struct param {$/
+paramfind	param.c	/^paramfind (pfp, pname, pos, exact)$/
+paramget	param.c	/^paramget (pp, field)$/
+paramset	param.c	/^paramset (pp, field)$/
+paramsrch	param.c	/^paramsrch (pkname, ltname, pname)$/
+parse_clmodes	modes.c	/^parse_clmodes (pp, newval)$/
+pfcopyback	pfiles.c	/^pfcopyback (pff)$/
+pfile	param.h	/^struct pfile {$/
+pfilecopy	pfiles.c	/^pfilecopy (pfp)$/
+pfilefind	pfiles.c	/^pfilefind (ltp)$/
+pfileinit	pfiles.c	/^pfileinit (ltp)$/
+pfileload	pfiles.c	/^pfileload (ltp)$/
+pfilemerge	pfiles.c	/^pfilemerge (npf, opfile)$/
+pfileread	pfiles.c	/^pfileread (ltp, pfilename, checkmode)$/
+pfilesrch	pfiles.c	/^pfilesrch (pfilepath)$/
+pfileunlink	pfiles.c	/^pfileunlink (pfp)$/
+pfileupdate	pfiles.c	/^pfileupdate (pfp)$/
+pfilewrite	pfiles.c	/^pfilewrite (pfp, pfilename)$/
+pipefile	gram.c	/^pipefile (pipecode)$/
+poffset	modes.c	/^poffset (off)$/
+pop	stack.c	/^pop ()$/
+popop	stack.c	/^popop ()$/
+poptask	stack.c	/^poptask ()$/
+ppfind	exec.c	/^ppfind (pfp, tn, pn, pos, abbrev)$/
+pprompt	history.c	/^pprompt (string)$/
+ppush	stack.c	/^ppush (p)$/
+pquery	modes.c	/^pquery (pp, fp)$/
+pr_busy	prcache.c	/^#define	pr_busy(pr)	(((pr)->pr_flags&(P_ACTIVE|P_L/
+pr_cachetask	prcache.c	/^pr_cachetask (ltname)$/
+pr_chdir	prcache.c	/^pr_chdir (pid, newdir)$/
+pr_checkup	prcache.c	/^pr_checkup()$/
+pr_connect	prcache.c	/^pr_connect (process, command, in,out, t_in,t_out,t/
+pr_disconnect	prcache.c	/^pr_disconnect (pid)$/
+pr_dumpcache	prcache.c	/^pr_dumpcache (pid, break_locks)$/
+pr_envset	prcache.c	/^pr_envset (pid, envvar, valuestr)$/
+pr_findproc	prcache.c	/^pr_findproc (process)$/
+pr_getpno	prcache.c	/^pr_getpno()$/
+pr_idle	prcache.c	/^#define	pr_idle(pr)	(((pr)->pr_flags&P_ACTIVE)==0)/
+pr_initcache	prcache.c	/^pr_initcache()$/
+pr_listcache	prcache.c	/^pr_listcache (fp)$/
+pr_lock	prcache.c	/^pr_lock (pid)$/
+pr_pconnect	prcache.c	/^pr_pconnect (process, in, out)$/
+pr_pdisconnect	prcache.c	/^pr_pdisconnect (pr)$/
+pr_pnametopid	prcache.c	/^pr_pnametopid (pname)$/
+pr_prunecache	prcache.c	/^pr_prunecache (pno)$/
+pr_setcache	prcache.c	/^pr_setcache (new_szprcache)$/
+pr_tohead	prcache.c	/^pr_tohead (pr)$/
+pr_totail	prcache.c	/^pr_totail (pr)$/
+pr_unlink	prcache.c	/^pr_unlink (pr)$/
+pretty_param	gram.c	/^pretty_param (pp, fp)$/
+print_command	history.c	/^print_command (fp, command, marg1, marg2)$/
+printcall	exec.c	/^printcall (fp, tp)$/
+printparam	param.c	/^printparam (pp, fp)$/
+proc_params	decl.c	/^proc_params (npar)$/
+process	prcache.c	/^struct process {$/
+process_history_directive	history.c	/^process_history_directive (directive, new_command_/
+procscript	decl.c	/^procscript (fp)$/
+prop	operand.c	/^prop (op)$/
+prparamval	clprintf.c	/^prparamval (pp, fp)$/
+psetreload	exec.c	/^psetreload (main_pfp, psetp)$/
+push	stack.c	/^push (v)$/
+pushbparams	builtin.c	/^pushbparams (pp)$/
+pushbpvals	builtin.c	/^pushbpvals (pp)$/
+pushfparams	builtin.c	/^pushfparams (pp)$/
+pushop	stack.c	/^pushop (op)$/
+pushtask	stack.c	/^pushtask ()$/
+put_history	history.c	/^put_history (command)$/
+put_logfile	history.c	/^put_logfile (command)$/
+putlog	history.c	/^putlog (tp, usermsg)$/
+pvaldefined	param.c	/^pvaldefined (pp, s)$/
+qputs	param.c	/^qputs (str, fp)$/
+qstrcmp	clprintf.c	/^qstrcmp (a, b)$/
+query	modes.c	/^query (pp)$/
+range_check	modes.c	/^range_check (pp)$/
+rbkgfile	bkg.c	/^rbkgfile (bkgfile)$/
+readlist	lists.c	/^readlist (pp)$/
+reference	mem.h	/^#define	reference(sname,index)	((struct sname *) (/
+rerun	gram.c	/^rerun()$/
+reset_logfile	history.c	/^reset_logfile()$/
+restor	exec.c	/^restor (tp)$/
+run	exec.c	/^run ()$/
+scanenum	decl.c	/^scanenum (pp, o)$/
+scanftype	decl.c	/^scanftype (pp, o)$/
+scanlen	decl.c	/^scanlen (pp, o)$/
+scanmax	decl.c	/^scanmax (pp, o)$/
+scanmin	decl.c	/^scanmin (pp, o)$/
+scanmode	pfiles.c	/^scanmode (s)$/
+scantype	pfiles.c	/^scantype (s)$/
+search_history	history.c	/^search_history (directive, new_command_block)$/
+service_bkgquery	modes.c	/^service_bkgquery (bkgno)$/
+set_clio	exec.c	/^set_clio (newtask)$/
+setbuiltins	builtin.c	/^setbuiltins (pkp)$/
+setclmodes	modes.c	/^setclmodes (tp)$/
+setigoto	gram.c	/^setigoto (loc)$/
+setlabel	gram.c	/^setlabel (name)$/
+setopindef	operand.h	/^#define	setopindef(op)	((op)->o_type |= OT_INDEF)$/
+setopundef	operand.h	/^#define	setopundef(op)	((op)->o_type |= OT_UNDEF)$/
+setswitch	gram.c	/^setswitch ()$/
+sexa	gram.c	/^struct operand $/
+sexa_to_index	gram.c	/^sexa_to_index (r, i1, i2)$/
+show_editorhelp	edcap.c	/^show_editorhelp()$/
+show_history	history.c	/^show_history (fp, max_commands)$/
+show_param	gram.c	/^show_param (ltp, pp, fp)$/
+showtype	clmodes.h	/^#define	showtype()	(clshowtype != NULL && \\$/
+shutdown	main.c	/^shutdown()$/
+size_array	param.c	/^size_array (pp)$/
+skip_to	decl.c	/^skip_to (fp, key)$/
+spparval	operand.c	/^spparval (outstr, pp)$/
+sprop	operand.c	/^sprop (outstr, op)$/
+startup	main.c	/^startup()$/
+stkop	ytab.c	/^#define	stkop(x)	(reference (operand, (x)))$/
+stredit	history.c	/^stredit (edit_directive, in_text, out_text)$/
+strint	binop.c	/^strint (s, side)$/
+strsort	clprintf.c	/^strsort (list, nstr)$/
+strtable	clprintf.c	/^strtable (fp, list, nstr, first_col, last_col, max/
+task	task.h	/^struct task {$/
+taskmode	modes.c	/^taskmode (tp)$/
+taskunwind	task.c	/^taskunwind()$/
+today	history.c	/^today()$/
+tprintf	clprintf.c	/^tprintf (va_alist)$/
+traverse	lexyy.c	/^traverse (delim)$/
+unexp	unop.c	/^unexp (opcode)$/
+unop	unop.c	/^unop (opcode)$/
+unsetigoto	gram.c	/^unsetigoto (loc)$/
+until	config.h	/^#define	until(x)	while (!(x))$/
+validparamget	param.c	/^validparamget (pp, field)$/
+value	operand.h	/^union value {$/
+wbkgfile	bkg.c	/^wbkgfile (jobno, cmd)$/
+what_cmd	edcap.c	/^what_cmd (first_char)$/
+what_record	history.c	/^what_record()$/
+y_typedef	gram.c	/^y_typedef (key)$/
+yy_getc	history.c	/^yy_getc (fp)$/
+yy_startblock	history.c	/^yy_startblock (logflag)$/
+yyback	lexyy.c	/^yyback(p, m)$/
+yyerror	gram.c	/^yyerror (s)$/
+yyinput	lexyy.c	/^yyinput(){$/
+yylex	lexicon.c	/^yylex()$/
+yylook	lexyy.c	/^yylook(){$/
+yyoutput	lexyy.c	/^yyoutput(c)$/
+yyparse	ytab.c	/^yyparse()$/
+yysvf	lexyy.c	/^struct yysvf { $/
+yytoktype	ytab.c	/^typedef struct { char *t_name; int t_val; } yytokt/
+yyunput	lexyy.c	/^yyunput(c)$/
+yywork	lexyy.c	/^struct yywork { YYTYPE verify, advance; } yycrank[/
+yywrap	gram.c	/^yywrap ()$/
diff --git a/pkg/vocl/task.c b/pkg/vocl/task.c
new file mode 100644
index 00000000..dbcfd3f9
--- /dev/null
+++ b/pkg/vocl/task.c
@@ -0,0 +1,569 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#include <iraf.h>
+
+#include "config.h"
+#include "operand.h"
+#include "param.h"
+#include "mem.h"
+#include "task.h"
+#include "errs.h"
+#include "clmodes.h"
+#include "proto.h"
+
+
+/*
+ * TASK -- Operators for tasks.
+ */
+
+extern int cldebug;
+extern char *nullstr;
+extern struct param *clabbrev;	/* used to inhibit abbrevs in addltask	*/
+
+extern	int errorline, currentline;
+
+struct task *firstask;		/* ptr to original cl task		*/
+struct task *newtask;		/* ptr to new, but unlinked, task	*/
+struct task *currentask;	/* ptr to ltask currently running	*/
+struct package *curpack;	/* current package in effect		*/
+
+XINT pachead;			/* dict index of first package		*/
+
+
+/* CMDSRCH -- Used by callnewtask() to find the ltask to be run.  Ltname is
+ *   the name of the logical task to be run.  pkname is the name of an
+ *   explicit package.  If pkname is set, just look through its ltasks,
+ *   otherwise circularly search through all packages starting at curpack.
+ * Once we have found an ltask, we see if there is a package with the same
+ *   (full) name.  If there is, we return a pointer to the special pacltask
+ *   with LT_PACCL flag set to signal callnewtask() to just change packages.
+ *   if there isn't, just return a pointer to the ltask.
+ * Ltasksrch() should be used if you don't want all this package checking...
+ * Call error() and don't return on any kind of error.
+ * We need a fake rootpackage entry to be able to change the current package
+ *   to clpackage; see clpkg().
+ */
+struct ltask *
+cmdsrch (char *pkname, char *ltname)
+{
+	register struct ltask *ltp = (struct ltask *) NULL;
+	register struct package *pkp, *pkcand;
+	static	struct ltask pacltask;	/* used to signal a package change */
+	struct	ltask *temptaskset();
+	char	*name;
+
+	if (*pkname != '\0') {      /* package name included; just search it.*/
+	    pkp = pacfind (pkname);
+	    if (pkp == NULL)
+		cl_error (E_UERR, e_pcknonexist, pkname);
+	    else if ((XINT)pkp == ERR)
+		cl_error (E_UERR, e_pckambig, pkname);
+	    else
+		ltp = ltaskfind (pkp, ltname, 1);
+
+	    if (ltp == NULL) { 
+		errorline = currentline; 
+		cl_error (E_UERR, e_tnonexist, ltname);
+	    }
+
+	    if ((XINT)ltp == ERR)
+		cl_error (E_UERR, e_tambig, ltname);
+
+	} else
+	    /* Search all packages. ltasksrch() does not return if it has
+	     * problems so we can count on ltp being set here.
+	     */
+	    ltp = ltasksrch ("", ltname);
+
+	/* If this task did not define a package, just go with it.
+ 	 * Otherwise, search around for package with same name and use it.
+	 * Don't use pacfind() since always want exact matches only.
+	 * If can't find the package now, it must have been existed so we
+	 * should run the task again.
+	 */
+	if (!(ltp->lt_flags & LT_DEFPCK))
+	    return (ltp);
+
+	name = ltp->lt_lname;
+	pkcand = NULL;
+
+	for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
+	    if (!strcmp (name, pkp->pk_name)) {
+		if (pkcand == NULL)
+		    pkcand = pkp;
+		else
+		    pkcand = (struct package *) ERR;
+	    }
+
+	if (pkcand == (struct package *) ERR)
+	    cl_error (E_UERR, e_pckambig, name);
+
+	if (pkcand == NULL)
+	    return (ltp);
+	else {
+	    /* Just change to the given package.
+	     * If unions could be inited, we could set lt_flags once in
+	     *   its declaration above. phooey.
+	     * Use lt_pkp to return new package. see callnewtask().
+	     */
+	    pacltask.lt_flags = (LT_PACCL|LT_CL);
+	    pacltask.lt_pkp = pkcand;
+	    return (&pacltask);
+	}
+}
+
+
+/* LTASKSRCH -- Find ltask of given name along standard path, ie, circularly
+ *   through all packages starting with curpack.  If name included package name
+ *   explicitly, it will be in pkname and then just look down it.
+ * Use abbreviations if enabled. always accept an exact match, even if it
+ *   happened to match more than one longer name as an abbreviation.
+ * Use cmdsrch() if want to include packages themselves in search path.
+ * Always return a valid pointer; call error() and don't return on any kind of
+ *   error.
+ */
+struct ltask *
+ltasksrch (char *pkname, char *ltname)
+{
+	struct	ltask *ltp;
+	struct	package *pkp;
+
+	ltp = _ltasksrch (pkname, ltname, &pkp);
+
+	if (*pkname != EOS) {
+	    if (pkp == NULL)
+		cl_error (E_UERR, e_pcknonexist, pkname);
+	    if ((XINT)pkp == ERR)
+		cl_error (E_UERR, e_pckambig, pkname);
+	}
+
+	if (ltp == NULL)
+	    cl_error (E_UERR, e_tnonexist, ltname);
+	if (ltp == (struct ltask *) ERR)
+	    cl_error (E_UERR, e_tambig, ltname);
+
+	return (ltp);
+}
+
+
+/* _LTASKSRCH -- Same as ltasksrch(), except that cl_error is not called.
+ */
+struct ltask *
+_ltasksrch (char *pkname, char *ltname, struct package **o_pkp)
+{
+	register struct ltask *ltp, *ltcand;
+	register struct package *pkp;
+	register char first_char = ltname[0];
+
+	ltcand = NULL;
+	if (*pkname != '\0') {
+	    /* Package name included; just search it. */
+	    pkp = pacfind (pkname);
+	    if (pkp != NULL && (XINT)pkp != ERR)
+		ltcand = ltaskfind (pkp, ltname, 1);
+
+	} else if (abbrev()) {
+	    /* Settle for abbreviation. */
+	    int     n = strlen (ltname);
+	    int     hit_in_curpack = 0;
+
+	    pkp = curpack;
+	    do {
+		for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt) {
+		    if (*ltp->lt_lname == first_char) {
+			if (!strncmp (ltp->lt_lname, ltname, n)) {
+			    if (ltp->lt_lname[n] == '\0') {	/* exact hit */
+				*o_pkp = pkp;
+				return (ltp);
+			    }
+			    /* Only accept exact hits for hidden tasks.
+			     */
+			    if (ltp->lt_flags & LT_INVIS)
+				continue;
+			    if (ltcand == NULL)
+				ltcand = ltp;
+			    else if (!hit_in_curpack)
+				ltcand = (struct ltask *) ERR;
+			}
+		    }
+		}
+
+		/* If an acceptable abbreviation was found in the current
+		 * package, use it, unless an exact match is found in some
+		 * other package.
+		 */
+		if (ltcand && pkp == curpack)
+		    hit_in_curpack++;
+
+		/* Circular search. */
+		if ((pkp = pkp->pk_npk) == NULL)
+		    pkp = reference (package, pachead);
+
+	    } until (pkp == curpack);
+
+	} else {
+	    /* Require exact match */
+	    pkp = curpack;
+	    do {
+		for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
+		   if (*ltp->lt_lname == first_char)
+		       if (!strcmp (ltp->lt_lname, ltname))
+		           return (ltp);
+		if ((pkp = pkp->pk_npk) == NULL)
+		    pkp = reference (package, pachead);
+	    } until (pkp == curpack);
+	}
+
+	*o_pkp = pkp;
+	return (ltcand);
+}
+
+
+/* PACFIND -- Start at pachead and look for package with given name.  Allow
+ * abbreviations if enabled. return ERR if ambiguous.  Return its pointer or
+ * NULL if not found.
+ */
+struct package *
+pacfind (char *name)
+{
+	struct	package *pkp;
+	struct	package *candidate;
+	int	n;
+
+	if (abbrev()) {
+	    /* Settle for abbreviation of name.
+	     * Check whole list in we can find an exact match.
+	     */
+	    candidate = NULL;
+	    n = strlen (name);
+	    for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
+		if (!strncmp (pkp->pk_name, name, n)) {
+		    if (pkp->pk_name[n] == '\0')
+			return (pkp);   /* exact hit */
+		    if (candidate == NULL)
+			candidate = pkp;
+		    else
+			candidate = (struct package *) ERR;
+		}
+
+	    return (candidate);
+
+	} else for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
+	    if (!strcmp (pkp->pk_name, name))
+		return (pkp);
+	return (NULL);
+}
+
+
+/* DEFPAC -- Return true/false if the named package is/isnot loaded.
+ * Call error if an ambiguous abbreviation is given.
+ */
+int 
+defpac (char *pkname)
+{
+	switch ((XINT) pacfind (pkname)) {
+	case NULL:
+	    return (NO);
+	case ERR:
+	    cl_error (E_UERR, e_pckambig, pkname);
+	default:
+	    return (YES);
+	}
+}
+
+
+/* LTASKFIND -- Start at given package and look for ltask with given name.
+ * Return NULL if not found, ERR if ambiguous or pointer if found.
+ */
+struct ltask *
+ltaskfind (
+    struct package *pkp,			/* package to be searched	*/
+    char *name,				/* ltask name			*/
+    int enable_abbreviations		/* enable abbrev. in search	*/
+)
+{
+	register struct ltask *ltp;
+	struct	ltask *candidate;
+	int	n;
+
+	if (enable_abbreviations && abbrev()) {
+	    /* Settle for abbreviation of nam.
+	     * Check whole list in case we can find an exact match.
+	     */
+	    candidate = NULL;
+	    n = strlen (name);
+	    for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
+		if (!strncmp (ltp->lt_lname, name, n)) {
+		    if (ltp->lt_lname[n] == '\0')
+			return (ltp);		/* exact hit */
+		    if (candidate == NULL)
+			candidate = ltp;
+		    else
+			candidate = (struct ltask *) ERR;
+		}
+
+	    return (candidate);
+
+	} else {
+	    /* Accept exact match only. */
+	    for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
+		if (!strcmp (ltp->lt_lname, name))
+		    return (ltp);
+	}
+
+	return (NULL);
+}
+
+
+/* DEFTASK -- Return true/false if the named ltask is/is not defined.
+ * If a specific package is named, look only there; otherwise search
+ * the usual path.  Call error if an ambiguous abbreviation is given.
+ */
+int 
+deftask (char *task_spec)
+{
+	char	buf[SZ_LINE];
+	char	*pkname, *ltname, *junk;
+	struct	package *pkp;
+	int	stat;
+
+	strcpy (buf, task_spec);
+	breakout (buf, &junk, &pkname, &ltname, &junk);
+
+	if (pkname[0] != '\0') {	/* explicit package named	*/
+	    if ((pkp = pacfind (pkname)) == NULL)
+		cl_error (E_UERR, e_pcknonexist, pkname);
+	    if ((stat = (XINT) ltaskfind (pkp, ltname, 1)) == NULL)
+		return (NO);
+
+	} else {			/* search all packages		*/
+	    pkp = reference (package, pachead);
+	    stat = NULL;
+
+	    while (pkp != NULL) {
+		stat = (XINT) ltaskfind (pkp, ltname, 1);
+		if (stat == ERR)
+		    break;
+		else if (stat != NULL)
+		    return (YES);
+		pkp = pkp->pk_npk;
+	    }
+	}
+
+	if (stat == ERR)
+	    cl_error (E_UERR, e_tambig, ltname);
+	if (stat != NULL)
+	    return (YES);
+	return (NO);
+}
+
+
+/* TASKUNWIND -- Used when aborting from an error or on interrupt, NOT on bye
+ *   or eof.  Starting with top task state, keep popping and killing tasks
+ *   until find one that is T_INTERACTIVE, closing files and pipes along the
+ *   way.
+ * Restore dictionary and stack to what they were when the new (now
+ *   current) task last started compiling with yyparse().  See runtask().
+ * Do NOT update parameter files when a task dies abnormally, just from
+ *   a proper "bye" command or eof.
+ */
+
+int unwind_level = 0;
+
+void 
+taskunwind (void)
+{
+	struct task *lastask = currentask;
+
+	unwind_level = 0;
+	while (!(currentask->t_flags & T_INTERACTIVE)) {
+	    if (cldebug)
+		eprintf ("taskunwind: %d  current='%s'/'%s' status=%d\n",
+		    currentask,
+		    currentask->t_ltp->lt_lname, currentask->t_ltp->lt_pname,
+		    currentask->t_call->status);
+
+	    killtask (currentask);
+	    currentask = poptask();
+	    if (lastask == currentask)
+		break;
+	}
+
+	restor (currentask);
+}
+
+
+/* ADDLTASK -- Make a new ltask off curpack with given ltname/ptname.
+ * Check through whole list and warn about redefs unless redef flag is set.
+ * Look for .cl (script task) or .par (pset task) specs in ptname, and $
+ *   (no pfile) and trailing .bt (io file type) specs in ltname and set
+ *   lt_flags accordingly.
+ * Actual new ltask entry made with newltask() and it re-uses dictionary space
+ *   for the ptask name if possible.
+ * Write error messages here and return ERR if problems, else OK.  Be sure they
+ *   use the same format as error() for consistency.
+ * Do not use abbreviations when checking for possible redefs.
+ * Newltask() may call error() if it can not get enough core.
+ * N.B. ptname and ltname may be changed IN PLACE to simplify suffix tests.
+ */
+struct ltask *
+addltask (struct package *pkp, char *ptname, char *ltname, int redef)
+{
+	register char *cp;
+	register struct ltask *ltp;
+	char	*rindex();
+	char	*ltbase;
+	int	flags;
+
+	flags = 0;
+	ltbase = ltname;
+	if (*ltbase == '$')
+	    ltbase++;
+	else
+	    flags |= LT_PFILE;
+
+	/* A leading underscore signifies that the task is not part of the
+	 * user interface, and hence should not appear in menus etc.  Set
+	 * the LT_INVIS flag, but leave the underscore in the name.
+	 */
+	if (*ltbase == CH_INVIS)
+	    flags |= LT_INVIS;
+
+	/* Check for trailing .bt etc. specs on logical task name.
+	 */
+	if ((cp = rindex (ltbase, '.')) != NULL) {
+	    /* replace '.' with '\0' in hopes of finding valid specs.
+	     * if invalid, put back before giving error diagnostic.
+	     */
+	    *cp++ = '\0';
+	    if (!strcmp (cp, "pkg"))
+		flags |= LT_DEFPCK;
+	    else if (!strcmp (cp, "bt"))
+		flags |= LT_STDINB;
+	    else if (!strcmp (cp, "tb"))
+		flags |= LT_STDOUTB;
+	    else if (!strcmp (cp, "bb") || !strcmp (cp, "b"))
+		flags |= (LT_STDOUTB|LT_STDINB);
+	    else if (strcmp (cp, "tt") && strcmp (cp, "t")) {
+		*--cp = '.';
+		eprintf ("ERROR: bad binary io spec in `%s'\n", ltbase);
+		return (NULL);
+	    }
+	}
+
+	/* Check to see if this is a redefined task.  Inhibit ltaskfind()
+	 * from using abbreviations during redef check.
+	 */
+	ltp = ltaskfind (pkp, ltbase, 0);
+	if (ltp != NULL) {
+	    if (!redef)
+		eprintf ("WARNING: `%s' is a task redefinition.\n", ltbase);
+	} else if (redef)
+	    eprintf ("WARNING: `%s' is not a defined task.\n", ltbase);
+
+	/* Check for trailing .cl spec in physical task name to indicate
+	 * a script task, or a .par to indicate a pset task.
+	 */
+	if (ptname && (cp = rindex (ptname, '.')) != NULL) {
+	    cp++;
+	    if (!strcmp (cp, "cl"))
+		flags |= LT_SCRIPT;
+	    else if (!strcmp (cp, "par"))
+		flags |= (LT_SCRIPT|LT_PSET);
+	}
+
+	ltp = newltask (pkp, ltbase, ptname, ltp);
+	ltp->lt_flags = flags;
+
+	return (ltp);
+}
+
+
+/* NEWLTASK -- Allocate a new ltask on the dictionary and link in off package
+ *   *pkp.  Compile logical name, lname, immediately after.
+ * Look for and reuse physical name, pname, if possible else compile next.
+ *   this is more than a simple savings of core. all ltasks within a ptask will
+ *   have the same lt_pname pointer so, for example, we can test
+ *   newtask->t_ltp->lt_pname == currentask->t_ltp->lt_pname to decide if the
+ *   next ltask is part of the current ptask.
+ * Don't do anything with lt_pname if LT_BUILTIN is set since it uses the
+ *   field (in a union) as a pointer to the built-in function. see task.h.
+ * Link the new ltask immediately off the package at pkp->pk_ltp. this is so
+ *   in a linear search the most recently added task will be seen first.
+ * For task redefinitions don't allocate a new logical task.  Re-use the
+ *   old block and don't change any of the links to the package and other
+ *   tasks.
+ * Null out all unused fields.
+ */
+struct ltask *
+newltask (register struct package *pkp, char *lname, char *pname, struct ltask *oldltp)
+{
+	register struct ltask *ltp, *newltp;
+
+	if (oldltp == NULL) {
+	    newltp = (struct ltask *) memneed (LTASKSIZ);
+	    newltp->lt_lname = comdstr (lname);
+	} else
+	    newltp = oldltp;
+
+	/* Look for another ltask with same pname; use it again if find else
+	 * compile in a new pname.  Don't do anything, however, if LT_BUILTIN
+	 * is set as it does not use this union member this way.
+	 */
+	if (pname) {
+	    for (ltp = pkp->pk_ltp;  ltp != NULL;  ltp = ltp->lt_nlt) {
+		if (!(ltp->lt_flags & LT_BUILTIN)) {
+		    if (strcmp (ltp->lt_pname, pname) == 0) {
+			newltp->lt_pname = ltp->lt_pname;
+			goto link;
+		    } 
+		}
+	    }
+	    newltp->lt_pname = comdstr (pname);
+	} else
+	    newltp->lt_pname = "";
+
+link:
+	if (oldltp == NULL) {
+	    /* Link in as first ltask off this package.
+	     */
+	    newltp->lt_nlt = pkp->pk_ltp;
+	    pkp->pk_ltp = newltp;
+	    newltp->lt_pkp = pkp;	/* set the back-link		*/
+	}
+
+	newltp->lt_flags = 0;
+	return (newltp);
+}
+
+
+/* NEWPAC -- Allocate a new package with given name on the dictionary and
+ * link in at pachead. compile name in-line immediately after.
+ * null out all unused fields.
+ * call error() if no core or if name already exists.
+ */
+struct package *
+newpac (char *name, char *bin)
+{
+	register struct package *pkp;
+
+	if (pacfind (name) != NULL)
+	    cl_error (E_UERR, "package `%s' already exists", name);
+
+	pkp = (struct package *) memneed (PACKAGESIZ);
+	pkp->pk_name = comdstr (name);
+	pkp->pk_bin = bin ? comdstr(bin) : curpack->pk_bin;
+
+	pkp->pk_npk = reference (package, pachead);
+	pachead = dereference (pkp);
+
+	pkp->pk_ltp = NULL;
+	pkp->pk_pfp = NULL;
+	pkp->pk_flags = 0;
+
+	return (pkp);
+}
diff --git a/pkg/vocl/task.h b/pkg/vocl/task.h
new file mode 100644
index 00000000..4a795a41
--- /dev/null
+++ b/pkg/vocl/task.h
@@ -0,0 +1,226 @@
+/*
+ * TASK.H -- Each time a new task is run, a task struct is pushed onto the top
+ * of the control stack. The struct is popped off when the task dies.
+ * This allows recursive task calling.
+ *
+ * Each TASK directive creates a new ltask struct at the top of the
+ *   dictionary and gets linked in at the head of the current package, curpack.
+ * Each PACKAGE directive creates a new package struct at the top of the
+ *   dictionary and gets linked at pachead.
+ *
+ * ASSUMES config.h, param.h and stdio.h already include'd.
+ */
+
+
+extern struct task *firstask;	/* pointer to original cl task		*/
+extern struct task *newtask;	/* new task being prepared for execing;
+				 * not linked in to task list nor does it
+				 * become currentask until run.
+				 */
+extern struct task *currentask;	/* the currently running task		*/
+extern struct package *curpack;	/* current package			*/
+
+
+/* prevtask may be used as a pointer to the previous, ie, parent, task.
+ * exploiting c's ability to do pointer arithmetic, it is simple one
+ * task up from currentask on the control stack.
+ * this is used alot in the builtin commands to gain access to their parent.
+ * note that if currentask == firstask, prevtask will point beyond the
+ * control stack and should not be used.
+ */
+
+/* Added because tp++ will not always be the next task structure. (FJR).
+ * NOTE -- Must explicitly coerce to char pointer for correct byte arithmetic
+ * on word (rather than byte) addessed machines.
+ */
+#define next_task(tp)	((struct task *)((char *)tp + (TASKSIZ*BPI)))
+
+#define	prevtask	next_task(currentask)
+
+
+/* ----------
+ * info that is needed about a task as it appears on the control stack
+ * while it is running.
+ */
+struct task {
+	FILE	*t_stdin,	/* where xmit/xfer to stdin/out/err go	*/
+		*t_stdout,
+	     	*t_stderr,
+		*t_stdgraph,	/* standard graphics streams		*/
+		*t_stdimage,
+		*t_stdplot;
+	FILE	*t_in,		/* pipe read and write connections	*/
+		*t_out;
+	char	*ft_in;		/* stdin  file for foreign task		*/
+	char	*ft_out;	/* stdout file for foreign task		*/
+	char	*ft_err;	/* stderr file for foreign task		*/
+	struct ltask *t_ltp;	/* link back to fostering ltask		*/
+	unsigned XINT
+		t_topd,		/* topd when this task was last pushed	*/
+		t_pc,		/* pc			"		*/
+		t_topos,	/* topos		"		*/
+		t_basos,	/* basos		"		*/
+		t_topcs;	/* topcs		"		*/
+	XINT	t_envp;		/* environment stack pointer		*/
+	int	t_pno;		/* mark package load time in prcache	*/
+	struct package *t_curpack;/* curpack		"		*/
+	unsigned t_bascode;	/* base addr of currently running code	*/
+	int	t_pid;		/* process id of this ptask		*/
+	int	t_scriptln;	/* script line number while parsing	*/
+	int	t_callln;	/* script line number while executing	*/
+	struct	param *t_modep;	/* pointer to this task's `mode' param	*/
+	struct	pfile *t_pfp;	/* pointer to pfile			*/
+	int	t_flags;	/* see T_XXX flags below		*/
+
+	struct task_call *t_call;/* pointer to task calling struct	*/
+	char	*onerr_handler; /* local onerr handler			*/
+};
+
+
+struct  task_call {
+	char   *name;		/* task name				*/
+	char   *script;		/* calling script name			*/
+	int    linenum;		/* calling script line number		*/
+	int    errcode;		/* error code				*/
+	char   *errmsg[SZ_LINE];/* error message			*/
+	int    status;		/* return status			*/
+};
+
+
+/* A leading underscore in the ltask name is used to flag tasks which
+ * should not appear in the menus.
+ */
+#define	CH_INVIS	'_'
+
+/* t_flags */
+#define	T_SCRIPT	00000001 /* means t_ltp->lt_flags & LT_SCRIPT >0*/
+#define	T_CL		00000002 /* means that t_ltp == firstask->t_ltp	*/
+#define	T_INTERACTIVE	00000004 /* T_CL && t_stdio == real stdio	*/
+#define	T_BUILTIN	00000010 /* task is built in; see builtin.c	*/
+#define	T_FOREIGN	00000020 /* host task, a type of builtin	*/
+#define	T_PSET		00000040 /* pset (parameter set) task		*/
+#define	T_PKGCL		00000100 /* task is name of a loaded package	*/
+#define	T_CLEOF		00000200 /* cl() with EOF on current stream	*/
+#define	T_TIMEIT	00000400 /* print time consumed by task		*/
+
+
+/* These flags are set by the opcodes that change a newtask's pseudofile,
+ * such as SETSTDOUT.  Only when the flag is set will the file then be
+ * closed by a "bye" or eof from the ltask by clbye().
+ */
+#define	T_MYOUT		00001000 /* t_stdout was set to exec this task	*/
+#define	T_MYIN		00002000 /* t_stdin             "		*/
+#define	T_MYERR		00004000 /* t_stderr	        "		*/
+#define	T_MYSTDGRAPH	00010000 /* t_stdgraph	        "		*/
+#define	T_MYSTDIMAGE	00020000 /* t_stdimage	        "		*/
+#define	T_MYSTDPLOT	00040000 /* t_stdplot	        "		*/
+#define	T_IPCIO		00100000 /* t_stdout redirected to t_out	*/
+#define	T_STDINB	00200000 /* stdin is binary			*/
+#define	T_STDOUTB	00400000 /* stdout is binary			*/
+#define	T_APPEND	01000000 /* append output of foreign task	*/
+
+/* This flag is set by execnewtask() when a task begins running, and is
+ * cleared by iofinish() when the task's i/o is closed down.  Provided so
+ * that we can call iofinish at several points during error recovery without
+ * trying to close files more than once.
+ */
+#define	T_RUNNING	02000000
+
+/* When this bit is set we are running unattended as a background cl.
+ * Seeing this bit on will prevent pfile writes and all errors and signals
+ * will cause immediate io flushing and exit.
+ */
+#define	T_BATCH		04000000
+
+/* IPCIO definitions. */
+#define	IPCOUT		"IPC$IPCIO-OUT"
+#define	IPCDONEMSG	"# IPC$IPCIO-FINISHED\n"
+
+
+/* Struct LTASK -- One of these is created at the top of the dictionary and
+ *   gets linked in to its package by each ltask named (or implied) in a TASK
+ *   directive.  We need the name of the ltask, filename of the ptask, pointer
+ *   to next in list of ltasks on this package, pointer to the parent package
+ *   and misc flags.
+ * The pointer to the parent package is used to get the prefix for the
+ *   ltask's param file when writing it out locally.  Lname is built into the
+ *   directionary right after the structure; pname is re-used if possible by
+ *   looking to see if another ltask exists in the same package with the same
+ *   name.  This is more than a savings of core as its the way connect()
+ *   decides if a new ltask is in the currently running ptask (by comparing
+ *   currentask->t_ltp->lt_pname with newtask->t_ltp->lt_pname).
+ * Note that the ftprefix string cannot be included in the union lt_u as
+ *   a foreign task is a builtin and the ltu_f field is already used to point
+ *   to the builtin to be run to issue the host command.
+ */
+
+struct ltask {
+	char *lt_lname;		/* name of this logical task		*/
+	union {
+		char *ltu_pname;/* name of this ltask's physical file	*/
+		void (*ltu_f)();/* function to run for this builtin	*/
+	} lt_u;
+	char	*lt_ftprefix;	/* OSCMD command prefix for foreign tsk	*/
+	struct	ltask *lt_nlt;	/* ptr to next ltask in this package	*/
+	struct	package *lt_pkp;/* pointer to parent package		*/
+	int	lt_flags;	/* see LT_XXX flags below		*/
+};
+
+/* alias's for fields in union lt_u.
+ */
+#define	lt_pname	lt_u.ltu_pname
+#define	lt_f		lt_u.ltu_f
+
+
+/* lt_flags */
+#define	LT_SCRIPT	000001	/* this task is just a script and so is	*/
+				/*   the only one in this ptask		*/
+#define	LT_PFILE	000002	/* this task has a pfile (some don't!).	*/
+#define	LT_STDINB	000004	/* set if task's stdin is binary stream	*/
+#define	LT_STDOUTB	000010	/*      "        stdout       "		*/
+#define	LT_BUILTIN	000020	/* task is built into CL		*/
+#define	LT_FOREIGN	000040	/* host task, called with c_oscmd()	*/
+#define	LT_PSET		000100	/* pset (parameter set) task		*/
+#define	LT_INVIS	000200	/* don't show this task in menu		*/
+#define	LT_PACCL	000400	/* changing packages; see callnewtask()	*/
+#define LT_CL		001000	/* task is some variant of cl()		*/
+#define LT_CLEOF	002000	/* task is cl with EOF (cleof())	*/
+#define	LT_DEFPCK	004000	/* the task def'd a pkg with same name	*/
+#define	LT_UPFOK	010000	/* user pfile exists and is valid	*/
+
+
+/* ----------
+ * A package consists of its name, a pointer to next package (maintained in
+ * a LIFO fashion off pachead), pointer to first in a list of ltasks in
+ * this package, pointer to its in-core pfile, and misc flags (not used so far).
+ * the name string is built into the dictionary directly after the struct.
+ */
+ 
+struct package {
+	char	*pk_name;		/* name of package		*/
+	char	*pk_bin;		/* package BIN directory	*/
+	struct	package *pk_npk;	/* ptr to next package		*/
+	struct	ltask *pk_ltp;		/* ptr to first ltask in pkg	*/
+	struct	pfile *pk_pfp;		/* ptr to pkg pfile, if loaded	*/
+	int	pk_flags;		/* package flags		*/
+};
+ 
+/* pk_flags */
+    	/* none at present */
+
+
+/* ----------
+ * size of of the task, ltask, and package structs IN INTS.
+ * this is to properly increment pointers within dictionary.
+ */
+ 
+#define	TASKSIZ		btoi (sizeof (struct task))
+#define	LTASKSIZ	btoi (sizeof (struct ltask))
+#define	PACKAGESIZ	btoi (sizeof (struct package))
+#define	TCALLSIZ	btoi (sizeof (struct task_call))
+
+struct	package *newpac(), *pacfind();
+struct	ltask *addltask(), *newltask(), *ltaskfind(), *cmdsrch();
+struct	ltask *ltasksrch(), *_ltasksrch();
+struct	task *pushtask(), *poptask();
+int	deftask(), defpac();
diff --git a/pkg/vocl/unop.c b/pkg/vocl/unop.c
new file mode 100644
index 00000000..92893412
--- /dev/null
+++ b/pkg/vocl/unop.c
@@ -0,0 +1,419 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define	import_spp
+#define	import_libc
+#define	import_stdio
+#define	import_xnames
+#define	import_math
+#include <iraf.h>
+
+#include <ctype.h>
+#include "config.h"
+#include "operand.h"
+#include "errs.h"
+#include "task.h"
+#include "param.h"
+#include "proto.h"
+
+
+extern	int	cldebug;
+
+/*
+ * UNOP -- Perform unary operations or expressions on one operand.
+ *
+ * Always perform the arithmetic in native machine type, eg, don't do integer
+ * arithmetic by converting to floating and back.
+ */
+
+#define	UNSET		(-1)		/* value not set yet		*/
+
+#define	RADIAN		57.295779513082320877
+
+
+/* UNOP -- pop top operand from stack and push back result of performing the
+ * unary operation whose code is in opcode.  An indef operand is not considered
+ * fatal but is propagated through.  Call error() and do not return if find an
+ * internal error or an undefined string operation.
+ */
+void 
+unop (int opcode)
+{
+	register int out_type;		/* bool, int, real, string	*/
+	register int in_type;		/* bool, int, real, string	*/
+	struct	operand o, result;
+	double	rval=0., rresult;	/* input value, result		*/
+	long	ival=0, iresult;
+	char	*sval=NULL, *sresult=NULL;
+	char	fname[SZ_PATHNAME];
+	char	ch, sbuf[SZ_LINE];
+	char	*envget();
+	int 	i;
+
+	o = popop();			/* pop operand from stack	*/
+	in_type = o.o_type;
+
+	/* Exit if indefinite and we're not testing for it. */
+	if (opindef(&o)) {		
+	   if (opcode != OP_ISINDEF) {
+	       result.o_type = OT_INT;
+	       setopindef (&result);
+	       goto pushresult;
+	    } else
+		in_type = OT_BOOL;
+	}
+
+
+	/* Check that operand is a legal type.  Determine the type of the
+	 * result.  Set the input value (ival, rval, sval).
+	 */
+
+	out_type = UNSET;
+
+	switch (opcode) {
+	case OP_ABS:
+	case OP_MINUS:
+	    out_type = in_type;
+	    /* fall through */
+
+	case OP_INT:
+	case OP_NINT:
+	case OP_BNOT:
+	case OP_SIGN:
+	    if (out_type == UNSET)
+		out_type = OT_INT;	/* force integer result here	*/
+	    /* fall through */
+
+	case OP_ACOS:
+	case OP_ASIN:
+	case OP_COS:
+	case OP_DACOS:
+	case OP_DASIN:
+	case OP_DCOS:
+	case OP_DSIN:
+	case OP_DTAN:
+	case OP_DEG:
+	case OP_EXP:
+	case OP_LOG:
+	case OP_LOG10:
+	case OP_SIN:
+	case OP_SQRT:
+	case OP_RAD:
+	case OP_REAL:
+	case OP_TAN:
+	case OP_FRAC:
+	    /* Check that an improper operation is not being performed upon
+	     * a string operand.  If the output result is int or real, the
+	     * only legal operations are explicit type coercion via the INT
+	     * and REAL intrinsic functions.
+	     */
+	    if (in_type == OT_STRING)
+		switch (opcode) {
+		case OP_INT:
+		case OP_REAL:
+		    break;
+		default:
+		    cl_error (E_UERR, e_badstrop, o.o_val.v_s);
+		}
+
+	    if (out_type == UNSET)	/* force real result here	*/
+		out_type = OT_REAL;
+	    break;
+
+	case OP_STRLEN:
+	    out_type = OT_INT;
+	    /* fall through */
+
+	case OP_ACCESS:			/* these all require string op	*/
+	case OP_IMACCESS:
+	case OP_DEFPAC:
+	case OP_DEFPAR:
+	case OP_DEFVAR:
+	case OP_DEFTASK:
+	    if (out_type == UNSET)
+		out_type = OT_BOOL;
+	    /* fall through */
+
+	case OP_ENVGET:
+	case OP_MKTEMP:
+	case OP_OSFN:
+	case OP_STRLWR:
+	case OP_STRUPR:
+	    if (in_type != OT_STRING)
+		cl_error (E_UERR, "operand must be of type string");
+	    /* fall through */
+
+	case OP_STR:
+	    if (out_type == UNSET)
+		out_type = OT_STRING;
+	    break;
+
+	case OP_ISINDEF:
+	    out_type = OT_BOOL;
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "unop()");
+	}
+
+	/* Set the appropriate handy input value variable; check that the
+	 * input type is not a boolean.
+	 */
+	switch (in_type) {
+	case OT_BOOL:
+	    if (opcode == OP_STR)
+		ival = o.o_val.v_i;		/* str(bool) is ok	*/
+	    else if (opcode == OP_MINUS)
+		cl_error (E_UERR, "Arithmetic negation of a boolean operand");
+	    else if (opcode != OP_ISINDEF)
+		cl_error (E_UERR,
+		"Intrinsic function called with illegal boolean argument");
+	    break;
+	case OT_INT:
+	    ival = o.o_val.v_i;
+	    rval = (double)ival;
+	    break;
+	case OT_REAL:
+	    rval = o.o_val.v_r;
+	    if (rval > MAX_LONG || -rval > MAX_LONG)
+		ival = INDEFL;
+	    else
+		ival = (long)rval;
+	    break;
+	case OT_STRING:
+	    sval = o.o_val.v_s;
+	    break;
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "unop()");
+	}
+
+	/* Perform the operation.
+	 */
+	switch (opcode) {
+	case OP_ABS:
+	    if (out_type == OT_REAL)
+		rresult = (rval < 0) ? -rval : rval;
+	    else
+		iresult = (ival < 0) ? -ival : ival;
+	    break;
+	case OP_ACCESS:
+	    iresult = (c_access (sval, 0, 0) == YES);
+	    break;
+	case OP_ACOS:
+	    rresult = acos (rval);
+	    break;
+	case OP_ASIN:
+	    rresult = asin (rval);
+	    break;
+	case OP_BNOT:
+	    iresult = ~ival;
+	    break;
+	case OP_COS:
+	    rresult = cos (rval);
+	    break;
+	case OP_DACOS:
+	    rresult = acos (rval) * RADIAN;
+	    break;
+	case OP_DASIN:
+	    rresult = asin (rval) * RADIAN;
+	    break;
+	case OP_DCOS:
+	    rresult = cos (rval/RADIAN);
+	    break;
+	case OP_DSIN:
+	    rresult = sin (rval/RADIAN);
+	    break;
+	case OP_DTAN:
+	    rresult = tan (rval/RADIAN);
+	    break;
+	case OP_DEFPAC:
+	    iresult = defpac (sval);
+	    break;
+	case OP_DEFPAR:
+	    iresult = defpar (sval);
+	    break;
+	case OP_DEFTASK:
+	    iresult = deftask (sval);
+	    break;
+	case OP_DEFVAR:
+	    iresult = defvar (sval);
+	    break;
+	case OP_DEG:
+	    /* Convert input radians to degrees. */
+	    rresult = rval * RADIAN;
+	    break;
+	case OP_ENVGET:
+	    if ((sresult = envget (sval)) == NULL)
+		cl_error (E_UERR, "Environment variable '%s' not found", sval);
+	    break;
+	case OP_EXP:
+	    rresult = exp (rval);
+	    break;
+	case OP_FRAC:
+	    if (rval < 0.0e0) {
+		rresult = -rval;
+		rresult = -(rresult - (int) rresult);
+	    } else
+		rresult = rval - (int) rval;
+	    break;
+	case OP_IMACCESS:
+	    iresult = (c_imaccess (sval, 0) == YES);
+	    break;
+	case OP_INT:
+	    if (in_type == OT_STRING) {
+		if (sscanf (sval, "%ld", &iresult) != 1)
+		    cl_error (E_UERR, "Cannot coerce string `%s' to int", sval);
+	    } else
+		iresult = ival;
+	    break;
+	case OP_ISINDEF:
+	    if (in_type == OT_STRING)
+	        iresult = (strcmp (o.o_val.v_s, "INDEF") == 0);
+	    else
+	        iresult = opindef(&o);
+	    break;
+	case OP_LOG:
+	    if (rval <= 0)
+		cl_error (E_UERR, "log of a negative or zero argument");
+	    rresult = log (rval);
+	    break;
+	case OP_LOG10:
+	    if (rval <= 0)
+		cl_error (E_UERR, "log10 of a negative or zero argument");
+	    rresult = log10 (rval);
+	    break;
+	case OP_MINUS:
+	    if (out_type == OT_REAL)
+		rresult = -rval;
+	    else
+		iresult = -ival;
+	    break;
+	case OP_MKTEMP:
+	    c_mktemp (sval, fname, SZ_PATHNAME);
+	    sresult = fname;
+	    break;
+	case OP_NINT:
+	    if (in_type == OT_REAL)
+		iresult = nint (rval);
+	    else
+		iresult = ival;
+	    break;
+	case OP_OSFN:
+	    c_fmapfn (sval, fname, SZ_PATHNAME);
+	    sresult = fname;
+	    break;
+	case OP_RAD:
+	    /* Convert input degrees to radians. */
+	    rresult = rval / RADIAN;
+	    break;
+	case OP_REAL:
+	    if (in_type == OT_STRING) {
+		if (sscanf (sval, "%lf", &rresult) != 1)
+		    cl_error (E_UERR,
+			"Cannot coerce string `%s' to real", sval);
+	    } else
+		rresult = rval;
+	    break;
+	case OP_SIGN:
+	    if (in_type == OT_REAL)
+		iresult = (rval < 0) ? -1 : 1;
+	    else
+		iresult = (ival < 0) ? -1 : 1;
+	    break;
+	case OP_SIN:
+	    rresult = sin (rval);
+	    break;
+	case OP_SQRT:
+	    if (rval < 0)
+		cl_error (E_UERR, "sqrt of a negative number");
+	    rresult = sqrt (rval);
+	    break;
+	case OP_STR:
+	    pushop (&o);
+	    opcast (OT_STRING);
+	    o = popop();
+	    sresult = o.o_val.v_s;
+	    break;
+	case OP_STRLEN:
+	    iresult = strlen (sval);
+	    break;
+	case OP_STRLWR:
+	    for (i=0; (ch = o.o_val.v_s[i]) != EOS; i++)
+		sbuf[i] = (isupper (ch) ? tolower (ch) : ch);
+	    sbuf[i] = EOS;
+	    sresult = sbuf;
+	    break;
+	case OP_STRUPR:
+	    for (i=0; (ch = o.o_val.v_s[i]) != EOS; i++)
+		sbuf[i] = (islower (ch) ? toupper (ch) : ch);
+	    sbuf[i] = EOS;
+	    sresult = sbuf;
+	    break;
+	case OP_TAN:
+	    rresult = tan (rval);
+	    break;
+
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "unop()");
+	}
+
+	switch (out_type) {
+	case OT_BOOL:
+	case OT_INT:
+	    result.o_val.v_i = iresult;
+	    break;
+	case OT_REAL:
+	    result.o_val.v_r = rresult;
+	    break;
+	case OT_STRING:
+	    result.o_val.v_s = sresult;
+	    break;
+	default:
+	    cl_error (E_UERR, "illegal datatype in intrinsic");
+	}
+	result.o_type = out_type;
+
+pushresult:
+	pushop (&result);
+}
+
+
+/* UNEXP -- Pop top operand and replace with boolean result operand of applying
+ *   logical operation in opcode.
+ * Result is always an operand with o_type OP_BOOL and o_val.v_i as
+ *   returned from relation.
+ * Propagate bad operands through, but call error() and do not return
+ *   on internal errors or undefined operations.
+ * It is illegal to perform a boolean operation on a non-boolean operand;
+ *   there is no automatic type coercion for booleans.
+ */
+void 
+unexp (int opcode)
+{
+	struct	operand o, result;
+	int	type;
+
+	o = popop();
+	type = o.o_type;
+
+	if (opindef (&o)) {
+	    result.o_type = OT_BOOL;
+	    setopindef (&result);
+	    goto pushresult;
+	}
+
+	switch (opcode) {
+	case OP_NOT:
+	    if (type != OT_BOOL)
+		cl_error (E_UERR, "Boolean negation of a non-boolean operand");
+	    result.o_val.v_i = !o.o_val.v_i;
+	    break;
+	default:
+	    cl_error (E_IERR, e_badsw, opcode, "unexp()");
+	}
+
+	result.o_type = OT_BOOL;
+
+pushresult:
+	pushop (&result);
+}
diff --git a/pkg/vocl/uparm/history.cl b/pkg/vocl/uparm/history.cl
new file mode 100644
index 00000000..52becd62
--- /dev/null
+++ b/pkg/vocl/uparm/history.cl
@@ -0,0 +1,22 @@
+  1 ls uparm
+  2 cat uparm/usrtest.par
+  3 logo
+  1 test
+  2 print (test.sql)
+  3 logo
+  1 logo
+  1 logo
+  1 logo
+  1 logo
+  1 logo
+  1 logo
+  1 logo
+  1 path
+  2 logo
+  1 logo
+  1 print ("dir") | cl()
+  2 logo
+  1 logo
+  1 logo
+  1 logo
+  1 logo
diff --git a/pkg/vocl/uparm/usrtest.par b/pkg/vocl/uparm/usrtest.par
new file mode 100644
index 00000000..3820b30e
--- /dev/null
+++ b/pkg/vocl/uparm/usrtest.par
@@ -0,0 +1,2 @@
+sql,s,h,"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla",,,"out"
+mode,s,h,"ql",,,
diff --git a/pkg/vocl/vocl.x b/pkg/vocl/vocl.x
new file mode 100644
index 00000000..531a9602
--- /dev/null
+++ b/pkg/vocl/vocl.x
@@ -0,0 +1,32 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	vocl = t_vocl
+
+procedure t_vocl ()
+begin
+end
+
+
+# CL -- The main entry point of the CL.  Unlike most IRAF tasks, the CL task
+# occupies a process all by itself and takes control immediately when the task
+# is executed; the in-task interpreter never runs.  The ONENTRY procedure is
+# used to achieve this.  ONENTRY gains control from the IRAF main at process
+# startup, before the in task interpreter is entered.  The t_cl procedure is
+# not called by the interpreter as the TASK statement suggests.  The purpose
+# of the task statement is to give us an IRAF main.
+
+int procedure onentry (prtype, bkgfile, cmd)
+
+int	prtype			# process type flag (not used)
+char	bkgfile[ARB]		# bkgfilename if detached process (not used)
+char	cmd[ARB]		# optional host command line
+
+char	pk_bkgfile[SZ_PATHNAME]
+char	pk_cmd[SZ_COMMAND]
+int	c_main()
+
+begin
+	call strpak (bkgfile, pk_bkgfile, SZ_PATHNAME)
+	call strpak (cmd, pk_cmd, SZ_COMMAND)
+	return (c_main (prtype, pk_bkgfile, pk_cmd))
+end
diff --git a/pkg/vocl/voclient.c b/pkg/vocl/voclient.c
new file mode 100644
index 00000000..e140b7dd
--- /dev/null
+++ b/pkg/vocl/voclient.c
@@ -0,0 +1,1754 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_prstat
+#define import_xwhen
+#include <iraf.h>
+
+#include "config.h"
+#include "clmodes.h"
+#include "operand.h"
+#include "mem.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "param.h"
+#include "task.h"
+#include "errs.h"
+#include "construct.h"
+#include "ytab.h"		/* pick up yacc token #defines		*/
+
+#include "voclient.h"
+
+#define SZ_RESBUF		(32*SZ_LINE)
+#define DEF_RESATTR		"ServiceURL"
+#define MAX_ATTRS		32
+
+
+extern  int do_error;           /* runtime error handling               */
+extern  ErrCom  errcom;
+
+extern int     optbl[];
+extern char   *ifnames[];
+
+static int    debug			= 0;
+static int    reg_nresolved 		= 0;
+
+int    	      VOClient_initialized 	= 0;
+
+char   	     *voGetStrArg();
+int           voGetIntArg();
+double        voGetDblArg();
+
+#ifdef FOO
+typedef int   DAL;                 	/* DAL type aliases             */
+typedef int   Query;			/* DAL Query object		*/
+typedef int   QResponse;		/* Query Response object	*/
+typedef int   QRecord;			/* Query Record (row) object	*/
+typedef int   QRAttribute;		/* Query Attr (col)  object	*/
+typedef int   RegQuery;                 /* Registry Query object        */
+typedef int   RegResult;                /* Query Result object          */
+#endif
+
+    
+
+/**
+ *   VO Client Library:
+ *   ----------------------
+ *
+ *	 stat = initVOClient (opts)				    int [opt]
+ *       stat = closeVOClient (quit_flag)		    	    int [opt]
+ *     stat = restartVOClient (quit_flag)		    	    int [opt]
+ *
+ *         stat = validateObj (obj)		    	    	    int
+ *            stat = vocReady ()		    	    	    bool
+ *
+ *   DAL Service Interface:   		(task prefix 'dal')
+ *   ----------------------
+ *
+ *    Hi-Level Interface:
+ *
+ *          qres = dalConeSvc (url, ra, dec, sr)                     int
+ *          qres = dalSiapSvc (url, ra, dec, rsize[, dsize[, fmt]])  int
+ *
+ *     count = dalRecordCount (qres)                                 int
+ *
+ *          stat = dalGetData (qres, recnum, fname)                  int
+ *
+ *            fname = getData (acref)                    	     string
+ *            fname = getData (acref, fname)                         string
+ *            fname = getData (rec, acref, fname)                    string
+ *
+ *         rec = dalGetRecord (qres, recnum)                         int
+ *            str = dalGetStr (qres, attrname, recnum)               string
+ *           ival = dalGetInt (qres, attrname, recnum)               int
+ *           dval = dalGetDbl (qres, attrname, recnum)               double
+ *
+ *
+ *    Low-Level Interface:
+ *
+ *       count = dalAttrCount (rec)                                  int
+ *     attrname = dalAttrName (rec, index)                           string
+ *          ival = dalIntAttr (rec, attrname)                        int
+ *        dval = dalFloatAttr (rec, attrname)                        double
+ *           str = dalStrAttr (rec, attrname)                        string
+ *
+ *        nscan = dalAttrScan (rec, attr_list, <p1>...<pN>)          *NYI
+ *
+ *
+ *   Registry Search Interface:   	(task prefix 'reg')
+ *   --------------------------
+ *
+ *	   str = regResolver (shortName,[svctype[,attr[,index]]])    string
+ *	       N = nresolved ()					     int
+ *
+ *       resource = regSearch (term [, orValues])                    int     
+ *       resource = regSearch (keywords, orValues)                   int     
+ *       resource = regSearch (sql, keywords, orValues)              int     
+ *
+ *    resource = regSvcSearch (searchTerm, svcType, bpass, 
+ *					   clevel, orValues)         int
+ *
+ *     count = regResultCount (resource)                             int     
+ *             str = regValue (resource, attr_list, resIndex)        int
+ *
+ *            nscan = regScan (resource, attribute, resIndex, <p>)   *NYI
+ */
+ 
+
+
+
+/* VOCOP --  Process a VO Client request.
+ */
+vocop (opcode, op_index, nargs)
+int     opcode;
+int     op_index;
+int     nargs;
+{
+    struct	operand o;
+    int 	op = optbl[op_index];	
+
+
+    if (debug)
+	printf ("vocop:  opcode=%d  index=%d  nargs=%d\n", 
+	    opcode, op_index, nargs);
+
+#ifndef USE_VOCOP
+    if (opcode != OP_INITVOC && opcode != OP_RESTARTVOC) {
+        if (VOClient_initialized) {
+	    int voc_status = voc_ready();
+	    if (voc_status != 0) {
+    	        VOClient_initialized = 0;
+                voc_closeVOClient (0);
+                if (voc_initVOClient (envget("vo_runid")) != OK)
+                    cl_error (E_UERR, "Error re-initializing VOClient");
+	    }
+        } else {
+            if (voc_initVOClient (envget("vo_runid")) != OK)
+                cl_error (E_UERR, "Error initializing VOClient");
+            else {
+    		VOClient_initialized = 1;
+		sleep (3);
+            }
+        }
+    }
+#else
+    VOClient_initialized = 1;
+#endif
+
+    switch (opcode) {
+    case OP_INITVOC:
+	/* Initialize the VOClient
+	 */
+    	if (nargs > 1)
+            cl_error (E_UERR, "usage: initVOClient([opt_string])\n");
+	else
+	    cl_initVOClient (nargs);
+	break;
+		
+    case OP_CLOSEVOC:
+	/* Shut down the VO Client connection	
+	 */
+	if (nargs != 1)
+            cl_error (E_UERR, "usage: closeVOClient(shutdown_flag)\n");
+	else
+	    cl_closeVOClient ();
+	break;
+
+    case OP_RESTARTVOC:
+	/* Restart the VO Client connection	
+	 */
+	if (nargs > 0)
+            cl_error (E_UERR, "usage: restartVOClient()\n");
+	else
+	    cl_restartVOClient ();
+	break;
+
+    case OP_CONESVC:
+	/* Query a Cone Service
+	 */
+	if (nargs < 4)
+	    cl_error (E_UERR, "usage: res = dalConeSvc(url, ra, dec, sr)");
+	else
+	    cl_dalConeSvc ();
+	break;
+		
+    case OP_SIAPSVC:
+	/* Query a SIAP Service
+	 */
+	if (nargs < 4)
+	    cl_error (E_UERR, 
+		"usage: res = dalSiapSvc(url, ra, dec, rasz[, decsz[, fmt]])");
+	else
+	    cl_dalSiapSvc (nargs);
+        break;
+
+    case OP_RECCNT:
+	/* Count DAL query result records
+	 */
+	if (nargs != 1)
+            cl_error (E_UERR, "usage: dalRecordCount(qres)\n");
+	else
+	    cl_dalRecordCount ();
+        break;
+
+    case OP_GETREC:
+	/* Get a QRecord handle from a QResponse
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: dalGetRecord(qres, recnum)\n");
+	else
+	    cl_dalGetRecord ();
+        break;
+
+    case OP_GETDATA:
+	/* Get a dataset pointed to by an AccessReference field at the
+	 * given record number in the query response.  Download to the
+	 * named file.
+	 */
+	if (nargs != 3)
+            cl_error (E_UERR, "usage: dalGetData(qres, recnum, fname)\n");
+	else
+	    cl_dalGetData ();
+        break;
+
+    case OP_GETSTR:
+	/* Get a string-valued attribute from a DAL response table.
+	 */
+	if (nargs != 3)
+            cl_error (E_UERR, "usage: dalGetStr(qres, attrname, recnum)\n");
+	else
+	    cl_dalGetStr ();
+        break;
+
+    case OP_GETINT:
+	/* Get an integer-valued attribute from a DAL response table.
+	 */
+	if (nargs != 3)
+            cl_error (E_UERR, "usage: dalGetInt(qres, attrname, recnum)\n");
+	else
+	    cl_dalGetInt ();
+        break;
+
+    case OP_GETDBL:
+	/* Get a real-valued attribute from a DAL response table.
+	 */
+	if (nargs != 3)
+            cl_error (E_UERR, "usage: dalGetDbl(qres, attrname, recnum)\n");
+	else
+	    cl_dalGetDbl ();
+        break;
+
+    case OP_ATTRCNT:
+	/* Count number of attributes in a QRecord
+	 */
+	if (nargs != 1)
+            cl_error (E_UERR, "usage: dalAttrCount(rec)\n");
+	else
+	    cl_dalAttrCount ();
+        break;
+
+    case OP_ATTRNAME:
+	/* Get an attribute name for the given column index
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: dalAttrName(rec,index)\n");
+	else
+	    cl_dalAttrName ();
+        break;
+
+    case OP_INTATTR:
+	/* Get a an attribute as an integer.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: dalIntAttr(rec,attrname)\n");
+	else
+	    cl_dalIntAttr ();
+        break;
+
+    case OP_FLOATATTR:
+	/* Get a an attribute as a real.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: dalFloatAttr(rec,attrname)\n");
+	else
+	    cl_dalFloatAttr ();
+        break;
+
+    case OP_STRATTR:
+	/* Get a an attribute as a string.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: dalStrAttr(rec,attrname)\n");
+	else
+	    cl_dalStrAttr ();
+        break;
+
+    case OP_DATASET:
+	/* Download the dataset at the given acref to a named file
+	 */
+	if (nargs > 3)
+            cl_error (E_UERR, "usage: dalDataset([rec,] acref [,fname])\n");
+	else
+	    cl_dalDataset (nargs);
+        break;
+
+    case OP_ATTRSCAN:
+	/* Get the value of one or more attributes.
+	 */
+	if (nargs < 2)
+            cl_error (E_UERR, "usage: dalAttrScan(rec,attrList,p1,...,pN)\n");
+	else
+	    cl_dalAttrScan (nargs);
+        break;
+
+
+    case OP_REGSEARCH:
+	/* Get the value of the named resource attribute.
+	 *       resource = regSearch (term [, orValues])
+	 *       resource = regSearch (keywords, orValues)
+	 *       resource = regSearch (sql, keywords, orValues)
+	 */
+	if (nargs < 1 || nargs > 3)
+            cl_error (E_UERR, "usage: regSearch(res,attr)\n");
+	else
+	    cl_regSearch (nargs);
+        break;
+
+    case OP_REGSVCSEARCH:
+	/* Get the value of the named resource attribute.
+	 *    resource = regSvcSearch (term, svcType, bpass, clevel, orValues)
+	 */
+	if (nargs != 5)
+            cl_error (E_UERR,
+		"usage: regSvcSearch(term,svcType,bpass,clevel,orVals)\n");
+	else
+	    cl_regSvcSearch ();
+        break;
+
+    case OP_REGCOUNT:
+	/* Get the value of the named resource attribute.
+	 */
+	if (nargs > 1)
+            cl_error (E_UERR, "usage: regResultCount(res)\n");
+	else
+	    cl_regResultCount ();
+        break;
+
+    case OP_REGBPASS:
+	/* Set a Bandpass constraint on a query.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: regSetBandpass(query, bpass)\n");
+	else
+	    cl_regSetBandpass ();
+        break;
+
+    case OP_REGSVC:
+	/* Set a ServiceType constraint on a query.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: regSetService(res, svcType)\n");
+	else
+	    cl_regSetService ();
+        break;
+
+    case OP_REGCONTENT:
+	/* Set a ContentLevel constraint on a query.
+	 */
+	if (nargs != 2)
+            cl_error (E_UERR, "usage: regSetContent(res, clevel)\n");
+	else
+	    cl_regSetContent ();
+        break;
+
+    case OP_REGVALUE:
+	/* Get the value of the named resource attribute.
+	 *    nscan = regValue (resource, attribute, resIndex, <p>)
+	 */
+	if (nargs < 2 || nargs > 3)
+            cl_error (E_UERR, "usage: regValue(res,attr)\n");
+	else
+	    cl_regValue ();
+        break;
+
+
+    case OP_REGRESOLVER:
+	/* Get the number of resources found with the last regResolver() call.
+	 */
+	if (nargs < 1 || nargs > 4)
+            cl_error (E_UERR, 
+		"usage: regResolver(id_str [, svctyp [, attr [, index] ] ])\n");
+	else
+	    cl_regResolver (nargs);
+        break;
+
+    case OP_NRESOLVED:
+	/* Get the number of resources found with the last regResolver() call.
+	 */
+	if (nargs > 0)
+            cl_error (E_UERR, "usage: nresolved()\n");
+	else
+	    cl_regNResolved ();
+        break;
+
+    case OP_VALIDOBJ:
+	/* Validate an object in the VO Client.
+	 */
+	if (nargs != 1)
+            cl_error (E_UERR, "usage: validObj(obj)\n");
+	else
+	    cl_validObj ();
+        break;
+
+    case OP_VOCREADY:
+	/* Verify that the VO Client is ready.
+	 */
+	if (nargs != 1)
+            cl_error (E_UERR, "usage: vocReady()\n");
+	else
+	    cl_vocReady ();
+        break;
+
+    default:
+    	cl_error (E_IERR, e_badsw, op, "voclient has invalid intrfunc()");
+        break;
+    }
+
+    return (OK);
+}
+
+
+/* Initialize the VO Client.
+ */
+int
+cl_initVOClient (nargs)
+int nargs;
+{
+    char *opts = NULL, *runid = NULL;
+    struct	operand o;
+
+    if (nargs)
+        opts = voGetStrArg ();
+
+    runid = envget ("vo_runid");	/* Get the system RUNID	 	*/
+    if (runid) {
+	if (opts)
+	    strcat (opts, ",");
+	strcat (opts, runid);
+    }
+
+    o.o_type = OT_INT;
+    if (! VOClient_initialized)
+        o.o_val.v_i = voc_initVOClient (opts);
+    else
+        o.o_val.v_i = OK;
+    pushop (&o);
+
+    VOClient_initialized = 1;
+
+    if (opts)
+        free ((char *) opts);
+    return (OK);
+}
+		
+
+/* Close the VO Client connection.
+ */
+int
+cl_closeVOClient ()
+{
+    int shutdown = 0;
+    struct	operand o;
+
+    shutdown = voGetIntArg ();
+
+    /* The close is a void function so we simply return a dummy OK
+     * value to the caller.
+     */
+    if (VOClient_initialized)
+        (void) voc_closeVOClient (shutdown);
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = OK;
+    pushop (&o);
+
+    VOClient_initialized = 0;
+
+    return (OK);
+}
+
+
+/* Restart the VO Client.
+ */
+int
+cl_restartVOClient ()
+{
+    char *opts = NULL;
+    struct	operand o;
+
+    o.o_type = OT_INT;
+    voc_closeVOClient (1);
+    if (VOClient_initialized)
+        o.o_val.v_i = voc_initVOClient (envget("vo_runid"));
+    else
+        o.o_val.v_i = 0;
+    pushop (&o);
+
+    VOClient_initialized = 1;
+
+    return (OK);
+}
+
+
+/* Validate an object in the VO Client.
+ */
+int
+cl_validObj ()
+{
+    struct	operand o;
+
+    int obj  = voGetIntArg ();
+
+    o.o_type = OT_INT;
+    if (! VOClient_initialized) {
+	/* Client not initialized, obviously not valid.
+	 */
+        o.o_val.v_i = 0;
+    } else
+        o.o_val.v_i = voc_validateObject (obj);
+    pushop (&o);
+
+    return (OK);
+}
+		
+
+/* Verify the VOClient is ready.
+ */
+int
+cl_vocReady ()
+{
+    struct	operand o;
+
+    o.o_type = OT_BOOL;
+    if (! VOClient_initialized) {
+	/* Client not initialized, obviously not valid.
+	 */
+        o.o_val.v_i = 0;
+    } else
+        o.o_val.v_i = voc_ready ();
+    pushop (&o);
+
+    return (OK);
+}
+		
+
+/* Call a Cone service.
+ */
+int 
+cl_dalConeSvc ()
+{
+    char      *url;
+    double    sr, ra, dec;
+    DAL       cone;
+    Query     query;
+    QResponse result = (QResponse) ERR;
+    struct    operand o;
+
+
+    /* Initialize the VO Client if it isn't already running. */
+    if (! VOClient_initialized) {
+	cl_initVOClient (NULL);
+	o = popop ();			/* pop status posted by initVOClient */
+    }
+
+    /* Args are on the stack in reverse order, pop 'em now. */
+    sr  = voGetDblArg ();
+    dec = voGetDblArg ();
+    ra  = voGetDblArg ();
+    url = voGetStrArg ();
+
+    /* Open a connection to the url, form a query and execute it.
+     */
+    cone = voc_openConeConnection (url);
+    query = voc_getConeQuery (cone, ra, dec, sr);
+    result = voc_executeQuery (query);
+
+    o.o_type = OT_INT;				   /* push result on stack */
+    o.o_val.v_i = result;
+    pushop (&o);
+
+    if (debug)
+	printf ("dalConeSvc=%d: url='%s'\n\tra=%g dec=%g sr=%g\n", 
+	   result, url, ra, dec, sr);
+
+    if (url) free ((char *) url);
+
+    return (OK);
+}
+
+
+/* Call a Siap service.
+ */
+int 
+cl_dalSiapSvc (nargs)
+int nargs;
+{
+    char     *fmt, *url;
+    double    rasz, decsz, ra, dec;
+    DAL       siap;
+    Query     query;
+    QResponse result;
+    struct    operand o;
+
+
+    /* Initialize the VO Client if it isn't already running. */
+    if (! VOClient_initialized) {
+	cl_initVOClient (NULL);
+	o = popop ();			/* pop status posted by initVOClient */
+    }
+
+    /* Args are on the stack in reverse order, pop 'em now. */
+    if (nargs > 5)
+        fmt   = voGetStrArg ();
+    else
+        fmt   = "image/fits";
+    if (nargs > 4) {
+        decsz = voGetDblArg ();
+        rasz  = voGetDblArg ();
+    } else if (nargs == 4) {
+        rasz = decsz = voGetDblArg ();
+    }
+    dec   = voGetDblArg ();
+    ra    = voGetDblArg ();
+    url   = voGetStrArg ();
+
+    /* Open a connection to the url, form a query and execute it.
+     */
+    if (url && url[0]) {
+        siap = voc_openSiapConnection (url);
+        query = voc_getSiapQuery (siap, ra, dec, rasz, decsz, fmt);
+
+        result = voc_executeQuery (query);
+    } else
+	cl_error (E_UERR, "Invalid or NULL service URL specified.");
+
+    if (debug)
+	printf ("dalSiapSvc: siap=%d query=%d result=%d\n",
+	    siap, query, result);
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = result;
+    pushop (&o);
+
+    if (debug)
+	printf ("dalSiapSvc=%d: url='%s'\n\tra=%g dec=%g sz=%g/%g fmt=%s\n", 
+	   result, url, ra, dec, rasz, decsz, fmt);
+
+    if (url) free ((char *) url);
+    if (fmt && nargs > 5) free ((char *) fmt);
+
+    return ( (result ? OK : ERR) );
+}
+
+
+/* Get a count of the number of return records.
+ */
+int 
+cl_dalRecordCount ()
+{
+    QResponse qres;
+    int       count = -1;
+    int       stat = OK;
+    struct    operand o;
+
+
+    qres = (QResponse) voGetIntArg ();
+
+    if (qres > 0)
+        count = voc_getRecordCount (qres);
+    else
+	stat = ERR;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = count;
+    pushop (&o);
+
+    return (stat);
+}
+
+
+/* Get the record handle.
+ */
+int 
+cl_dalGetRecord ()
+{
+    QRecord   rec;
+    QResponse qres;
+    int       stat, count, recnum = -1;
+    struct    operand o;
+
+    recnum = voGetIntArg ();
+    qres   = (QResponse) voGetIntArg ();
+
+    if (voc_validateObject (qres)) {
+	/* Do the bounds checking here so we can return a sensible error.
+	 */
+        count = voc_getRecordCount (qres);
+	if (recnum < 0 || recnum > (count-1))
+            cl_error (E_UERR, "dalGetRecord: index out-of-bounds\n");
+	else
+            rec = voc_getRecord (qres, recnum);
+    } else 
+        cl_error (E_UERR, "dalGetRecord: invalid `qres' argument\n");
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = (int) rec;
+    pushop (&o);
+
+    return (stat);
+}
+
+
+/* Download a dataset referred to by a URL.
+ */
+int 
+cl_dalGetData ()
+{
+    QRecord   rec;
+    QResponse qres;
+    QRAttribute attr;
+    char      *fname, *acref, fbuf[SZ_FNAME];
+    int       recnum, count = -1;
+    int       stat = OK;
+    struct    operand o;
+
+
+    bzero (fbuf, SZ_FNAME);
+
+    fname  = voGetStrArg ();
+    recnum = voGetIntArg ();
+    qres   = (QResponse) voGetIntArg ();
+
+    if (voc_validateObject (qres)) {
+	rec  = voc_getRecord (qres, recnum);
+	if (voc_validateObject (rec)) {
+            attr = voc_getAttribute (rec, "AccessReference");
+	    if (voc_validateObject (attr)) {
+	        acref = voc_stringValue (attr);
+                stat  = voc_getDataset (rec, acref, fname);
+	    } else
+                cl_error (E_UERR, "getData: invalid `attr' argument\n");
+	} else 
+            cl_error (E_UERR, "getData: invalid `rec' argument\n");
+    } else
+        cl_error (E_UERR, "getData: invalid `qres' argument\n");
+
+    o.o_type = OT_STRING;
+    strcpy (fbuf, fname);
+    o.o_val.v_s = fbuf;
+    pushop (&o);
+
+    if (fname) free ((char *) fname);
+    if (acref) voc_freePointer( ((char *) acref) );
+    return (stat);
+}
+
+
+/* Get a string-valued attribute from a DAL response table. 
+ */
+int 
+cl_dalGetStr ()
+{
+    QRecord     rec;
+    QResponse   qres;
+    QRAttribute attr;
+    char        *attrname, *aval, sbuf[SZ_LINE];
+    int         recnum, stat = ERR;
+    struct      operand o;
+
+
+    recnum   = voGetIntArg ();
+    attrname = voGetStrArg ();
+    qres     = (QResponse) voGetIntArg ();
+
+    bzero (sbuf, SZ_LINE);
+    if (voc_validateObject (qres)) {
+	rec  = voc_getRecord (qres, recnum);
+	if (voc_validateObject (rec)) {
+            attr = voc_getAttribute (rec, attrname);
+	    if (voc_validateObject (attr)) {
+    		if ( (aval = voc_stringValue (attr)) ) {
+		    strcpy (sbuf, aval);
+		    voc_freePointer( ((char *) aval) );
+		    stat = OK;
+		} 
+	    } 
+	}
+    }
+
+    o.o_type = OT_STRING;
+    o.o_val.v_s = sbuf;
+    pushop (&o);
+
+    if (attrname) free ((char *) attrname);
+    return (stat);
+}
+
+
+/* Get an integer-valued attribute from a DAL response table. 
+ */
+int 
+cl_dalGetInt ()
+{
+    QRecord     rec;
+    QResponse   qres;
+    QRAttribute attr;
+    char        *attrname;
+    int         ival = INDEFI, recnum, stat = OK;
+    struct      operand o;
+
+
+    recnum   = voGetIntArg ();
+    attrname = voGetStrArg ();
+    qres     = (QResponse) voGetIntArg ();
+
+    if (voc_validateObject (qres)) {
+	rec  = voc_getRecord (qres, recnum);
+	if (voc_validateObject (rec)) {
+            attr = voc_getAttribute (rec, attrname);
+	    if (voc_validateObject (attr))
+    		ival = voc_intValue (attr);
+	}
+    }
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = ival;
+    pushop (&o);
+
+    if (attrname) free ((char *) attrname);
+    return (stat);
+}
+
+
+/* Get an integer-valued attribute from a DAL response table. 
+*/
+int 
+cl_dalGetDbl ()
+{
+    QRecord     rec;
+    QResponse   qres;
+    QRAttribute attr;
+    char        *attrname;
+    int         recnum, stat = OK;
+    double 	dval = INDEFD;
+    struct      operand o;
+
+
+    recnum   = voGetIntArg ();
+    attrname = voGetStrArg ();
+    qres     = (QResponse) voGetIntArg ();
+
+    if (voc_validateObject (qres)) {
+	rec  = voc_getRecord (qres, recnum);
+	if (voc_validateObject (rec)) {
+            attr = voc_getAttribute (rec, attrname);
+	    if (voc_validateObject (attr))
+    		dval = voc_floatValue (attr);
+	}
+    }
+
+    o.o_type = OT_REAL;
+    o.o_val.v_r = dval;
+    pushop (&o);
+
+    if (attrname) free ((char *) attrname);
+    return (stat);
+}
+
+
+
+/* Return a count of the number of attributes (i.e. columns) in a record (row).
+ */
+int 
+cl_dalAttrCount ()
+{
+    QRecord   rec;
+    int       count = -1;
+    int       stat = OK;
+    struct    operand o;
+
+
+    rec = (QRecord) voGetIntArg ();
+
+    if (voc_validateObject (rec))
+        count = voc_getAttrCount (rec);
+    else {
+        cl_error (E_UERR, "dalAttrCount: invalid `rec' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = count;
+    pushop (&o);
+
+    return (stat);
+}
+
+
+/* Get the name of the attribute (i.e. column) given the index.
+ */
+int 
+cl_dalAttrName ()
+{
+    QRecord   rec;
+    int       index, count = -1;
+    int       stat = OK;
+    struct    operand o;
+
+
+    index = voGetIntArg ();
+    rec   = (QRecord) voGetIntArg ();
+
+    if (voc_validateObject (rec)) {
+	char *attr_list = voc_getAttrList (rec);
+	char *ip = attr_list;
+
+    } else {
+        cl_error (E_UERR, "dalAttrCount: invalid `rec' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_STRING;
+    o.o_val.v_s = "foo";
+    pushop (&o);
+
+    return (stat);
+}
+
+
+/* Get the requested attribute as an integer.
+ */
+int 
+cl_dalStrAttr ()
+{
+    QRAttribute attr;
+    QRecord   rec;
+    char      *name;
+    int       stat = OK;
+    struct    operand o;
+
+
+    name = voGetStrArg ();
+    rec = (QRecord) voGetIntArg ();
+
+    if (voc_validateObject (rec))
+        attr = voc_getAttribute (rec, name);
+    else {
+        cl_error (E_UERR, "dalAttrCount: invalid `rec' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_STRING;
+    o.o_val.v_s = voc_stringValue (attr);
+    pushop (&o);
+
+    if (name) free ((char *) name);
+
+    return (stat);
+}
+
+
+/* Get the requested attribute as an integer.
+ */
+int 
+cl_dalFloatAttr ()
+{
+    QRAttribute attr;
+    QRecord   rec;
+    char      *name;
+    int       stat = OK;
+    struct    operand o;
+
+
+    name = voGetStrArg ();
+    rec = (QRecord) voGetIntArg ();
+
+    if (voc_validateObject (rec))
+        attr = voc_getAttribute (rec, name);
+    else {
+        cl_error (E_UERR, "dalAttrCount: invalid `rec' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_REAL;
+    o.o_val.v_r = voc_floatValue (attr);
+    pushop (&o);
+
+    if (name) free ((char *) name);
+
+    return (stat);
+}
+
+
+/* Get the requested attribute as an integer.
+ */
+int 
+cl_dalIntAttr ()
+{
+    QRAttribute attr;
+    QRecord   rec;
+    char      *name;
+    int       stat = OK;
+    struct    operand o;
+
+
+    name = voGetStrArg ();
+    rec = (QRecord) voGetIntArg ();
+
+    if (voc_validateObject (rec))
+        attr = voc_getAttribute (rec, name);
+    else {
+        cl_error (E_UERR, "dalAttrCount: invalid `rec' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_INT;
+    o.o_val.v_s = voc_intValue (attr);
+    pushop (&o);
+
+    if (name) free ((char *) name);
+
+    return (stat);
+}
+
+
+/* Download a dataset referred to by a URL.
+ */
+int 
+cl_dalDataset (nargs)
+int nargs;
+{
+    QRecord   rec = (QRecord) NULL;
+    char      *fname, *acref, *res, *val, fbuf[SZ_FNAME];
+    int       count = -1, stat = OK, urlsize = (2 * 1024 * 1024);
+    struct    operand o;
+
+
+    bzero (fbuf, SZ_FNAME);
+
+    switch (nargs) {
+    case 3:
+        fname = voGetStrArg ();
+        acref = voGetStrArg ();
+        rec   = (QRecord) voGetIntArg ();
+	break;
+    case 2:
+        fname = voGetStrArg ();
+        acref = voGetStrArg ();
+	break;
+    case 1:
+	fname = "uparm$url_file";
+        acref = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "dalDataset: invalid argument list\n");
+	break;
+    }
+
+    if (acref && acref[0]) {
+	if (rec && voc_validateObject (rec)) {
+            stat = voc_getDataset (rec, acref, fname);
+        } else {
+	    int  fd, nb, nbytes;
+
+            res = voc_getRawURL (acref, &nbytes);
+	    if (res == NULL)
+        	cl_error (E_UERR, "getDataset: cannot access URL\n");
+
+	    if (c_access (fname, 0, 0)) 
+	 	c_delete (fname);
+	    if ((fd = c_open (fname, NEW_FILE, BINARY_FILE)) != ERR) {
+		nb = c_write (fd, res, nbytes);
+		if (nb != nbytes)
+		    printf ("Warning: short file write\n");
+		c_close (fd);
+	    } else {
+        	cl_error (E_UERR, "dalDataset: cannot open output file\n");
+	    }
+	    voc_freePointer ((char *) res);
+        }
+    } else {
+        cl_error (E_UERR, "dalDataset: invalid `acref' argument\n");
+	stat = ERR;
+    }
+
+    o.o_type = OT_STRING;
+    strcpy (fbuf, fname);
+    o.o_val.v_s = fbuf;
+    pushop (&o);
+
+    if (acref) free ((char *) acref);
+    if (nargs > 1 && fname) free ((char *) fname);
+
+    return (stat);
+}
+
+
+/* Scan attribute values to local parameters.  Returns number of values
+ * read (always the number requested, empty fields filled w/ INDEF) or EOF.
+ */
+int 
+cl_dalAttrScan (nargs)
+int nargs;
+{
+    QRecord     rec;
+    QRAttribute attr;
+    char      *alist, *val = NULL;
+    char      *ip, *op, *attr_list[MAX_ATTRS];
+    int       i, nattrs=0, stat = OK;
+    struct    operand o;
+
+
+    bzero (attr_list, MAX_ATTRS); 		/* clear arrays		    */
+
+    alist = voGetStrArg ();			/* get the attribute list   */
+    for (nattrs=0, ip=alist; *ip && nattrs < MAX_ATTRS; ) {
+	attr_list[nattrs++] = op = ip;
+	while (*ip && *ip != ',')
+	    ip++;
+	if (*ip == ',')
+	    *ip++ = '\0';
+	else
+	    break;
+    }
+/*
+for(i=0; i < nattrs; i++)
+  printf ("%d:  attr_list='%s'\n", i, attr_list[i]);
+*/
+
+    rec = (QRecord) voGetIntArg ();
+
+    if (attr) {
+	for (i = (nattrs-1); i > 0; i--) {
+            attr = voc_getAttribute (rec, attr_list[i]);
+            val = voc_getStringAttr (rec, attr);
+/*
+printf ("%d:  attr='%s'  =>  '%s'\n", i, attr_list[i], val);
+*/
+	}
+    } else
+	stat = ERR;
+
+    o.o_type = OT_STRING;
+    o.o_val.v_i = val;
+    pushop (&o);
+
+    if (alist) free ((char *) alist);
+
+    return (stat);
+}
+
+
+
+
+/*  Do a Registry search using keyword terms and/or sql predicates.  We 
+ *  return a resource pointer to the records that can be queried using the
+ *  regValue() builtin for specific items.
+ *
+ *  Usage:
+ *       resource = regSearch (sql)
+ *       resource = regSearch (keywords, orValues)
+ *       resource = regSearch (sql, keywords, orValues)
+ */
+int 
+cl_regSearch (nargs)
+int nargs;
+{
+    RegResult res;
+    char      *sql = NULL, *keyw = NULL;
+    int       stat = OK, orValues = 0;
+    struct    operand o;
+
+
+
+    /* Initialize the VO Client if it isn't already running. */
+    if (! VOClient_initialized) {
+        cl_initVOClient (NULL);
+        o = popop ();                   /* pop status posted by initVOClient */
+    }
+
+    /* Get the calling arguments in reverse order from the stack.
+     */
+    switch (nargs) {
+    case 3:
+        orValues = voGetIntArg ();
+	keyw     = voGetStrArg ();
+	sql      = voGetStrArg ();
+	break;
+    case 2:
+        orValues = voGetIntArg ();
+	keyw     = voGetStrArg ();
+	break;
+    case 1:
+	sql      = voGetStrArg ();
+	break;
+    default:
+        cl_error (E_UERR, "regSearch: invalid number of arguments\n");
+	return (ERR);
+    }
+
+
+    /*  Do the registry query. */
+    res = voc_regSearch (sql,  keyw, orValues);
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = res;
+    pushop (&o);
+
+    /* Clean up and return.
+     */
+    if (keyw) free ((char *) keyw);
+    if (sql)  free ((char *) sql);
+
+    return (stat);
+}
+
+
+/*  Do a Registry search and limit results to a specific service type.
+ *  Search term may be either a keyword list or sql predicate.
+ */
+int 
+cl_regSvcSearch ()
+{
+    RegResult res;
+    int       count = -1;
+    char      *svc, *term, *bpass, *clevel;
+    int       stat = OK, orValues = 0;
+    struct    operand o;
+
+
+    /* Initialize the VO Client if it isn't already running. */
+    if (! VOClient_initialized) {
+        cl_initVOClient (NULL);
+        o = popop ();                   /* pop status posted by initVOClient */
+    }
+
+    orValues = voGetIntArg ();
+    clevel   = voGetStrArg ();
+    bpass    = voGetStrArg ();
+    svc      = voGetStrArg ();
+    term     = voGetStrArg ();
+
+
+    /*  Do the registry query. */
+    res = voc_regSearchByService (svc, term, orValues);
+
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = res;
+    pushop (&o);
+
+    /* Clean up and return.
+     */
+    if (term) free ((char *) term);
+    if (svc)  free ((char *) svc);
+
+    return (stat);
+}
+
+
+/* Return a count of the number of attributes (i.e. columns) in a record (row).
+ */
+int 
+cl_regResultCount ()
+{
+    RegResult res;
+    int       count = -1;
+    int       stat = OK;
+    struct    operand o;
+
+    res = (RegResult) voGetIntArg ();
+
+    if (res)
+        count = voc_resGetCount (res);
+    else
+	stat = ERR;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = count;
+    pushop (&o);
+
+    return (stat);
+}
+
+	    
+/*  Set a bandpass constraint on a query.
+ */
+int
+cl_regSetBandpass ()
+{
+    char     *bpass = NULL;
+    RegQuery  query = 0;
+    int       stat = OK;
+    struct    operand o;
+
+    bpass = voGetStrArg ();
+    query = (RegQuery) voGetIntArg ();
+
+    if (query)
+        voc_regConstWaveband (query, bpass);
+    else
+	stat = ERR;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = stat;
+    pushop (&o);
+
+    return (stat);
+}
+
+	    
+/*  Set a ServiceType constraint on a query.
+ */
+int
+cl_regSetService ()
+{
+    char     *svctype = NULL;
+    RegQuery  query = 0;
+    int       stat = OK;
+    struct    operand o;
+
+    svctype = voGetStrArg ();
+    query = (RegQuery) voGetIntArg ();
+
+    if (query)
+        voc_regConstSvcType (query, svctype);
+    else
+	stat = ERR;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = stat;
+    pushop (&o);
+
+    return (stat);
+}
+
+	    
+/*  Set a ContentLevel constraint on a query.
+ */
+int
+cl_regSetContent ()			/* FIXME - Not Yet Implemented */
+{
+    struct operand o;
+    int    stat = OK;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = stat;
+    pushop (&o);
+
+    return (stat);
+}
+
+
+/*  Get the attribute value from the named resource query handle.
+ */
+int 
+cl_regValue (nargs)
+int	nargs;
+{
+    RegResult res;
+    int      index = 0, stat = OK;
+    char     *attr, *val, sbuf[SZ_RESBUF];
+    struct    operand o;
+
+
+    /* Get the arguments.  Remember they're on the stack backwards.
+     */
+    if (nargs > 2)
+	index = voGetIntArg ();
+    attr = voGetStrArg ();
+    res = (RegResult) voGetIntArg ();
+
+    bzero (sbuf, SZ_RESBUF);
+
+    if (res)
+        val = (char *) voc_resGetStr (res, attr, index);
+    else
+	stat = ERR;
+
+    if (val && val[0])
+	strcpy (sbuf, val);
+
+    if (strlen (sbuf) > 255)
+	sbuf[255] = '\0';
+
+    o.o_type = OT_STRING;
+    o.o_val.v_s = sbuf;
+    pushop (&o);
+
+    /* Clean up and return.
+     */
+    if (attr) free ((char *) attr);
+    if (val) voc_freePointer ((char *) val);
+
+    return (stat);
+}
+
+
+/*  Resolve a (presumed) ShortName or Identifier string to one or more
+ *  Registry resource attributes.  By default we assume we are interested
+ *  only in the ServiceURL, however optional arguments allow us to narrow
+ *  the search to particular service types or individual records.  Examples:
+ *
+ *  1) Find the ServiceURL for the GSC2.2 catalog
+ *
+ *	cl> =regResolver ("GSC2.2")
+ * 	http://chart.stsci.edu/GSCVO/GSC22VO.jsp?
+ *	cl> =nresolved()
+ *	2				# found more than one resource
+ *
+ *  2) Print the Title and ServiceType for each record found for USNO-B1:
+ *
+ *	cl> print (regResolver ("USNO-B1","","ServiceType,Title",-1))
+ *	CONE    USNO-B1 Catalogue
+ *	SKYNODE USNO-B1 SkyNode from VizieR
+ *
+ *	Note that in usage such as this we are still limited by the length
+ *	of output permitted by the print() function (currently 32*SZ_LINE).
+ *
+ *  3) Get the ServiceURL for the USNO-B1 Skynode service:
+ *
+ *	cl> =regResolver ("USNO-B1","skynode")
+ *	http://cdsws.u-strasbg.fr/USNO-B1BasicSkyNode/services/BasicSkyNode
+ *
+ */
+
+int 
+cl_regResolver (nargs)
+int	nargs;
+{
+    int       i, j, nreturns=0, nattrs=0, comma = ',', stat = OK;
+    int	      exact=-1, recnum=0, istart, iend;
+    char      *qterm=NULL, *attr=NULL, *type=NULL, *attr_val=NULL;
+    char      *ip, *op, *attr_list[MAX_ATTRS];
+    char      qstring[SZ_LINE], svcstr[SZ_LINE];
+    char      attr_str[SZ_LINE], sbuf[SZ_RESBUF];
+    struct    operand o;
+    RegQuery  query = 0;
+    RegResult resource = 0;
+
+
+    bzero (qstring, SZ_LINE);
+    bzero (svcstr, SZ_LINE);
+    bzero (sbuf, SZ_RESBUF);
+
+    strcpy (attr_str, DEF_RESATTR);
+
+
+    /* Initialize the VO Client if it isn't already running. */
+    if (! VOClient_initialized) {
+        cl_initVOClient (NULL);
+        o = popop ();                   /* pop status posted by initVOClient */
+    }
+
+    /* Parse any remaining (optional) arguments.  Remember that the args are
+     * on the stack in the reverse order!  The 1st arg is required and will 
+     * be either an ivo: identifier or is presumed to be the ShortName.
+     */
+    attr_list[0] = "ShortName";
+    attr_list[1] = "Identifier";
+    attr_list[2] = "ServiceUrl";
+    nattrs = 3;
+
+    switch (nargs) {
+    case 4: 
+        recnum = voGetIntArg ();
+	/*  fall thru */
+
+    case 3: 
+        attr = voGetStrArg ();
+	if (attr && attr[0]) {
+	    for (nattrs=2, ip=attr; *ip && nattrs < MAX_ATTRS; ) {
+		attr_list[nattrs++] = op = ip;
+		while (*ip && *ip != ',')
+		    ip++;
+		if (*ip == ',')
+		    *ip++ = '\0';
+		else
+		    break;
+	    }
+	}
+	/*  fall thru */
+
+    case 2: 
+        type = voGetStrArg ();
+	if (type && type[0]) {
+	    /*  Aliases for service type include:
+	     *
+	     *     Cone	-> catalog, table
+	     *     SIAP	-> image, archive
+	     *     SSAP	-> spectrum
+	     *
+	     */
+	    if (strcmp(type,"catalog") == 0 || strcmp(type,"table") == 0)
+	        sprintf (svcstr, "ServiceType like '%%cone%%'");
+	    else if (strcmp(type,"image") == 0 || strcmp(type,"archive") == 0)
+	        sprintf (svcstr, "ServiceType like '%%siap%%'");
+	    else if (strcmp(type,"spectrum") == 0)
+	        sprintf (svcstr, "ServiceType like '%%ssap%%'");
+	    else 
+	        sprintf (svcstr, "ServiceType like '%%%s%%'", type);
+	}
+	/*  fall thru */
+
+    case 1: 
+        qterm = voGetStrArg ();
+
+	if (strncmp (qterm, "ivo://", 6) == 0) {	/* remove svc num. */
+	    char *ip = qterm;
+	    for (ip=qterm; *ip && *ip != '#'; ip++)
+		;
+	    *ip = '\0';
+	}
+	sprintf (qstring, 
+	    "(Identifier like '%%%s%%') OR (ShortName like '%%%s%%')",
+	    qterm, qterm);
+	break;
+
+    default:
+        cl_error (E_UERR, "regResolver: invalid number of arguments\n");
+	return (ERR);
+    }
+
+
+
+    /*  Do the registry query.
+     */
+    query = voc_regQuery (qstring, 0);
+    if (type && type[0])
+	voc_regAddSearchTerm (query, svcstr, 0);
+
+    if (debug) {
+	printf ("regResolver: qterm='%s'  type='%s'  attr='%s'  recnum=%d\n", 
+	    (qterm ? qterm : "null"), 
+	    (type ? type : "null"), 
+	    (attr ? attr : "null"), recnum);
+	printf ("query string:\n\n%s\n\n", voc_regGetQueryString (query));
+    }
+
+    /*  Execute the query.
+     */
+    resource = voc_regExecute (query);
+
+    /* Save the number of resolved resources and get the requested attribute
+     * (or the default service URL).
+     */
+    if ((reg_nresolved = voc_resGetCount (resource)) > 0) {
+	nreturns = (recnum >= 0 ? 1 : reg_nresolved);
+
+	exact = 0;
+	if (recnum == 0 && reg_nresolved > 1) {
+	    /* We didn't specify a record number but have more than one
+	     * result.  Look for an exact match in the ShortName which was
+	     * a hidden part of the query.
+	     */
+	    for (i=0; i < reg_nresolved; i++) {
+                attr_val = voc_resGetStr (resource, attr_list[0], i);
+		if (strncasecmp (qterm, attr_val, strlen(attr_val)) == 0) {
+		    exact = i;
+		    break;
+		}
+                attr_val = voc_resGetStr (resource, attr_list[1], i);
+		if (strncasecmp (qterm, attr_val, strlen(attr_val)) == 0) {
+		    exact = i;
+		    break;
+		}
+	    }
+	}
+
+	if (exact >= 0 && recnum < 1 && nreturns == 1) {
+	    istart = exact;
+	    iend   = exact + 1;
+	} else {
+	    istart = 0;
+	    iend   = nreturns;
+	}
+
+	/*  For a negative recnum we list the attr for all records.
+	 */
+	for (i=istart; i < iend; i++) {
+	    for (j=2; j < nattrs; j++) {
+                attr_val = voc_resGetStr (resource, attr_list[j], i);
+
+                if (attr_val) {
+		    strcat (sbuf, attr_val);
+		    if (j < (nattrs-1))
+			strcat (sbuf, "\t");
+		    voc_freePointer ((char *) attr_val);
+		} else
+		    strcat (sbuf, "INDEF\t");
+	    }
+	    if (nreturns > 1 && i < (reg_nresolved-1))
+		strcat (sbuf, "\n");
+	}
+
+        o.o_type = OT_STRING;
+        o.o_val.v_s = sbuf;
+	attr_val = (char *) NULL;
+
+    } else {
+	for (j=0; j < nattrs; j++) {
+            strcpy (sbuf, "INDEF");
+	    if (j < (nattrs-1))
+		strcat (sbuf, "\t");
+	}
+
+        o.o_type = OT_STRING;
+        o.o_val.v_s = sbuf;
+    }
+
+    /* Push the result operand on the stack.
+     */
+    pushop (&o);
+
+
+    /* Clean up and return.
+     */
+    if (qterm) free ((char *) qterm);
+    if (type)  free ((char *) type);
+    if (attr)  free ((char *) attr);
+
+    return (stat);
+}
+
+
+/*  Get a count of the number of return records.
+ */
+int 
+cl_regNResolved ()
+{
+    struct    operand o;
+
+    o.o_type = OT_INT;
+    o.o_val.v_i = reg_nresolved;
+    pushop (&o);
+
+    return (OK);
+}
+
+
+/* ========================================================
+ *
+ * End of VO Client functions.
+ * What follows is their support code.
+ *
+ * ========================================================*/
+
+
+int
+voGetIntArg ()
+{
+    struct	operand o;
+    int ival;
+
+
+    o = popop();
+
+    switch (o.o_type & OT_BASIC) {
+    case OT_BOOL:
+    case OT_INT: 	ival = (int) o.o_val.v_i; 	 break;
+    case OT_REAL: 	ival = (int) o.o_val.v_r; 	 break;
+    case OT_STRING: ival = (int) atoi (o.o_val.v_s); break;
+    default:
+        cl_error (E_UERR, "printf: bad operand type\n");
+    }
+
+    if (debug)
+        printf ("ival arg = '%d'\n", ival);
+
+    return (ival);
+}
+
+
+double
+voGetDblArg ()
+{
+    struct	operand o;
+    double dval;
+
+
+    o = popop();
+
+    switch (o.o_type & OT_BASIC) {
+    case OT_BOOL:
+    case OT_INT: 	dval = (double) o.o_val.v_i; 	    break;
+    case OT_REAL: 	dval = (double) o.o_val.v_r; 	    break;
+    case OT_STRING: dval = (double) atof (o.o_val.v_s); break;
+    default:
+        cl_error (E_UERR, "printf: bad operand type\n");
+    }
+
+    if (debug)
+        printf ("dval arg = '%g'\n", dval);
+
+    return (dval);
+}
+
+
+/* Note: caller must free the pointer!
+ */
+char *
+voGetStrArg ()
+{
+    struct  operand o;
+    char   *str = NULL;
+
+    o = popop();
+
+    switch (o.o_type & OT_BASIC) {
+    case OT_BOOL:
+    case OT_INT: 	
+        str = calloc (1, SZ_FNAME);
+        sprintf (str, "%d", o.o_val.v_i);  
+        break;
+    case OT_REAL: 	
+        str = calloc (1, SZ_FNAME);
+        sprintf (str, "%f", o.o_val.v_r);  
+        break;
+    case OT_STRING: 
+        str = calloc (1, strlen(o.o_val.v_s)+1);
+        sprintf (str, "%s", o.o_val.v_s);  
+        break;
+    default:
+        cl_error (E_UERR, "printf: bad operand type\n");
+    }
+
+    if (debug)
+        printf ("str arg = '%s'\n", str);
+
+    return (str);
+}
+
diff --git a/pkg/vocl/voclient.h b/pkg/vocl/voclient.h
new file mode 100644
index 00000000..1641cd25
--- /dev/null
+++ b/pkg/vocl/voclient.h
@@ -0,0 +1,131 @@
+/**
+ *  VOClient.i  -- SWIG Interface definition file.
+ */
+
+
+/*  vocDAL.c
+ */
+typedef int   	   ObjectID;
+typedef int   	   DAL;
+typedef int   	   Query;
+typedef int   	   QResponse;
+typedef int   	   QRecord;
+typedef int   	   QRAttribute;
+
+char       *voc_coneCaller (char *url, double ra, double dec, double sr, 
+			int otype);
+int         voc_coneCallerToFile (char *url, double ra, double dec, 
+			double sr, int otype, char *file);
+
+char       *voc_siapCaller (char *url, double ra, double dec, 
+			double rsize, double dsize, char *fmt, int otype);
+int         voc_siapCallerToFile (char *url, double ra, double dec,
+			double rsize, double dsize, char *fmt, int otype, 
+			char *file);
+char       *voc_ssapCaller (char *url, double ra, double dec, 
+			double size, char *band, char *time, char *fmt);
+int         voc_ssapCallerToFile (char *url, double ra, double dec,
+			double size, char *band, char *time, char *fmt,
+			char *file);
+char       *voc_getRawURL (char *url, int *nbytes);
+
+int         voc_validateObject (int hcode);
+
+
+
+/*  vocLIB.c
+ */
+int         voc_initVOClient (char *opts);
+void        voc_closeVOClient (int shutdown);
+void        voc_abortVOClient (int code, char *msg);
+DAL         voc_openConnection (char *service_url, int type);
+DAL         voc_openConeConnection (char *service_url);
+DAL         voc_openSiapConnection (char *service_url);
+DAL         voc_openSsapConnection (char *service_url);
+void        voc_closeConnection (DAL dal);
+int         voc_getServiceCount (DAL dal);
+void        voc_addServiceURL (DAL dal, char *service_url);
+char       *voc_getServiceURL (DAL dal, int index);
+Query       voc_getQuery (DAL dal, int type);
+Query       voc_getConeQuery (DAL dal, double ra, double dec, double sr);
+Query       voc_getSiapQuery (DAL dal, double ra, double dec,
+                         double ra_size, double dec_size, char *format);
+Query       voc_getSsapQuery (DAL dal, double ra, double dec,
+                         double size, char *band, char *time, char *format);
+int         voc_addIntParam (Query query, char *name, int value);
+int         voc_addFloatParam (Query query, char *name, double value);
+int         voc_addStringParam (Query query, char *name, char *value);
+char       *voc_getQueryString (Query query, int type, int index);
+QResponse   voc_executeQuery (Query query);
+QResponse   voc_getQueryResponse (Query query);
+char       *voc_executeCSV (Query query);
+char       *voc_executeVOTable (Query query);
+int         voc_executeQueryAs (Query query, char *fname, int type);
+int         voc_getRecordCount (QResponse qr);
+QRecord     voc_getRecord (QResponse qr, int recnum);
+char       *voc_getFieldAttr (QResponse qr, int fieldnum, char *attr);
+QRAttribute voc_getAttribute (QRecord rec, char *attrname);
+int         voc_intValue (QRAttribute v);
+double      voc_floatValue (QRAttribute v);
+char       *voc_stringValue (QRAttribute v);
+int         voc_getIntAttr (QRecord rec, char *attr_name);
+double      voc_getFloatAttr (QRecord rec, char *attr_name);
+char       *voc_getStringAttr (QRecord rec, char *attr_name);
+char       *voc_getAttrList (QRecord rec);
+int         voc_getAttrCount (QRecord rec);
+int         voc_getDataset (QRecord rec, char *acref, char *fname);
+int         voc_debugLevel (int level);
+
+
+
+/*  vocRegistry.c
+ */
+typedef int   	   RegResult;
+typedef int   	   RegQuery;
+
+
+RegResult   voc_regSearch (char *term1,  char *term2, int orValues);
+RegResult   voc_regSearchByService (char *svc, char *term, int orValues);
+RegQuery    voc_regQuery (char *term, int orValues);
+void        voc_regConstSvcType (RegQuery query, char *svc);
+void        voc_regConstWaveband (RegQuery query, char *waveband);
+void        voc_regDALOnly (RegQuery query, int value);
+void        voc_regSortRes (RegQuery query, int value);
+void        voc_regAddSearchTerm (RegQuery query, char *term, 
+			int orValue);
+void        voc_removeSearchTerm (RegQuery query, char *term);
+int         voc_regGetSTCount (RegQuery query);
+char       *voc_regGetQueryString (RegQuery query);
+RegResult   voc_regExecute (RegQuery query);
+char       *voc_regExecuteRaw (RegQuery query);
+int         voc_resGetCount (RegResult res);
+char       *voc_resGetStr (RegResult res, char *attribute, int index);
+double      voc_resGetFloat (RegResult res, char *attribute, int index);
+int         voc_resGetInt (RegResult res, char *attribute, int index);
+
+
+/*  vocSesame.c
+ */
+typedef int   	   Sesame;
+
+Sesame      voc_nameResolver (char *target);
+char       *voc_resolverPos (Sesame sr);
+double      voc_resolverRA (Sesame sr);
+double      voc_resolverDEC (Sesame sr);
+double      voc_resolverRAErr (Sesame sr);
+double      voc_resolverDECErr (Sesame sr);
+char       *voc_resolverOtype (Sesame sr);
+
+
+/*  vocSkybot.c
+ */
+typedef int   	   Skybot;
+
+Skybot      voc_skybot (double ra, double dec, double rsz, double dsz,
+                	double epoch);
+int         voc_skybotNObjs (Skybot sb);
+char       *voc_skybotStrAttr (Skybot sb, char *attr, int index);
+double      voc_skybotDblAttr (Skybot sb, char *attr, int index);
+
+
+
diff --git a/pkg/vocl/y.output b/pkg/vocl/y.output
new file mode 100644
index 00000000..4743a545
--- /dev/null
+++ b/pkg/vocl/y.output
@@ -0,0 +1,7034 @@
+State 0 conflicts: 1 shift/reduce
+State 88 conflicts: 1 shift/reduce
+State 91 conflicts: 1 shift/reduce
+State 101 conflicts: 1 shift/reduce
+State 105 conflicts: 1 shift/reduce
+State 187 conflicts: 1 shift/reduce
+State 261 conflicts: 1 shift/reduce
+State 310 conflicts: 1 shift/reduce
+State 374 conflicts: 2 shift/reduce
+
+
+Grammar
+
+    0 $accept: block $end
+
+    1 block: /* empty */
+    2      | '.' NL
+
+    3 @1: /* empty */
+
+    4 block: block @1 debug xstmt
+    5      | script_params
+    6      | script_body
+    7      | error NL
+
+    8 debug: /* empty */
+
+    9 @2: /* empty */
+
+   10 debug: D_XXX EOST @2 debug
+
+   11 D_XXX: D_D
+   12      | D_PEEK Y_CONSTANT
+   13      | '~'
+
+   14 script_params: proc_stmt var_decls begin_stmt
+
+   15 @3: /* empty */
+
+   16 script_body: begin_stmt @3 s_list opnl end_stmt
+
+   17 @4: /* empty */
+
+   18 proc_stmt: Y_PROCEDURE @4 param bparam_list EOST
+
+   19 bparam_list: /* empty */
+   20            | LP param_list RP
+
+   21 param_list: /* empty */
+   22           | xparam_list
+
+   23 xparam_list: param
+   24            | xparam_list DELIM param
+
+   25 var_decls: /* empty */
+   26          | var_decl_block
+
+   27 var_decl_block: var_decl_line
+   28               | var_decl_block var_decl_line
+
+   29 var_decl_line: EOST
+   30              | var_decl_stmt
+   31              | error NL
+
+   32 @5: /* empty */
+
+   33 var_decl_stmt: typedefs @5 var_decl_list EOST
+
+   34 typedefs: Y_BOOL
+   35         | Y_STRING
+   36         | Y_REAL
+   37         | Y_FILE
+   38         | Y_GCUR
+   39         | Y_IMCUR
+   40         | Y_UKEY
+   41         | Y_PSET
+   42         | Y_INT
+   43         | Y_STRUCT
+
+   44 var_decl_list: var_decl_plus
+   45              | var_decl_plus DELIM var_decl_list
+
+   46 var_decl_plus: var_decl
+   47              | var_decl '{' options_list ';' '}'
+
+   48 var_decl: var_def
+
+   49 @6: /* empty */
+
+   50 var_decl: var_def '=' @6 init_list
+
+   51 var_def: var_name
+
+   52 @7: /* empty */
+
+   53 var_def: var_name @7 '[' init_index_list ']'
+
+   54 var_name: param
+   55         | '*' param
+
+   56 init_index_list: /* empty */
+   57                | init_index_range
+   58                | init_index_list DELIM init_index_range
+
+   59 init_index_range: const
+   60                 | const ':' const
+
+   61 init_list: init_elem
+   62          | init_list DELIM init_elem
+
+   63 init_elem: const
+   64          | Y_CONSTANT LP const RP
+
+   65 const: Y_CONSTANT
+   66      | number
+
+   67 number: sign Y_CONSTANT
+
+   68 sign: '+'
+   69     | '-'
+
+   70 options_list: init_list DELIM options
+   71             | init_list
+   72             | options
+
+   73 options: option
+   74        | options DELIM option
+
+   75 option: Y_IDENT '=' const
+
+   76 begin_stmt: Y_BEGIN NL
+
+   77 expr: expr0
+   78     | ref
+
+   79 expr0: expr1
+   80      | Y_CONSTANT
+   81      | Y_GCUR
+   82      | Y_IMCUR
+   83      | Y_UKEY
+   84      | Y_PSET
+
+   85 expr1: LP expr RP
+   86      | expr '+' opnl expr
+   87      | expr '-' opnl expr
+   88      | expr '*' opnl expr
+   89      | expr '/' opnl expr
+   90      | expr YOP_POW opnl expr
+   91      | expr '%' opnl expr
+   92      | expr YOP_CONCAT opnl expr
+   93      | expr '<' opnl expr
+   94      | expr '>' opnl expr
+   95      | expr YOP_LE opnl expr
+   96      | expr YOP_GE opnl expr
+   97      | expr YOP_EQ opnl expr
+   98      | expr YOP_NE opnl expr
+   99      | expr YOP_OR opnl expr
+  100      | expr YOP_AND opnl expr
+  101      | YOP_NOT expr
+  102      | '-' expr
+
+  103 @8: /* empty */
+
+  104 expr1: Y_SCAN LP @8 scanarg RP
+
+  105 @9: /* empty */
+
+  106 expr1: Y_SCANF LP @9 scanfmt DELIM scanarg RP
+
+  107 @10: /* empty */
+
+  108 expr1: Y_FSCAN LP @10 scanarg RP
+
+  109 @11: /* empty */
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 scanfmt DELIM scanarg RP
+
+  111 @12: /* empty */
+
+  112 expr1: intrinsx LP @12 intrarg RP
+
+  113 intrinsx: intrins
+  114         | Y_INT
+  115         | Y_REAL
+
+  116 scanfmt: expr
+
+  117 scanarg: /* empty */
+  118        | Y_IDENT
+  119        | Y_IDENT DELIM scanarg
+
+  120 intrarg: /* empty */
+  121        | expr
+  122        | intrarg DELIM expr
+
+  123 stmt: c_stmt
+  124     | assign EOST
+  125     | cmdlist EOST
+  126     | immed EOST
+  127     | inspect EOST
+  128     | osesc EOST
+  129     | popstk EOST
+  130     | if
+  131     | ifelse
+  132     | iferr
+  133     | iferr_else
+  134     | while
+  135     | for
+  136     | switch
+  137     | case
+  138     | default
+  139     | next EOST
+  140     | break EOST
+  141     | goto EOST
+  142     | return EOST
+  143     | label_stmt
+  144     | nullstmt
+
+  145 c_stmt: c_blk
+  146       | c_blk NL
+
+  147 @13: /* empty */
+
+  148 @14: /* empty */
+
+  149 c_blk: '{' @13 s_list opnl @14 '}'
+
+  150 s_list: /* empty */
+  151       | s_list opnl xstmt
+
+  152 assign: ref equals expr0
+  153       | ref equals ref
+
+  154 @15: /* empty */
+
+  155 assign: ref @15 assign_oper expr
+
+  156 equals: '='
+
+  157 assign_oper: YOP_AOADD
+  158            | YOP_AOSUB
+  159            | YOP_AOMUL
+  160            | YOP_AODIV
+  161            | YOP_AOCAT
+
+  162 @16: /* empty */
+
+  163 cmdlist: command @16 cmdpipe
+
+  164 cmdpipe: /* empty */
+
+  165 @17: /* empty */
+
+  166 cmdpipe: cmdpipe pipe @17 command
+
+  167 pipe: '|' opnl
+  168     | Y_ALLPIPE opnl
+
+  169 @18: /* empty */
+
+  170 @19: /* empty */
+
+  171 command: tasknam @18 BARG @19 args EARG
+
+  172 @20: /* empty */
+
+  173 args: DELIM @20 arglist
+  174     | arglist
+
+  175 arglist: arg
+  176        | arglist DELIM arg
+
+  177 arg: /* empty */
+  178    | expr0
+  179    | ref
+  180    | ref '=' expr0
+  181    | ref '=' ref
+  182    | param '+'
+  183    | param '-'
+  184    | '<' file
+  185    | '>' file
+  186    | Y_ALLREDIR file
+  187    | Y_APPEND file
+  188    | Y_ALLAPPEND file
+  189    | Y_GSREDIR file
+
+  190 file: expr0
+  191     | param
+
+  192 immed: equals expr0
+  193      | equals ref
+
+  194 inspect: ref equals
+
+  195 osesc: Y_OSESC
+
+  196 popstk: equals
+
+  197 iferr: iferr_stat
+
+  198 @21: /* empty */
+
+  199 @22: /* empty */
+
+  200 iferr_stat: iferr_tok @21 c_blk @22 op_then opnl xstmt
+
+  201 @23: /* empty */
+
+  202 iferr_else: iferr_stat Y_ELSE @23 opnl xstmt
+
+  203 iferr_tok: Y_IFERR
+  204          | Y_IFNOERR
+
+  205 op_then: /* empty */
+  206        | Y_THEN
+
+  207 if: if_stat
+
+  208 @24: /* empty */
+
+  209 if_stat: Y_IF LP expr RP @24 opnl xstmt
+
+  210 @25: /* empty */
+
+  211 ifelse: if_stat Y_ELSE @25 opnl xstmt
+
+  212 @26: /* empty */
+
+  213 @27: /* empty */
+
+  214 while: Y_WHILE LP @26 expr RP @27 opnl xstmt
+
+  215 @28: /* empty */
+
+  216 @29: /* empty */
+
+  217 @30: /* empty */
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+  219 xassign: assign
+  220        | /* empty */
+
+  221 xexpr: expr
+  222      | /* empty */
+
+  223 @31: /* empty */
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl RP opnl @31 xstmt
+
+  225 @32: /* empty */
+
+  226 @33: /* empty */
+
+  227 case: Y_CASE @32 const_expr_list ':' opnl @33 xstmt
+
+  228 @34: /* empty */
+
+  229 default: Y_DEFAULT ':' opnl @34 xstmt
+
+  230 next: Y_NEXT
+
+  231 break: Y_BREAK
+
+  232 return: Y_RETURN
+  233       | Y_RETURN expr
+
+  234 end_stmt: Y_END NL
+
+  235 @35: /* empty */
+
+  236 label_stmt: Y_IDENT ':' opnl @35 xstmt
+
+  237 goto: Y_GOTO Y_IDENT
+
+  238 nullstmt: ';'
+  239         | ';' NL
+
+  240 @36: /* empty */
+
+  241 xstmt: @36 stmt
+  242      | var_decl_stmt
+  243      | error NL
+
+  244 const_expr_list: const_expr
+  245                | const_expr DELIM const_expr_list
+
+  246 const_expr: const
+
+  247 opnl: /* empty */
+  248     | NL
+
+  249 ref: param
+
+  250 @37: /* empty */
+
+  251 ref: param @37 '[' index_list ']'
+
+  252 index_list: index
+
+  253 @38: /* empty */
+
+  254 index_list: index @38 DELIM index_list
+
+  255 index: expr1
+  256      | ref
+  257      | '*'
+  258      | Y_CONSTANT
+
+  259 intrins: Y_IDENT
+
+  260 param: Y_IDENT
+
+  261 tasknam: Y_IDENT
+
+  262 EOST: NL
+  263     | ';'
+
+  264 DELIM: ','
+
+  265 BARG: /* empty */
+  266     | LP
+
+  267 EARG: /* empty */
+  268     | RP
+
+  269 LP: '('
+
+  270 RP: ')'
+
+  271 NL: Y_NEWLINE
+
+
+Terminals, with rules where they appear
+
+$end (0) 0
+'%' (37) 91
+'(' (40) 269
+')' (41) 270
+'*' (42) 55 88 257
+'+' (43) 68 86 182
+',' (44) 264
+'-' (45) 69 87 102 183
+'.' (46) 2
+'/' (47) 89
+':' (58) 60 227 229 236
+';' (59) 47 218 238 239 263
+'<' (60) 93 184
+'=' (61) 50 75 156 180 181
+'>' (62) 94 185
+'[' (91) 53 251
+']' (93) 53 251
+'{' (123) 47 149
+'|' (124) 167
+'}' (125) 47 149
+'~' (126) 13
+error (256) 7 31 243
+Y_SCAN (258) 104
+Y_SCANF (259) 106
+Y_FSCAN (260) 108
+Y_FSCANF (261) 110
+Y_OSESC (262) 195
+Y_APPEND (263) 187
+Y_ALLAPPEND (264) 188
+Y_ALLREDIR (265) 186
+Y_GSREDIR (266) 189
+Y_ALLPIPE (267) 168
+D_D (268) 11
+D_PEEK (269) 12
+Y_NEWLINE (270) 271
+Y_CONSTANT (271) 12 64 65 67 80 258
+Y_IDENT (272) 75 110 118 119 236 237 259 260 261
+Y_WHILE (273) 214
+Y_IF (274) 209
+Y_ELSE (275) 202 211
+Y_FOR (276) 218
+Y_BREAK (277) 231
+Y_NEXT (278) 230
+Y_SWITCH (279) 224
+Y_CASE (280) 227
+Y_DEFAULT (281) 229
+Y_RETURN (282) 232 233
+Y_GOTO (283) 237
+Y_PROCEDURE (284) 18
+Y_BEGIN (285) 76
+Y_END (286) 234
+Y_BOOL (287) 34
+Y_INT (288) 42 114
+Y_REAL (289) 36 115
+Y_STRING (290) 35
+Y_FILE (291) 37
+Y_STRUCT (292) 43
+Y_GCUR (293) 38 81
+Y_IMCUR (294) 39 82
+Y_UKEY (295) 40 83
+Y_PSET (296) 41 84
+Y_IFERR (297) 203
+Y_IFNOERR (298) 204
+Y_THEN (299) 206
+YOP_AOCAT (300) 161
+YOP_AODIV (301) 160
+YOP_AOMUL (302) 159
+YOP_AOSUB (303) 158
+YOP_AOADD (304) 157
+YOP_OR (305) 99
+YOP_AND (306) 100
+YOP_NE (307) 98
+YOP_EQ (308) 97
+YOP_GE (309) 96
+YOP_LE (310) 95
+YOP_CONCAT (311) 92
+UMINUS (312)
+YOP_NOT (313) 101
+YOP_POW (314) 90
+
+
+Nonterminals, with rules where they appear
+
+$accept (80)
+    on left: 0
+block (81)
+    on left: 1 2 4 5 6 7, on right: 0 4
+@1 (82)
+    on left: 3, on right: 4
+debug (83)
+    on left: 8 10, on right: 4 10
+@2 (84)
+    on left: 9, on right: 10
+D_XXX (85)
+    on left: 11 12 13, on right: 10
+script_params (86)
+    on left: 14, on right: 5
+script_body (87)
+    on left: 16, on right: 6
+@3 (88)
+    on left: 15, on right: 16
+proc_stmt (89)
+    on left: 18, on right: 14
+@4 (90)
+    on left: 17, on right: 18
+bparam_list (91)
+    on left: 19 20, on right: 18
+param_list (92)
+    on left: 21 22, on right: 20
+xparam_list (93)
+    on left: 23 24, on right: 22 24
+var_decls (94)
+    on left: 25 26, on right: 14
+var_decl_block (95)
+    on left: 27 28, on right: 26 28
+var_decl_line (96)
+    on left: 29 30 31, on right: 27 28
+var_decl_stmt (97)
+    on left: 33, on right: 30 242
+@5 (98)
+    on left: 32, on right: 33
+typedefs (99)
+    on left: 34 35 36 37 38 39 40 41 42 43, on right: 33
+var_decl_list (100)
+    on left: 44 45, on right: 33 45
+var_decl_plus (101)
+    on left: 46 47, on right: 44 45
+var_decl (102)
+    on left: 48 50, on right: 46 47
+@6 (103)
+    on left: 49, on right: 50
+var_def (104)
+    on left: 51 53, on right: 48 50
+@7 (105)
+    on left: 52, on right: 53
+var_name (106)
+    on left: 54 55, on right: 51 53
+init_index_list (107)
+    on left: 56 57 58, on right: 53 58
+init_index_range (108)
+    on left: 59 60, on right: 57 58
+init_list (109)
+    on left: 61 62, on right: 50 62 70 71
+init_elem (110)
+    on left: 63 64, on right: 61 62
+const (111)
+    on left: 65 66, on right: 59 60 63 64 75 246
+number (112)
+    on left: 67, on right: 66
+sign (113)
+    on left: 68 69, on right: 67
+options_list (114)
+    on left: 70 71 72, on right: 47
+options (115)
+    on left: 73 74, on right: 70 72 74
+option (116)
+    on left: 75, on right: 73 74
+begin_stmt (117)
+    on left: 76, on right: 14 16
+expr (118)
+    on left: 77 78, on right: 85 86 87 88 89 90 91 92 93 94 95 96 97
+    98 99 100 101 102 116 121 122 155 209 214 221 224 233
+expr0 (119)
+    on left: 79 80 81 82 83 84, on right: 77 152 178 180 190 192
+expr1 (120)
+    on left: 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
+    104 106 108 110 112, on right: 79 255
+@8 (121)
+    on left: 103, on right: 104
+@9 (122)
+    on left: 105, on right: 106
+@10 (123)
+    on left: 107, on right: 108
+@11 (124)
+    on left: 109, on right: 110
+@12 (125)
+    on left: 111, on right: 112
+intrinsx (126)
+    on left: 113 114 115, on right: 112
+scanfmt (127)
+    on left: 116, on right: 106 110
+scanarg (128)
+    on left: 117 118 119, on right: 104 106 108 110 119
+intrarg (129)
+    on left: 120 121 122, on right: 112 122
+stmt (130)
+    on left: 123 124 125 126 127 128 129 130 131 132 133 134 135 136
+    137 138 139 140 141 142 143 144, on right: 218 241
+c_stmt (131)
+    on left: 145 146, on right: 123
+c_blk (132)
+    on left: 149, on right: 145 146 200
+@13 (133)
+    on left: 147, on right: 149
+@14 (134)
+    on left: 148, on right: 149
+s_list (135)
+    on left: 150 151, on right: 16 149 151
+assign (136)
+    on left: 152 153 155, on right: 124 219
+@15 (137)
+    on left: 154, on right: 155
+equals (138)
+    on left: 156, on right: 152 153 192 193 194 196
+assign_oper (139)
+    on left: 157 158 159 160 161, on right: 155
+cmdlist (140)
+    on left: 163, on right: 125
+@16 (141)
+    on left: 162, on right: 163
+cmdpipe (142)
+    on left: 164 166, on right: 163 166
+@17 (143)
+    on left: 165, on right: 166
+pipe (144)
+    on left: 167 168, on right: 166
+command (145)
+    on left: 171, on right: 163 166
+@18 (146)
+    on left: 169, on right: 171
+@19 (147)
+    on left: 170, on right: 171
+args (148)
+    on left: 173 174, on right: 171
+@20 (149)
+    on left: 172, on right: 173
+arglist (150)
+    on left: 175 176, on right: 173 174 176
+arg (151)
+    on left: 177 178 179 180 181 182 183 184 185 186 187 188 189,
+    on right: 175 176
+file (152)
+    on left: 190 191, on right: 184 185 186 187 188 189
+immed (153)
+    on left: 192 193, on right: 126
+inspect (154)
+    on left: 194, on right: 127
+osesc (155)
+    on left: 195, on right: 128
+popstk (156)
+    on left: 196, on right: 129
+iferr (157)
+    on left: 197, on right: 132
+iferr_stat (158)
+    on left: 200, on right: 197 202
+@21 (159)
+    on left: 198, on right: 200
+@22 (160)
+    on left: 199, on right: 200
+iferr_else (161)
+    on left: 202, on right: 133
+@23 (162)
+    on left: 201, on right: 202
+iferr_tok (163)
+    on left: 203 204, on right: 200
+op_then (164)
+    on left: 205 206, on right: 200
+if (165)
+    on left: 207, on right: 130
+if_stat (166)
+    on left: 209, on right: 207 211
+@24 (167)
+    on left: 208, on right: 209
+ifelse (168)
+    on left: 211, on right: 131
+@25 (169)
+    on left: 210, on right: 211
+while (170)
+    on left: 214, on right: 134
+@26 (171)
+    on left: 212, on right: 214
+@27 (172)
+    on left: 213, on right: 214
+for (173)
+    on left: 218, on right: 135
+@28 (174)
+    on left: 215, on right: 218
+@29 (175)
+    on left: 216, on right: 218
+@30 (176)
+    on left: 217, on right: 218
+xassign (177)
+    on left: 219 220, on right: 218
+xexpr (178)
+    on left: 221 222, on right: 218
+switch (179)
+    on left: 224, on right: 136
+@31 (180)
+    on left: 223, on right: 224
+case (181)
+    on left: 227, on right: 137
+@32 (182)
+    on left: 225, on right: 227
+@33 (183)
+    on left: 226, on right: 227
+default (184)
+    on left: 229, on right: 138
+@34 (185)
+    on left: 228, on right: 229
+next (186)
+    on left: 230, on right: 139
+break (187)
+    on left: 231, on right: 140
+return (188)
+    on left: 232 233, on right: 142
+end_stmt (189)
+    on left: 234, on right: 16
+label_stmt (190)
+    on left: 236, on right: 143
+@35 (191)
+    on left: 235, on right: 236
+goto (192)
+    on left: 237, on right: 141
+nullstmt (193)
+    on left: 238 239, on right: 144
+xstmt (194)
+    on left: 241 242 243, on right: 4 151 200 202 209 211 214 224 227
+    229 236
+@36 (195)
+    on left: 240, on right: 241
+const_expr_list (196)
+    on left: 244 245, on right: 227 245
+const_expr (197)
+    on left: 246, on right: 244 245
+opnl (198)
+    on left: 247 248, on right: 16 86 87 88 89 90 91 92 93 94 95 96
+    97 98 99 100 149 151 167 168 200 202 209 211 214 218 224 227 229
+    236
+ref (199)
+    on left: 249 251, on right: 78 152 153 155 179 180 181 193 194
+    256
+@37 (200)
+    on left: 250, on right: 251
+index_list (201)
+    on left: 252 254, on right: 251 254
+@38 (202)
+    on left: 253, on right: 254
+index (203)
+    on left: 255 256 257 258, on right: 252 254
+intrins (204)
+    on left: 259, on right: 113
+param (205)
+    on left: 260, on right: 18 23 24 54 55 182 183 191 249 251
+tasknam (206)
+    on left: 261, on right: 171
+EOST (207)
+    on left: 262 263, on right: 10 18 29 33 124 125 126 127 128 129
+    139 140 141 142
+DELIM (208)
+    on left: 264, on right: 24 45 58 62 70 74 106 110 119 122 173 176
+    245 254
+BARG (209)
+    on left: 265 266, on right: 171
+EARG (210)
+    on left: 267 268, on right: 171
+LP (211)
+    on left: 269, on right: 20 64 85 104 106 108 110 112 209 214 218
+    224 266
+RP (212)
+    on left: 270, on right: 20 64 85 104 106 108 110 112 209 214 218
+    224 268
+NL (213)
+    on left: 271, on right: 2 7 31 76 146 234 239 243 248 262
+
+
+state 0
+
+    0 $accept: . block $end
+
+    error        shift, and go to state 1
+    Y_PROCEDURE  shift, and go to state 2
+    Y_BEGIN      shift, and go to state 3
+    '.'          shift, and go to state 4
+
+    $end       reduce using rule 1 (block)
+    error      [reduce using rule 1 (block)]
+    Y_OSESC    reduce using rule 1 (block)
+    D_D        reduce using rule 1 (block)
+    D_PEEK     reduce using rule 1 (block)
+    Y_IDENT    reduce using rule 1 (block)
+    Y_WHILE    reduce using rule 1 (block)
+    Y_IF       reduce using rule 1 (block)
+    Y_FOR      reduce using rule 1 (block)
+    Y_BREAK    reduce using rule 1 (block)
+    Y_NEXT     reduce using rule 1 (block)
+    Y_SWITCH   reduce using rule 1 (block)
+    Y_CASE     reduce using rule 1 (block)
+    Y_DEFAULT  reduce using rule 1 (block)
+    Y_RETURN   reduce using rule 1 (block)
+    Y_GOTO     reduce using rule 1 (block)
+    Y_BOOL     reduce using rule 1 (block)
+    Y_INT      reduce using rule 1 (block)
+    Y_REAL     reduce using rule 1 (block)
+    Y_STRING   reduce using rule 1 (block)
+    Y_FILE     reduce using rule 1 (block)
+    Y_STRUCT   reduce using rule 1 (block)
+    Y_GCUR     reduce using rule 1 (block)
+    Y_IMCUR    reduce using rule 1 (block)
+    Y_UKEY     reduce using rule 1 (block)
+    Y_PSET     reduce using rule 1 (block)
+    Y_IFERR    reduce using rule 1 (block)
+    Y_IFNOERR  reduce using rule 1 (block)
+    '='        reduce using rule 1 (block)
+    '~'        reduce using rule 1 (block)
+    '{'        reduce using rule 1 (block)
+    ';'        reduce using rule 1 (block)
+
+    block          go to state 5
+    script_params  go to state 6
+    script_body    go to state 7
+    proc_stmt      go to state 8
+    begin_stmt     go to state 9
+
+
+state 1
+
+    7 block: error . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 11
+
+
+state 2
+
+   18 proc_stmt: Y_PROCEDURE . @4 param bparam_list EOST
+
+    $default  reduce using rule 17 (@4)
+
+    @4  go to state 12
+
+
+state 3
+
+   76 begin_stmt: Y_BEGIN . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 13
+
+
+state 4
+
+    2 block: '.' . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 14
+
+
+state 5
+
+    0 $accept: block . $end
+    4 block: block . @1 debug xstmt
+
+    $end  shift, and go to state 15
+
+    $default  reduce using rule 3 (@1)
+
+    @1  go to state 16
+
+
+state 6
+
+    5 block: script_params .
+
+    $default  reduce using rule 5 (block)
+
+
+state 7
+
+    6 block: script_body .
+
+    $default  reduce using rule 6 (block)
+
+
+state 8
+
+   14 script_params: proc_stmt . var_decls begin_stmt
+
+    error      shift, and go to state 17
+    Y_NEWLINE  shift, and go to state 10
+    Y_BOOL     shift, and go to state 18
+    Y_INT      shift, and go to state 19
+    Y_REAL     shift, and go to state 20
+    Y_STRING   shift, and go to state 21
+    Y_FILE     shift, and go to state 22
+    Y_STRUCT   shift, and go to state 23
+    Y_GCUR     shift, and go to state 24
+    Y_IMCUR    shift, and go to state 25
+    Y_UKEY     shift, and go to state 26
+    Y_PSET     shift, and go to state 27
+    ';'        shift, and go to state 28
+
+    Y_BEGIN  reduce using rule 25 (var_decls)
+
+    var_decls       go to state 29
+    var_decl_block  go to state 30
+    var_decl_line   go to state 31
+    var_decl_stmt   go to state 32
+    typedefs        go to state 33
+    EOST            go to state 34
+    NL              go to state 35
+
+
+state 9
+
+   16 script_body: begin_stmt . @3 s_list opnl end_stmt
+
+    $default  reduce using rule 15 (@3)
+
+    @3  go to state 36
+
+
+state 10
+
+  271 NL: Y_NEWLINE .
+
+    $default  reduce using rule 271 (NL)
+
+
+state 11
+
+    7 block: error NL .
+
+    $default  reduce using rule 7 (block)
+
+
+state 12
+
+   18 proc_stmt: Y_PROCEDURE @4 . param bparam_list EOST
+
+    Y_IDENT  shift, and go to state 37
+
+    param  go to state 38
+
+
+state 13
+
+   76 begin_stmt: Y_BEGIN NL .
+
+    $default  reduce using rule 76 (begin_stmt)
+
+
+state 14
+
+    2 block: '.' NL .
+
+    $default  reduce using rule 2 (block)
+
+
+state 15
+
+    0 $accept: block $end .
+
+    $default  accept
+
+
+state 16
+
+    4 block: block @1 . debug xstmt
+
+    D_D     shift, and go to state 39
+    D_PEEK  shift, and go to state 40
+    '~'     shift, and go to state 41
+
+    $default  reduce using rule 8 (debug)
+
+    debug  go to state 42
+    D_XXX  go to state 43
+
+
+state 17
+
+   31 var_decl_line: error . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 44
+
+
+state 18
+
+   34 typedefs: Y_BOOL .
+
+    $default  reduce using rule 34 (typedefs)
+
+
+state 19
+
+   42 typedefs: Y_INT .
+
+    $default  reduce using rule 42 (typedefs)
+
+
+state 20
+
+   36 typedefs: Y_REAL .
+
+    $default  reduce using rule 36 (typedefs)
+
+
+state 21
+
+   35 typedefs: Y_STRING .
+
+    $default  reduce using rule 35 (typedefs)
+
+
+state 22
+
+   37 typedefs: Y_FILE .
+
+    $default  reduce using rule 37 (typedefs)
+
+
+state 23
+
+   43 typedefs: Y_STRUCT .
+
+    $default  reduce using rule 43 (typedefs)
+
+
+state 24
+
+   38 typedefs: Y_GCUR .
+
+    $default  reduce using rule 38 (typedefs)
+
+
+state 25
+
+   39 typedefs: Y_IMCUR .
+
+    $default  reduce using rule 39 (typedefs)
+
+
+state 26
+
+   40 typedefs: Y_UKEY .
+
+    $default  reduce using rule 40 (typedefs)
+
+
+state 27
+
+   41 typedefs: Y_PSET .
+
+    $default  reduce using rule 41 (typedefs)
+
+
+state 28
+
+  263 EOST: ';' .
+
+    $default  reduce using rule 263 (EOST)
+
+
+state 29
+
+   14 script_params: proc_stmt var_decls . begin_stmt
+
+    Y_BEGIN  shift, and go to state 3
+
+    begin_stmt  go to state 45
+
+
+state 30
+
+   26 var_decls: var_decl_block .
+   28 var_decl_block: var_decl_block . var_decl_line
+
+    error      shift, and go to state 17
+    Y_NEWLINE  shift, and go to state 10
+    Y_BOOL     shift, and go to state 18
+    Y_INT      shift, and go to state 19
+    Y_REAL     shift, and go to state 20
+    Y_STRING   shift, and go to state 21
+    Y_FILE     shift, and go to state 22
+    Y_STRUCT   shift, and go to state 23
+    Y_GCUR     shift, and go to state 24
+    Y_IMCUR    shift, and go to state 25
+    Y_UKEY     shift, and go to state 26
+    Y_PSET     shift, and go to state 27
+    ';'        shift, and go to state 28
+
+    Y_BEGIN  reduce using rule 26 (var_decls)
+
+    var_decl_line  go to state 46
+    var_decl_stmt  go to state 32
+    typedefs       go to state 33
+    EOST           go to state 34
+    NL             go to state 35
+
+
+state 31
+
+   27 var_decl_block: var_decl_line .
+
+    $default  reduce using rule 27 (var_decl_block)
+
+
+state 32
+
+   30 var_decl_line: var_decl_stmt .
+
+    $default  reduce using rule 30 (var_decl_line)
+
+
+state 33
+
+   33 var_decl_stmt: typedefs . @5 var_decl_list EOST
+
+    $default  reduce using rule 32 (@5)
+
+    @5  go to state 47
+
+
+state 34
+
+   29 var_decl_line: EOST .
+
+    $default  reduce using rule 29 (var_decl_line)
+
+
+state 35
+
+  262 EOST: NL .
+
+    $default  reduce using rule 262 (EOST)
+
+
+state 36
+
+   16 script_body: begin_stmt @3 . s_list opnl end_stmt
+
+    $default  reduce using rule 150 (s_list)
+
+    s_list  go to state 48
+
+
+state 37
+
+  260 param: Y_IDENT .
+
+    $default  reduce using rule 260 (param)
+
+
+state 38
+
+   18 proc_stmt: Y_PROCEDURE @4 param . bparam_list EOST
+
+    '('  shift, and go to state 49
+
+    $default  reduce using rule 19 (bparam_list)
+
+    bparam_list  go to state 50
+    LP           go to state 51
+
+
+state 39
+
+   11 D_XXX: D_D .
+
+    $default  reduce using rule 11 (D_XXX)
+
+
+state 40
+
+   12 D_XXX: D_PEEK . Y_CONSTANT
+
+    Y_CONSTANT  shift, and go to state 52
+
+
+state 41
+
+   13 D_XXX: '~' .
+
+    $default  reduce using rule 13 (D_XXX)
+
+
+state 42
+
+    4 block: block @1 debug . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 55
+    @36            go to state 56
+
+
+state 43
+
+   10 debug: D_XXX . EOST @2 debug
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 57
+    NL    go to state 35
+
+
+state 44
+
+   31 var_decl_line: error NL .
+
+    $default  reduce using rule 31 (var_decl_line)
+
+
+state 45
+
+   14 script_params: proc_stmt var_decls begin_stmt .
+
+    $default  reduce using rule 14 (script_params)
+
+
+state 46
+
+   28 var_decl_block: var_decl_block var_decl_line .
+
+    $default  reduce using rule 28 (var_decl_block)
+
+
+state 47
+
+   33 var_decl_stmt: typedefs @5 . var_decl_list EOST
+
+    Y_IDENT  shift, and go to state 37
+    '*'      shift, and go to state 58
+
+    var_decl_list  go to state 59
+    var_decl_plus  go to state 60
+    var_decl       go to state 61
+    var_def        go to state 62
+    var_name       go to state 63
+    param          go to state 64
+
+
+state 48
+
+   16 script_body: begin_stmt @3 s_list . opnl end_stmt
+  151 s_list: s_list . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 65
+    NL    go to state 66
+
+
+state 49
+
+  269 LP: '(' .
+
+    $default  reduce using rule 269 (LP)
+
+
+state 50
+
+   18 proc_stmt: Y_PROCEDURE @4 param bparam_list . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 67
+    NL    go to state 35
+
+
+state 51
+
+   20 bparam_list: LP . param_list RP
+
+    Y_IDENT  shift, and go to state 37
+
+    $default  reduce using rule 21 (param_list)
+
+    param_list   go to state 68
+    xparam_list  go to state 69
+    param        go to state 70
+
+
+state 52
+
+   12 D_XXX: D_PEEK Y_CONSTANT .
+
+    $default  reduce using rule 12 (D_XXX)
+
+
+state 53
+
+  243 xstmt: error . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 71
+
+
+state 54
+
+  242 xstmt: var_decl_stmt .
+
+    $default  reduce using rule 242 (xstmt)
+
+
+state 55
+
+    4 block: block @1 debug xstmt .
+
+    $default  reduce using rule 4 (block)
+
+
+state 56
+
+  241 xstmt: @36 . stmt
+
+    Y_OSESC    shift, and go to state 72
+    Y_IDENT    shift, and go to state 73
+    Y_WHILE    shift, and go to state 74
+    Y_IF       shift, and go to state 75
+    Y_FOR      shift, and go to state 76
+    Y_BREAK    shift, and go to state 77
+    Y_NEXT     shift, and go to state 78
+    Y_SWITCH   shift, and go to state 79
+    Y_CASE     shift, and go to state 80
+    Y_DEFAULT  shift, and go to state 81
+    Y_RETURN   shift, and go to state 82
+    Y_GOTO     shift, and go to state 83
+    Y_IFERR    shift, and go to state 84
+    Y_IFNOERR  shift, and go to state 85
+    '='        shift, and go to state 86
+    '{'        shift, and go to state 87
+    ';'        shift, and go to state 88
+
+    stmt        go to state 89
+    c_stmt      go to state 90
+    c_blk       go to state 91
+    assign      go to state 92
+    equals      go to state 93
+    cmdlist     go to state 94
+    command     go to state 95
+    immed       go to state 96
+    inspect     go to state 97
+    osesc       go to state 98
+    popstk      go to state 99
+    iferr       go to state 100
+    iferr_stat  go to state 101
+    iferr_else  go to state 102
+    iferr_tok   go to state 103
+    if          go to state 104
+    if_stat     go to state 105
+    ifelse      go to state 106
+    while       go to state 107
+    for         go to state 108
+    switch      go to state 109
+    case        go to state 110
+    default     go to state 111
+    next        go to state 112
+    break       go to state 113
+    return      go to state 114
+    label_stmt  go to state 115
+    goto        go to state 116
+    nullstmt    go to state 117
+    ref         go to state 118
+    param       go to state 119
+    tasknam     go to state 120
+
+
+state 57
+
+   10 debug: D_XXX EOST . @2 debug
+
+    $default  reduce using rule 9 (@2)
+
+    @2  go to state 121
+
+
+state 58
+
+   55 var_name: '*' . param
+
+    Y_IDENT  shift, and go to state 37
+
+    param  go to state 122
+
+
+state 59
+
+   33 var_decl_stmt: typedefs @5 var_decl_list . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 123
+    NL    go to state 35
+
+
+state 60
+
+   44 var_decl_list: var_decl_plus .
+   45              | var_decl_plus . DELIM var_decl_list
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 44 (var_decl_list)
+
+    DELIM  go to state 125
+
+
+state 61
+
+   46 var_decl_plus: var_decl .
+   47              | var_decl . '{' options_list ';' '}'
+
+    '{'  shift, and go to state 126
+
+    $default  reduce using rule 46 (var_decl_plus)
+
+
+state 62
+
+   48 var_decl: var_def .
+   50         | var_def . '=' @6 init_list
+
+    '='  shift, and go to state 127
+
+    $default  reduce using rule 48 (var_decl)
+
+
+state 63
+
+   51 var_def: var_name .
+   53        | var_name . @7 '[' init_index_list ']'
+
+    '['       reduce using rule 52 (@7)
+    $default  reduce using rule 51 (var_def)
+
+    @7  go to state 128
+
+
+state 64
+
+   54 var_name: param .
+
+    $default  reduce using rule 54 (var_name)
+
+
+state 65
+
+   16 script_body: begin_stmt @3 s_list opnl . end_stmt
+  151 s_list: s_list opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_END     shift, and go to state 129
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    end_stmt       go to state 130
+    xstmt          go to state 131
+    @36            go to state 56
+
+
+state 66
+
+  248 opnl: NL .
+
+    $default  reduce using rule 248 (opnl)
+
+
+state 67
+
+   18 proc_stmt: Y_PROCEDURE @4 param bparam_list EOST .
+
+    $default  reduce using rule 18 (proc_stmt)
+
+
+state 68
+
+   20 bparam_list: LP param_list . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 133
+
+
+state 69
+
+   22 param_list: xparam_list .
+   24 xparam_list: xparam_list . DELIM param
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 22 (param_list)
+
+    DELIM  go to state 134
+
+
+state 70
+
+   23 xparam_list: param .
+
+    $default  reduce using rule 23 (xparam_list)
+
+
+state 71
+
+  243 xstmt: error NL .
+
+    $default  reduce using rule 243 (xstmt)
+
+
+state 72
+
+  195 osesc: Y_OSESC .
+
+    $default  reduce using rule 195 (osesc)
+
+
+state 73
+
+  236 label_stmt: Y_IDENT . ':' opnl @35 xstmt
+  260 param: Y_IDENT .
+  261 tasknam: Y_IDENT .
+
+    ':'  shift, and go to state 135
+
+    '='        reduce using rule 260 (param)
+    YOP_AOCAT  reduce using rule 260 (param)
+    YOP_AODIV  reduce using rule 260 (param)
+    YOP_AOMUL  reduce using rule 260 (param)
+    YOP_AOSUB  reduce using rule 260 (param)
+    YOP_AOADD  reduce using rule 260 (param)
+    '['        reduce using rule 260 (param)
+    $default   reduce using rule 261 (tasknam)
+
+
+state 74
+
+  214 while: Y_WHILE . LP @26 expr RP @27 opnl xstmt
+
+    '('  shift, and go to state 49
+
+    LP  go to state 136
+
+
+state 75
+
+  209 if_stat: Y_IF . LP expr RP @24 opnl xstmt
+
+    '('  shift, and go to state 49
+
+    LP  go to state 137
+
+
+state 76
+
+  218 for: Y_FOR . LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    '('  shift, and go to state 49
+
+    LP  go to state 138
+
+
+state 77
+
+  231 break: Y_BREAK .
+
+    $default  reduce using rule 231 (break)
+
+
+state 78
+
+  230 next: Y_NEXT .
+
+    $default  reduce using rule 230 (next)
+
+
+state 79
+
+  224 switch: Y_SWITCH . opnl LP opnl expr opnl RP opnl @31 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 139
+    NL    go to state 66
+
+
+state 80
+
+  227 case: Y_CASE . @32 const_expr_list ':' opnl @33 xstmt
+
+    $default  reduce using rule 225 (@32)
+
+    @32  go to state 140
+
+
+state 81
+
+  229 default: Y_DEFAULT . ':' opnl @34 xstmt
+
+    ':'  shift, and go to state 141
+
+
+state 82
+
+  232 return: Y_RETURN .
+  233       | Y_RETURN . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    $default  reduce using rule 232 (return)
+
+    expr      go to state 156
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 83
+
+  237 goto: Y_GOTO . Y_IDENT
+
+    Y_IDENT  shift, and go to state 163
+
+
+state 84
+
+  203 iferr_tok: Y_IFERR .
+
+    $default  reduce using rule 203 (iferr_tok)
+
+
+state 85
+
+  204 iferr_tok: Y_IFNOERR .
+
+    $default  reduce using rule 204 (iferr_tok)
+
+
+state 86
+
+  156 equals: '=' .
+
+    $default  reduce using rule 156 (equals)
+
+
+state 87
+
+  149 c_blk: '{' . @13 s_list opnl @14 '}'
+
+    $default  reduce using rule 147 (@13)
+
+    @13  go to state 164
+
+
+state 88
+
+  238 nullstmt: ';' .
+  239         | ';' . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    Y_NEWLINE  [reduce using rule 238 (nullstmt)]
+    $default   reduce using rule 238 (nullstmt)
+
+    NL  go to state 165
+
+
+state 89
+
+  241 xstmt: @36 stmt .
+
+    $default  reduce using rule 241 (xstmt)
+
+
+state 90
+
+  123 stmt: c_stmt .
+
+    $default  reduce using rule 123 (stmt)
+
+
+state 91
+
+  145 c_stmt: c_blk .
+  146       | c_blk . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    Y_NEWLINE  [reduce using rule 145 (c_stmt)]
+    $default   reduce using rule 145 (c_stmt)
+
+    NL  go to state 166
+
+
+state 92
+
+  124 stmt: assign . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 167
+    NL    go to state 35
+
+
+state 93
+
+  192 immed: equals . expr0
+  193      | equals . ref
+  196 popstk: equals .
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    $default  reduce using rule 196 (popstk)
+
+    expr      go to state 168
+    expr0     go to state 169
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 170
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 94
+
+  125 stmt: cmdlist . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 171
+    NL    go to state 35
+
+
+state 95
+
+  163 cmdlist: command . @16 cmdpipe
+
+    $default  reduce using rule 162 (@16)
+
+    @16  go to state 172
+
+
+state 96
+
+  126 stmt: immed . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 173
+    NL    go to state 35
+
+
+state 97
+
+  127 stmt: inspect . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 174
+    NL    go to state 35
+
+
+state 98
+
+  128 stmt: osesc . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 175
+    NL    go to state 35
+
+
+state 99
+
+  129 stmt: popstk . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 176
+    NL    go to state 35
+
+
+state 100
+
+  132 stmt: iferr .
+
+    $default  reduce using rule 132 (stmt)
+
+
+state 101
+
+  197 iferr: iferr_stat .
+  202 iferr_else: iferr_stat . Y_ELSE @23 opnl xstmt
+
+    Y_ELSE  shift, and go to state 177
+
+    Y_ELSE    [reduce using rule 197 (iferr)]
+    $default  reduce using rule 197 (iferr)
+
+
+state 102
+
+  133 stmt: iferr_else .
+
+    $default  reduce using rule 133 (stmt)
+
+
+state 103
+
+  200 iferr_stat: iferr_tok . @21 c_blk @22 op_then opnl xstmt
+
+    $default  reduce using rule 198 (@21)
+
+    @21  go to state 178
+
+
+state 104
+
+  130 stmt: if .
+
+    $default  reduce using rule 130 (stmt)
+
+
+state 105
+
+  207 if: if_stat .
+  211 ifelse: if_stat . Y_ELSE @25 opnl xstmt
+
+    Y_ELSE  shift, and go to state 179
+
+    Y_ELSE    [reduce using rule 207 (if)]
+    $default  reduce using rule 207 (if)
+
+
+state 106
+
+  131 stmt: ifelse .
+
+    $default  reduce using rule 131 (stmt)
+
+
+state 107
+
+  134 stmt: while .
+
+    $default  reduce using rule 134 (stmt)
+
+
+state 108
+
+  135 stmt: for .
+
+    $default  reduce using rule 135 (stmt)
+
+
+state 109
+
+  136 stmt: switch .
+
+    $default  reduce using rule 136 (stmt)
+
+
+state 110
+
+  137 stmt: case .
+
+    $default  reduce using rule 137 (stmt)
+
+
+state 111
+
+  138 stmt: default .
+
+    $default  reduce using rule 138 (stmt)
+
+
+state 112
+
+  139 stmt: next . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 180
+    NL    go to state 35
+
+
+state 113
+
+  140 stmt: break . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 181
+    NL    go to state 35
+
+
+state 114
+
+  142 stmt: return . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 182
+    NL    go to state 35
+
+
+state 115
+
+  143 stmt: label_stmt .
+
+    $default  reduce using rule 143 (stmt)
+
+
+state 116
+
+  141 stmt: goto . EOST
+
+    Y_NEWLINE  shift, and go to state 10
+    ';'        shift, and go to state 28
+
+    EOST  go to state 183
+    NL    go to state 35
+
+
+state 117
+
+  144 stmt: nullstmt .
+
+    $default  reduce using rule 144 (stmt)
+
+
+state 118
+
+  152 assign: ref . equals expr0
+  153       | ref . equals ref
+  155       | ref . @15 assign_oper expr
+  194 inspect: ref . equals
+
+    '='  shift, and go to state 86
+
+    $default  reduce using rule 154 (@15)
+
+    @15     go to state 184
+    equals  go to state 185
+
+
+state 119
+
+  249 ref: param .
+  251    | param . @37 '[' index_list ']'
+
+    '['       reduce using rule 250 (@37)
+    $default  reduce using rule 249 (ref)
+
+    @37  go to state 186
+
+
+state 120
+
+  171 command: tasknam . @18 BARG @19 args EARG
+
+    $default  reduce using rule 169 (@18)
+
+    @18  go to state 187
+
+
+state 121
+
+   10 debug: D_XXX EOST @2 . debug
+
+    D_D     shift, and go to state 39
+    D_PEEK  shift, and go to state 40
+    '~'     shift, and go to state 41
+
+    $default  reduce using rule 8 (debug)
+
+    debug  go to state 188
+    D_XXX  go to state 43
+
+
+state 122
+
+   55 var_name: '*' param .
+
+    $default  reduce using rule 55 (var_name)
+
+
+state 123
+
+   33 var_decl_stmt: typedefs @5 var_decl_list EOST .
+
+    $default  reduce using rule 33 (var_decl_stmt)
+
+
+state 124
+
+  264 DELIM: ',' .
+
+    $default  reduce using rule 264 (DELIM)
+
+
+state 125
+
+   45 var_decl_list: var_decl_plus DELIM . var_decl_list
+
+    Y_IDENT  shift, and go to state 37
+    '*'      shift, and go to state 58
+
+    var_decl_list  go to state 189
+    var_decl_plus  go to state 60
+    var_decl       go to state 61
+    var_def        go to state 62
+    var_name       go to state 63
+    param          go to state 64
+
+
+state 126
+
+   47 var_decl_plus: var_decl '{' . options_list ';' '}'
+
+    Y_CONSTANT  shift, and go to state 190
+    Y_IDENT     shift, and go to state 191
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    init_list     go to state 194
+    init_elem     go to state 195
+    const         go to state 196
+    number        go to state 197
+    sign          go to state 198
+    options_list  go to state 199
+    options       go to state 200
+    option        go to state 201
+
+
+state 127
+
+   50 var_decl: var_def '=' . @6 init_list
+
+    $default  reduce using rule 49 (@6)
+
+    @6  go to state 202
+
+
+state 128
+
+   53 var_def: var_name @7 . '[' init_index_list ']'
+
+    '['  shift, and go to state 203
+
+
+state 129
+
+  234 end_stmt: Y_END . NL
+
+    Y_NEWLINE  shift, and go to state 10
+
+    NL  go to state 204
+
+
+state 130
+
+   16 script_body: begin_stmt @3 s_list opnl end_stmt .
+
+    $default  reduce using rule 16 (script_body)
+
+
+state 131
+
+  151 s_list: s_list opnl xstmt .
+
+    $default  reduce using rule 151 (s_list)
+
+
+state 132
+
+  270 RP: ')' .
+
+    $default  reduce using rule 270 (RP)
+
+
+state 133
+
+   20 bparam_list: LP param_list RP .
+
+    $default  reduce using rule 20 (bparam_list)
+
+
+state 134
+
+   24 xparam_list: xparam_list DELIM . param
+
+    Y_IDENT  shift, and go to state 37
+
+    param  go to state 205
+
+
+state 135
+
+  236 label_stmt: Y_IDENT ':' . opnl @35 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 206
+    NL    go to state 66
+
+
+state 136
+
+  214 while: Y_WHILE LP . @26 expr RP @27 opnl xstmt
+
+    $default  reduce using rule 212 (@26)
+
+    @26  go to state 207
+
+
+state 137
+
+  209 if_stat: Y_IF LP . expr RP @24 opnl xstmt
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 208
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 138
+
+  218 for: Y_FOR LP . opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 209
+    NL    go to state 66
+
+
+state 139
+
+  224 switch: Y_SWITCH opnl . LP opnl expr opnl RP opnl @31 xstmt
+
+    '('  shift, and go to state 49
+
+    LP  go to state 210
+
+
+state 140
+
+  227 case: Y_CASE @32 . const_expr_list ':' opnl @33 xstmt
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    const            go to state 212
+    number           go to state 197
+    sign             go to state 198
+    const_expr_list  go to state 213
+    const_expr       go to state 214
+
+
+state 141
+
+  229 default: Y_DEFAULT ':' . opnl @34 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 215
+    NL    go to state 66
+
+
+state 142
+
+  104 expr1: Y_SCAN . LP @8 scanarg RP
+
+    '('  shift, and go to state 49
+
+    LP  go to state 216
+
+
+state 143
+
+  106 expr1: Y_SCANF . LP @9 scanfmt DELIM scanarg RP
+
+    '('  shift, and go to state 49
+
+    LP  go to state 217
+
+
+state 144
+
+  108 expr1: Y_FSCAN . LP @10 scanarg RP
+
+    '('  shift, and go to state 49
+
+    LP  go to state 218
+
+
+state 145
+
+  110 expr1: Y_FSCANF . LP Y_IDENT DELIM @11 scanfmt DELIM scanarg RP
+
+    '('  shift, and go to state 49
+
+    LP  go to state 219
+
+
+state 146
+
+   80 expr0: Y_CONSTANT .
+
+    $default  reduce using rule 80 (expr0)
+
+
+state 147
+
+  259 intrins: Y_IDENT .
+  260 param: Y_IDENT .
+
+    '('       reduce using rule 259 (intrins)
+    $default  reduce using rule 260 (param)
+
+
+state 148
+
+  114 intrinsx: Y_INT .
+
+    $default  reduce using rule 114 (intrinsx)
+
+
+state 149
+
+  115 intrinsx: Y_REAL .
+
+    $default  reduce using rule 115 (intrinsx)
+
+
+state 150
+
+   81 expr0: Y_GCUR .
+
+    $default  reduce using rule 81 (expr0)
+
+
+state 151
+
+   82 expr0: Y_IMCUR .
+
+    $default  reduce using rule 82 (expr0)
+
+
+state 152
+
+   83 expr0: Y_UKEY .
+
+    $default  reduce using rule 83 (expr0)
+
+
+state 153
+
+   84 expr0: Y_PSET .
+
+    $default  reduce using rule 84 (expr0)
+
+
+state 154
+
+  102 expr1: '-' . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 220
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 155
+
+  101 expr1: YOP_NOT . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 221
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 156
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  233 return: Y_RETURN expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 233 (return)
+
+
+state 157
+
+   77 expr: expr0 .
+
+    $default  reduce using rule 77 (expr)
+
+
+state 158
+
+   79 expr0: expr1 .
+
+    $default  reduce using rule 79 (expr0)
+
+
+state 159
+
+  112 expr1: intrinsx . LP @12 intrarg RP
+
+    '('  shift, and go to state 49
+
+    LP  go to state 237
+
+
+state 160
+
+   78 expr: ref .
+
+    $default  reduce using rule 78 (expr)
+
+
+state 161
+
+  113 intrinsx: intrins .
+
+    $default  reduce using rule 113 (intrinsx)
+
+
+state 162
+
+   85 expr1: LP . expr RP
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 238
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 163
+
+  237 goto: Y_GOTO Y_IDENT .
+
+    $default  reduce using rule 237 (goto)
+
+
+state 164
+
+  149 c_blk: '{' @13 . s_list opnl @14 '}'
+
+    $default  reduce using rule 150 (s_list)
+
+    s_list  go to state 239
+
+
+state 165
+
+  239 nullstmt: ';' NL .
+
+    $default  reduce using rule 239 (nullstmt)
+
+
+state 166
+
+  146 c_stmt: c_blk NL .
+
+    $default  reduce using rule 146 (c_stmt)
+
+
+state 167
+
+  124 stmt: assign EOST .
+
+    $default  reduce using rule 124 (stmt)
+
+
+state 168
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+
+state 169
+
+   77 expr: expr0 .
+  192 immed: equals expr0 .
+
+    Y_NEWLINE  reduce using rule 192 (immed)
+    ';'        reduce using rule 192 (immed)
+    $default   reduce using rule 77 (expr)
+
+
+state 170
+
+   78 expr: ref .
+  193 immed: equals ref .
+
+    Y_NEWLINE  reduce using rule 193 (immed)
+    ';'        reduce using rule 193 (immed)
+    $default   reduce using rule 78 (expr)
+
+
+state 171
+
+  125 stmt: cmdlist EOST .
+
+    $default  reduce using rule 125 (stmt)
+
+
+state 172
+
+  163 cmdlist: command @16 . cmdpipe
+
+    $default  reduce using rule 164 (cmdpipe)
+
+    cmdpipe  go to state 240
+
+
+state 173
+
+  126 stmt: immed EOST .
+
+    $default  reduce using rule 126 (stmt)
+
+
+state 174
+
+  127 stmt: inspect EOST .
+
+    $default  reduce using rule 127 (stmt)
+
+
+state 175
+
+  128 stmt: osesc EOST .
+
+    $default  reduce using rule 128 (stmt)
+
+
+state 176
+
+  129 stmt: popstk EOST .
+
+    $default  reduce using rule 129 (stmt)
+
+
+state 177
+
+  202 iferr_else: iferr_stat Y_ELSE . @23 opnl xstmt
+
+    $default  reduce using rule 201 (@23)
+
+    @23  go to state 241
+
+
+state 178
+
+  200 iferr_stat: iferr_tok @21 . c_blk @22 op_then opnl xstmt
+
+    '{'  shift, and go to state 87
+
+    c_blk  go to state 242
+
+
+state 179
+
+  211 ifelse: if_stat Y_ELSE . @25 opnl xstmt
+
+    $default  reduce using rule 210 (@25)
+
+    @25  go to state 243
+
+
+state 180
+
+  139 stmt: next EOST .
+
+    $default  reduce using rule 139 (stmt)
+
+
+state 181
+
+  140 stmt: break EOST .
+
+    $default  reduce using rule 140 (stmt)
+
+
+state 182
+
+  142 stmt: return EOST .
+
+    $default  reduce using rule 142 (stmt)
+
+
+state 183
+
+  141 stmt: goto EOST .
+
+    $default  reduce using rule 141 (stmt)
+
+
+state 184
+
+  155 assign: ref @15 . assign_oper expr
+
+    YOP_AOCAT  shift, and go to state 244
+    YOP_AODIV  shift, and go to state 245
+    YOP_AOMUL  shift, and go to state 246
+    YOP_AOSUB  shift, and go to state 247
+    YOP_AOADD  shift, and go to state 248
+
+    assign_oper  go to state 249
+
+
+state 185
+
+  152 assign: ref equals . expr0
+  153       | ref equals . ref
+  194 inspect: ref equals .
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    $default  reduce using rule 194 (inspect)
+
+    expr      go to state 168
+    expr0     go to state 250
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 251
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 186
+
+  251 ref: param @37 . '[' index_list ']'
+
+    '['  shift, and go to state 252
+
+
+state 187
+
+  171 command: tasknam @18 . BARG @19 args EARG
+
+    '('  shift, and go to state 49
+
+    '('       [reduce using rule 265 (BARG)]
+    $default  reduce using rule 265 (BARG)
+
+    BARG  go to state 253
+    LP    go to state 254
+
+
+state 188
+
+   10 debug: D_XXX EOST @2 debug .
+
+    $default  reduce using rule 10 (debug)
+
+
+state 189
+
+   45 var_decl_list: var_decl_plus DELIM var_decl_list .
+
+    $default  reduce using rule 45 (var_decl_list)
+
+
+state 190
+
+   64 init_elem: Y_CONSTANT . LP const RP
+   65 const: Y_CONSTANT .
+
+    '('  shift, and go to state 49
+
+    $default  reduce using rule 65 (const)
+
+    LP  go to state 255
+
+
+state 191
+
+   75 option: Y_IDENT . '=' const
+
+    '='  shift, and go to state 256
+
+
+state 192
+
+   68 sign: '+' .
+
+    $default  reduce using rule 68 (sign)
+
+
+state 193
+
+   69 sign: '-' .
+
+    $default  reduce using rule 69 (sign)
+
+
+state 194
+
+   62 init_list: init_list . DELIM init_elem
+   70 options_list: init_list . DELIM options
+   71             | init_list .
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 71 (options_list)
+
+    DELIM  go to state 257
+
+
+state 195
+
+   61 init_list: init_elem .
+
+    $default  reduce using rule 61 (init_list)
+
+
+state 196
+
+   63 init_elem: const .
+
+    $default  reduce using rule 63 (init_elem)
+
+
+state 197
+
+   66 const: number .
+
+    $default  reduce using rule 66 (const)
+
+
+state 198
+
+   67 number: sign . Y_CONSTANT
+
+    Y_CONSTANT  shift, and go to state 258
+
+
+state 199
+
+   47 var_decl_plus: var_decl '{' options_list . ';' '}'
+
+    ';'  shift, and go to state 259
+
+
+state 200
+
+   72 options_list: options .
+   74 options: options . DELIM option
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 72 (options_list)
+
+    DELIM  go to state 260
+
+
+state 201
+
+   73 options: option .
+
+    $default  reduce using rule 73 (options)
+
+
+state 202
+
+   50 var_decl: var_def '=' @6 . init_list
+
+    Y_CONSTANT  shift, and go to state 190
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    init_list  go to state 261
+    init_elem  go to state 195
+    const      go to state 196
+    number     go to state 197
+    sign       go to state 198
+
+
+state 203
+
+   53 var_def: var_name @7 '[' . init_index_list ']'
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    $default  reduce using rule 56 (init_index_list)
+
+    init_index_list   go to state 262
+    init_index_range  go to state 263
+    const             go to state 264
+    number            go to state 197
+    sign              go to state 198
+
+
+state 204
+
+  234 end_stmt: Y_END NL .
+
+    $default  reduce using rule 234 (end_stmt)
+
+
+state 205
+
+   24 xparam_list: xparam_list DELIM param .
+
+    $default  reduce using rule 24 (xparam_list)
+
+
+state 206
+
+  236 label_stmt: Y_IDENT ':' opnl . @35 xstmt
+
+    $default  reduce using rule 235 (@35)
+
+    @35  go to state 265
+
+
+state 207
+
+  214 while: Y_WHILE LP @26 . expr RP @27 opnl xstmt
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 266
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 208
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  209 if_stat: Y_IF LP expr . RP @24 opnl xstmt
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+    ')'         shift, and go to state 132
+
+    RP  go to state 267
+
+
+state 209
+
+  218 for: Y_FOR LP opnl . xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    Y_IDENT  shift, and go to state 37
+
+    $default  reduce using rule 220 (xassign)
+
+    assign   go to state 268
+    xassign  go to state 269
+    ref      go to state 270
+    param    go to state 119
+
+
+state 210
+
+  224 switch: Y_SWITCH opnl LP . opnl expr opnl RP opnl @31 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 271
+    NL    go to state 66
+
+
+state 211
+
+   65 const: Y_CONSTANT .
+
+    $default  reduce using rule 65 (const)
+
+
+state 212
+
+  246 const_expr: const .
+
+    $default  reduce using rule 246 (const_expr)
+
+
+state 213
+
+  227 case: Y_CASE @32 const_expr_list . ':' opnl @33 xstmt
+
+    ':'  shift, and go to state 272
+
+
+state 214
+
+  244 const_expr_list: const_expr .
+  245                | const_expr . DELIM const_expr_list
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 244 (const_expr_list)
+
+    DELIM  go to state 273
+
+
+state 215
+
+  229 default: Y_DEFAULT ':' opnl . @34 xstmt
+
+    $default  reduce using rule 228 (@34)
+
+    @34  go to state 274
+
+
+state 216
+
+  104 expr1: Y_SCAN LP . @8 scanarg RP
+
+    $default  reduce using rule 103 (@8)
+
+    @8  go to state 275
+
+
+state 217
+
+  106 expr1: Y_SCANF LP . @9 scanfmt DELIM scanarg RP
+
+    $default  reduce using rule 105 (@9)
+
+    @9  go to state 276
+
+
+state 218
+
+  108 expr1: Y_FSCAN LP . @10 scanarg RP
+
+    $default  reduce using rule 107 (@10)
+
+    @10  go to state 277
+
+
+state 219
+
+  110 expr1: Y_FSCANF LP . Y_IDENT DELIM @11 scanfmt DELIM scanarg RP
+
+    Y_IDENT  shift, and go to state 278
+
+
+state 220
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  102      | '-' expr .
+
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 102 (expr1)
+
+
+state 221
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  101      | YOP_NOT expr .
+
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 101 (expr1)
+
+
+state 222
+
+   99 expr1: expr YOP_OR . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 279
+    NL    go to state 66
+
+
+state 223
+
+  100 expr1: expr YOP_AND . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 280
+    NL    go to state 66
+
+
+state 224
+
+   98 expr1: expr YOP_NE . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 281
+    NL    go to state 66
+
+
+state 225
+
+   97 expr1: expr YOP_EQ . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 282
+    NL    go to state 66
+
+
+state 226
+
+   93 expr1: expr '<' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 283
+    NL    go to state 66
+
+
+state 227
+
+   94 expr1: expr '>' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 284
+    NL    go to state 66
+
+
+state 228
+
+   96 expr1: expr YOP_GE . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 285
+    NL    go to state 66
+
+
+state 229
+
+   95 expr1: expr YOP_LE . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 286
+    NL    go to state 66
+
+
+state 230
+
+   92 expr1: expr YOP_CONCAT . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 287
+    NL    go to state 66
+
+
+state 231
+
+   86 expr1: expr '+' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 288
+    NL    go to state 66
+
+
+state 232
+
+   87 expr1: expr '-' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 289
+    NL    go to state 66
+
+
+state 233
+
+   88 expr1: expr '*' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 290
+    NL    go to state 66
+
+
+state 234
+
+   89 expr1: expr '/' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 291
+    NL    go to state 66
+
+
+state 235
+
+   91 expr1: expr '%' . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 292
+    NL    go to state 66
+
+
+state 236
+
+   90 expr1: expr YOP_POW . opnl expr
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 293
+    NL    go to state 66
+
+
+state 237
+
+  112 expr1: intrinsx LP . @12 intrarg RP
+
+    $default  reduce using rule 111 (@12)
+
+    @12  go to state 294
+
+
+state 238
+
+   85 expr1: LP expr . RP
+   86      | expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+    ')'         shift, and go to state 132
+
+    RP  go to state 295
+
+
+state 239
+
+  149 c_blk: '{' @13 s_list . opnl @14 '}'
+  151 s_list: s_list . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 296
+    NL    go to state 66
+
+
+state 240
+
+  163 cmdlist: command @16 cmdpipe .
+  166 cmdpipe: cmdpipe . pipe @17 command
+
+    Y_ALLPIPE  shift, and go to state 297
+    '|'        shift, and go to state 298
+
+    $default  reduce using rule 163 (cmdlist)
+
+    pipe  go to state 299
+
+
+state 241
+
+  202 iferr_else: iferr_stat Y_ELSE @23 . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 300
+    NL    go to state 66
+
+
+state 242
+
+  200 iferr_stat: iferr_tok @21 c_blk . @22 op_then opnl xstmt
+
+    $default  reduce using rule 199 (@22)
+
+    @22  go to state 301
+
+
+state 243
+
+  211 ifelse: if_stat Y_ELSE @25 . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 302
+    NL    go to state 66
+
+
+state 244
+
+  161 assign_oper: YOP_AOCAT .
+
+    $default  reduce using rule 161 (assign_oper)
+
+
+state 245
+
+  160 assign_oper: YOP_AODIV .
+
+    $default  reduce using rule 160 (assign_oper)
+
+
+state 246
+
+  159 assign_oper: YOP_AOMUL .
+
+    $default  reduce using rule 159 (assign_oper)
+
+
+state 247
+
+  158 assign_oper: YOP_AOSUB .
+
+    $default  reduce using rule 158 (assign_oper)
+
+
+state 248
+
+  157 assign_oper: YOP_AOADD .
+
+    $default  reduce using rule 157 (assign_oper)
+
+
+state 249
+
+  155 assign: ref @15 assign_oper . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 303
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 250
+
+   77 expr: expr0 .
+  152 assign: ref equals expr0 .
+
+    Y_NEWLINE  reduce using rule 152 (assign)
+    ';'        reduce using rule 152 (assign)
+    ')'        reduce using rule 152 (assign)
+    $default   reduce using rule 77 (expr)
+
+
+state 251
+
+   78 expr: ref .
+  153 assign: ref equals ref .
+
+    Y_NEWLINE  reduce using rule 153 (assign)
+    ';'        reduce using rule 153 (assign)
+    ')'        reduce using rule 153 (assign)
+    $default   reduce using rule 78 (expr)
+
+
+state 252
+
+  251 ref: param @37 '[' . index_list ']'
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 304
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    '*'         shift, and go to state 305
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr        go to state 168
+    expr0       go to state 157
+    expr1       go to state 306
+    intrinsx    go to state 159
+    ref         go to state 307
+    index_list  go to state 308
+    index       go to state 309
+    intrins     go to state 161
+    param       go to state 119
+    LP          go to state 162
+
+
+state 253
+
+  171 command: tasknam @18 BARG . @19 args EARG
+
+    $default  reduce using rule 170 (@19)
+
+    @19  go to state 310
+
+
+state 254
+
+  266 BARG: LP .
+
+    $default  reduce using rule 266 (BARG)
+
+
+state 255
+
+   64 init_elem: Y_CONSTANT LP . const RP
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    const   go to state 311
+    number  go to state 197
+    sign    go to state 198
+
+
+state 256
+
+   75 option: Y_IDENT '=' . const
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    const   go to state 312
+    number  go to state 197
+    sign    go to state 198
+
+
+state 257
+
+   62 init_list: init_list DELIM . init_elem
+   70 options_list: init_list DELIM . options
+
+    Y_CONSTANT  shift, and go to state 190
+    Y_IDENT     shift, and go to state 191
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    init_elem  go to state 313
+    const      go to state 196
+    number     go to state 197
+    sign       go to state 198
+    options    go to state 314
+    option     go to state 201
+
+
+state 258
+
+   67 number: sign Y_CONSTANT .
+
+    $default  reduce using rule 67 (number)
+
+
+state 259
+
+   47 var_decl_plus: var_decl '{' options_list ';' . '}'
+
+    '}'  shift, and go to state 315
+
+
+state 260
+
+   74 options: options DELIM . option
+
+    Y_IDENT  shift, and go to state 191
+
+    option  go to state 316
+
+
+state 261
+
+   50 var_decl: var_def '=' @6 init_list .
+   62 init_list: init_list . DELIM init_elem
+
+    ','  shift, and go to state 124
+
+    ','       [reduce using rule 50 (var_decl)]
+    $default  reduce using rule 50 (var_decl)
+
+    DELIM  go to state 317
+
+
+state 262
+
+   53 var_def: var_name @7 '[' init_index_list . ']'
+   58 init_index_list: init_index_list . DELIM init_index_range
+
+    ']'  shift, and go to state 318
+    ','  shift, and go to state 124
+
+    DELIM  go to state 319
+
+
+state 263
+
+   57 init_index_list: init_index_range .
+
+    $default  reduce using rule 57 (init_index_list)
+
+
+state 264
+
+   59 init_index_range: const .
+   60                 | const . ':' const
+
+    ':'  shift, and go to state 320
+
+    $default  reduce using rule 59 (init_index_range)
+
+
+state 265
+
+  236 label_stmt: Y_IDENT ':' opnl @35 . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 321
+    @36            go to state 56
+
+
+state 266
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  214 while: Y_WHILE LP @26 expr . RP @27 opnl xstmt
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+    ')'         shift, and go to state 132
+
+    RP  go to state 322
+
+
+state 267
+
+  209 if_stat: Y_IF LP expr RP . @24 opnl xstmt
+
+    $default  reduce using rule 208 (@24)
+
+    @24  go to state 323
+
+
+state 268
+
+  219 xassign: assign .
+
+    $default  reduce using rule 219 (xassign)
+
+
+state 269
+
+  218 for: Y_FOR LP opnl xassign . ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    ';'  shift, and go to state 324
+
+
+state 270
+
+  152 assign: ref . equals expr0
+  153       | ref . equals ref
+  155       | ref . @15 assign_oper expr
+
+    '='  shift, and go to state 86
+
+    $default  reduce using rule 154 (@15)
+
+    @15     go to state 184
+    equals  go to state 325
+
+
+state 271
+
+  224 switch: Y_SWITCH opnl LP opnl . expr opnl RP opnl @31 xstmt
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 326
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 272
+
+  227 case: Y_CASE @32 const_expr_list ':' . opnl @33 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 327
+    NL    go to state 66
+
+
+state 273
+
+  245 const_expr_list: const_expr DELIM . const_expr_list
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    const            go to state 212
+    number           go to state 197
+    sign             go to state 198
+    const_expr_list  go to state 328
+    const_expr       go to state 214
+
+
+state 274
+
+  229 default: Y_DEFAULT ':' opnl @34 . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 329
+    @36            go to state 56
+
+
+state 275
+
+  104 expr1: Y_SCAN LP @8 . scanarg RP
+
+    Y_IDENT  shift, and go to state 330
+
+    $default  reduce using rule 117 (scanarg)
+
+    scanarg  go to state 331
+
+
+state 276
+
+  106 expr1: Y_SCANF LP @9 . scanfmt DELIM scanarg RP
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 332
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    scanfmt   go to state 333
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 277
+
+  108 expr1: Y_FSCAN LP @10 . scanarg RP
+
+    Y_IDENT  shift, and go to state 330
+
+    $default  reduce using rule 117 (scanarg)
+
+    scanarg  go to state 334
+
+
+state 278
+
+  110 expr1: Y_FSCANF LP Y_IDENT . DELIM @11 scanfmt DELIM scanarg RP
+
+    ','  shift, and go to state 124
+
+    DELIM  go to state 335
+
+
+state 279
+
+   99 expr1: expr YOP_OR opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 336
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 280
+
+  100 expr1: expr YOP_AND opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 337
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 281
+
+   98 expr1: expr YOP_NE opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 338
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 282
+
+   97 expr1: expr YOP_EQ opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 339
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 283
+
+   93 expr1: expr '<' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 340
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 284
+
+   94 expr1: expr '>' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 341
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 285
+
+   96 expr1: expr YOP_GE opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 342
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 286
+
+   95 expr1: expr YOP_LE opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 343
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 287
+
+   92 expr1: expr YOP_CONCAT opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 344
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 288
+
+   86 expr1: expr '+' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 345
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 289
+
+   87 expr1: expr '-' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 346
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 290
+
+   88 expr1: expr '*' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 347
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 291
+
+   89 expr1: expr '/' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 348
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 292
+
+   91 expr1: expr '%' opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 349
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 293
+
+   90 expr1: expr YOP_POW opnl . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 350
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 294
+
+  112 expr1: intrinsx LP @12 . intrarg RP
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    $default  reduce using rule 120 (intrarg)
+
+    expr      go to state 351
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    intrarg   go to state 352
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 295
+
+   85 expr1: LP expr RP .
+
+    $default  reduce using rule 85 (expr1)
+
+
+state 296
+
+  149 c_blk: '{' @13 s_list opnl . @14 '}'
+  151 s_list: s_list opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+    '}'        reduce using rule 148 (@14)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    @14            go to state 353
+    xstmt          go to state 131
+    @36            go to state 56
+
+
+state 297
+
+  168 pipe: Y_ALLPIPE . opnl
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 354
+    NL    go to state 66
+
+
+state 298
+
+  167 pipe: '|' . opnl
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 355
+    NL    go to state 66
+
+
+state 299
+
+  166 cmdpipe: cmdpipe pipe . @17 command
+
+    $default  reduce using rule 165 (@17)
+
+    @17  go to state 356
+
+
+state 300
+
+  202 iferr_else: iferr_stat Y_ELSE @23 opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 357
+    @36            go to state 56
+
+
+state 301
+
+  200 iferr_stat: iferr_tok @21 c_blk @22 . op_then opnl xstmt
+
+    Y_THEN  shift, and go to state 358
+
+    $default  reduce using rule 205 (op_then)
+
+    op_then  go to state 359
+
+
+state 302
+
+  211 ifelse: if_stat Y_ELSE @25 opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 360
+    @36            go to state 56
+
+
+state 303
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  155 assign: ref @15 assign_oper expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 155 (assign)
+
+
+state 304
+
+   80 expr0: Y_CONSTANT .
+  258 index: Y_CONSTANT .
+
+    ']'       reduce using rule 258 (index)
+    ','       reduce using rule 258 (index)
+    $default  reduce using rule 80 (expr0)
+
+
+state 305
+
+  257 index: '*' .
+
+    $default  reduce using rule 257 (index)
+
+
+state 306
+
+   79 expr0: expr1 .
+  255 index: expr1 .
+
+    ']'       reduce using rule 255 (index)
+    ','       reduce using rule 255 (index)
+    $default  reduce using rule 79 (expr0)
+
+
+state 307
+
+   78 expr: ref .
+  256 index: ref .
+
+    ']'       reduce using rule 256 (index)
+    ','       reduce using rule 256 (index)
+    $default  reduce using rule 78 (expr)
+
+
+state 308
+
+  251 ref: param @37 '[' index_list . ']'
+
+    ']'  shift, and go to state 361
+
+
+state 309
+
+  252 index_list: index .
+  254           | index . @38 DELIM index_list
+
+    ','       reduce using rule 253 (@38)
+    $default  reduce using rule 252 (index_list)
+
+    @38  go to state 362
+
+
+state 310
+
+  171 command: tasknam @18 BARG @19 . args EARG
+
+    Y_SCAN       shift, and go to state 142
+    Y_SCANF      shift, and go to state 143
+    Y_FSCAN      shift, and go to state 144
+    Y_FSCANF     shift, and go to state 145
+    Y_APPEND     shift, and go to state 363
+    Y_ALLAPPEND  shift, and go to state 364
+    Y_ALLREDIR   shift, and go to state 365
+    Y_GSREDIR    shift, and go to state 366
+    Y_CONSTANT   shift, and go to state 146
+    Y_IDENT      shift, and go to state 147
+    Y_INT        shift, and go to state 148
+    Y_REAL       shift, and go to state 149
+    Y_GCUR       shift, and go to state 150
+    Y_IMCUR      shift, and go to state 151
+    Y_UKEY       shift, and go to state 152
+    Y_PSET       shift, and go to state 153
+    '<'          shift, and go to state 367
+    '>'          shift, and go to state 368
+    '-'          shift, and go to state 154
+    YOP_NOT      shift, and go to state 155
+    ','          shift, and go to state 124
+    '('          shift, and go to state 49
+
+    ','       [reduce using rule 177 (arg)]
+    $default  reduce using rule 177 (arg)
+
+    expr      go to state 168
+    expr0     go to state 369
+    expr1     go to state 158
+    intrinsx  go to state 159
+    args      go to state 370
+    arglist   go to state 371
+    arg       go to state 372
+    ref       go to state 373
+    intrins   go to state 161
+    param     go to state 374
+    DELIM     go to state 375
+    LP        go to state 162
+
+
+state 311
+
+   64 init_elem: Y_CONSTANT LP const . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 376
+
+
+state 312
+
+   75 option: Y_IDENT '=' const .
+
+    $default  reduce using rule 75 (option)
+
+
+state 313
+
+   62 init_list: init_list DELIM init_elem .
+
+    $default  reduce using rule 62 (init_list)
+
+
+state 314
+
+   70 options_list: init_list DELIM options .
+   74 options: options . DELIM option
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 70 (options_list)
+
+    DELIM  go to state 260
+
+
+state 315
+
+   47 var_decl_plus: var_decl '{' options_list ';' '}' .
+
+    $default  reduce using rule 47 (var_decl_plus)
+
+
+state 316
+
+   74 options: options DELIM option .
+
+    $default  reduce using rule 74 (options)
+
+
+state 317
+
+   62 init_list: init_list DELIM . init_elem
+
+    Y_CONSTANT  shift, and go to state 190
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    init_elem  go to state 313
+    const      go to state 196
+    number     go to state 197
+    sign       go to state 198
+
+
+state 318
+
+   53 var_def: var_name @7 '[' init_index_list ']' .
+
+    $default  reduce using rule 53 (var_def)
+
+
+state 319
+
+   58 init_index_list: init_index_list DELIM . init_index_range
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    init_index_range  go to state 377
+    const             go to state 264
+    number            go to state 197
+    sign              go to state 198
+
+
+state 320
+
+   60 init_index_range: const ':' . const
+
+    Y_CONSTANT  shift, and go to state 211
+    '+'         shift, and go to state 192
+    '-'         shift, and go to state 193
+
+    const   go to state 378
+    number  go to state 197
+    sign    go to state 198
+
+
+state 321
+
+  236 label_stmt: Y_IDENT ':' opnl @35 xstmt .
+
+    $default  reduce using rule 236 (label_stmt)
+
+
+state 322
+
+  214 while: Y_WHILE LP @26 expr RP . @27 opnl xstmt
+
+    $default  reduce using rule 213 (@27)
+
+    @27  go to state 379
+
+
+state 323
+
+  209 if_stat: Y_IF LP expr RP @24 . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 380
+    NL    go to state 66
+
+
+state 324
+
+  218 for: Y_FOR LP opnl xassign ';' . opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 381
+    NL    go to state 66
+
+
+state 325
+
+  152 assign: ref equals . expr0
+  153       | ref equals . ref
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 250
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 251
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 326
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  224 switch: Y_SWITCH opnl LP opnl expr . opnl RP opnl @31 xstmt
+
+    Y_NEWLINE   shift, and go to state 10
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 382
+    NL    go to state 66
+
+
+state 327
+
+  227 case: Y_CASE @32 const_expr_list ':' opnl . @33 xstmt
+
+    $default  reduce using rule 226 (@33)
+
+    @33  go to state 383
+
+
+state 328
+
+  245 const_expr_list: const_expr DELIM const_expr_list .
+
+    $default  reduce using rule 245 (const_expr_list)
+
+
+state 329
+
+  229 default: Y_DEFAULT ':' opnl @34 xstmt .
+
+    $default  reduce using rule 229 (default)
+
+
+state 330
+
+  118 scanarg: Y_IDENT .
+  119        | Y_IDENT . DELIM scanarg
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 118 (scanarg)
+
+    DELIM  go to state 384
+
+
+state 331
+
+  104 expr1: Y_SCAN LP @8 scanarg . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 385
+
+
+state 332
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  116 scanfmt: expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 116 (scanfmt)
+
+
+state 333
+
+  106 expr1: Y_SCANF LP @9 scanfmt . DELIM scanarg RP
+
+    ','  shift, and go to state 124
+
+    DELIM  go to state 386
+
+
+state 334
+
+  108 expr1: Y_FSCAN LP @10 scanarg . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 387
+
+
+state 335
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM . @11 scanfmt DELIM scanarg RP
+
+    $default  reduce using rule 109 (@11)
+
+    @11  go to state 388
+
+
+state 336
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+   99      | expr YOP_OR opnl expr .
+  100      | expr . YOP_AND opnl expr
+
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 99 (expr1)
+
+
+state 337
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  100      | expr YOP_AND opnl expr .
+
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 100 (expr1)
+
+
+state 338
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   98      | expr YOP_NE opnl expr .
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 98 (expr1)
+
+
+state 339
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   97      | expr YOP_EQ opnl expr .
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 97 (expr1)
+
+
+state 340
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   93      | expr '<' opnl expr .
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 93 (expr1)
+
+
+state 341
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   94      | expr '>' opnl expr .
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 94 (expr1)
+
+
+state 342
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   96      | expr YOP_GE opnl expr .
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 96 (expr1)
+
+
+state 343
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   95      | expr YOP_LE opnl expr .
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 95 (expr1)
+
+
+state 344
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   92      | expr YOP_CONCAT opnl expr .
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    '+'      shift, and go to state 231
+    '-'      shift, and go to state 232
+    '*'      shift, and go to state 233
+    '/'      shift, and go to state 234
+    '%'      shift, and go to state 235
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 92 (expr1)
+
+
+state 345
+
+   86 expr1: expr . '+' opnl expr
+   86      | expr '+' opnl expr .
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    '*'      shift, and go to state 233
+    '/'      shift, and go to state 234
+    '%'      shift, and go to state 235
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 86 (expr1)
+
+
+state 346
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   87      | expr '-' opnl expr .
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    '*'      shift, and go to state 233
+    '/'      shift, and go to state 234
+    '%'      shift, and go to state 235
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 87 (expr1)
+
+
+state 347
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   88      | expr '*' opnl expr .
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 88 (expr1)
+
+
+state 348
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   89      | expr '/' opnl expr .
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 89 (expr1)
+
+
+state 349
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   91      | expr '%' opnl expr .
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    YOP_POW  shift, and go to state 236
+
+    $default  reduce using rule 91 (expr1)
+
+
+state 350
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   90      | expr YOP_POW opnl expr .
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+
+    $default  reduce using rule 90 (expr1)
+
+
+state 351
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  121 intrarg: expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 121 (intrarg)
+
+
+state 352
+
+  112 expr1: intrinsx LP @12 intrarg . RP
+  122 intrarg: intrarg . DELIM expr
+
+    ','  shift, and go to state 124
+    ')'  shift, and go to state 132
+
+    DELIM  go to state 389
+    RP     go to state 390
+
+
+state 353
+
+  149 c_blk: '{' @13 s_list opnl @14 . '}'
+
+    '}'  shift, and go to state 391
+
+
+state 354
+
+  168 pipe: Y_ALLPIPE opnl .
+
+    $default  reduce using rule 168 (pipe)
+
+
+state 355
+
+  167 pipe: '|' opnl .
+
+    $default  reduce using rule 167 (pipe)
+
+
+state 356
+
+  166 cmdpipe: cmdpipe pipe @17 . command
+
+    Y_IDENT  shift, and go to state 392
+
+    command  go to state 393
+    tasknam  go to state 120
+
+
+state 357
+
+  202 iferr_else: iferr_stat Y_ELSE @23 opnl xstmt .
+
+    $default  reduce using rule 202 (iferr_else)
+
+
+state 358
+
+  206 op_then: Y_THEN .
+
+    $default  reduce using rule 206 (op_then)
+
+
+state 359
+
+  200 iferr_stat: iferr_tok @21 c_blk @22 op_then . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 394
+    NL    go to state 66
+
+
+state 360
+
+  211 ifelse: if_stat Y_ELSE @25 opnl xstmt .
+
+    $default  reduce using rule 211 (ifelse)
+
+
+state 361
+
+  251 ref: param @37 '[' index_list ']' .
+
+    $default  reduce using rule 251 (ref)
+
+
+state 362
+
+  254 index_list: index @38 . DELIM index_list
+
+    ','  shift, and go to state 124
+
+    DELIM  go to state 395
+
+
+state 363
+
+  187 arg: Y_APPEND . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 397
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 364
+
+  188 arg: Y_ALLAPPEND . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 399
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 365
+
+  186 arg: Y_ALLREDIR . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 400
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 366
+
+  189 arg: Y_GSREDIR . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 401
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 367
+
+  184 arg: '<' . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 402
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 368
+
+  185 arg: '>' . file
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 396
+    expr1     go to state 158
+    intrinsx  go to state 159
+    file      go to state 403
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 398
+    LP        go to state 162
+
+
+state 369
+
+   77 expr: expr0 .
+  178 arg: expr0 .
+
+    Y_ALLPIPE  reduce using rule 178 (arg)
+    Y_NEWLINE  reduce using rule 178 (arg)
+    ';'        reduce using rule 178 (arg)
+    '|'        reduce using rule 178 (arg)
+    ','        reduce using rule 178 (arg)
+    ')'        reduce using rule 178 (arg)
+    $default   reduce using rule 77 (expr)
+
+
+state 370
+
+  171 command: tasknam @18 BARG @19 args . EARG
+
+    ')'  shift, and go to state 132
+
+    $default  reduce using rule 267 (EARG)
+
+    EARG  go to state 404
+    RP    go to state 405
+
+
+state 371
+
+  174 args: arglist .
+  176 arglist: arglist . DELIM arg
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 174 (args)
+
+    DELIM  go to state 406
+
+
+state 372
+
+  175 arglist: arg .
+
+    $default  reduce using rule 175 (arglist)
+
+
+state 373
+
+   78 expr: ref .
+  179 arg: ref .
+  180    | ref . '=' expr0
+  181    | ref . '=' ref
+
+    '='  shift, and go to state 407
+
+    Y_ALLPIPE  reduce using rule 179 (arg)
+    Y_NEWLINE  reduce using rule 179 (arg)
+    ';'        reduce using rule 179 (arg)
+    '|'        reduce using rule 179 (arg)
+    ','        reduce using rule 179 (arg)
+    ')'        reduce using rule 179 (arg)
+    $default   reduce using rule 78 (expr)
+
+
+state 374
+
+  182 arg: param . '+'
+  183    | param . '-'
+  249 ref: param .
+  251    | param . @37 '[' index_list ']'
+
+    '+'  shift, and go to state 408
+    '-'  shift, and go to state 409
+
+    '+'       [reduce using rule 249 (ref)]
+    '-'       [reduce using rule 249 (ref)]
+    '['       reduce using rule 250 (@37)
+    $default  reduce using rule 249 (ref)
+
+    @37  go to state 186
+
+
+state 375
+
+  173 args: DELIM . @20 arglist
+
+    $default  reduce using rule 172 (@20)
+
+    @20  go to state 410
+
+
+state 376
+
+   64 init_elem: Y_CONSTANT LP const RP .
+
+    $default  reduce using rule 64 (init_elem)
+
+
+state 377
+
+   58 init_index_list: init_index_list DELIM init_index_range .
+
+    $default  reduce using rule 58 (init_index_list)
+
+
+state 378
+
+   60 init_index_range: const ':' const .
+
+    $default  reduce using rule 60 (init_index_range)
+
+
+state 379
+
+  214 while: Y_WHILE LP @26 expr RP @27 . opnl xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 411
+    NL    go to state 66
+
+
+state 380
+
+  209 if_stat: Y_IF LP expr RP @24 opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 412
+    @36            go to state 56
+
+
+state 381
+
+  218 for: Y_FOR LP opnl xassign ';' opnl . @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    $default  reduce using rule 215 (@28)
+
+    @28  go to state 413
+
+
+state 382
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl . RP opnl @31 xstmt
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 414
+
+
+state 383
+
+  227 case: Y_CASE @32 const_expr_list ':' opnl @33 . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 415
+    @36            go to state 56
+
+
+state 384
+
+  119 scanarg: Y_IDENT DELIM . scanarg
+
+    Y_IDENT  shift, and go to state 330
+
+    $default  reduce using rule 117 (scanarg)
+
+    scanarg  go to state 416
+
+
+state 385
+
+  104 expr1: Y_SCAN LP @8 scanarg RP .
+
+    $default  reduce using rule 104 (expr1)
+
+
+state 386
+
+  106 expr1: Y_SCANF LP @9 scanfmt DELIM . scanarg RP
+
+    Y_IDENT  shift, and go to state 330
+
+    $default  reduce using rule 117 (scanarg)
+
+    scanarg  go to state 417
+
+
+state 387
+
+  108 expr1: Y_FSCAN LP @10 scanarg RP .
+
+    $default  reduce using rule 108 (expr1)
+
+
+state 388
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 . scanfmt DELIM scanarg RP
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 332
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    scanfmt   go to state 418
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 389
+
+  122 intrarg: intrarg DELIM . expr
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 419
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 390
+
+  112 expr1: intrinsx LP @12 intrarg RP .
+
+    $default  reduce using rule 112 (expr1)
+
+
+state 391
+
+  149 c_blk: '{' @13 s_list opnl @14 '}' .
+
+    $default  reduce using rule 149 (c_blk)
+
+
+state 392
+
+  261 tasknam: Y_IDENT .
+
+    $default  reduce using rule 261 (tasknam)
+
+
+state 393
+
+  166 cmdpipe: cmdpipe pipe @17 command .
+
+    $default  reduce using rule 166 (cmdpipe)
+
+
+state 394
+
+  200 iferr_stat: iferr_tok @21 c_blk @22 op_then opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 420
+    @36            go to state 56
+
+
+state 395
+
+  254 index_list: index @38 DELIM . index_list
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 304
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    '*'         shift, and go to state 305
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr        go to state 168
+    expr0       go to state 157
+    expr1       go to state 306
+    intrinsx    go to state 159
+    ref         go to state 307
+    index_list  go to state 421
+    index       go to state 309
+    intrins     go to state 161
+    param       go to state 119
+    LP          go to state 162
+
+
+state 396
+
+   77 expr: expr0 .
+  190 file: expr0 .
+
+    Y_ALLPIPE  reduce using rule 190 (file)
+    Y_NEWLINE  reduce using rule 190 (file)
+    ';'        reduce using rule 190 (file)
+    '|'        reduce using rule 190 (file)
+    ','        reduce using rule 190 (file)
+    ')'        reduce using rule 190 (file)
+    $default   reduce using rule 77 (expr)
+
+
+state 397
+
+  187 arg: Y_APPEND file .
+
+    $default  reduce using rule 187 (arg)
+
+
+state 398
+
+  191 file: param .
+  249 ref: param .
+  251    | param . @37 '[' index_list ']'
+
+    Y_ALLPIPE  reduce using rule 191 (file)
+    Y_NEWLINE  reduce using rule 191 (file)
+    ';'        reduce using rule 191 (file)
+    '['        reduce using rule 250 (@37)
+    '|'        reduce using rule 191 (file)
+    ','        reduce using rule 191 (file)
+    ')'        reduce using rule 191 (file)
+    $default   reduce using rule 249 (ref)
+
+    @37  go to state 186
+
+
+state 399
+
+  188 arg: Y_ALLAPPEND file .
+
+    $default  reduce using rule 188 (arg)
+
+
+state 400
+
+  186 arg: Y_ALLREDIR file .
+
+    $default  reduce using rule 186 (arg)
+
+
+state 401
+
+  189 arg: Y_GSREDIR file .
+
+    $default  reduce using rule 189 (arg)
+
+
+state 402
+
+  184 arg: '<' file .
+
+    $default  reduce using rule 184 (arg)
+
+
+state 403
+
+  185 arg: '>' file .
+
+    $default  reduce using rule 185 (arg)
+
+
+state 404
+
+  171 command: tasknam @18 BARG @19 args EARG .
+
+    $default  reduce using rule 171 (command)
+
+
+state 405
+
+  268 EARG: RP .
+
+    $default  reduce using rule 268 (EARG)
+
+
+state 406
+
+  176 arglist: arglist DELIM . arg
+
+    Y_SCAN       shift, and go to state 142
+    Y_SCANF      shift, and go to state 143
+    Y_FSCAN      shift, and go to state 144
+    Y_FSCANF     shift, and go to state 145
+    Y_APPEND     shift, and go to state 363
+    Y_ALLAPPEND  shift, and go to state 364
+    Y_ALLREDIR   shift, and go to state 365
+    Y_GSREDIR    shift, and go to state 366
+    Y_CONSTANT   shift, and go to state 146
+    Y_IDENT      shift, and go to state 147
+    Y_INT        shift, and go to state 148
+    Y_REAL       shift, and go to state 149
+    Y_GCUR       shift, and go to state 150
+    Y_IMCUR      shift, and go to state 151
+    Y_UKEY       shift, and go to state 152
+    Y_PSET       shift, and go to state 153
+    '<'          shift, and go to state 367
+    '>'          shift, and go to state 368
+    '-'          shift, and go to state 154
+    YOP_NOT      shift, and go to state 155
+    '('          shift, and go to state 49
+
+    $default  reduce using rule 177 (arg)
+
+    expr      go to state 168
+    expr0     go to state 369
+    expr1     go to state 158
+    intrinsx  go to state 159
+    arg       go to state 422
+    ref       go to state 373
+    intrins   go to state 161
+    param     go to state 374
+    LP        go to state 162
+
+
+state 407
+
+  180 arg: ref '=' . expr0
+  181    | ref '=' . ref
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    expr      go to state 168
+    expr0     go to state 423
+    expr1     go to state 158
+    intrinsx  go to state 159
+    ref       go to state 424
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 408
+
+  182 arg: param '+' .
+
+    $default  reduce using rule 182 (arg)
+
+
+state 409
+
+  183 arg: param '-' .
+
+    $default  reduce using rule 183 (arg)
+
+
+state 410
+
+  173 args: DELIM @20 . arglist
+
+    Y_SCAN       shift, and go to state 142
+    Y_SCANF      shift, and go to state 143
+    Y_FSCAN      shift, and go to state 144
+    Y_FSCANF     shift, and go to state 145
+    Y_APPEND     shift, and go to state 363
+    Y_ALLAPPEND  shift, and go to state 364
+    Y_ALLREDIR   shift, and go to state 365
+    Y_GSREDIR    shift, and go to state 366
+    Y_CONSTANT   shift, and go to state 146
+    Y_IDENT      shift, and go to state 147
+    Y_INT        shift, and go to state 148
+    Y_REAL       shift, and go to state 149
+    Y_GCUR       shift, and go to state 150
+    Y_IMCUR      shift, and go to state 151
+    Y_UKEY       shift, and go to state 152
+    Y_PSET       shift, and go to state 153
+    '<'          shift, and go to state 367
+    '>'          shift, and go to state 368
+    '-'          shift, and go to state 154
+    YOP_NOT      shift, and go to state 155
+    '('          shift, and go to state 49
+
+    $default  reduce using rule 177 (arg)
+
+    expr      go to state 168
+    expr0     go to state 369
+    expr1     go to state 158
+    intrinsx  go to state 159
+    arglist   go to state 425
+    arg       go to state 372
+    ref       go to state 373
+    intrins   go to state 161
+    param     go to state 374
+    LP        go to state 162
+
+
+state 411
+
+  214 while: Y_WHILE LP @26 expr RP @27 opnl . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 426
+    @36            go to state 56
+
+
+state 412
+
+  209 if_stat: Y_IF LP expr RP @24 opnl xstmt .
+
+    $default  reduce using rule 209 (if_stat)
+
+
+state 413
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 . xexpr ';' opnl @29 xassign RP opnl @30 stmt
+
+    Y_SCAN      shift, and go to state 142
+    Y_SCANF     shift, and go to state 143
+    Y_FSCAN     shift, and go to state 144
+    Y_FSCANF    shift, and go to state 145
+    Y_CONSTANT  shift, and go to state 146
+    Y_IDENT     shift, and go to state 147
+    Y_INT       shift, and go to state 148
+    Y_REAL      shift, and go to state 149
+    Y_GCUR      shift, and go to state 150
+    Y_IMCUR     shift, and go to state 151
+    Y_UKEY      shift, and go to state 152
+    Y_PSET      shift, and go to state 153
+    '-'         shift, and go to state 154
+    YOP_NOT     shift, and go to state 155
+    '('         shift, and go to state 49
+
+    $default  reduce using rule 222 (xexpr)
+
+    expr      go to state 427
+    expr0     go to state 157
+    expr1     go to state 158
+    intrinsx  go to state 159
+    xexpr     go to state 428
+    ref       go to state 160
+    intrins   go to state 161
+    param     go to state 119
+    LP        go to state 162
+
+
+state 414
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl RP . opnl @31 xstmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 429
+    NL    go to state 66
+
+
+state 415
+
+  227 case: Y_CASE @32 const_expr_list ':' opnl @33 xstmt .
+
+    $default  reduce using rule 227 (case)
+
+
+state 416
+
+  119 scanarg: Y_IDENT DELIM scanarg .
+
+    $default  reduce using rule 119 (scanarg)
+
+
+state 417
+
+  106 expr1: Y_SCANF LP @9 scanfmt DELIM scanarg . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 430
+
+
+state 418
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 scanfmt . DELIM scanarg RP
+
+    ','  shift, and go to state 124
+
+    DELIM  go to state 431
+
+
+state 419
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  122 intrarg: intrarg DELIM expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 122 (intrarg)
+
+
+state 420
+
+  200 iferr_stat: iferr_tok @21 c_blk @22 op_then opnl xstmt .
+
+    $default  reduce using rule 200 (iferr_stat)
+
+
+state 421
+
+  254 index_list: index @38 DELIM index_list .
+
+    $default  reduce using rule 254 (index_list)
+
+
+state 422
+
+  176 arglist: arglist DELIM arg .
+
+    $default  reduce using rule 176 (arglist)
+
+
+state 423
+
+   77 expr: expr0 .
+  180 arg: ref '=' expr0 .
+
+    Y_ALLPIPE  reduce using rule 180 (arg)
+    Y_NEWLINE  reduce using rule 180 (arg)
+    ';'        reduce using rule 180 (arg)
+    '|'        reduce using rule 180 (arg)
+    ','        reduce using rule 180 (arg)
+    ')'        reduce using rule 180 (arg)
+    $default   reduce using rule 77 (expr)
+
+
+state 424
+
+   78 expr: ref .
+  181 arg: ref '=' ref .
+
+    Y_ALLPIPE  reduce using rule 181 (arg)
+    Y_NEWLINE  reduce using rule 181 (arg)
+    ';'        reduce using rule 181 (arg)
+    '|'        reduce using rule 181 (arg)
+    ','        reduce using rule 181 (arg)
+    ')'        reduce using rule 181 (arg)
+    $default   reduce using rule 78 (expr)
+
+
+state 425
+
+  173 args: DELIM @20 arglist .
+  176 arglist: arglist . DELIM arg
+
+    ','  shift, and go to state 124
+
+    $default  reduce using rule 173 (args)
+
+    DELIM  go to state 406
+
+
+state 426
+
+  214 while: Y_WHILE LP @26 expr RP @27 opnl xstmt .
+
+    $default  reduce using rule 214 (while)
+
+
+state 427
+
+   86 expr1: expr . '+' opnl expr
+   87      | expr . '-' opnl expr
+   88      | expr . '*' opnl expr
+   89      | expr . '/' opnl expr
+   90      | expr . YOP_POW opnl expr
+   91      | expr . '%' opnl expr
+   92      | expr . YOP_CONCAT opnl expr
+   93      | expr . '<' opnl expr
+   94      | expr . '>' opnl expr
+   95      | expr . YOP_LE opnl expr
+   96      | expr . YOP_GE opnl expr
+   97      | expr . YOP_EQ opnl expr
+   98      | expr . YOP_NE opnl expr
+   99      | expr . YOP_OR opnl expr
+  100      | expr . YOP_AND opnl expr
+  221 xexpr: expr .
+
+    YOP_OR      shift, and go to state 222
+    YOP_AND     shift, and go to state 223
+    YOP_NE      shift, and go to state 224
+    YOP_EQ      shift, and go to state 225
+    '<'         shift, and go to state 226
+    '>'         shift, and go to state 227
+    YOP_GE      shift, and go to state 228
+    YOP_LE      shift, and go to state 229
+    YOP_CONCAT  shift, and go to state 230
+    '+'         shift, and go to state 231
+    '-'         shift, and go to state 232
+    '*'         shift, and go to state 233
+    '/'         shift, and go to state 234
+    '%'         shift, and go to state 235
+    YOP_POW     shift, and go to state 236
+
+    $default  reduce using rule 221 (xexpr)
+
+
+state 428
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr . ';' opnl @29 xassign RP opnl @30 stmt
+
+    ';'  shift, and go to state 432
+
+
+state 429
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl RP opnl . @31 xstmt
+
+    $default  reduce using rule 223 (@31)
+
+    @31  go to state 433
+
+
+state 430
+
+  106 expr1: Y_SCANF LP @9 scanfmt DELIM scanarg RP .
+
+    $default  reduce using rule 106 (expr1)
+
+
+state 431
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 scanfmt DELIM . scanarg RP
+
+    Y_IDENT  shift, and go to state 330
+
+    $default  reduce using rule 117 (scanarg)
+
+    scanarg  go to state 434
+
+
+state 432
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' . opnl @29 xassign RP opnl @30 stmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 435
+    NL    go to state 66
+
+
+state 433
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl RP opnl @31 . xstmt
+
+    error     shift, and go to state 53
+    Y_BOOL    shift, and go to state 18
+    Y_INT     shift, and go to state 19
+    Y_REAL    shift, and go to state 20
+    Y_STRING  shift, and go to state 21
+    Y_FILE    shift, and go to state 22
+    Y_STRUCT  shift, and go to state 23
+    Y_GCUR    shift, and go to state 24
+    Y_IMCUR   shift, and go to state 25
+    Y_UKEY    shift, and go to state 26
+    Y_PSET    shift, and go to state 27
+
+    Y_OSESC    reduce using rule 240 (@36)
+    Y_IDENT    reduce using rule 240 (@36)
+    Y_WHILE    reduce using rule 240 (@36)
+    Y_IF       reduce using rule 240 (@36)
+    Y_FOR      reduce using rule 240 (@36)
+    Y_BREAK    reduce using rule 240 (@36)
+    Y_NEXT     reduce using rule 240 (@36)
+    Y_SWITCH   reduce using rule 240 (@36)
+    Y_CASE     reduce using rule 240 (@36)
+    Y_DEFAULT  reduce using rule 240 (@36)
+    Y_RETURN   reduce using rule 240 (@36)
+    Y_GOTO     reduce using rule 240 (@36)
+    Y_IFERR    reduce using rule 240 (@36)
+    Y_IFNOERR  reduce using rule 240 (@36)
+    '='        reduce using rule 240 (@36)
+    '{'        reduce using rule 240 (@36)
+    ';'        reduce using rule 240 (@36)
+
+    var_decl_stmt  go to state 54
+    typedefs       go to state 33
+    xstmt          go to state 436
+    @36            go to state 56
+
+
+state 434
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 scanfmt DELIM scanarg . RP
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 437
+
+
+state 435
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl . @29 xassign RP opnl @30 stmt
+
+    $default  reduce using rule 216 (@29)
+
+    @29  go to state 438
+
+
+state 436
+
+  224 switch: Y_SWITCH opnl LP opnl expr opnl RP opnl @31 xstmt .
+
+    $default  reduce using rule 224 (switch)
+
+
+state 437
+
+  110 expr1: Y_FSCANF LP Y_IDENT DELIM @11 scanfmt DELIM scanarg RP .
+
+    $default  reduce using rule 110 (expr1)
+
+
+state 438
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 . xassign RP opnl @30 stmt
+
+    Y_IDENT  shift, and go to state 37
+
+    $default  reduce using rule 220 (xassign)
+
+    assign   go to state 268
+    xassign  go to state 439
+    ref      go to state 270
+    param    go to state 119
+
+
+state 439
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign . RP opnl @30 stmt
+
+    ')'  shift, and go to state 132
+
+    RP  go to state 440
+
+
+state 440
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP . opnl @30 stmt
+
+    Y_NEWLINE  shift, and go to state 10
+
+    $default  reduce using rule 247 (opnl)
+
+    opnl  go to state 441
+    NL    go to state 66
+
+
+state 441
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl . @30 stmt
+
+    $default  reduce using rule 217 (@30)
+
+    @30  go to state 442
+
+
+state 442
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 . stmt
+
+    Y_OSESC    shift, and go to state 72
+    Y_IDENT    shift, and go to state 73
+    Y_WHILE    shift, and go to state 74
+    Y_IF       shift, and go to state 75
+    Y_FOR      shift, and go to state 76
+    Y_BREAK    shift, and go to state 77
+    Y_NEXT     shift, and go to state 78
+    Y_SWITCH   shift, and go to state 79
+    Y_CASE     shift, and go to state 80
+    Y_DEFAULT  shift, and go to state 81
+    Y_RETURN   shift, and go to state 82
+    Y_GOTO     shift, and go to state 83
+    Y_IFERR    shift, and go to state 84
+    Y_IFNOERR  shift, and go to state 85
+    '='        shift, and go to state 86
+    '{'        shift, and go to state 87
+    ';'        shift, and go to state 88
+
+    stmt        go to state 443
+    c_stmt      go to state 90
+    c_blk       go to state 91
+    assign      go to state 92
+    equals      go to state 93
+    cmdlist     go to state 94
+    command     go to state 95
+    immed       go to state 96
+    inspect     go to state 97
+    osesc       go to state 98
+    popstk      go to state 99
+    iferr       go to state 100
+    iferr_stat  go to state 101
+    iferr_else  go to state 102
+    iferr_tok   go to state 103
+    if          go to state 104
+    if_stat     go to state 105
+    ifelse      go to state 106
+    while       go to state 107
+    for         go to state 108
+    switch      go to state 109
+    case        go to state 110
+    default     go to state 111
+    next        go to state 112
+    break       go to state 113
+    return      go to state 114
+    label_stmt  go to state 115
+    goto        go to state 116
+    nullstmt    go to state 117
+    ref         go to state 118
+    param       go to state 119
+    tasknam     go to state 120
+
+
+state 443
+
+  218 for: Y_FOR LP opnl xassign ';' opnl @28 xexpr ';' opnl @29 xassign RP opnl @30 stmt .
+
+    $default  reduce using rule 218 (for)
diff --git a/pkg/vocl/ytab.c b/pkg/vocl/ytab.c
new file mode 100644
index 00000000..810d9d58
--- /dev/null
+++ b/pkg/vocl/ytab.c
@@ -0,0 +1,4644 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     Y_SCAN = 258,
+     Y_SCANF = 259,
+     Y_FSCAN = 260,
+     Y_FSCANF = 261,
+     Y_OSESC = 262,
+     Y_APPEND = 263,
+     Y_ALLAPPEND = 264,
+     Y_ALLREDIR = 265,
+     Y_GSREDIR = 266,
+     Y_ALLPIPE = 267,
+     D_D = 268,
+     D_PEEK = 269,
+     Y_NEWLINE = 270,
+     Y_CONSTANT = 271,
+     Y_IDENT = 272,
+     Y_WHILE = 273,
+     Y_IF = 274,
+     Y_ELSE = 275,
+     Y_FOR = 276,
+     Y_BREAK = 277,
+     Y_NEXT = 278,
+     Y_SWITCH = 279,
+     Y_CASE = 280,
+     Y_DEFAULT = 281,
+     Y_RETURN = 282,
+     Y_GOTO = 283,
+     Y_PROCEDURE = 284,
+     Y_BEGIN = 285,
+     Y_END = 286,
+     Y_BOOL = 287,
+     Y_INT = 288,
+     Y_REAL = 289,
+     Y_STRING = 290,
+     Y_FILE = 291,
+     Y_STRUCT = 292,
+     Y_GCUR = 293,
+     Y_IMCUR = 294,
+     Y_UKEY = 295,
+     Y_PSET = 296,
+     Y_IFERR = 297,
+     Y_IFNOERR = 298,
+     Y_THEN = 299,
+     YOP_AOCAT = 300,
+     YOP_AODIV = 301,
+     YOP_AOMUL = 302,
+     YOP_AOSUB = 303,
+     YOP_AOADD = 304,
+     YOP_OR = 305,
+     YOP_AND = 306,
+     YOP_NE = 307,
+     YOP_EQ = 308,
+     YOP_GE = 309,
+     YOP_LE = 310,
+     YOP_CONCAT = 311,
+     UMINUS = 312,
+     YOP_NOT = 313,
+     YOP_POW = 314
+   };
+#endif
+/* Tokens.  */
+#define Y_SCAN 258
+#define Y_SCANF 259
+#define Y_FSCAN 260
+#define Y_FSCANF 261
+#define Y_OSESC 262
+#define Y_APPEND 263
+#define Y_ALLAPPEND 264
+#define Y_ALLREDIR 265
+#define Y_GSREDIR 266
+#define Y_ALLPIPE 267
+#define D_D 268
+#define D_PEEK 269
+#define Y_NEWLINE 270
+#define Y_CONSTANT 271
+#define Y_IDENT 272
+#define Y_WHILE 273
+#define Y_IF 274
+#define Y_ELSE 275
+#define Y_FOR 276
+#define Y_BREAK 277
+#define Y_NEXT 278
+#define Y_SWITCH 279
+#define Y_CASE 280
+#define Y_DEFAULT 281
+#define Y_RETURN 282
+#define Y_GOTO 283
+#define Y_PROCEDURE 284
+#define Y_BEGIN 285
+#define Y_END 286
+#define Y_BOOL 287
+#define Y_INT 288
+#define Y_REAL 289
+#define Y_STRING 290
+#define Y_FILE 291
+#define Y_STRUCT 292
+#define Y_GCUR 293
+#define Y_IMCUR 294
+#define Y_UKEY 295
+#define Y_PSET 296
+#define Y_IFERR 297
+#define Y_IFNOERR 298
+#define Y_THEN 299
+#define YOP_AOCAT 300
+#define YOP_AODIV 301
+#define YOP_AOMUL 302
+#define YOP_AOSUB 303
+#define YOP_AOADD 304
+#define YOP_OR 305
+#define YOP_AND 306
+#define YOP_NE 307
+#define YOP_EQ 308
+#define YOP_GE 309
+#define YOP_LE 310
+#define YOP_CONCAT 311
+#define UMINUS 312
+#define YOP_NOT 313
+#define YOP_POW 314
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 1 "grammar.y"
+
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "clmodes.h"
+#include "task.h"
+#include "construct.h"
+#include "errs.h"
+
+
+/* CL parser, written as a yacc grammar:
+ *   build up an (rpn) instruction sequence begining at the base of the
+ *   operand stack as the grammar is recognized.
+ *
+ * The parser may be called during parameter initialization (initiated by
+ * the CALL meta-code instruction), and to parse the executable portion
+ * (from the EXEC instruction).
+ *
+ * CONSTANT's are put on the dictionary by addconst() rather than the operand
+ *   stack to avoid conflict with the code being created.  They are accessed
+ *   by using the yylval of IDENT and CONSTANT as dictionary indices that
+ *   point to struct operands.  This is facilitated with the stkop() macro.
+ *   Make sure that topd and topcs are restored on return to discard these
+ *   temporaries.
+ * When building offsets for branches, such as BIFF and GOTO, allow
+ *   for the advancement of the pc by the size of the instruction (in ints).
+ *   See opcodes.c for the code executed by the branch instructions.
+ */
+
+extern	int cldebug;
+#define	lint			/* turns off sccsid in Yacc parser	*/
+
+/* shorthand way to get at operands in dictionary. x will be values returned
+ * from addconst() by way of $n's from CONSTANT and IDENT tokens; see gram.c
+ * and its uses in grammar.l. also see pushop() for a description of the stack.
+ */
+#define	stkop(x)	(reference (operand, (x)))
+
+int	dobkg 		= 0;	/* set when want to do code in bkground	*/
+int	npipes 		= 0;	/* number of pipes in a command		*/
+XINT	pipe_pc		= 0;	/* pc of last ADDPIPE instruction	*/
+int	posit 		= 0;	/* positional argument count		*/
+int	inarglist 	= 0;	/* set when in argument list		*/
+int	parenlevel 	= 0;	/* level of paren nesting in command	*/
+int 	in_iferr 	= 0;	/* in an iferr block			*/
+int	cl_level	= 0;	/* CL calling level			*/
+
+int	index_cnt;		/* Index counter in array ref's		*/
+char	curr_param[SZ_FNAME];	/* Parameter name of ref's		*/
+char	curr_task[SZ_FNAME];	/* ltaskname of command 		*/
+XINT	stmt_pc;		/* PC at beginning of current statement */
+int	varlist;		/* Declaration is list directed.	*/
+int	vartype;		/* Type of declaration.			*/
+int	do_params;		/* Are param definitions legal here?	*/
+int	errcnt;			/* Syntax error count.			*/
+int	inited;			/* Was variable already initialized.	*/
+struct	param *pp;		/* Pointer to param being compiled.	*/
+int	n_aval;			/* Number of array init values.		*/
+int	lastref;		/* Was last ref an array?		*/
+int	for_expr;		/* Was there an expression in FOR?	*/
+char	*ifseen;		/* Have we just processed an IF?	*/
+char	*errmsg;		/* Syntax error message.		*/
+
+/* context-sensitive switches. technique is ok, but beware of nesting!
+ */
+static	int absmode 	= 0;	/* set by first absolute mode arg in cmd*/
+static	int newstdout 	= 0;	/* set if stdout redirected in arg	*/
+static	int bracelevel 	= 0;	/* set while in s_list to inhibit &	*/
+static	int tbrace 	= 0;	/* fake braces for declarations		*/
+static	int dobrace 	= 0;	/* handling braces.			*/
+static	int sawnl 	= 0;	/* set when EOST was \n, else 0		*/
+static	int printstmt 	= 0;	/* set when parsing FPRINT statement	*/
+static	int scanstmt 	= 0;	/* set when parsing SCAN statement	*/
+static	int iferr_tok 	= 0;	/* iferr/ifnoerr token type seen	*/
+
+/* printf-format error messages.
+ */
+char *arrdeferr   = "Error in array initialization for `%s'.";
+char *badparm     = "Parameter definition of `%s' is illegal here.";
+char *inval_arr   = "Invalid array type for `%s'.";
+char *inv_index   = "Invalid index definition for `%s'.";
+char *twoinits    = "Two initializations for parameter `%s'.";
+
+char *exlimits    = "Explicit range required for loop in external param.";
+char *illegalvar  = "Illegal variable declarations.";
+char *locallist   = "Local list variables are not permitted.";
+char *nestediferr = "Nested iferr not allowed in test or handler block.";
+char *posfirst    = "All positional arguments must be first";
+
+
+extern	char	cmdblk[SZ_CMDBLK+1];	/* Command buffer in history.c */
+extern	char	*ip_cmdblk;		/* Pointer to current char in command.*/
+extern	char	*err_cmdblk;		/* ip_cmdblk when error detected. */
+
+char	*index();
+struct	param *initparam();
+struct	label *getlabel(), *setlabel();
+
+/* arbitrary large number for bracelevel in a procedure script 
+ */
+#define MAX_ERR    10
+#define EYYERROR  { err_cmdblk = ip_cmdblk; YYERROR; }
+
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations.  */
+
+
+/* Line 216 of yacc.c.  */
+#line 339 "y.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  15
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   984
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  80
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  134
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  272
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  444
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   314
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,    64,     2,     2,
+      78,    79,    62,    60,    77,    61,    68,    63,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,    75,    71,
+      55,    45,    56,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,    73,     2,    74,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,    70,    76,    72,    69,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     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,
+      46,    47,    48,    49,    50,    51,    52,    53,    54,    57,
+      58,    59,    65,    66,    67
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint16 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     8,    13,    15,    17,    20,
+      21,    22,    27,    29,    32,    34,    38,    39,    45,    46,
+      52,    53,    57,    58,    60,    62,    66,    67,    69,    71,
+      74,    76,    78,    81,    82,    87,    89,    91,    93,    95,
+      97,    99,   101,   103,   105,   107,   109,   113,   115,   121,
+     123,   124,   129,   131,   132,   138,   140,   143,   144,   146,
+     150,   152,   156,   158,   162,   164,   169,   171,   173,   176,
+     178,   180,   184,   186,   188,   190,   194,   198,   201,   203,
+     205,   207,   209,   211,   213,   215,   217,   221,   226,   231,
+     236,   241,   246,   251,   256,   261,   266,   271,   276,   281,
+     286,   291,   296,   299,   302,   303,   309,   310,   318,   319,
+     325,   326,   336,   337,   343,   345,   347,   349,   351,   352,
+     354,   358,   359,   361,   365,   367,   370,   373,   376,   379,
+     382,   385,   387,   389,   391,   393,   395,   397,   399,   401,
+     403,   406,   409,   412,   415,   417,   419,   421,   424,   425,
+     426,   433,   434,   438,   442,   446,   447,   452,   454,   456,
+     458,   460,   462,   464,   465,   469,   470,   471,   476,   479,
+     482,   483,   484,   491,   492,   496,   498,   500,   504,   505,
+     507,   509,   513,   517,   520,   523,   526,   529,   532,   535,
+     538,   541,   543,   545,   548,   551,   554,   556,   558,   560,
+     561,   562,   570,   571,   577,   579,   581,   582,   584,   586,
+     587,   595,   596,   602,   603,   604,   613,   614,   615,   616,
+     633,   635,   636,   638,   639,   640,   651,   652,   653,   661,
+     662,   668,   670,   672,   674,   677,   680,   681,   687,   690,
+     692,   695,   696,   699,   701,   704,   706,   710,   712,   713,
+     715,   717,   718,   724,   726,   727,   732,   734,   736,   738,
+     740,   742,   744,   746,   748,   750,   752,   753,   755,   756,
+     758,   760,   762
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int16 yyrhs[] =
+{
+      81,     0,    -1,    -1,    68,   213,    -1,    -1,    81,    82,
+      83,   194,    -1,    86,    -1,    87,    -1,     1,   213,    -1,
+      -1,    -1,    85,   207,    84,    83,    -1,    13,    -1,    14,
+      16,    -1,    69,    -1,    89,    94,   117,    -1,    -1,   117,
+      88,   135,   198,   189,    -1,    -1,    29,    90,   205,    91,
+     207,    -1,    -1,   211,    92,   212,    -1,    -1,    93,    -1,
+     205,    -1,    93,   208,   205,    -1,    -1,    95,    -1,    96,
+      -1,    95,    96,    -1,   207,    -1,    97,    -1,     1,   213,
+      -1,    -1,    99,    98,   100,   207,    -1,    32,    -1,    35,
+      -1,    34,    -1,    36,    -1,    38,    -1,    39,    -1,    40,
+      -1,    41,    -1,    33,    -1,    37,    -1,   101,    -1,   101,
+     208,   100,    -1,   102,    -1,   102,    70,   114,    71,    72,
+      -1,   104,    -1,    -1,   104,    45,   103,   109,    -1,   106,
+      -1,    -1,   106,   105,    73,   107,    74,    -1,   205,    -1,
+      62,   205,    -1,    -1,   108,    -1,   107,   208,   108,    -1,
+     111,    -1,   111,    75,   111,    -1,   110,    -1,   109,   208,
+     110,    -1,   111,    -1,    16,   211,   111,   212,    -1,    16,
+      -1,   112,    -1,   113,    16,    -1,    60,    -1,    61,    -1,
+     109,   208,   115,    -1,   109,    -1,   115,    -1,   116,    -1,
+     115,   208,   116,    -1,    17,    45,   111,    -1,    30,   213,
+      -1,   119,    -1,   199,    -1,   120,    -1,    16,    -1,    38,
+      -1,    39,    -1,    40,    -1,    41,    -1,   211,   118,   212,
+      -1,   118,    60,   198,   118,    -1,   118,    61,   198,   118,
+      -1,   118,    62,   198,   118,    -1,   118,    63,   198,   118,
+      -1,   118,    67,   198,   118,    -1,   118,    64,   198,   118,
+      -1,   118,    59,   198,   118,    -1,   118,    55,   198,   118,
+      -1,   118,    56,   198,   118,    -1,   118,    58,   198,   118,
+      -1,   118,    57,   198,   118,    -1,   118,    54,   198,   118,
+      -1,   118,    53,   198,   118,    -1,   118,    51,   198,   118,
+      -1,   118,    52,   198,   118,    -1,    66,   118,    -1,    61,
+     118,    -1,    -1,     3,   211,   121,   128,   212,    -1,    -1,
+       4,   211,   122,   127,   208,   128,   212,    -1,    -1,     5,
+     211,   123,   128,   212,    -1,    -1,     6,   211,    17,   208,
+     124,   127,   208,   128,   212,    -1,    -1,   126,   211,   125,
+     129,   212,    -1,   204,    -1,    33,    -1,    34,    -1,   118,
+      -1,    -1,    17,    -1,    17,   208,   128,    -1,    -1,   118,
+      -1,   129,   208,   118,    -1,   131,    -1,   136,   207,    -1,
+     140,   207,    -1,   153,   207,    -1,   154,   207,    -1,   155,
+     207,    -1,   156,   207,    -1,   165,    -1,   168,    -1,   157,
+      -1,   161,    -1,   170,    -1,   173,    -1,   179,    -1,   181,
+      -1,   184,    -1,   186,   207,    -1,   187,   207,    -1,   192,
+     207,    -1,   188,   207,    -1,   190,    -1,   193,    -1,   132,
+      -1,   132,   213,    -1,    -1,    -1,    70,   133,   135,   198,
+     134,    72,    -1,    -1,   135,   198,   194,    -1,   199,   138,
+     119,    -1,   199,   138,   199,    -1,    -1,   199,   137,   139,
+     118,    -1,    45,    -1,    50,    -1,    49,    -1,    48,    -1,
+      47,    -1,    46,    -1,    -1,   145,   141,   142,    -1,    -1,
+      -1,   142,   144,   143,   145,    -1,    76,   198,    -1,    12,
+     198,    -1,    -1,    -1,   206,   146,   209,   147,   148,   210,
+      -1,    -1,   208,   149,   150,    -1,   150,    -1,   151,    -1,
+     150,   208,   151,    -1,    -1,   119,    -1,   199,    -1,   199,
+      45,   119,    -1,   199,    45,   199,    -1,   205,    60,    -1,
+     205,    61,    -1,    55,   152,    -1,    56,   152,    -1,    10,
+     152,    -1,     8,   152,    -1,     9,   152,    -1,    11,   152,
+      -1,   119,    -1,   205,    -1,   138,   119,    -1,   138,   199,
+      -1,   199,   138,    -1,     7,    -1,   138,    -1,   158,    -1,
+      -1,    -1,   163,   159,   132,   160,   164,   198,   194,    -1,
+      -1,   158,    20,   162,   198,   194,    -1,    42,    -1,    43,
+      -1,    -1,    44,    -1,   166,    -1,    -1,    19,   211,   118,
+     212,   167,   198,   194,    -1,    -1,   166,    20,   169,   198,
+     194,    -1,    -1,    -1,    18,   211,   171,   118,   212,   172,
+     198,   194,    -1,    -1,    -1,    -1,    21,   211,   198,   177,
+      71,   198,   174,   178,    71,   198,   175,   177,   212,   198,
+     176,   130,    -1,   136,    -1,    -1,   118,    -1,    -1,    -1,
+      24,   198,   211,   198,   118,   198,   212,   198,   180,   194,
+      -1,    -1,    -1,    25,   182,   196,    75,   198,   183,   194,
+      -1,    -1,    26,    75,   198,   185,   194,    -1,    23,    -1,
+      22,    -1,    27,    -1,    27,   118,    -1,    31,   213,    -1,
+      -1,    17,    75,   198,   191,   194,    -1,    28,    17,    -1,
+      71,    -1,    71,   213,    -1,    -1,   195,   130,    -1,    97,
+      -1,     1,   213,    -1,   197,    -1,   197,   208,   196,    -1,
+     111,    -1,    -1,   213,    -1,   205,    -1,    -1,   205,   200,
+      73,   201,    74,    -1,   203,    -1,    -1,   203,   202,   208,
+     201,    -1,   120,    -1,   199,    -1,    62,    -1,    16,    -1,
+      17,    -1,    17,    -1,    17,    -1,   213,    -1,    71,    -1,
+      77,    -1,    -1,   211,    -1,    -1,   212,    -1,    78,    -1,
+      79,    -1,    15,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   144,   144,   169,   181,   181,   201,   212,   224,   265,
+     266,   266,   276,   279,   288,   293,   303,   303,   329,   329,
+     352,   355,   361,   364,   367,   372,   379,   380,   383,   384,
+     387,   388,   389,   426,   426,   463,   464,   465,   466,   467,
+     468,   469,   470,   471,   472,   475,   476,   479,   497,   515,
+     519,   519,   527,   532,   532,   551,   555,   566,   570,   571,
+     575,   598,   615,   616,   619,   627,   648,   649,   655,   669,
+     670,   672,   682,   690,   693,   694,   697,   704,   712,   713,
+     726,   727,   731,   739,   743,   747,   753,   755,   759,   763,
+     767,   771,   775,   784,   788,   792,   796,   800,   804,   808,
+     812,   816,   820,   824,   829,   829,   842,   842,   859,   859,
+     873,   873,   894,   894,   911,   912,   920,   926,   933,   939,
+     945,   953,   956,   960,   969,   970,   971,   972,   973,   974,
+     975,   976,   977,   978,   979,   980,   981,   982,   983,   984,
+     985,   986,   987,   988,   989,   990,   996,   997,  1000,  1002,
+    1000,  1007,  1008,  1014,  1019,  1030,  1030,  1042,  1047,  1048,
+    1049,  1050,  1051,  1054,  1054,  1065,  1066,  1066,  1111,  1114,
+    1119,  1143,  1119,  1154,  1154,  1165,  1168,  1169,  1173,  1183,
+    1191,  1237,  1242,  1254,  1259,  1264,  1268,  1273,  1278,  1283,
+    1288,  1294,  1299,  1310,  1315,  1322,  1329,  1335,  1345,  1355,
+    1363,  1355,  1380,  1380,  1400,  1401,  1404,  1405,  1412,  1423,
+    1423,  1456,  1456,  1479,  1486,  1479,  1524,  1528,  1544,  1524,
+    1573,  1574,  1577,  1580,  1606,  1605,  1623,  1631,  1623,  1650,
+    1650,  1668,  1683,  1707,  1711,  1723,  1735,  1735,  1769,  1791,
+    1792,  1799,  1799,  1845,  1846,  1907,  1908,  1911,  1927,  1928,
+    1931,  1968,  1968,  1983,  1986,  1986,  1992,  1996,  2003,  2024,
+    2058,  2063,  2068,  2073,  2074,  2082,  2085,  2086,  2089,  2090,
+    2096,  2099,  2102
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "Y_SCAN", "Y_SCANF", "Y_FSCAN",
+  "Y_FSCANF", "Y_OSESC", "Y_APPEND", "Y_ALLAPPEND", "Y_ALLREDIR",
+  "Y_GSREDIR", "Y_ALLPIPE", "D_D", "D_PEEK", "Y_NEWLINE", "Y_CONSTANT",
+  "Y_IDENT", "Y_WHILE", "Y_IF", "Y_ELSE", "Y_FOR", "Y_BREAK", "Y_NEXT",
+  "Y_SWITCH", "Y_CASE", "Y_DEFAULT", "Y_RETURN", "Y_GOTO", "Y_PROCEDURE",
+  "Y_BEGIN", "Y_END", "Y_BOOL", "Y_INT", "Y_REAL", "Y_STRING", "Y_FILE",
+  "Y_STRUCT", "Y_GCUR", "Y_IMCUR", "Y_UKEY", "Y_PSET", "Y_IFERR",
+  "Y_IFNOERR", "Y_THEN", "'='", "YOP_AOCAT", "YOP_AODIV", "YOP_AOMUL",
+  "YOP_AOSUB", "YOP_AOADD", "YOP_OR", "YOP_AND", "YOP_NE", "YOP_EQ", "'<'",
+  "'>'", "YOP_GE", "YOP_LE", "YOP_CONCAT", "'+'", "'-'", "'*'", "'/'",
+  "'%'", "UMINUS", "YOP_NOT", "YOP_POW", "'.'", "'~'", "'{'", "';'", "'}'",
+  "'['", "']'", "':'", "'|'", "','", "'('", "')'", "$accept", "block",
+  "@1", "debug", "@2", "D_XXX", "script_params", "script_body", "@3",
+  "proc_stmt", "@4", "bparam_list", "param_list", "xparam_list",
+  "var_decls", "var_decl_block", "var_decl_line", "var_decl_stmt", "@5",
+  "typedefs", "var_decl_list", "var_decl_plus", "var_decl", "@6",
+  "var_def", "@7", "var_name", "init_index_list", "init_index_range",
+  "init_list", "init_elem", "const", "number", "sign", "options_list",
+  "options", "option", "begin_stmt", "expr", "expr0", "expr1", "@8", "@9",
+  "@10", "@11", "@12", "intrinsx", "scanfmt", "scanarg", "intrarg", "stmt",
+  "c_stmt", "c_blk", "@13", "@14", "s_list", "assign", "@15", "equals",
+  "assign_oper", "cmdlist", "@16", "cmdpipe", "@17", "pipe", "command",
+  "@18", "@19", "args", "@20", "arglist", "arg", "file", "immed",
+  "inspect", "osesc", "popstk", "iferr", "iferr_stat", "@21", "@22",
+  "iferr_else", "@23", "iferr_tok", "op_then", "if", "if_stat", "@24",
+  "ifelse", "@25", "while", "@26", "@27", "for", "@28", "@29", "@30",
+  "xassign", "xexpr", "switch", "@31", "case", "@32", "@33", "default",
+  "@34", "next", "break", "return", "end_stmt", "label_stmt", "@35",
+  "goto", "nullstmt", "xstmt", "@36", "const_expr_list", "const_expr",
+  "opnl", "ref", "@37", "index_list", "@38", "index", "intrins", "param",
+  "tasknam", "EOST", "DELIM", "BARG", "EARG", "LP", "RP", "NL", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   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,    61,   300,   301,   302,   303,
+     304,   305,   306,   307,   308,    60,    62,   309,   310,   311,
+      43,    45,    42,    47,    37,   312,   313,   314,    46,   126,
+     123,    59,   125,    91,    93,    58,   124,    44,    40,    41
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint8 yyr1[] =
+{
+       0,    80,    81,    81,    82,    81,    81,    81,    81,    83,
+      84,    83,    85,    85,    85,    86,    88,    87,    90,    89,
+      91,    91,    92,    92,    93,    93,    94,    94,    95,    95,
+      96,    96,    96,    98,    97,    99,    99,    99,    99,    99,
+      99,    99,    99,    99,    99,   100,   100,   101,   101,   102,
+     103,   102,   104,   105,   104,   106,   106,   107,   107,   107,
+     108,   108,   109,   109,   110,   110,   111,   111,   112,   113,
+     113,   114,   114,   114,   115,   115,   116,   117,   118,   118,
+     119,   119,   119,   119,   119,   119,   120,   120,   120,   120,
+     120,   120,   120,   120,   120,   120,   120,   120,   120,   120,
+     120,   120,   120,   120,   121,   120,   122,   120,   123,   120,
+     124,   120,   125,   120,   126,   126,   126,   127,   128,   128,
+     128,   129,   129,   129,   130,   130,   130,   130,   130,   130,
+     130,   130,   130,   130,   130,   130,   130,   130,   130,   130,
+     130,   130,   130,   130,   130,   130,   131,   131,   133,   134,
+     132,   135,   135,   136,   136,   137,   136,   138,   139,   139,
+     139,   139,   139,   141,   140,   142,   143,   142,   144,   144,
+     146,   147,   145,   149,   148,   148,   150,   150,   151,   151,
+     151,   151,   151,   151,   151,   151,   151,   151,   151,   151,
+     151,   152,   152,   153,   153,   154,   155,   156,   157,   159,
+     160,   158,   162,   161,   163,   163,   164,   164,   165,   167,
+     166,   169,   168,   171,   172,   170,   174,   175,   176,   173,
+     177,   177,   178,   178,   180,   179,   182,   183,   181,   185,
+     184,   186,   187,   188,   188,   189,   191,   190,   192,   193,
+     193,   195,   194,   194,   194,   196,   196,   197,   198,   198,
+     199,   200,   199,   201,   202,   201,   203,   203,   203,   203,
+     204,   205,   206,   207,   207,   208,   209,   209,   210,   210,
+     211,   212,   213
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     0,     4,     1,     1,     2,     0,
+       0,     4,     1,     2,     1,     3,     0,     5,     0,     5,
+       0,     3,     0,     1,     1,     3,     0,     1,     1,     2,
+       1,     1,     2,     0,     4,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     3,     1,     5,     1,
+       0,     4,     1,     0,     5,     1,     2,     0,     1,     3,
+       1,     3,     1,     3,     1,     4,     1,     1,     2,     1,
+       1,     3,     1,     1,     1,     3,     3,     2,     1,     1,
+       1,     1,     1,     1,     1,     1,     3,     4,     4,     4,
+       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
+       4,     4,     2,     2,     0,     5,     0,     7,     0,     5,
+       0,     9,     0,     5,     1,     1,     1,     1,     0,     1,
+       3,     0,     1,     3,     1,     2,     2,     2,     2,     2,
+       2,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       2,     2,     2,     2,     1,     1,     1,     2,     0,     0,
+       6,     0,     3,     3,     3,     0,     4,     1,     1,     1,
+       1,     1,     1,     0,     3,     0,     0,     4,     2,     2,
+       0,     0,     6,     0,     3,     1,     1,     3,     0,     1,
+       1,     3,     3,     2,     2,     2,     2,     2,     2,     2,
+       2,     1,     1,     2,     2,     2,     1,     1,     1,     0,
+       0,     7,     0,     5,     1,     1,     0,     1,     1,     0,
+       7,     0,     5,     0,     0,     8,     0,     0,     0,    16,
+       1,     0,     1,     0,     0,    10,     0,     0,     7,     0,
+       5,     1,     1,     1,     2,     2,     0,     5,     2,     1,
+       2,     0,     2,     1,     2,     1,     3,     1,     0,     1,
+       1,     0,     5,     1,     0,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     0,     1,     0,     1,
+       1,     1,     1
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint16 yydefact[] =
+{
+       0,     0,    18,     0,     0,     4,     6,     7,     0,    16,
+     272,     8,     0,    77,     3,     1,     9,     0,    35,    43,
+      37,    36,    38,    44,    39,    40,    41,    42,   264,     0,
+       0,    28,    31,    33,    30,   263,   151,   261,    20,    12,
+       0,    14,     0,     0,    32,    15,    29,     0,   248,   270,
+       0,    22,    13,     0,   243,     5,     0,    10,     0,     0,
+      45,    47,    49,    52,    55,     0,   249,    19,     0,    23,
+      24,   244,   196,   262,     0,     0,     0,   232,   231,   248,
+     226,     0,   233,     0,   204,   205,   157,   148,   239,   242,
+     124,   146,     0,   197,     0,   163,     0,     0,     0,     0,
+     133,   198,   134,   199,   131,   208,   132,   135,   136,   137,
+     138,   139,     0,     0,     0,   144,     0,   145,   155,   250,
+     170,     9,    56,    34,   265,     0,     0,    50,     0,     0,
+      17,   152,   271,    21,     0,   248,   213,     0,   248,     0,
+       0,   248,     0,     0,     0,     0,    81,   261,   115,   116,
+      82,    83,    84,    85,     0,     0,   234,    78,    80,     0,
+      79,   114,     0,   238,   151,   240,   147,   125,     0,    78,
+      79,   126,   165,   127,   128,   129,   130,   202,     0,   211,
+     140,   141,   143,   142,     0,   195,     0,   266,    11,    46,
+      66,     0,    69,    70,    72,    62,    64,    67,     0,     0,
+      73,    74,     0,    57,   235,    25,   236,     0,     0,   221,
+     248,    66,   247,     0,   245,   229,   104,   106,   108,     0,
+     103,   102,   248,   248,   248,   248,   248,   248,   248,   248,
+     248,   248,   248,   248,   248,   248,   248,   112,     0,   248,
+     164,   248,   200,   248,   162,   161,   160,   159,   158,     0,
+      78,    79,     0,   171,   267,     0,     0,     0,    68,     0,
+       0,    51,     0,    58,    60,     0,     0,   209,   220,     0,
+     155,     0,   248,     0,     0,   118,     0,   118,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   121,    86,     0,   248,   248,   166,
+       0,   206,     0,   156,    81,   258,    80,    79,     0,   253,
+     178,     0,    76,    63,    71,    48,    75,     0,    54,     0,
+       0,   237,   214,   248,   248,     0,   248,   227,   246,   230,
+     119,     0,   117,     0,     0,   110,   100,   101,    99,    98,
+      94,    95,    97,    96,    93,    87,    88,    89,    90,    92,
+      91,   122,     0,     0,   169,   168,     0,   203,   207,   248,
+     212,   252,     0,     0,     0,     0,     0,     0,     0,    78,
+     268,   175,   176,    79,   250,   173,    65,    59,    61,   248,
+       0,   216,     0,     0,   118,   105,   118,   109,     0,     0,
+     113,   150,   262,   167,     0,     0,    78,   188,   250,   189,
+     187,   190,   185,   186,   172,   269,   178,     0,   183,   184,
+     178,     0,   210,   223,   248,   228,   120,     0,     0,   123,
+     201,   255,   177,    78,    79,   174,   215,   222,     0,   224,
+     107,   118,   248,     0,     0,   217,   225,   111,   221,     0,
+     248,   218,     0,   219
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int16 yydefgoto[] =
+{
+      -1,     5,    16,    42,   121,    43,     6,     7,    36,     8,
+      12,    50,    68,    69,    29,    30,    31,    54,    47,    33,
+      59,    60,    61,   202,    62,   128,    63,   262,   263,   194,
+     195,   196,   197,   198,   199,   200,   201,     9,   168,   157,
+     158,   275,   276,   277,   388,   294,   159,   333,   331,   352,
+      89,    90,    91,   164,   353,    48,    92,   184,    93,   249,
+      94,   172,   240,   356,   299,    95,   187,   310,   370,   410,
+     371,   372,   397,    96,    97,    98,    99,   100,   101,   178,
+     301,   102,   241,   103,   359,   104,   105,   323,   106,   243,
+     107,   207,   379,   108,   413,   438,   442,   269,   428,   109,
+     433,   110,   140,   383,   111,   274,   112,   113,   114,   130,
+     115,   265,   116,   117,   131,    56,   213,   214,    65,   160,
+     186,   308,   362,   309,   161,   119,   120,    34,   260,   253,
+     404,   162,   133,    66
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -256
+static const yytype_int16 yypact[] =
+{
+     576,    -8,  -256,    -8,    -8,    24,  -256,  -256,   785,  -256,
+    -256,  -256,    11,  -256,  -256,  -256,    13,    -8,  -256,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,   -17,
+     801,  -256,  -256,  -256,  -256,  -256,  -256,  -256,   -30,  -256,
+      37,  -256,   742,    21,  -256,  -256,  -256,    42,    -8,  -256,
+      21,    11,  -256,    -8,  -256,  -256,   836,  -256,    11,    21,
+       6,    36,    52,    18,  -256,   687,  -256,  -256,    31,     6,
+    -256,  -256,  -256,   236,   -30,   -30,   -30,  -256,  -256,    -8,
+    -256,    39,   409,   104,  -256,  -256,  -256,  -256,    -8,  -256,
+    -256,    -8,    21,   409,    21,  -256,    21,    21,    21,    21,
+    -256,   106,  -256,  -256,  -256,   112,  -256,  -256,  -256,  -256,
+    -256,  -256,    21,    21,    21,  -256,    21,  -256,    88,    65,
+    -256,    13,  -256,  -256,  -256,    42,     0,  -256,    78,    -8,
+    -256,  -256,  -256,  -256,    11,    -8,  -256,   409,    -8,   -30,
+       4,    -8,   -30,   -30,   -30,   -30,  -256,    66,  -256,  -256,
+    -256,  -256,  -256,  -256,   409,   409,   886,  -256,  -256,   -30,
+    -256,  -256,   409,  -256,  -256,  -256,  -256,  -256,   886,    27,
+      28,  -256,  -256,  -256,  -256,  -256,  -256,  -256,    82,  -256,
+    -256,  -256,  -256,  -256,   220,   409,    80,   -30,  -256,  -256,
+     -30,   109,  -256,  -256,     6,  -256,  -256,  -256,   141,   107,
+       6,  -256,    79,     4,  -256,  -256,  -256,   409,   857,    11,
+      -8,  -256,  -256,   110,     6,  -256,  -256,  -256,  -256,   170,
+     121,   121,    -8,    -8,    -8,    -8,    -8,    -8,    -8,    -8,
+      -8,    -8,    -8,    -8,    -8,    -8,    -8,  -256,   857,    -8,
+       2,    -8,  -256,    -8,  -256,  -256,  -256,  -256,  -256,   409,
+      -3,    10,   513,  -256,  -256,     4,     4,     0,  -256,   117,
+     173,     6,   -44,  -256,   120,   742,   857,  -256,  -256,   128,
+      88,   409,    -8,     4,   742,   183,   409,   183,     6,   409,
+     409,   409,   409,   409,   409,   409,   409,   409,   409,   409,
+     409,   409,   409,   409,   409,  -256,   631,    -8,    -8,  -256,
+     742,   157,   742,   886,   -40,  -256,    60,    71,   130,   138,
+      46,    31,  -256,  -256,     6,  -256,  -256,    79,  -256,     4,
+       4,  -256,  -256,    -8,    -8,   409,   831,  -256,  -256,  -256,
+       6,    31,   886,     6,    31,  -256,   902,   917,   481,   481,
+     421,   421,   421,   421,   160,    53,    53,   121,   121,   121,
+    -256,   886,   -39,   135,  -256,  -256,   208,  -256,  -256,    -8,
+    -256,  -256,     6,   409,   409,   409,   409,   409,   409,    32,
+      31,     6,  -256,    -4,   -42,  -256,  -256,  -256,  -256,    -8,
+     742,  -256,    31,   742,   183,  -256,   183,  -256,   409,   409,
+    -256,  -256,  -256,  -256,   742,   513,   115,  -256,    17,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,   494,   409,  -256,  -256,
+     494,   742,  -256,   409,    -8,  -256,  -256,    31,     6,   886,
+    -256,  -256,  -256,   169,   201,     6,  -256,   886,   147,  -256,
+    -256,   183,    -8,   742,    31,  -256,  -256,  -256,    11,    31,
+      -8,  -256,   836,  -256
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int16 yypgoto[] =
+{
+    -256,  -256,  -256,   108,  -256,  -256,  -256,  -256,  -256,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,   200,    15,  -256,  -256,
+     111,  -256,  -256,  -256,  -256,  -256,  -256,  -256,   -84,    40,
+    -248,  -137,  -256,  -256,  -256,   -19,   -13,   212,    43,    54,
+    -246,  -256,  -256,  -256,  -256,  -256,  -256,  -145,  -255,  -256,
+    -193,  -256,    74,  -256,  -256,    89,  -207,  -256,  -114,  -256,
+    -256,  -256,  -256,  -256,  -256,  -101,  -256,  -256,  -256,  -256,
+    -154,  -148,   -60,  -256,  -256,  -256,  -256,  -256,  -256,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,  -256,  -177,  -256,  -256,
+    -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,  -256,
+    -256,  -256,  -256,  -256,   -37,  -256,    -9,  -256,   -64,   -35,
+    -256,  -122,  -256,  -256,  -256,   -12,  -256,   472,   -59,  -256,
+    -256,    67,  -138,   380
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -262
+static const yytype_int16 yytable[] =
+{
+      38,   125,   268,   212,   185,    55,   306,    10,  -180,   313,
+     134,  -180,  -153,     3,   297,   139,   190,   191,   408,   409,
+     211,   118,   334,    32,    15,  -154,    39,    40,    37,  -192,
+     318,  -251,  -192,   124,  -259,    64,    10,  -259,   124,    70,
+     132,   407,  -193,  -194,  -179,    32,   122,  -179,    49,   142,
+     143,   144,   145,    52,   363,   364,   365,   366,   170,    37,
+     192,   193,   146,   147,   192,   193,   264,  -180,  -153,   313,
+     267,   206,  -180,  -180,   209,  -180,  -153,   215,   298,   148,
+     149,  -154,    41,   124,   150,   151,   152,   153,  -192,  -154,
+    -251,   -53,    28,  -192,  -192,   190,  -192,   127,  -193,  -194,
+     295,   367,   368,  -179,    58,    51,   126,   154,  -179,  -179,
+     132,  -179,   155,    64,   141,   233,   234,   235,   311,   312,
+     236,   163,   205,   124,    49,   156,   177,  -191,   322,   416,
+    -191,   417,   179,    86,  -256,   257,   212,  -256,  -251,   192,
+     193,   136,   137,   138,  -260,  -257,   271,   169,  -257,   306,
+     251,   203,    87,   252,   256,   273,   325,   258,   279,   280,
+     281,   282,   283,   284,   285,   286,   287,   288,   289,   290,
+     291,   292,   293,   376,   270,   296,   434,   300,   259,   302,
+     208,  -181,   264,   378,  -181,   272,  -191,   278,   236,   315,
+     191,  -191,  -191,   385,  -191,   320,   387,   220,   221,   324,
+     330,   358,   317,   319,   361,   238,   210,   391,   327,   216,
+     217,   218,   219,  -182,   390,  -254,  -182,   307,   432,   335,
+     231,   232,   233,   234,   235,   392,   237,   236,   321,   188,
+      46,   268,   405,   354,   355,   377,   189,   329,   314,   250,
+    -181,    45,   261,   418,   414,  -181,  -181,   316,  -181,   443,
+     266,   375,   242,   239,   254,   393,   425,   255,   422,   380,
+     381,   439,   382,   357,   328,   360,   244,   245,   246,   247,
+     248,   384,  -182,   421,   386,   373,     0,  -182,  -182,   430,
+    -182,  -261,  -261,  -261,  -261,  -261,  -261,     0,     0,     0,
+     251,     0,   303,   389,     0,   394,   437,     0,   374,     0,
+       0,   440,     0,   395,   399,   400,   401,   402,   403,  -261,
+       0,   135,   406,     0,   326,   411,     0,     0,     0,   332,
+       0,     0,   336,   337,   338,   339,   340,   341,   342,   343,
+     344,   345,   346,   347,   348,   349,   350,   351,     0,     0,
+       0,     0,     0,   412,     0,     0,   415,     0,     0,     0,
+     429,   398,   398,   398,   398,   398,   398,   420,     0,   431,
+     307,     0,     0,     0,   369,     0,   406,     0,   435,     0,
+       0,   373,   424,     0,   426,   373,   441,     0,     0,   250,
+       0,    11,     0,    13,    14,     0,     0,     0,    35,     0,
+       0,     0,     0,     0,   374,     0,   436,    44,   374,     0,
+       0,     0,     0,   270,     0,     0,     0,   118,     0,     0,
+      35,     0,   142,   143,   144,   145,     0,   396,   396,   396,
+     396,   396,   396,    35,     0,   146,   147,     0,     0,     0,
+      35,   332,   419,    71,     0,     0,     0,     0,     0,    35,
+       0,     0,   148,   149,     0,     0,     0,   150,   151,   152,
+     153,     0,     0,     0,     0,     0,   427,     0,     0,     0,
+     369,   423,     0,     0,   369,     0,     0,     0,   165,     0,
+     154,   166,    35,     0,    35,   155,    35,    35,    35,    35,
+     230,   231,   232,   233,   234,   235,     0,    49,   236,     0,
+       0,     0,    35,    35,    35,     0,    35,   142,   143,   144,
+     145,     0,   363,   364,   365,   366,     0,     0,     0,   204,
+     146,   147,     0,     0,     0,    57,   142,   143,   144,   145,
+       0,     0,    67,     0,     0,     0,     0,   148,   149,   304,
+     147,   123,   150,   151,   152,   153,   226,   227,   228,   229,
+     230,   231,   232,   233,   234,   235,   148,   149,   236,   367,
+     368,   150,   151,   152,   153,   154,     0,     0,     0,     0,
+     155,     0,     0,     0,   167,     0,   171,     0,   173,   174,
+     175,   176,    49,     0,   154,   305,    -2,     1,     0,   155,
+       0,     0,     0,    -2,   180,   181,   182,     0,   183,    -2,
+      -2,    49,     0,    -2,    -2,    -2,     0,    -2,    -2,    -2,
+      -2,    -2,    -2,    -2,    -2,     2,     3,     0,    -2,    -2,
+      -2,    -2,    -2,    -2,    -2,    -2,    -2,    -2,    -2,    -2,
+       0,    -2,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,    53,     0,     0,     0,     0,     0,  -241,     0,
+       0,     0,     0,     0,     4,    -2,    -2,    -2,  -241,  -241,
+    -241,     0,  -241,  -241,  -241,  -241,  -241,  -241,  -241,  -241,
+       0,     0,     0,    18,    19,    20,    21,    22,    23,    24,
+      25,    26,    27,  -241,  -241,     0,  -241,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,    53,     0,
+       0,     0,     0,     0,  -241,     0,     0,     0,     0,     0,
+       0,  -241,  -241,  -149,  -241,  -241,  -241,     0,  -241,  -241,
+    -241,  -241,  -241,  -241,  -241,  -241,     0,     0,   129,    18,
+      19,    20,    21,    22,    23,    24,    25,    26,    27,  -241,
+    -241,     0,  -241,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    53,     0,     0,     0,     0,     0,  -241,
+       0,     0,     0,     0,     0,     0,     0,  -241,  -241,  -241,
+    -241,  -241,     0,  -241,  -241,  -241,  -241,  -241,  -241,  -241,
+    -241,     0,     0,     0,    18,    19,    20,    21,    22,    23,
+      24,    25,    26,    27,  -241,  -241,    17,  -241,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+      10,     0,    17,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,  -241,  -241,     0,   -26,    10,    18,    19,    20,
+      21,    22,    23,    24,    25,    26,    27,     0,     0,     0,
+       0,   -27,     0,    18,    19,    20,    21,    22,    23,    24,
+      25,    26,    27,    72,     0,     0,    10,     0,     0,     0,
+       0,     0,     0,    73,    74,    75,    28,    76,    77,    78,
+      79,    80,    81,    82,    83,     0,     0,     0,     0,     0,
+       0,     0,    28,     0,     0,     0,     0,     0,    84,    85,
+       0,    86,   222,   223,   224,   225,   226,   227,   228,   229,
+     230,   231,   232,   233,   234,   235,     0,     0,   236,     0,
+       0,     0,     0,     0,     0,     0,    87,    88,   222,   223,
+     224,   225,   226,   227,   228,   229,   230,   231,   232,   233,
+     234,   235,     0,     0,   236,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   132,   222,   223,   224,
+     225,   226,   227,   228,   229,   230,   231,   232,   233,   234,
+     235,     0,     0,   236,   223,   224,   225,   226,   227,   228,
+     229,   230,   231,   232,   233,   234,   235,     0,     0,   236,
+     224,   225,   226,   227,   228,   229,   230,   231,   232,   233,
+     234,   235,     0,     0,   236
+};
+
+static const yytype_int16 yycheck[] =
+{
+      12,    60,   209,   140,   118,    42,   252,    15,    12,   257,
+      69,    15,    15,    30,    12,    79,    16,    17,    60,    61,
+      16,    56,   277,     8,     0,    15,    13,    14,    17,    12,
+      74,    73,    15,    77,    74,    47,    15,    77,    77,    51,
+      79,    45,    15,    15,    12,    30,    58,    15,    78,     3,
+       4,     5,     6,    16,     8,     9,    10,    11,    93,    17,
+      60,    61,    16,    17,    60,    61,   203,    71,    71,   317,
+     208,   135,    76,    77,   138,    79,    79,   141,    76,    33,
+      34,    71,    69,    77,    38,    39,    40,    41,    71,    79,
+      73,    73,    71,    76,    77,    16,    79,    45,    71,    71,
+     238,    55,    56,    71,    62,    38,    70,    61,    76,    77,
+      79,    79,    66,   125,    75,    62,    63,    64,   255,   256,
+      67,    17,   134,    77,    78,    82,    20,    12,   266,   384,
+      15,   386,    20,    45,    74,   194,   273,    77,    73,    60,
+      61,    74,    75,    76,    78,    74,   210,    93,    77,   395,
+     185,    73,    70,    73,    45,   214,   270,    16,   222,   223,
+     224,   225,   226,   227,   228,   229,   230,   231,   232,   233,
+     234,   235,   236,   311,   209,   239,   431,   241,    71,   243,
+     137,    12,   319,   320,    15,    75,    71,    17,    67,    72,
+      17,    76,    77,   331,    79,    75,   334,   154,   155,    71,
+      17,    44,   261,   262,    74,   162,   139,    72,   272,   142,
+     143,   144,   145,    12,   352,    77,    15,   252,    71,   278,
+      60,    61,    62,    63,    64,    17,   159,    67,   265,   121,
+      30,   438,   370,   297,   298,   319,   125,   274,   257,   185,
+      71,    29,   202,   388,   382,    76,    77,   260,    79,   442,
+     207,   310,   178,   164,   187,   356,   410,   190,   406,   323,
+     324,   438,   326,   300,   273,   302,    46,    47,    48,    49,
+      50,   330,    71,   395,   333,   310,    -1,    76,    77,   417,
+      79,    45,    46,    47,    48,    49,    50,    -1,    -1,    -1,
+     325,    -1,   249,   352,    -1,   359,   434,    -1,   310,    -1,
+      -1,   439,    -1,   362,   364,   365,   366,   367,   368,    73,
+      -1,    75,   371,    -1,   271,   379,    -1,    -1,    -1,   276,
+      -1,    -1,   279,   280,   281,   282,   283,   284,   285,   286,
+     287,   288,   289,   290,   291,   292,   293,   294,    -1,    -1,
+      -1,    -1,    -1,   380,    -1,    -1,   383,    -1,    -1,    -1,
+     414,   363,   364,   365,   366,   367,   368,   394,    -1,   418,
+     395,    -1,    -1,    -1,   310,    -1,   425,    -1,   432,    -1,
+      -1,   406,   407,    -1,   411,   410,   440,    -1,    -1,   325,
+      -1,     1,    -1,     3,     4,    -1,    -1,    -1,     8,    -1,
+      -1,    -1,    -1,    -1,   406,    -1,   433,    17,   410,    -1,
+      -1,    -1,    -1,   438,    -1,    -1,    -1,   442,    -1,    -1,
+      30,    -1,     3,     4,     5,     6,    -1,   363,   364,   365,
+     366,   367,   368,    43,    -1,    16,    17,    -1,    -1,    -1,
+      50,   388,   389,    53,    -1,    -1,    -1,    -1,    -1,    59,
+      -1,    -1,    33,    34,    -1,    -1,    -1,    38,    39,    40,
+      41,    -1,    -1,    -1,    -1,    -1,   413,    -1,    -1,    -1,
+     406,   407,    -1,    -1,   410,    -1,    -1,    -1,    88,    -1,
+      61,    91,    92,    -1,    94,    66,    96,    97,    98,    99,
+      59,    60,    61,    62,    63,    64,    -1,    78,    67,    -1,
+      -1,    -1,   112,   113,   114,    -1,   116,     3,     4,     5,
+       6,    -1,     8,     9,    10,    11,    -1,    -1,    -1,   129,
+      16,    17,    -1,    -1,    -1,    43,     3,     4,     5,     6,
+      -1,    -1,    50,    -1,    -1,    -1,    -1,    33,    34,    16,
+      17,    59,    38,    39,    40,    41,    55,    56,    57,    58,
+      59,    60,    61,    62,    63,    64,    33,    34,    67,    55,
+      56,    38,    39,    40,    41,    61,    -1,    -1,    -1,    -1,
+      66,    -1,    -1,    -1,    92,    -1,    94,    -1,    96,    97,
+      98,    99,    78,    -1,    61,    62,     0,     1,    -1,    66,
+      -1,    -1,    -1,     7,   112,   113,   114,    -1,   116,    13,
+      14,    78,    -1,    17,    18,    19,    -1,    21,    22,    23,
+      24,    25,    26,    27,    28,    29,    30,    -1,    32,    33,
+      34,    35,    36,    37,    38,    39,    40,    41,    42,    43,
+      -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     1,    -1,    -1,    -1,    -1,    -1,     7,    -1,
+      -1,    -1,    -1,    -1,    68,    69,    70,    71,    17,    18,
+      19,    -1,    21,    22,    23,    24,    25,    26,    27,    28,
+      -1,    -1,    -1,    32,    33,    34,    35,    36,    37,    38,
+      39,    40,    41,    42,    43,    -1,    45,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     1,    -1,
+      -1,    -1,    -1,    -1,     7,    -1,    -1,    -1,    -1,    -1,
+      -1,    70,    71,    72,    17,    18,    19,    -1,    21,    22,
+      23,    24,    25,    26,    27,    28,    -1,    -1,    31,    32,
+      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
+      43,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,     1,    -1,    -1,    -1,    -1,    -1,     7,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    70,    71,    17,
+      18,    19,    -1,    21,    22,    23,    24,    25,    26,    27,
+      28,    -1,    -1,    -1,    32,    33,    34,    35,    36,    37,
+      38,    39,    40,    41,    42,    43,     1,    45,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      15,    -1,     1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    70,    71,    -1,    30,    15,    32,    33,    34,
+      35,    36,    37,    38,    39,    40,    41,    -1,    -1,    -1,
+      -1,    30,    -1,    32,    33,    34,    35,    36,    37,    38,
+      39,    40,    41,     7,    -1,    -1,    15,    -1,    -1,    -1,
+      -1,    -1,    -1,    17,    18,    19,    71,    21,    22,    23,
+      24,    25,    26,    27,    28,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    71,    -1,    -1,    -1,    -1,    -1,    42,    43,
+      -1,    45,    51,    52,    53,    54,    55,    56,    57,    58,
+      59,    60,    61,    62,    63,    64,    -1,    -1,    67,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    70,    71,    51,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,    64,    -1,    -1,    67,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    79,    51,    52,    53,
+      54,    55,    56,    57,    58,    59,    60,    61,    62,    63,
+      64,    -1,    -1,    67,    52,    53,    54,    55,    56,    57,
+      58,    59,    60,    61,    62,    63,    64,    -1,    -1,    67,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,    64,    -1,    -1,    67
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint8 yystos[] =
+{
+       0,     1,    29,    30,    68,    81,    86,    87,    89,   117,
+      15,   213,    90,   213,   213,     0,    82,     1,    32,    33,
+      34,    35,    36,    37,    38,    39,    40,    41,    71,    94,
+      95,    96,    97,    99,   207,   213,    88,    17,   205,    13,
+      14,    69,    83,    85,   213,   117,    96,    98,   135,    78,
+      91,   211,    16,     1,    97,   194,   195,   207,    62,   100,
+     101,   102,   104,   106,   205,   198,   213,   207,    92,    93,
+     205,   213,     7,    17,    18,    19,    21,    22,    23,    24,
+      25,    26,    27,    28,    42,    43,    45,    70,    71,   130,
+     131,   132,   136,   138,   140,   145,   153,   154,   155,   156,
+     157,   158,   161,   163,   165,   166,   168,   170,   173,   179,
+     181,   184,   186,   187,   188,   190,   192,   193,   199,   205,
+     206,    84,   205,   207,    77,   208,    70,    45,   105,    31,
+     189,   194,    79,   212,   208,    75,   211,   211,   211,   198,
+     182,    75,     3,     4,     5,     6,    16,    17,    33,    34,
+      38,    39,    40,    41,    61,    66,   118,   119,   120,   126,
+     199,   204,   211,    17,   133,   213,   213,   207,   118,   119,
+     199,   207,   141,   207,   207,   207,   207,    20,   159,    20,
+     207,   207,   207,   207,   137,   138,   200,   146,    83,   100,
+      16,    17,    60,    61,   109,   110,   111,   112,   113,   114,
+     115,   116,   103,    73,   213,   205,   198,   171,   118,   198,
+     211,    16,   111,   196,   197,   198,   211,   211,   211,   211,
+     118,   118,    51,    52,    53,    54,    55,    56,    57,    58,
+      59,    60,    61,    62,    63,    64,    67,   211,   118,   135,
+     142,   162,   132,   169,    46,    47,    48,    49,    50,   139,
+     119,   199,    73,   209,   211,   211,    45,   208,    16,    71,
+     208,   109,   107,   108,   111,   191,   118,   212,   136,   177,
+     199,   198,    75,   208,   185,   121,   122,   123,    17,   198,
+     198,   198,   198,   198,   198,   198,   198,   198,   198,   198,
+     198,   198,   198,   198,   125,   212,   198,    12,    76,   144,
+     198,   160,   198,   118,    16,    62,   120,   199,   201,   203,
+     147,   111,   111,   110,   115,    72,   116,   208,    74,   208,
+      75,   194,   212,   167,    71,   138,   118,   198,   196,   194,
+      17,   128,   118,   127,   128,   208,   118,   118,   118,   118,
+     118,   118,   118,   118,   118,   118,   118,   118,   118,   118,
+     118,   118,   129,   134,   198,   198,   143,   194,    44,   164,
+     194,    74,   202,     8,     9,    10,    11,    55,    56,   119,
+     148,   150,   151,   199,   205,   208,   212,   108,   111,   172,
+     198,   198,   198,   183,   208,   212,   208,   212,   124,   208,
+     212,    72,    17,   145,   198,   208,   119,   152,   205,   152,
+     152,   152,   152,   152,   210,   212,   208,    45,    60,    61,
+     149,   198,   194,   174,   212,   194,   128,   128,   127,   118,
+     194,   201,   151,   119,   199,   150,   194,   118,   178,   198,
+     212,   208,    71,   180,   128,   198,   194,   212,   175,   177,
+     212,   198,   176,   130
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      fprintf (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
+    }
+}
+#endif /* YYERROR_VERBOSE */
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+  
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 2:
+#line 144 "grammar.y"
+    {
+		    /* Done once on entry but after at least one call to
+		     * yylex().  Good for initing parser flags.
+		     * Note: this does not get called in procedure scripts.
+		     */
+		    if (cldebug)
+			eprintf ("parse init (block)...\n");
+
+		    errcnt     = 0;
+		    err_cmdblk = 0;
+		    dobkg      = 0;
+		    inarglist  = 0;
+		    parenlevel = 0;
+		    bracelevel = 0;
+		    tbrace     = 0;
+		    dobrace    = 0;
+		    in_iferr   = 0;
+		    do_params  = YES;
+		    last_parm  = NULL;
+		    ifseen     = NULL;
+		    label1     = NULL;
+		    errmsg     = NULL;
+		    parse_pfile= currentask->t_pfp;
+		}
+    break;
+
+  case 3:
+#line 169 "grammar.y"
+    {
+		    /* Prepare to rerun whatever was compiled last.
+		     * Does not work for the debug commands builtin here.
+		     */
+		    if (parse_state != PARSE_FREE) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		    rerun();
+		    YYACCEPT;
+		}
+    break;
+
+  case 4:
+#line 181 "grammar.y"
+    {
+		    if (parse_state == PARSE_PARAMS) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		}
+    break;
+
+  case 5:
+#line 187 "grammar.y"
+    {
+		    if (sawnl && bracelevel == 0) {
+			if (!errcnt)
+			    compile (END);
+			if (ifseen) {
+			    /* Simulate an unput of what has been read
+			     * from the current line.
+			     */
+			    ip_cmdblk = ifseen;
+			}
+			YYACCEPT;
+		    }
+		}
+    break;
+
+  case 6:
+#line 201 "grammar.y"
+    {
+		    /* Parse the parameters in a script file.  This will
+		     * normally be done on a call by pfileread().
+		     */
+		    if (parse_state != PARSE_PARAMS) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    YYACCEPT;
+		}
+    break;
+
+  case 7:
+#line 212 "grammar.y"
+    {
+		    /* Parse the executable statements in a script.
+		     */
+		    if (parse_state != PARSE_BODY) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    if (!errcnt)
+			compile (END);
+		    YYACCEPT;
+		}
+    break;
+
+  case 8:
+#line 224 "grammar.y"
+    {
+		    /* This catches errors that the two other error lines
+		     * can't get, e.g. a missing `}' at the end of a script, 
+		     * or errors occuring in interactive input.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.
+		     */
+		    p_position();
+		    if (currentask->t_flags & T_SCRIPT) 
+			cl_error (E_UERR, "syntax error, line %d",
+			    currentask->t_scriptln);
+		    else
+			cl_error (E_UERR, "syntax error");
+
+		    YYACCEPT;
+		}
+    break;
+
+  case 10:
+#line 266 "grammar.y"
+    {
+		    /* debug are those debugging functions that
+		     * should be run directly and not through a
+		     * builtin task due to stack or other changes,
+		     * ie, don't change what we are trying to show.
+		     */
+		    printf ("\n");
+		}
+    break;
+
+  case 12:
+#line 276 "grammar.y"
+    {
+		    d_d(); /* show dictionary/stack pointers */
+		}
+    break;
+
+  case 13:
+#line 279 "grammar.y"
+    { /* show a dictionary location	*/
+		    if (stkop((yyvsp[(2) - (2)]))->o_type & OT_INT) {
+			int	idx;
+			idx = stkop((yyvsp[(2) - (2)]))->o_val.v_i;
+			eprintf ("%d:\t%d (0%o)\n", idx, stack[idx],
+				stack[idx]);
+		    } else
+			eprintf ("usage: D_PEEK <d. index>\n");
+		}
+    break;
+
+  case 14:
+#line 288 "grammar.y"
+    {
+		    d_stack (pc, 0, 0);		/* show compiled code	*/
+		}
+    break;
+
+  case 15:
+#line 295 "grammar.y"
+    { 
+			/* Check for required params.
+			 */
+			if (!errcnt)
+			    proc_params(n_procpar);
+		}
+    break;
+
+  case 16:
+#line 303 "grammar.y"
+    {
+			/* Initialize parser for procedure body.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (script_body)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+		        in_iferr   = 0;
+			dobrace    = 0;
+			bracelevel = PBRACE; /* disable lexmodes; force "end" */
+			tbrace     = 0;
+ 			do_params  = NO;
+			last_parm  = NULL;
+			ifseen     = NULL;
+			label1     = NULL;
+			parse_pfile= currentask->t_pfp;
+		}
+    break;
+
+  case 18:
+#line 329 "grammar.y"
+    {  
+			/* Initialize parser for procedure parameters.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (proc_stmt)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+			bracelevel = PBRACE;
+			tbrace     = 0;
+		        dobrace    = 0;
+		        in_iferr   = 0;
+			do_params  = YES;
+		        last_parm  = NULL;
+			label1     = NULL;
+		}
+    break;
+
+  case 20:
+#line 352 "grammar.y"
+    {
+		    n_procpar = 0;
+		}
+    break;
+
+  case 22:
+#line 361 "grammar.y"
+    {
+		    n_procpar = 0;
+		}
+    break;
+
+  case 24:
+#line 367 "grammar.y"
+    { 
+		    n_procpar = 1;
+		    if (!errcnt)
+			push (stkop((yyvsp[(1) - (1)])));
+		}
+    break;
+
+  case 25:
+#line 372 "grammar.y"
+    {
+		    n_procpar++;
+		    if (!errcnt)
+			push (stkop((yyvsp[(3) - (3)])));
+		}
+    break;
+
+  case 32:
+#line 389 "grammar.y"
+    {
+		    /* This catches errors in the parameter declarations
+		     * of a procedure script.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.  We know
+		     * we're parsing a procedure script, so print the line
+		     * number too.
+		     */
+		    p_position();
+		    cl_error (E_UERR, "syntax error, line %d", 
+			currentask->t_scriptln);
+		}
+    break;
+
+  case 33:
+#line 426 "grammar.y"
+    {
+	 	        /* For in-line definitions we don't want
+			 * to freeze stuff on the dictionary, so
+			 * only allow additions if the dictionary
+			 * is the same as at the beginning of the task.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				if (currentask->t_topd != topd)
+				    cl_error (E_UERR, illegalvar);
+				last_parm = currentask->t_pfp->pf_lastpp;
+			    }
+			}
+
+		        /* Increment bracelevel temporarily to defeat command
+			 * mode, in case this is an in-line declaration and
+			 * lexmodes=yes.
+			 */
+			bracelevel += PBRACE;
+			tbrace++;
+
+		}
+    break;
+
+  case 34:
+#line 447 "grammar.y"
+    {
+		      	/* Update dictionary to include these definitions.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				currentask->t_topd = topd;
+				last_parm = 0;
+			    }
+			}
+
+			/* Restore command mode */
+			bracelevel -= PBRACE;
+			tbrace--;
+		}
+    break;
+
+  case 35:
+#line 463 "grammar.y"
+    { vartype = V_BOOL; }
+    break;
+
+  case 36:
+#line 464 "grammar.y"
+    { vartype = V_STRING; }
+    break;
+
+  case 37:
+#line 465 "grammar.y"
+    { vartype = V_REAL; }
+    break;
+
+  case 38:
+#line 466 "grammar.y"
+    { vartype = V_FILE; }
+    break;
+
+  case 39:
+#line 467 "grammar.y"
+    { vartype = V_GCUR; }
+    break;
+
+  case 40:
+#line 468 "grammar.y"
+    { vartype = V_IMCUR; }
+    break;
+
+  case 41:
+#line 469 "grammar.y"
+    { vartype = V_UKEY; }
+    break;
+
+  case 42:
+#line 470 "grammar.y"
+    { vartype = V_PSET; }
+    break;
+
+  case 43:
+#line 471 "grammar.y"
+    { vartype = V_INT; }
+    break;
+
+  case 44:
+#line 472 "grammar.y"
+    { vartype = V_STRUCT; }
+    break;
+
+  case 47:
+#line 479 "grammar.y"
+    {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, inited);
+			    }
+			}
+		}
+    break;
+
+  case 48:
+#line 497 "grammar.y"
+    {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (!do_params)
+				    cl_error (E_UERR, badparm, pp->p_name);
+
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, n_aval);
+			    }
+			}
+		}
+    break;
+
+  case 49:
+#line 515 "grammar.y"
+    {
+			inited = NO;
+			n_aval = 0;
+		}
+    break;
+
+  case 50:
+#line 519 "grammar.y"
+    {
+			n_aval = 0;
+		}
+    break;
+
+  case 51:
+#line 522 "grammar.y"
+    {
+			inited = YES;
+		}
+    break;
+
+  case 52:
+#line 527 "grammar.y"
+    {
+		    index_cnt = 0;
+		    if (!errcnt)
+			pp = initparam (stkop((yyvsp[(1) - (1)])), do_params, vartype, varlist);
+		}
+    break;
+
+  case 53:
+#line 532 "grammar.y"
+    {
+		    int  itemp;
+
+		    if (!errcnt) {
+			pp = initparam (stkop((yyvsp[(1) - (1)])), do_params, vartype, varlist);
+
+			if (pp != NULL) {
+			    itemp = (pp->p_type & OT_BASIC) == pp->p_type;
+			    itemp = itemp && !varlist;
+			    if (itemp)
+				pp->p_type |= PT_ARRAY;
+			    else
+				cl_error (E_UERR, inval_arr, pp->p_name);
+			}
+		    }
+		}
+    break;
+
+  case 55:
+#line 551 "grammar.y"
+    {
+			varlist = NO;
+			index_cnt = 0;
+		}
+    break;
+
+  case 56:
+#line 555 "grammar.y"
+    {
+			if (!do_params) {
+			    errmsg = locallist;
+			    EYYERROR;
+			}
+			varlist = YES;
+			index_cnt = 0;
+			(yyval) = (yyvsp[(2) - (2)]);
+		}
+    break;
+
+  case 60:
+#line 575 "grammar.y"
+    {
+		    if (!errcnt) {
+			if (pp != NULL) {
+			    if (stkop((yyvsp[(1) - (1)]))->o_type == OT_INT) {
+				push (stkop((yyvsp[(1) - (1)]))->o_val.v_i);
+				push (1);
+			    } else if (maybeindex) {
+				/* Confusion between sexagesimal and index
+				 * range.  Maybeindex is set only when operand
+				 * is real.
+			 	 */
+				int  i1,i2;
+				sexa_to_index (stkop((yyvsp[(1) - (1)]))->o_val.v_r, &i1, &i2);
+				push (i2-i1+1);
+				push (i1);
+			    } else {
+				eprintf (inv_index, pp->p_name);
+				EYYERROR;
+			    }
+			    index_cnt++;
+			}
+		    }
+		}
+    break;
+
+  case 61:
+#line 598 "grammar.y"
+    {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (stkop((yyvsp[(1) - (3)]))->o_type != OT_INT  ||
+				    stkop((yyvsp[(3) - (3)]))->o_type != OT_INT)
+				    cl_error (E_UERR, inv_index, pp->p_name);
+				else {
+				    push (stkop((yyvsp[(3) - (3)]))->o_val.v_i -
+				          stkop((yyvsp[(1) - (3)]))->o_val.v_i + 1);
+				    push (stkop((yyvsp[(1) - (3)]))->o_val.v_i);
+			        }
+			        index_cnt++;
+			    }
+			}
+		}
+    break;
+
+  case 64:
+#line 619 "grammar.y"
+    {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				push (stkop((yyvsp[(1) - (1)])) );
+				n_aval++;
+			    }
+			}
+		}
+    break;
+
+  case 65:
+#line 628 "grammar.y"
+    {
+			int   cnt;
+			
+			if (!errcnt)
+			    if (pp != NULL) {
+			    	if (stkop((yyvsp[(1) - (4)]))->o_type != OT_INT)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        cnt = stkop((yyvsp[(1) - (4)]))->o_val.v_i;
+			        if (cnt <= 0)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        while (cnt-- > 0) {
+				    push (stkop((yyvsp[(3) - (4)])));
+				    n_aval++;
+			        }
+			    }
+		}
+    break;
+
+  case 68:
+#line 655 "grammar.y"
+    {
+		      	if (stkop((yyvsp[(2) - (2)]))->o_type == OT_INT) {
+			    stkop((yyvsp[(2) - (2)]))->o_val.v_i *= (yyvsp[(1) - (2)]);
+			    (yyval) = (yyvsp[(2) - (2)]);
+			} else if (stkop((yyvsp[(2) - (2)]))->o_type == OT_REAL) {
+			    stkop((yyvsp[(2) - (2)]))->o_val.v_r *= (yyvsp[(1) - (2)]);
+			    (yyval) = (yyvsp[(2) - (2)]);
+			} else {
+			    errmsg = "Invalid constant in declaration.";
+			    EYYERROR;
+			}
+		}
+    break;
+
+  case 69:
+#line 669 "grammar.y"
+    { (yyval) =  1; }
+    break;
+
+  case 70:
+#line 670 "grammar.y"
+    { (yyval) = -1; }
+    break;
+
+  case 71:
+#line 672 "grammar.y"
+    {
+			/* Check if we already had an initialization. 
+			 */
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+				eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+    break;
+
+  case 72:
+#line 682 "grammar.y"
+    {
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+			        eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+    break;
+
+  case 76:
+#line 697 "grammar.y"
+    {
+			if (!errcnt)
+			    if (pp != NULL)
+			    	do_option (pp, stkop((yyvsp[(1) - (3)])), stkop((yyvsp[(3) - (3)])));
+		}
+    break;
+
+  case 79:
+#line 713 "grammar.y"
+    {
+		    if (!errcnt)
+		        compile (PUSHPARAM, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+		}
+    break;
+
+  case 81:
+#line 727 "grammar.y"
+    {
+		    if  (!errcnt)
+		        compile (PUSHCONST, stkop((yyvsp[(1) - (1)])));
+		}
+    break;
+
+  case 82:
+#line 731 "grammar.y"
+    {
+		    /* "gcur" is both a keyword and a CL global parameter,
+		     * and must be built into the grammar here to permit
+		     * reference of the parameter in expressions.
+		     */
+		    if (!errcnt)
+			compile (PUSHPARAM, "gcur");
+		}
+    break;
+
+  case 83:
+#line 739 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (PUSHPARAM, "imcur");
+		}
+    break;
+
+  case 84:
+#line 743 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (PUSHPARAM, "ukey");
+		}
+    break;
+
+  case 85:
+#line 747 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (PUSHPARAM, "pset");
+		}
+    break;
+
+  case 87:
+#line 755 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (ADD);
+		}
+    break;
+
+  case 88:
+#line 759 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (SUB);
+		}
+    break;
+
+  case 89:
+#line 763 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (MUL);
+		}
+    break;
+
+  case 90:
+#line 767 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (DIV);
+		}
+    break;
+
+  case 91:
+#line 771 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (POW);
+		}
+    break;
+
+  case 92:
+#line 775 "grammar.y"
+    {
+		    struct	operand o;
+		    if (!errcnt) {
+			o.o_type = OT_INT;
+			o.o_val.v_i = 2;
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, "mod");
+		    }
+		}
+    break;
+
+  case 93:
+#line 784 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (CONCAT);
+		}
+    break;
+
+  case 94:
+#line 788 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (LT);
+		}
+    break;
+
+  case 95:
+#line 792 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (GT);
+		}
+    break;
+
+  case 96:
+#line 796 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (LE);
+		}
+    break;
+
+  case 97:
+#line 800 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (GE);
+		}
+    break;
+
+  case 98:
+#line 804 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (EQ);
+		}
+    break;
+
+  case 99:
+#line 808 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (NE);
+		}
+    break;
+
+  case 100:
+#line 812 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (OR);
+		}
+    break;
+
+  case 101:
+#line 816 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (AND);
+		}
+    break;
+
+  case 102:
+#line 820 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (NOT);
+		}
+    break;
+
+  case 103:
+#line 824 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (CHSIGN);
+		}
+    break;
+
+  case 104:
+#line 829 "grammar.y"
+    {
+		    /* Free format scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		}
+    break;
+
+  case 105:
+#line 833 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (SCAN);
+		    }
+		}
+    break;
+
+  case 106:
+#line 842 "grammar.y"
+    {
+		    /* Formatted scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		}
+    break;
+
+  case 107:
+#line 846 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (SCANF);
+		    }
+		}
+    break;
+
+  case 108:
+#line 859 "grammar.y"
+    {
+		    /* Free format scan from a parameter.  */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		}
+    break;
+
+  case 109:
+#line 863 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (FSCAN);
+		    }
+		}
+    break;
+
+  case 110:
+#line 873 "grammar.y"
+    {
+		    /* Formatted scan from a parameter.
+		     * fscanf (param, format, arg1, ...)
+		     */
+		    if (!errcnt) {
+			compile (PUSHCONST, stkop ((yyvsp[(3) - (4)])));
+		        push (1);	/* use control stack to count args */
+		    }
+		}
+    break;
+
+  case 111:
+#line 881 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (FSCANF);
+		    }
+		}
+    break;
+
+  case 112:
+#line 894 "grammar.y"
+    {
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		}
+    break;
+
+  case 113:
+#line 897 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, stkop((yyvsp[(1) - (5)]))->o_val.v_s);
+		    }
+		}
+    break;
+
+  case 115:
+#line 912 "grammar.y"
+    {
+			/* The YACC value of this must match normal intrinsics
+			 * so we must generate an operand with the proper
+			 * string. 
+			 */
+			if (!errcnt)
+			    (yyval) = addconst ("int", OT_STRING);
+		}
+    break;
+
+  case 116:
+#line 920 "grammar.y"
+    {
+			if (!errcnt)
+			    (yyval) = addconst ("real", OT_STRING);
+		}
+    break;
+
+  case 117:
+#line 926 "grammar.y"
+    {
+		    if (!errcnt) {
+		        push (pop() + 1);		/* inc num args	*/
+		    }
+		}
+    break;
+
+  case 119:
+#line 939 "grammar.y"
+    {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ((yyvsp[(1) - (1)])));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+    break;
+
+  case 120:
+#line 945 "grammar.y"
+    {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ((yyvsp[(1) - (3)])));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+    break;
+
+  case 122:
+#line 956 "grammar.y"
+    {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+    break;
+
+  case 123:
+#line 960 "grammar.y"
+    {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+    break;
+
+  case 148:
+#line 1000 "grammar.y"
+    {
+		    bracelevel++;
+		}
+    break;
+
+  case 149:
+#line 1002 "grammar.y"
+    {
+		    --bracelevel;
+		}
+    break;
+
+  case 153:
+#line 1014 "grammar.y"
+    {
+			--parenlevel;
+ 			if (!errcnt)
+		      	    compile (ASSIGN, stkop((yyvsp[(1) - (3)]))->o_val.v_s);
+		}
+    break;
+
+  case 154:
+#line 1019 "grammar.y"
+    {
+			/* Old code pushed a constant rather than a param
+			 * when not within braces.  This doesn't seem
+			 * to be what most people want.
+			 */
+			--parenlevel;
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop((yyvsp[(3) - (3)]))->o_val.v_s);
+		            compile (ASSIGN, stkop((yyvsp[(1) - (3)]))->o_val.v_s);
+		    	}
+		}
+    break;
+
+  case 155:
+#line 1030 "grammar.y"
+    {
+			parenlevel++;
+		}
+    break;
+
+  case 156:
+#line 1033 "grammar.y"
+    {
+		      	--parenlevel;
+			if (!errcnt)
+		  	    compile ((yyvsp[(3) - (4)]), stkop((yyvsp[(1) - (4)]))->o_val.v_s);
+		}
+    break;
+
+  case 157:
+#line 1042 "grammar.y"
+    {
+			parenlevel++;
+		}
+    break;
+
+  case 158:
+#line 1047 "grammar.y"
+    { (yyval) = ADDASSIGN; }
+    break;
+
+  case 159:
+#line 1048 "grammar.y"
+    { (yyval) = SUBASSIGN; }
+    break;
+
+  case 160:
+#line 1049 "grammar.y"
+    { (yyval) = MULASSIGN; }
+    break;
+
+  case 161:
+#line 1050 "grammar.y"
+    { (yyval) = DIVASSIGN; }
+    break;
+
+  case 162:
+#line 1051 "grammar.y"
+    { (yyval) = CATASSIGN; }
+    break;
+
+  case 163:
+#line 1054 "grammar.y"
+    {
+		    npipes = 0;
+		}
+    break;
+
+  case 164:
+#line 1056 "grammar.y"
+    {
+		    if (!errcnt) {
+			compile (EXEC);
+			if (npipes > 0)
+			    compile (RMPIPES, npipes);
+		    }
+		}
+    break;
+
+  case 166:
+#line 1066 "grammar.y"
+    {
+		    /* Pipefiles must be allocated at run time using a stack
+		     * to permit pipe commands within loops, and to permit
+		     * scripts called in a pipe to themselves contain pipe
+		     * commands.  ADDPIPE allocates a new pipefile on the
+		     * pipe stack and pushes its name on the operand stack.
+		     * GETPIPE pushes the pipefile at the top of the pipe
+		     * stack onto the operand stack.  RMPIPES removes N pipes
+		     * from the pipe stack, and deletes the physical pipefiles.
+		     */
+
+		    if (!newstdout) {
+			/* When the runtime code creates the pipe it needs to
+			 * know the identity of the two tasks sharing the pipe
+			 * to determine what type of pipe to create (text or
+			 * binary).  Save the pc of the ADDPIPE instruction
+			 * so that we can backpatch it below with a pointer to
+			 * the name of the second task in the pipe (ADDPIPE
+			 * will be called during startup of the first task
+			 * hence will know its name).
+			 */
+			pipe_pc = compile (ADDPIPE, NULL);
+
+			if ((yyvsp[(2) - (2)]) == 1)
+			    compile (REDIR);
+			else
+			    compile (ALLREDIR);
+			compile (EXEC);
+
+		    } else {
+			eprintf ("multiple redirection\n");
+			YYERROR;
+		    }
+
+		}
+    break;
+
+  case 167:
+#line 1100 "grammar.y"
+    {
+		    /* Compile the GETPIPE instruction with the name of the
+		     * second task in the current pipe, and backpatch the
+		     * matching ADDPIPE instruction with the PC of the GETPIPE.
+		     */
+		    (coderef(pipe_pc))->c_args = compile (GETPIPE, curr_task);
+		    compile (REDIRIN);
+		    npipes++;		/* Overflow checking is in ADDPIPE */
+		}
+    break;
+
+  case 168:
+#line 1111 "grammar.y"
+    {
+		    (yyval) = 1;
+		}
+    break;
+
+  case 169:
+#line 1114 "grammar.y"
+    {
+		    (yyval) = 2;
+		}
+    break;
+
+  case 170:
+#line 1119 "grammar.y"
+    {
+		    char    *ltname;
+
+		    ltname = stkop((yyvsp[(1) - (1)]))->o_val.v_s;
+		    compile (CALL, ltname);
+		    strcpy (curr_task, ltname);
+
+		    /* The FPRINT task is special; the first arg
+		     * is the destination and must be compiled as
+		     * a string constant no matter what.  Set flag
+		     * so that 'arg' compiles PUSHCONST.
+		     */
+		    printstmt = (strcmp (ltname, "fprint") == 0);
+
+		    /* Ditto with SCAN; all the arguments are call by
+		     * reference and must be compiled as string constants.
+		     */
+		    scanstmt = (strcmp (ltname, "scan") == 0 ||
+				strcmp (ltname, "scanf") == 0);
+
+		    absmode = 0;
+		    posit = 0;
+		    newstdout = 0;
+		    parenlevel = 0;
+		}
+    break;
+
+  case 171:
+#line 1143 "grammar.y"
+    {
+		    inarglist = 1;
+		}
+    break;
+
+  case 172:
+#line 1145 "grammar.y"
+    {
+		    extern char *onerr_handler;
+
+		    inarglist = 0;
+		    parenlevel = 0;
+		    scanstmt = 0;
+		}
+    break;
+
+  case 173:
+#line 1154 "grammar.y"
+    {
+		    /* (,x) equates to nargs == 2.  Call posargset with
+		     * negative dummy argument to bump nargs.
+		     */
+		    if (!errcnt) {
+			compile (POSARGSET, -1);
+			posit++;
+			printstmt = 0;
+			scanstmt = 0;
+		    }
+		}
+    break;
+
+  case 178:
+#line 1173 "grammar.y"
+    {
+		    if (!errcnt) {
+			if (posit > 0) {		/* not first time */
+			    compile (POSARGSET, -posit);
+			    printstmt = 0;
+			    scanstmt = 0;
+			}
+			posit++;
+		    }
+		}
+    break;
+
+  case 179:
+#line 1183 "grammar.y"
+    {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else
+			if (!errcnt)
+			    compile (POSARGSET, posit++);
+		}
+    break;
+
+  case 180:
+#line 1191 "grammar.y"
+    {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else if (!errcnt) {
+			if (scanstmt) {
+			    char    pname[SZ_FNAME];
+			    char    *pk, *t, *p, *f;
+			    struct  pfile *pfp;
+			    struct  operand o;
+
+			    /* If no task name specified check the pfile for
+			     * the task containing the scan statement for the
+			     * named parameter.
+			     */
+			    breakout (stkop((yyvsp[(1) - (1)]))->o_val.v_s, &pk, &t, &p, &f);
+			    pfp = currentask->t_pfp;
+			    if (*pk == NULL && *t == NULL &&
+				pfp && paramfind(pfp,p,0,1)) {
+
+				sprintf (pname, "%s.%s",
+				    currentask->t_ltp->lt_lname, p);
+				if (*f) {
+				    strcat (pname, ".");
+				    strcat (pname, f);
+				}
+			    } else
+				strcpy (pname, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+
+			    o = *(stkop((yyvsp[(1) - (1)])));
+			    o.o_val.v_s = pname;
+			    compile (PUSHCONST, &o);
+			    compile (INDIRPOSSET, posit++);
+
+			} else if (parenlevel == 0 || printstmt) {
+			    compile (PUSHCONST, stkop((yyvsp[(1) - (1)])));
+			    compile (INDIRPOSSET, posit++);
+			    /* only first arg of fprint stmt is special. */
+			    printstmt = 0;
+
+			} else {
+			    compile (PUSHPARAM, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+			    compile (POSARGSET, posit++);
+			}
+		    }
+		}
+    break;
+
+  case 181:
+#line 1237 "grammar.y"
+    {
+		    absmode++;
+		    if (!errcnt)
+			compile (ABSARGSET, stkop((yyvsp[(1) - (3)]))->o_val.v_s); 
+		}
+    break;
+
+  case 182:
+#line 1242 "grammar.y"
+    {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0) {
+			    compile (PUSHCONST, stkop((yyvsp[(3) - (3)])));
+			    compile (INDIRABSSET, stkop((yyvsp[(1) - (3)]))->o_val.v_s); 
+			} else {
+			    compile (PUSHPARAM, stkop((yyvsp[(3) - (3)]))->o_val.v_s);
+			    compile (ABSARGSET, stkop((yyvsp[(1) - (3)]))->o_val.v_s);
+			}
+		    }
+		}
+    break;
+
+  case 183:
+#line 1254 "grammar.y"
+    {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWON, stkop((yyvsp[(1) - (2)]))->o_val.v_s);
+		}
+    break;
+
+  case 184:
+#line 1259 "grammar.y"
+    {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWOFF, stkop((yyvsp[(1) - (2)]))->o_val.v_s);
+		}
+    break;
+
+  case 185:
+#line 1264 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (REDIRIN);
+		}
+    break;
+
+  case 186:
+#line 1268 "grammar.y"
+    {
+		    newstdout++;
+		    if (!errcnt)
+			compile (REDIR);
+		}
+    break;
+
+  case 187:
+#line 1273 "grammar.y"
+    {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLREDIR);
+		}
+    break;
+
+  case 188:
+#line 1278 "grammar.y"
+    {
+		    newstdout++;
+		    if (!errcnt)
+			compile (APPENDOUT);
+		}
+    break;
+
+  case 189:
+#line 1283 "grammar.y"
+    {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLAPPEND);
+		}
+    break;
+
+  case 190:
+#line 1288 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (GSREDIR, stkop((yyvsp[(1) - (2)]))->o_val.v_s);
+		}
+    break;
+
+  case 191:
+#line 1294 "grammar.y"
+    {
+		    absmode++;
+		    /* constant already pushed by expr0.
+		     */
+		}
+    break;
+
+  case 192:
+#line 1299 "grammar.y"
+    {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0)
+			    compile (PUSHCONST, stkop((yyvsp[(1) - (1)])));
+			else
+			    compile (PUSHPARAM, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+			}
+		}
+    break;
+
+  case 193:
+#line 1310 "grammar.y"
+    {
+			--parenlevel;
+			if (!errcnt)
+			    compile (IMMED);
+		}
+    break;
+
+  case 194:
+#line 1315 "grammar.y"
+    {
+		      	--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop((yyvsp[(2) - (2)]))->o_val.v_s);
+		}
+    break;
+
+  case 195:
+#line 1322 "grammar.y"
+    {
+			--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop((yyvsp[(1) - (2)]))->o_val.v_s);
+		}
+    break;
+
+  case 196:
+#line 1329 "grammar.y"
+    {
+		    if (!errcnt)
+			compile (OSESC, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+		}
+    break;
+
+  case 197:
+#line 1335 "grammar.y"
+    {
+		    --parenlevel;
+		    if (!errcnt)
+			compile (IMMED);
+		}
+    break;
+
+  case 198:
+#line 1345 "grammar.y"
+    {
+		    /* pop BIFF addr and set branch to just after statement */
+		    if (!errcnt) {
+		        XINT   biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		    in_iferr = 0;
+		}
+    break;
+
+  case 199:
+#line 1355 "grammar.y"
+    {
+		    if (++in_iferr > 1) { 
+			errmsg = nestediferr; 
+			EYYERROR; 
+		    } 
+		    compile (CALL, "_errpsh");
+		    compile (EXEC);
+
+		}
+    break;
+
+  case 200:
+#line 1363 "grammar.y"
+    {
+		    if (!errcnt) {
+			struct	operand o;
+
+			o.o_type = OT_INT;
+			o.o_val.v_i = 0;
+			compile (PUSHCONST, &o);       /* if (_errpop() != 0) */
+			compile (INTRINSIC, "_errpop");
+			compile (PUSHCONST, &o);
+			compile (((iferr_tok == 0) ? NE : EQ));
+			push (compile (BIFF, 0));
+		    }
+		}
+    break;
+
+  case 201:
+#line 1375 "grammar.y"
+    {
+		    in_iferr--;
+		}
+    break;
+
+  case 202:
+#line 1380 "grammar.y"
+    {
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			XINT  biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+
+		}
+    break;
+
+  case 203:
+#line 1390 "grammar.y"
+    {
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+		    	XINT  gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+    break;
+
+  case 204:
+#line 1400 "grammar.y"
+    { iferr_tok = 0; }
+    break;
+
+  case 205:
+#line 1401 "grammar.y"
+    { iferr_tok = 1; }
+    break;
+
+  case 208:
+#line 1412 "grammar.y"
+    {
+		    /* pop BIFF addr and set branch to just after statement
+		     */
+		    XINT   biffaddr;
+		    if (!errcnt) {
+			biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		}
+    break;
+
+  case 209:
+#line 1423 "grammar.y"
+    {
+			/* save BIFF addr so branch can be filled in 
+			 */
+			if (!errcnt)
+			    push (compile (BIFF, 0));
+		}
+    break;
+
+  case 210:
+#line 1428 "grammar.y"
+    {
+			/* The shift/reduce conflict in the IF-IF/ELSE
+			 * construct can cause errors in compilation
+			 * because the IF statement can also be a
+			 * terminal symbol, i.e. it may be all that
+			 * is parsed in one call to the parser.
+			 * The parser must look ahead one token
+			 * to find if there is an else statement
+			 * following.  If there is no following
+			 * token an EOF may be detected prematurely.
+			 * When the IF statement is being parsed not
+			 * inside any braces, then when the next token
+			 * is not an ELSE care must be taken that this
+			 * token is seen on a subsequent invocation
+			 * of the parser.  The `ifseen' flag is
+			 * used within the support for the lexical
+			 * analyzer located in `history.c'.
+			 */
+			if (cldebug) 
+			    eprintf ("ytab: setting ifseen=yes\n");
+
+			if (currentask->t_flags & T_INTERACTIVE)
+			    ifseen = ip_cmdblk;
+			else
+			    ifseen = cmdblk;
+		}
+    break;
+
+  case 211:
+#line 1456 "grammar.y"
+    {
+		    XINT  biffaddr;
+
+		    ifseen = NULL;
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		}
+    break;
+
+  case 212:
+#line 1468 "grammar.y"
+    {
+		    XINT  gotoaddr;
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+			gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+    break;
+
+  case 213:
+#line 1479 "grammar.y"
+    {
+		    /* Save starting addr of while expression.
+		     */
+		    if (!errcnt) {
+			push (pc);
+			loopincr();
+		    }
+		}
+    break;
+
+  case 214:
+#line 1486 "grammar.y"
+    {
+		    /* Save BIFF addr so branch can be filled in.
+		     */
+		    if (!errcnt)
+			push (compile (BIFF, 0));
+		}
+    break;
+
+  case 215:
+#line 1491 "grammar.y"
+    {
+		    XINT  biffaddr;
+
+		    if (!errcnt) {
+			/* Pop and save addr of BIFF instruction.	   */
+			biffaddr = pop();
+			/* Pop addr of expression and build a goto there.  */
+			compile (GOTO, pop() - pc - SZ_CE);
+			/* Now can set BIFF branch to just after statement.*/
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+			loopdecr();
+		    }
+		}
+    break;
+
+  case 216:
+#line 1524 "grammar.y"
+    {
+			if (!errcnt)
+			    push(pc);				/* Loop1: */
+		}
+    break;
+
+  case 217:
+#line 1528 "grammar.y"
+    {
+			if (!errcnt) {
+			    if (for_expr)
+				ppush (compile(BIFF, 0));	/* if (!e2) */
+
+			    /* Add SZ_CE to skip following GOTO. 
+			     */
+			    ppush (pc+SZ_CE);			/* Loop2: */
+			    ppush (compile(GOTO,0));		/* goto Loop3 */
+
+			    /* Save current location as the destination
+			     * for NEXT statements.
+			     */
+			    loopincr();
+			}
+		}
+    break;
+
+  case 218:
+#line 1544 "grammar.y"
+    {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); 	/* Goto loop1 */
+			    stmtaddr = pop();
+			    coderef(stmtaddr)->c_args = pc - stmtaddr - SZ_CE;
+			}
+		}
+    break;
+
+  case 219:
+#line 1554 "grammar.y"
+    {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); /* goto loop2 */
+
+			    if (for_expr) {
+				stmtaddr = pop();
+				coderef(stmtaddr)->c_args = pc-stmtaddr-SZ_CE;
+			    }
+			    loopdecr();
+			}
+		}
+    break;
+
+  case 222:
+#line 1577 "grammar.y"
+    {
+			for_expr = YES;
+		}
+    break;
+
+  case 223:
+#line 1580 "grammar.y"
+    {
+			for_expr = NO;
+		}
+    break;
+
+  case 224:
+#line 1606 "grammar.y"
+    {
+			if (!errcnt) {
+			    push (compile(SWITCH));
+
+			    /* Compile GOTO which will branch past end of
+			     * switch.  This is needed if there is no DEFAULT.
+			     */
+			    compile (GOTO, 0);
+			}
+		}
+    break;
+
+  case 225:
+#line 1615 "grammar.y"
+    {
+			/* Set up jumptable and pop space on stack.
+			 */
+			if (!errcnt)
+			    setswitch();
+		}
+    break;
+
+  case 226:
+#line 1623 "grammar.y"
+    {
+			if (!errcnt) {
+			    ncaseval = 0;
+			    if (!in_switch()) {
+				errmsg = "Improper CASE statement.";
+				EYYERROR;
+			    }
+			}
+		}
+    break;
+
+  case 227:
+#line 1631 "grammar.y"
+    {
+			XINT  pcase;
+
+			if (!errcnt) {
+			    pcase = compile (CASE, ncaseval);
+
+			    /* Fill in argument list. 
+			     */
+			    caseset (&(coderef(pcase)->c_args), ncaseval);
+			    push (pcase);
+			}
+		}
+    break;
+
+  case 228:
+#line 1642 "grammar.y"
+    {
+			/* Branch to end of switch block 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+    break;
+
+  case 229:
+#line 1650 "grammar.y"
+    {
+		      	/* Compile an operand to store the current PC.
+			 */
+			if (!errcnt) {
+			    if (!in_switch()) {
+				errmsg = "Improper DEFAULT statement.";
+				EYYERROR;
+			    }
+			    push (compile(DEFAULT));
+			}
+		}
+    break;
+
+  case 230:
+#line 1660 "grammar.y"
+    {
+		      	/* Branch past jump table. 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+    break;
+
+  case 231:
+#line 1668 "grammar.y"
+    {
+			/* All NEXT statements are backward references,
+			 * so we simply store the addresses in an array.
+			 */
+			if (!errcnt) {
+			    if (nestlevel)
+				compile (GOTO, nextdest[nestlevel-1]-pc-SZ_CE);
+			    else {
+				errmsg = "NEXT outside of loop.";
+				EYYERROR;
+			    }
+			}
+		}
+    break;
+
+  case 232:
+#line 1683 "grammar.y"
+    {
+			/* Each BREAK is a forward reference.  For the
+			 * first BREAK in each loop we compile a
+			 * GOTO statement which will be the object of
+			 * all BREAK statements within the loop.  When
+			 * the loop is terminated the target of this
+			 * GOTO will be set.
+			 */
+			int  dest;
+
+			if (!errcnt) {
+			    if (!nestlevel) {
+				errmsg = "Break outside of loop.";
+				EYYERROR;
+			    } else if ((dest = brkdest[nestlevel-1]) != 0)
+		    		compile (GOTO, dest-pc-SZ_CE);
+			    else {
+				brkdest[nestlevel-1] = pc;
+				compile (GOTO, 0);
+			    }
+			}
+		}
+    break;
+
+  case 233:
+#line 1707 "grammar.y"
+    {
+			if (!errcnt)
+			    compile (END);
+		}
+    break;
+
+  case 234:
+#line 1711 "grammar.y"
+    {
+			/* Return values currently not implemented.
+			 */
+			eprintf ("Warning: return value ignored.\n");
+			if (!errcnt)
+			    compile (END);
+		}
+    break;
+
+  case 235:
+#line 1723 "grammar.y"
+    {
+			bracelevel -= PBRACE;
+			if (bracelevel < 0) {
+			    errmsg = "Too few left braces.";
+			    EYYERROR;
+			} else if (bracelevel > 0) {
+			    errmsg = "Too few right braces.";
+			    EYYERROR;
+			}
+		}
+    break;
+
+  case 236:
+#line 1735 "grammar.y"
+    {
+			/* Put symbol in table in dictionary and
+			 * process indirect references if present.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop((yyvsp[(1) - (3)])));
+
+			    if (l == NULL) {
+				l = setlabel (stkop((yyvsp[(1) - (3)])));
+				l->l_loc = pc;
+			    } else if (l->l_defined) {
+			        errmsg = "Identical labels.";
+				EYYERROR;
+			    } else {
+				/* Get this GOTO out of the
+				 * indirect list so we can use
+				 * the argument as the destination
+				 */
+				XINT  gotopc;
+				gotopc = l->l_loc;
+				unsetigoto (gotopc);
+
+				/* Fix the indirect reference. 
+				 */
+				coderef(gotopc)->c_args = pc - gotopc - SZ_CE;
+			    }
+			    (l->l_defined)++;
+			}
+		}
+    break;
+
+  case 238:
+#line 1769 "grammar.y"
+    {
+			/* Get the address corresponding to the label.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop((yyvsp[(2) - (2)])));
+
+			    if (l != NULL)
+				compile (GOTO, l->l_loc - pc - SZ_CE);
+			    else {
+				/* Ready for indirect GOTO 
+				 */
+				l = setlabel (stkop((yyvsp[(2) - (2)])));
+				l->l_loc = pc;
+				setigoto (compile(GOTO, 0));
+				l->l_defined = 0;
+			    }
+			}
+		}
+    break;
+
+  case 241:
+#line 1799 "grammar.y"
+    { 
+			/* Save pc before compiling statement for loop back
+			 */
+			stmt_pc = pc;
+			n_oarr = 0;
+			i_oarr = 0;
+			ifseen = NULL;
+		}
+    break;
+
+  case 242:
+#line 1807 "grammar.y"
+    {
+		      	/* If there was an open reference compile the
+			 * loop increment and goback.
+			 */
+			XINT push_pc;
+
+			if (!errcnt) {
+			    if (n_oarr) {
+				compile (INDXINCR, stmt_pc-pc-4, 2*n_oarr+1);
+
+				/* We are going to store initialization
+				 * info for the implicit loop here.
+				 * It is loopincr's responsibility to 
+				 * branch around it.  This data is what
+				 * should be pointed to by the special
+				 * PUSHINDEX compiled at the first open
+				 * array reference.
+				 */
+				push_pc = pop();  /* Location of PUSHINDEX */
+				coderef(push_pc)->c_args = pc - push_pc - SZ_CE;
+
+				stack[pc++] = n_oarr;
+				for (i_oarr=0; i_oarr<n_oarr; i_oarr++) {
+				    stack[pc++] = oarr_beg[i_oarr];
+				    stack[pc++] = oarr_end[i_oarr];
+				}
+
+				/* Clear n_oarr.  This must be done here
+				 * because we may have the end of a compound
+				 * statement following on the heels of the
+				 * end of the simple statement with the
+				 * implicit loop.
+				 */
+				n_oarr = 0;
+				i_oarr = 0;
+			    }
+			}
+		}
+    break;
+
+  case 244:
+#line 1846 "grammar.y"
+    {
+		    /* This should get most errors in executable statements
+		     * or in the local variable declarations in a script.
+		     */
+		    yyerrok;
+
+		    /* Get rid of any fake braces.
+		     */
+		    bracelevel -= tbrace;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+ 		    }
+
+		    /* Tell user about the syntax error, printing the 
+		     * offending line and position if possible.
+		     */
+		    if (currentask->t_flags & T_SCRIPT) {
+		        if (errmsg != NULL) {
+			    eprintf ("** Syntax error, line %d: %s\n",
+			        currentask->t_scriptln, errmsg);
+			} else {
+			    eprintf ("** Syntax error, line %d\n",
+			        currentask->t_scriptln);
+			}
+		    } else
+			eprintf ("** Syntax error\n");
+		    p_position();
+
+		    if (!(currentask->t_flags & T_SCRIPT)) {
+			/* If interactive, we're finished if not within braces.
+			 */
+			if (!bracelevel)
+			    YYACCEPT;
+		    }
+
+		    /* Note that we do not call cl_error() here to abort, but
+		     * continue on parsing the script for more syntax errors.
+		     */
+		    if (++errcnt > MAX_ERR)
+			cl_error (E_UERR, "Too many syntax errors.");
+		}
+    break;
+
+  case 247:
+#line 1911 "grammar.y"
+    {
+				if (!errcnt) {
+				    push(stkop((yyvsp[(1) - (1)]))) ; 
+				    ncaseval++;
+				}
+			}
+    break;
+
+  case 250:
+#line 1931 "grammar.y"
+    {
+			int  dim, d, i1, i2, mode;
+
+			/*  In command arguments, when not in parentheses
+			 *  we just pass the param as a string constant.
+			 */
+			if (!errcnt) {
+			    lastref = NO;
+			    if (!inarglist || parenlevel) {
+				i_oarr = 0;
+				index_cnt = 0;
+
+				strncpy (curr_param, stkop((yyvsp[(1) - (1)]))->o_val.v_s, 
+					SZ_FNAME);
+
+				/* If a '.' is found in the name we have a 
+				 * reference to an external task, or to a 
+				 * specific field.  In these cases we don't 
+				 * want implicit looping.
+				 */
+				if (index (curr_param, '.') == NULL) {
+				    if ((dim = get_dim (curr_param)) > 0) {
+					lastref = YES;
+			        	for (d = 0; d < dim; d++) {
+					    getlimits (curr_param, d, &i1, &i2);
+					    mode = make_imloop (i1, i2);
+					    if (mode)
+						compile (PUSHINDEX, -1);
+					    else
+						push (compile(PUSHINDEX, 0));	
+					}
+			    		n_oarr = dim;
+				    }
+				}
+			    }
+			}
+		}
+    break;
+
+  case 251:
+#line 1968 "grammar.y"
+    {
+		    if (!errcnt) {
+			strncpy (curr_param, stkop((yyvsp[(1) - (1)]))->o_val.v_s, SZ_FNAME);
+			index_cnt = 0;
+		    }
+		}
+    break;
+
+  case 252:
+#line 1975 "grammar.y"
+    {
+		    if (i_oarr > 0  &&  n_oarr == 0)
+			n_oarr = i_oarr;
+		    i_oarr = 0;
+		    lastref = YES;
+		}
+    break;
+
+  case 253:
+#line 1983 "grammar.y"
+    {
+			index_cnt = 1;
+		}
+    break;
+
+  case 254:
+#line 1986 "grammar.y"
+    {
+			index_cnt++;
+		}
+    break;
+
+  case 256:
+#line 1992 "grammar.y"
+    {
+			if (!errcnt)
+			    compile (PUSHINDEX, 0);
+		}
+    break;
+
+  case 257:
+#line 1997 "grammar.y"
+    { 
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop((yyvsp[(1) - (1)]))->o_val.v_s);
+			    compile (PUSHINDEX, 0);
+			}
+		}
+    break;
+
+  case 258:
+#line 2003 "grammar.y"
+    {
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (index(curr_param, '.') != NULL) {
+				errmsg = exlimits;
+				EYYERROR;
+			    }
+			    if (getlimits (curr_param, index_cnt, &i1, &i2) 
+				== ERR) {
+				eprintf ("Implicit index error for %s.\n",
+					curr_param);
+				EYYERROR;
+			    }
+			    mode = make_imloop (i1, i2);
+			    if (mode)
+				compile (PUSHINDEX, mode);
+			    else
+				push (compile (PUSHINDEX, mode));
+			}
+		}
+    break;
+
+  case 259:
+#line 2024 "grammar.y"
+    {
+			/*  There is an ambiguity in the grammar between
+			 *  sexagesimal constants, and array range references.
+			 *  Since the sexagesimal constants are recognized
+			 *  in the lexical analyzer we can't just change the
+			 *  grammar.  The kludge around this is to have
+			 *  makeop set a flag telling us that the last
+			 *  constant it compiled COULD have been an index
+			 *  range.  We check the flag here and if it is
+			 *  set we convert back and compile an implicit loop
+			 *  otherwise we just push the constant.
+			 */
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (maybeindex) {
+				sexa_to_index (stkop((yyvsp[(1) - (1)]))->o_val.v_r, &i1, &i2);
+				mode = make_imloop (i1, i2);
+				if (mode)
+				    compile (PUSHINDEX, mode);
+				else
+				    push (compile (PUSHINDEX, mode));
+			    } else {
+				compile (PUSHCONST, stkop((yyvsp[(1) - (1)])));
+				compile (PUSHINDEX, 0);
+			    }
+			}
+		}
+    break;
+
+  case 260:
+#line 2058 "grammar.y"
+    {
+		    (yyval) = (yyvsp[(1) - (1)]);
+		}
+    break;
+
+  case 261:
+#line 2063 "grammar.y"
+    {
+		    (yyval) = (yyvsp[(1) - (1)]);
+		}
+    break;
+
+  case 262:
+#line 2068 "grammar.y"
+    {
+		    (yyval) = (yyvsp[(1) - (1)]);
+		}
+    break;
+
+  case 264:
+#line 2074 "grammar.y"
+    {
+		    /* If statements are delimited by ';'s, do not execute
+		     * until next newline EOST is received.
+		     */
+		    sawnl = 0;
+		}
+    break;
+
+  case 270:
+#line 2096 "grammar.y"
+    { parenlevel++; }
+    break;
+
+  case 271:
+#line 2099 "grammar.y"
+    { --parenlevel; }
+    break;
+
+  case 272:
+#line 2102 "grammar.y"
+    { sawnl = 1; }
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 4426 "y.tab.c"
+      default: break;
+    }
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+#line 2105 "grammar.y"
+
+
+#include "lexyy.c"
+#include "lexicon.c"
+
diff --git a/pkg/vocl/ytab.h b/pkg/vocl/ytab.h
new file mode 100644
index 00000000..fb000fb7
--- /dev/null
+++ b/pkg/vocl/ytab.h
@@ -0,0 +1,171 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton interface for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     Y_SCAN = 258,
+     Y_SCANF = 259,
+     Y_FSCAN = 260,
+     Y_FSCANF = 261,
+     Y_OSESC = 262,
+     Y_APPEND = 263,
+     Y_ALLAPPEND = 264,
+     Y_ALLREDIR = 265,
+     Y_GSREDIR = 266,
+     Y_ALLPIPE = 267,
+     D_D = 268,
+     D_PEEK = 269,
+     Y_NEWLINE = 270,
+     Y_CONSTANT = 271,
+     Y_IDENT = 272,
+     Y_WHILE = 273,
+     Y_IF = 274,
+     Y_ELSE = 275,
+     Y_FOR = 276,
+     Y_BREAK = 277,
+     Y_NEXT = 278,
+     Y_SWITCH = 279,
+     Y_CASE = 280,
+     Y_DEFAULT = 281,
+     Y_RETURN = 282,
+     Y_GOTO = 283,
+     Y_PROCEDURE = 284,
+     Y_BEGIN = 285,
+     Y_END = 286,
+     Y_BOOL = 287,
+     Y_INT = 288,
+     Y_REAL = 289,
+     Y_STRING = 290,
+     Y_FILE = 291,
+     Y_STRUCT = 292,
+     Y_GCUR = 293,
+     Y_IMCUR = 294,
+     Y_UKEY = 295,
+     Y_PSET = 296,
+     Y_IFERR = 297,
+     Y_IFNOERR = 298,
+     Y_THEN = 299,
+     YOP_AOCAT = 300,
+     YOP_AODIV = 301,
+     YOP_AOMUL = 302,
+     YOP_AOSUB = 303,
+     YOP_AOADD = 304,
+     YOP_OR = 305,
+     YOP_AND = 306,
+     YOP_NE = 307,
+     YOP_EQ = 308,
+     YOP_GE = 309,
+     YOP_LE = 310,
+     YOP_CONCAT = 311,
+     UMINUS = 312,
+     YOP_NOT = 313,
+     YOP_POW = 314
+   };
+#endif
+/* Tokens.  */
+#define Y_SCAN 258
+#define Y_SCANF 259
+#define Y_FSCAN 260
+#define Y_FSCANF 261
+#define Y_OSESC 262
+#define Y_APPEND 263
+#define Y_ALLAPPEND 264
+#define Y_ALLREDIR 265
+#define Y_GSREDIR 266
+#define Y_ALLPIPE 267
+#define D_D 268
+#define D_PEEK 269
+#define Y_NEWLINE 270
+#define Y_CONSTANT 271
+#define Y_IDENT 272
+#define Y_WHILE 273
+#define Y_IF 274
+#define Y_ELSE 275
+#define Y_FOR 276
+#define Y_BREAK 277
+#define Y_NEXT 278
+#define Y_SWITCH 279
+#define Y_CASE 280
+#define Y_DEFAULT 281
+#define Y_RETURN 282
+#define Y_GOTO 283
+#define Y_PROCEDURE 284
+#define Y_BEGIN 285
+#define Y_END 286
+#define Y_BOOL 287
+#define Y_INT 288
+#define Y_REAL 289
+#define Y_STRING 290
+#define Y_FILE 291
+#define Y_STRUCT 292
+#define Y_GCUR 293
+#define Y_IMCUR 294
+#define Y_UKEY 295
+#define Y_PSET 296
+#define Y_IFERR 297
+#define Y_IFNOERR 298
+#define Y_THEN 299
+#define YOP_AOCAT 300
+#define YOP_AODIV 301
+#define YOP_AOMUL 302
+#define YOP_AOSUB 303
+#define YOP_AOADD 304
+#define YOP_OR 305
+#define YOP_AND 306
+#define YOP_NE 307
+#define YOP_EQ 308
+#define YOP_GE 309
+#define YOP_LE 310
+#define YOP_CONCAT 311
+#define UMINUS 312
+#define YOP_NOT 313
+#define YOP_POW 314
+
+
+
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef int YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+extern YYSTYPE yylval;
+