Repatch (from linux) of OSX IRAF

29 files changed, 4138 insertions, 0 deletions

diff --git a/sys/nmemio/README b/sys/nmemio/README
new file mode 100644
index 00000000..597f1114
--- /dev/null
+++ b/sys/nmemio/README
@@ -0,0 +1 @@
+MEMIO -- Memory allocation and management facilities.
diff --git a/sys/nmemio/begmem.x b/sys/nmemio/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/nmemio/begmem.x
@@ -0,0 +1,65 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help begmem, fixmem
+.nf ___________________________________________________________________________
+BEGMEM, FIXMEM -- Try to get/release physical memory for a process.  The
+actual amount of physical memory available (in chars) is returned.  On a
+machine with virtual memory, these routines adjust the working set size.
+
+On any machine, BEGMEM may be used to determine the amount of available
+physical memory, to tune algorithms for optimum performance.  BEGMEM returns
+as its function value the actual working set size of the process after
+the adjustment (or the current working set size if "best_size" is zero).
+On some systems this represents a soft limit on the actual amount of memory
+which can be used; it is a guarantee that at least that much space is
+available.  Some systems will allow the actual working set to dynamically
+exceed this value at runtime if the process pages heavily.  The hard limit
+on the working set of a process is given by the "max_size" parameter.
+
+Note that the working set must include space not only for a task specific
+data buffers, but also for all other process data buffers and for the text
+(instruction space) of the code being executed.  There is no easy way to
+determine this, hence the application is expected to estimate it.  A typical
+value for the base text+data size required to execute a program is 150Kb.
+.endhelp ______________________________________________________________________
+
+
+# BEGMEM -- Attempt to the adjust the amount of physical memory allocated
+# to a process.  Save the old memory size in OLD_SIZE, so that memory may
+# later be restored with FIXMEM.  The new working set size is returned as
+# the function value and the hard limit on the working set size is returned
+# in MAX_SIZE.  In general, the process can be expected to page, possibly
+# heavily, or swap out if the working set size is exceeded.  All sizes are
+# returned in SPP chars.  If BEST_SIZE is zero the working set size is not
+# changed, i.e., the current working set parameters are returned.
+
+int procedure begmem (best_size, old_size, max_size)
+
+int	best_size		# desired working set size
+int	old_size		# former working set size
+int	max_size		# max physical memory available to this process
+
+int	new_size
+
+begin
+	call zawset (best_size * SZB_CHAR, new_size, old_size, max_size)
+	new_size = new_size / SZB_CHAR
+	old_size = old_size / SZB_CHAR
+	max_size = max_size / SZB_CHAR
+
+	return (new_size)
+end
+
+
+# FIXMEM -- Restore the original working set size.
+
+procedure fixmem (old_size)
+
+int	old_size
+int	j1, j2, j3
+
+begin
+	call zawset (old_size * SZB_CHAR, j1, j2, j3)
+end
diff --git a/sys/nmemio/calloc.x b/sys/nmemio/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/nmemio/calloc.x
@@ -0,0 +1,20 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# CALLOC -- Allocate and zero a block of memory.
+
+procedure calloc (ubufp, buflen, dtype)
+
+pointer	ubufp			# user buffer pointer [OUTPUT]
+int	buflen			# nelements of space required,
+int	dtype		# of this data type
+
+pointer	char_ptr
+pointer	coerce()
+int	sizeof()
+errchk	malloc
+
+begin
+	call malloc (ubufp, buflen, dtype)
+	char_ptr = coerce (ubufp, dtype, TY_CHAR)
+	call aclrc (Memc[char_ptr], buflen * sizeof (dtype))
+end
diff --git a/sys/nmemio/coerce.x b/sys/nmemio/coerce.x
new file mode 100644
index 00000000..36f762b2
--- /dev/null
+++ b/sys/nmemio/coerce.x
@@ -0,0 +1,25 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# COERCE -- Coerce a pointer from one datatype to another, choosing the
+# next larger element for t2 in the event that t1 is not aligned with t2.
+
+pointer procedure coerce (ptr, type1, type2)
+
+pointer	ptr				# input pointer
+int	type1, type2			# from, to data types
+int	n
+pointer	p
+include	<szdtype.inc>
+
+begin
+	p = ptr - 1
+	if (type1 == TY_CHAR) {
+	    return (p / ty_size[type2] + 1)
+	} else if (type2 == TY_CHAR) {
+	    return (p * ty_size[type1] + 1)
+	} else {
+	    p = p * ty_size[type1]				# ptr to char
+	    n = ty_size[type2]
+	    return (((p + n-1) / n) + 1)
+	}
+end
diff --git a/sys/nmemio/doc/memio.hlp b/sys/nmemio/doc/memio.hlp
new file mode 100644
index 00000000..1bc5c0a0
--- /dev/null
+++ b/sys/nmemio/doc/memio.hlp
@@ -0,0 +1,308 @@
+.help memio Feb83 "Dynamic Memory Management Routines"
+.sh
+Introduction
+
+    The memory management routines manage both a stack and a heap.
+Storage for the stack may be fragmented, and chunks of stack storage are
+allocated dynamically from the heap as needed.  Programs may allocate
+heap storage directly if desired, for large or semipermanent buffers.
+Stack storage is intended for use with small buffers, where the overhead
+of allocating and deallocating space must be kept to a minimum.
+
+
+.ks
+.nf
+heap routines:
+
+	malloc  (ptr, number_of_elements, data_type)
+	calloc  (ptr, number_of_elements, data_type)
+	realloc (ptr, number_of_elements, data_type)
+	mfree   (ptr, data_type)
+
+
+stack routines:
+
+	salloc  (ptr, number_of_elements, data_type)
+	smark   (ptr)
+	sfree   (ptr)
+.fi
+.ke
+
+
+MALLOC allocates space on the heap.  CALLOC does the same, and fills the buffer
+with zeroes.  REALLOC is used to change the size of a previously allocated
+buffer, copying the contents of the buffer if necessary.  MFREE frees space
+allocated by a prior call to MALLOC, CALLOC, or REALLOC.
+
+Space is allocated on the stack with SALLOC.  SMARK should be called before
+SALLOC, to mark the position of the stack pointer.  SFREE returns all space
+allocated on the stack since the matching call to SMARK.
+
+
+.KS
+Example:
+.nf
+	pointer	buf, sp
+
+	begin
+		call smark (sp)
+		call salloc (buf, SZ_BUF, TY_CHAR)
+		while (getline (fd, Memc[buf]) != EOF) {
+		    (code to use buffer ...)
+		}
+		call sfree (sp)
+.fi
+.KE
+
+
+These routines will generate an error abort if memory cannot be allocated
+for some reason.
+
+.sh
+Heap Management
+
+    Since many operating systems provide heap management facilities,
+MALLOC and MFREE consist of little more than calls to Z routines to
+allocate and free blocks of memory.  The main function of MALLOC is
+to convert the physical buffer address returned by the Z routine into
+a pointer of the requested type.
+
+The pointer returned to the calling routine does not point at the beginning
+of the physical buffer, but at a location a few bytes into the buffer.
+The physical address of the buffer is stored in the buffer, immediately
+before the cell pointed to by the pointer returned by MALLOC.  The
+stored address must be intact when MFREE is later called to deallocate
+the buffer, or a "Memory corrupted" error diagnostic will result.
+
+The Z routines required to manage the heap are the following:
+
+.KS
+.nf
+	 zmget (bufadr, nbytes)
+	zmrget (bufadr, nbytes)
+	zmfree (buf_addr)
+.fi
+.KE
+
+The "get" routines should return NULL as the buffer address if space
+cannot be allocated for some reason.
+
+.sh
+Stack Management
+
+    The heap management routines have quite a bit of overhead associated
+with them, which precludes their use in certain applications.  In addition,
+the heap can be most efficiently managed when it contains few buffers.
+The stack provides an efficient mechanism for parceling out small amounts
+of storage, which can later all be freed with a single call.
+
+The main use of the stack is to provide automatic storage for local 
+arrays in procedures.  The preprocessor compiles code which makes calls
+to the stack management routines whenever an array is declared with the
+storage calls AUTO, or whenever the ALLOC statement is used in a procedure.
+
+
+.KS
+.nf
+	auto	char lbuf[SZ_LINE]
+	real	x[n], y[n]
+	int	n
+
+	begin
+		alloc (x[npix], y[npix])
+
+		while (getline (fd, lbuf) != EOF) {
+		    ...
+.fi
+.KE
+
+
+The AUTO storage class and the ALLOC statement are provided in the full
+preprocessor, but not in the subset preprocessor.  The following subset
+preprocessor code is functionally equivalent to the code show above:
+
+
+.KS
+.nf
+	pointer	lbuf, x, y, sp
+	int	n, getline()
+
+	begin
+		call smark (sp)
+		call salloc (lbuf, SZ_LINE, TY_CHAR)
+		n = npix
+		call salloc (x, n, TY_REAL)
+		call salloc (y, n, TY_REAL)
+
+		while (getline (fd, Memc[lbuf]) != EOF) {
+		    ...
+
+		call sfree (sp)
+.fi
+.KE
+
+.sh
+Semicode for Stack Management
+
+    At any given time, the "stack" is a contiguous buffer of a certain size.
+Stack overflow is handled by calling MALLOC to allocate another stack segment.
+A pointer to the previous stack segment is kept in each new stack segment,
+to permit reclamation of stack space.
+
+
+
+
+.KS
+.nf
+		salloc             smark              sfree
+
+
+
+	    stack_overflow 
+
+
+	
+		malloc            realloc             mfree
+
+
+
+		zmget              zmrget             zmfree
+
+
+
+		Structure of the Memory Management Routines
+.fi
+.KE
+
+
+
+
+.tp 5
+.nf
+procedure salloc (bufptr, nelements, data_type)
+
+bufptr:		upon output, contains pointer to the allocated space
+nelements:	number of elements of space to be allocated
+data_type:	data type of the elements and of the buffer pointer
+
+begin
+	# align stack pointer for the specified data type,
+	# compute amount of storage to be allocated
+
+	if (data_type == TY_CHAR)
+	    nchars = nelements
+	else {
+	    sp = sp + mod (sp-1, sizeof(data_type))
+	    nchars = nelements * sizeof(data_type)
+	}
+
+	if (sp + nchars > stack_top)		# see if room
+	    call stack_overflow (nchars)
+
+	if (data_type == TY_CHAR)		# return pointer
+	    bufptr = sp
+	else
+	    bufptr = (sp-1) / sizeof(data_type) + 1
+
+	sp = sp + nchars			# bump stack ptr
+	return
+end
+
+
+
+
+.tp 5
+procedure sfree (old_sp)			# pop the stack
+
+begin
+	# return entire segments until segment containing the old
+	# stack pointer is reached
+
+	while (old_sp < stack_base || old_sp > stack_top) {
+	    if (this is the first stack segment)
+		fatal error, invalid value for old_sp
+	    stack_base = old_segment.stack_base
+	    stack_top = old_segment.stack_top
+	    mfree (segment_pointer, TY_CHAR)
+	    segment_pointer = old_segment
+	}
+
+	sp = old_sp
+end
+
+
+
+
+.tp 5
+procedure smark (old_sp)			# save stack pointer
+
+begin
+	old_sp = sp
+end
+
+
+
+
+.tp 5
+procedure stack_overflow (nchars_needed)	# increase stk size
+
+begin
+	# allocate storage for new segment
+	segment_size = max (SZ_STACK, nchars_needed + SZ_STKHDR)
+	malloc (new_segment, segment_size, TY_CHAR)
+
+	# initialize header for the new segment
+	new_segment.old_segment = segment_pointer
+	new_segment.stack_base = new_segment + SZ_STKHDR
+	new_segment.stack_top = new_segment + segment_size
+
+	# make new segment the current segment
+	segment_pointer = new_segment
+	stack_base = new_segment.stack_base
+	stack_top = new_segment.stack_top
+	sp = stack_base
+end
+
+
+.fi
+The segment header contains fields describing the location and size of
+the segment, plus a link pointer to the previous segment in the list.
+
+
+.KS
+.nf
+	struct stack_header {
+		char	*stack_base
+		char	*stack_top
+		struct	stack_header *old_segment
+	}
+.fi
+.KE
+
+.sh
+Pointers and Addresses
+
+    Pointers are indices into (one indexed) Fortran arrays.  A pointer to
+an object of one datatype will in general have a different value than a
+pointer to an object of a different datatype, even if the objects are stored
+at the same physical address.  Pointers have strict alignment requirements,
+and it is not always possible to coerce the type of a pointer.  For this
+reason, the pointers returned by MALLOC and SALLOC are always aligned for
+all data types, regardless of the data type requested.
+
+The IRAF system code must occasionally manipulate and store true physical
+addresses, obtained with the function LOC.  The problem with physical
+addresses is that they are unsigned integers, but Fortran does not provide
+any unsigned data types.  Thus, comparisons of addresses are difficult
+in Fortran.
+
+A second LOC primitive is provided for use in routines which must compare
+addresses.  LOCC returns the address of the object passed as argument,
+right shifted to the size of a CHAR.  Thus, the difference between LOCC(a[1])
+and LOCC(a[n]) is the size of the N element array A in chars.
+
+The relationship between chars, bytes, and machine addresses is machine
+dependent.  Bytes seem to be the smallest units.  Some machines are byte
+addressable, others are word addressable.  The size of a CHAR in machine
+bytes is given by the constant SZB_CHAR.  The size of a machine word in
+machine bytes is given by the constant SZB_WORD.
diff --git a/sys/nmemio/kmalloc.x b/sys/nmemio/kmalloc.x
new file mode 100644
index 00000000..7bfc4ee0
--- /dev/null
+++ b/sys/nmemio/kmalloc.x
@@ -0,0 +1,21 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+
+# KMALLOC -- Allocate space on the heap.  Equivalent to MALLOC, except that a
+# memory allocation failure is indicated by returning ERR as the function value.
+
+int procedure kmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align))
+end
diff --git a/sys/nmemio/krealloc.x b/sys/nmemio/krealloc.x
new file mode 100644
index 00000000..be080547
--- /dev/null
+++ b/sys/nmemio/krealloc.x
@@ -0,0 +1,110 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<config.h>
+include	<syserr.h>
+
+# KREALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.  This routine is equivalent to REALLOC except that it
+# merely returns ERR as the function value if an error occurs.
+# 
+# Buffer reallocation or resizing can always be implemented by allocating a new
+# buffer, copying the contents of the old buffer to the new buffer, and then
+# deleting the old buffer.  Nonetheless we use a OS entry point to do the actual
+# reallocation, because often it will be possible to change the size of a buffer
+# without moving it, particularly when decreasing the size of the buffer.
+# 
+# Allowing the OS to move a buffer causes problems due to the difference in
+# alignment criteria imposed by the IRAF pointer scheme, which enforces
+# stringent alignment criteria, versus OS memory allocation schemes which
+# typically only align on word or longword boundaries.  Therefore we must
+# check the offset of the data area after reallocation, possibly shifting
+# the contents of data area up or down a few chars to reestablish alignment
+# with Mem.
+
+int procedure krealloc (ptr, a_nelems, a_dtype)
+
+pointer	ptr			# buffer to be reallocated
+int	a_nelems		# new size of buffer
+int	a_dtype			# buffer datatype
+
+pointer	dataptr
+int	nelems, dtype, nchars, nuser, old_fwa, new_fwa
+int	char_shift, old_char_offset, new_char_offset
+int	status, locbuf, loc_Mem
+
+int	mgtfwa(), sizeof(), kmalloc()
+pointer	mgdptr(), msvfwa(), coerce()
+data	loc_Mem /NULL/
+
+begin
+	# Copy over the number of elements and the data type in case they are
+	# located in the block of memory we are reallocating.
+
+	nelems = a_nelems
+	dtype  = a_dtype
+
+	if (ptr == NULL) {
+	    return (kmalloc (ptr, nelems, dtype))
+
+	} else {
+	    if (dtype == TY_CHAR)
+		nuser = nelems + 1
+	    else
+		nuser = nelems * sizeof(dtype) + 1
+
+	    nchars = nuser + (8 * SZ_INT) + SZ_MEMALIGN
+	    old_fwa = mgtfwa (ptr, dtype)
+	    new_fwa = old_fwa
+
+	    # Change the buffer size; any error is fatal.
+	    call zraloc (new_fwa, nchars * SZB_CHAR,  status)
+	    if (status == ERR) {
+		call merror ("Realloc failed\n")
+		ptr = NULL
+		return (ERR)
+	    }
+
+	    # Compute the char offset of the old data area within the original
+	    # buffer; zraloc() guarantees that the old data will have the same
+	    # offset in the new buffer.  Compute the char offset of the new
+	    # data area.  These need not be the same due to the OS allocating
+	    # the new buffer to alignment criteria less than those required
+	    # by MEMIO.
+
+	    call zlocva (Memc[coerce(ptr,dtype,TY_CHAR)], locbuf)
+	    old_char_offset = (locbuf - old_fwa)
+
+	    # We must compute a pointer to the data area within the new
+	    # buffer before we can compute the char offset of the new data
+	    # area within the new buffer.
+
+	    if (loc_Mem == NULL)
+		call zlocva (Memc, loc_Mem)
+
+	    dataptr = mgdptr (new_fwa, TY_CHAR, SZ_MEMALIGN, loc_Mem)
+	    call zlocva (Memc[dataptr], locbuf)
+	    new_char_offset = (locbuf - new_fwa)
+
+	    # Shift the old data to satisfy the new alignment criteria,
+	    # if necessary.  
+	    # 
+	    # FIXME -- If the new alloation is smaller than the old pointer,
+	    # 	       we should only copy as much data as will fit in the
+	    #	       new space as per normal unix handling.
+
+	    char_shift = (new_char_offset - old_char_offset)
+	    if (char_shift != 0) {
+		call amovc (Memc[dataptr - char_shift], Memc[dataptr],
+		    nelems * sizeof(dtype))
+	    }
+
+	    # Save the fwa of the OS buffer in the buffer header, and return
+	    # new pointer to user.
+
+	    ptr = msvfwa (new_fwa, dtype, nelems, SZ_MEMALIGN, loc_Mem)
+	}
+
+	return (OK)
+end
diff --git a/sys/nmemio/main.x b/sys/nmemio/main.x
new file mode 100644
index 00000000..653023ed
--- /dev/null
+++ b/sys/nmemio/main.x
@@ -0,0 +1,893 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<error.h>
+include	<syserr.h>
+include	<clset.h>
+include	<fset.h>
+include	<ctype.h>
+include	<printf.h>
+include	<xwhen.h>
+include	<knet.h>
+
+.help iraf_main
+.nf __________________________________________________________________________
+The IRAF MAIN
+
+    Task resident interpreter for interface to CL.  Supervises process startup
+and shutdown, error restart, and task execution.  A process may contain any
+number of tasks, which need not be related.  The iraf main allows a process to
+be run either directly (interactively or in batch) or from the CL.  A brief
+description of the operation of the Main is given here; additional documentation
+is given in the System Interface Reference Manual.
+
+
+EXECUTION
+
+[1] The process containing the IRAF Main is run.  The PROCESS MAIN, a machine
+    dependent code segment, gains control initially.  The process main
+    determines whether the task is being run from as a connected subprocess,
+    as a detached process, or as a host process, and opens the process
+    standard i/o channels.  The process main then calls the IRAF Main, i.e., us.
+
+[2] The IRAF Main performs the initialization associated with process startup
+    and then enters the interpreter loop waiting for a command.  A number of
+    special commands are implemented, e.g.:
+
+	?		print menu
+	bye		shutdown process
+	chdir		change directory
+	set		set environment variable or variables
+
+    Any other command is assumed to be the name of a task.  The syntax of a
+    task invocation statement is as follows:
+
+	[$]task [<[fname]], ([[stream[(T|B)]]>[fname]])|([[stream]>>[fname]])
+
+    Everything but the task name is optional.  A leading $ enables printing of
+    the cpu time and clock time consumed by the process at termination.  Any
+    combination of the standard i/o streams may be redirected on the command
+    line into a file.  If the stream is redirected at the CL level redirection
+    is shown on the command line but the filename is omitted.
+
+[3] The communications protocol during task execution varies depending on
+    whether or not we are talking to the CL.  If talking directly to the user,
+    the interpreter generates a prompt, and the standard input and output is
+    not blocked into XMIT and XFER commands.  Interactive parameter requests
+    have the form "paramname: response" while CL/IPC requests have the form
+    "paramname=\nresponse", where "response" is the value entered by the user.
+
+[4] Task termination is indicated in interactive mode by generation of a prompt
+    for the next command and in CL/IPC mode by transmission of the command
+    "bye" to the parent process.  If a task terminates abnormally the command
+    "error" is sent to the parent process or the terminal, and the Main reenters
+    the interpreter loop.
+
+A unique SYS_RUNTASK procedure is generated for each process at compile time by
+performing string substitution on a TASK statement appearing in the source code.
+The SYS_RUNTASK procedure contains the task dictionary, CALL statements for
+each task, plus the special task "?".  The main itself, i.e. this file, is a
+precompiled library procedure which has no direct knowledge of the commands
+to be run.
+
+
+ERROR RECOVERY
+
+    If a task terminates abnormally two things can happen: [1] a panic abort
+occurs, causing immediate shutdown of the process (rare), or [2] the IRAF Main
+is reentered at the ZSVJMP statement by a corresponding call to ZDOJMP from
+elsewhere in the system, e.g., ERRACT in the error handling code.
+
+Error restart consists of the following steps:
+
+    (1) The IRAF main is reentered at the point just after the ZDOJMP statement,
+	with a nonzero error code identifying the error in STATUS.
+    (2) The main performs error recovery, cleaning up the files system (deleting
+	NEW_FILES and TEMP_FILES), clearing the stack, and calling any
+	procedures posted with ONERROR.  At present the error recovery code does
+	not free heap buffers or clear posted exception handlers.
+    (3) The ERROR statement is sent to the CL.  An example of the
+	error statment is "ERROR (501, "Access Violation")".
+    (4) The main reenters the interpreter loop awaiting the next command from
+	the CL.
+
+Any error occuring during error restart is fatal and results in immediate
+process termination, usually with a panic error message.  This is necessary
+to prevent infinite error recursion.
+
+
+SHUTDOWN
+
+    The process does not shutdown when interrupted by the CL or during error
+recovery, unless a panic occurs.  In normal operation shutdown only occurs when
+the command BYE is received from the parennt process, or when EOF is read from
+the process standard input.  Procedures posted during execution with ONEXIT 
+will be called during process shutdown.  Any error occuring while executing
+an ONEXIT procedure is fatal and will result in a panic abort of the process.
+.endhelp _____________________________________________________________________
+
+define	SZ_VALSTR		SZ_COMMAND
+define	SZ_CMDBUF		(SZ_COMMAND+1024)
+define	SZ_TASKNAME		32
+define	TIMEIT_CHAR		'$'
+define	MAXFD			5		# max redirectable fd's
+define	STARTUP			0		# stages of execution
+define	SHUTDOWN		1
+define	IDLE			2
+define	EXECUTING		3
+define	DUMMY			finit		# any procedure will do
+
+
+# IRAF_MAIN -- Execute commands read from the standard input until the special
+# command "bye" is received, initiating process shutdown.  The arguments tell
+# the process type (connected, detached, or host) and identify the process
+# standard i/o channels and device driver to be used.
+
+int procedure iraf_main (a_cmd, a_inchan, a_outchan, a_errchan,
+	a_driver, a_devtype, prtype, bkgfile, jobcode, sys_runtask, onentry)
+
+char	a_cmd[ARB]		# command to be executed or null string
+int	a_inchan		# process standard input
+int	a_outchan		# process standard output
+int	a_errchan		# process standard error output
+int	a_driver		# ZLOCPR address of device driver
+int	a_devtype		# device type (text or binary)
+int	prtype			# process type (connected, detached, host)
+char	bkgfile[ARB]		# packed filename of bkg file if detached
+int	jobcode			# jobcode if detached process
+extern	sys_runtask()		# client task execution procedure
+extern	onentry()		# client onentry procedure
+
+bool	networking
+int	inchan, outchan, errchan, driver, devtype
+char	cmd[SZ_CMDBUF], taskname[SZ_TASKNAME], bkgfname[SZ_FNAME]
+int	arglist_offset, timeit, junk, interactive, builtin_task, cmdin
+int	jumpbuf[LEN_JUMPBUF], status, errstat, state, interpret, i
+long	save_time[2]
+pointer	sp
+
+bool	streq()
+extern	DUMMY()
+int	sys_getcommand(), sys_runtask(), oscmd()
+int	access(), envscan(), onentry(), stropen()
+errchk	xonerror, fio_cleanup
+common	/JUMPCOM/ jumpbuf
+string	nullfile "dev$null"
+data	networking /KNET/
+define	shutdown_ 91
+
+# The following common is required on VMS systems to defeat the Fortran
+# optimizer, which would otherwise produce optimizations that would cause
+# a future return from ZSVJMP to fail.  Beware that this trick may fail on
+# other systems with clever optimizers.
+
+common	/zzfakecom/ state
+
+begin
+	# The following initialization code is executed upon process
+	# startup only.
+
+	errstat = OK
+	state = STARTUP
+	call mio_init()
+	call zsvjmp (jumpbuf, status)
+	if (status != OK)
+	    call sys_panic (EA_FATAL, "fatal error during process startup")
+
+	# Install the standard exception handlers, but if we are a connected
+	# subprocess do not enable interrupts until process startup has
+	# completed.
+
+	call ma_ideh()
+	if (prtype == PR_CONNECTED)
+	    call intr_disable()
+
+	inchan  = a_inchan
+	outchan = a_outchan
+	errchan = a_errchan
+	driver  = a_driver
+	devtype = a_devtype
+
+	# If the system is configured with networking initialize the network
+	# interface and convert the input channel codes and device driver
+	# code to their network equivalents.
+
+	if (networking)
+	    call ki_init (inchan, outchan, errchan, driver, devtype)
+
+	# Other initializations.
+	call env_init()
+	call fmt_init (FMT_INITIALIZE)			# init printf
+	call xer_reset()				# init error checking
+	call erract (OK)				# init error handling
+	call onerror (DUMMY)				# init onerror
+	call onexit  (DUMMY)				# init onexit 
+	call finit()					# initialize FIO
+	call clopen (inchan, outchan, errchan, driver, devtype)
+	call clseti (CL_PRTYPE, prtype)
+	call clc_init()					# init param cache
+	call strupk (bkgfile, bkgfname, SZ_FNAME)
+
+	# If we are running as a host process (no IRAF parent process) look
+	# for the file "zzsetenv.def" in the current directory and then in
+	# the system library, and initialize the environment from this file
+	# if found.  This works because the variable "iraf$" is defined at
+	# the ZGTENV level.
+
+	interactive = NO
+	if (prtype == PR_HOST) {
+	    interactive = YES
+	    if (access ("zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @zzsetenv.def"))
+		    ;
+	    } else if (access ("host$hlib/zzsetenv.def",0,0) == YES) {
+		iferr (junk = envscan ("set @host$hlib/zzsetenv.def"))
+		    ;
+	    }
+	}
+
+	# Save context for error restart.  If an error occurs execution
+	# resumes just past the ZSVJMP statement with a nonzero status.
+
+	call smark (sp)
+	call zsvjmp (jumpbuf, status)
+
+	if (status != OK) {
+	    errstat = status
+
+	    # Give up if error occurs during shutdown.
+	    if (state == SHUTDOWN)
+		call sys_panic (errstat, "fatal error during process shutdown")
+
+	    # Tell error handling package that an error restart is in
+	    # progress (necessary to avoid recursion).
+
+	    call erract (EA_RESTART)
+
+	    iferr {
+		# Call user cleanup routines and then clean up files system.
+		# Make sure that user cleanup routines are called FIRST.
+
+		call xonerror (status)
+		call ma_ideh()
+		call flush (STDERR)
+		do i = CLIN, STDPLOT
+		    call fseti (i, F_CANCEL, OK)
+		call fio_cleanup (status)
+		call fmt_init (FMT_INITIALIZE)
+		call sfree (sp)
+	    } then
+		call erract (EA_FATAL)			# panic abort
+
+	    # Send ERROR statement to the CL, telling the CL that the task
+	    # has terminated abnormally.  The CL will either kill us, resulting
+	    # in error restart with status=SYS_XINT, or send us another command
+	    # to execute.  If we are connected but idle, do not send the ERROR
+	    # statement because the CL will not read it until it executes the
+	    # next task (which it will then mistakenly think has aborted).
+
+	    if (!(prtype == PR_CONNECTED && state == IDLE))
+		call xer_send_error_statement_to_cl (status)
+
+	    # Inform error handling code that error restart has completed,
+	    # or next error call will result in a panic shutdown.
+
+	    call erract (OK)
+	    call xer_reset ()
+	    status = OK
+	}
+
+	# During process startup and shutdown the parent is not listening to
+	# us, hence we dump STDOUT and STDERR into the null file.  If this is
+	# not done and we write to CLOUT, deadlock may occur.  During startup
+	# we also call the ONENTRY procedure.  This is a no-op for connected
+	# and host subprocesses unless a special procedure is linked by the
+	# user (for detached processes the standard ONENTRY procedure opens
+	# the bkgfile as CLIN).  The return value of ONENTRY determines whether
+	# the interpreter loop is entered.  Note that ONENTRY permits complete
+	# bypass of the standard interpreter loop by an application (e.g. the
+	# IRAF CL).
+
+	if (state == STARTUP) {
+	    # Redirect stderr and stdout to the null file.
+	    if (prtype == PR_CONNECTED) {
+		call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+		call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	    }
+
+	    # Call the custom or default ONENTRY procedure.  The lowest bit
+	    # of the return value contains the PR_EXIT/PR_NOEXIT flag, higher
+	    # bits may contain a more meaningful 7-bit status code which will
+	    # be returned to the shell.
+
+	    i = onentry (prtype, bkgfname, a_cmd)
+	    if (mod(i, 2) == PR_EXIT) {
+		interpret = NO
+		errstat = i / 2
+		goto shutdown_
+	    } else
+		interpret = YES
+
+	    # Open the command input stream.  If a command string was given on
+	    # the command line then we read commands from that, otherwise we
+	    # take commands from CLIN.
+
+	    for (i=1;  IS_WHITE(a_cmd[i]) || a_cmd[i] == '\n';  i=i+1)
+		;
+	    if (a_cmd[i] != EOS) {
+		cmdin = stropen (a_cmd, ARB, READ_ONLY)
+		call fseti (cmdin, F_KEEP, YES)
+		interpret = NO
+		interactive = NO
+	    } else
+		cmdin = CLIN
+	}
+
+	# Interpreter loop of the IRAF Main.  Execute named tasks until the
+	# command "bye" is received, or EOF is read on the process standard
+	# input (CLIN).  Prompts and other perturbations in the CL/IPC protocol
+	# are generated if we are being run directly as a host process.
+
+	while (sys_getcommand (cmdin, cmd, taskname, arglist_offset,
+	    timeit, prtype) != EOF) {
+
+	    builtin_task = NO
+	    if (streq (taskname, "bye")) {
+		# Initiate process shutdown.
+		break
+	    } else if (streq (taskname, "set") || streq (taskname, "reset")) {
+		builtin_task = YES
+	    } else if (streq (taskname, "cd")  || streq (taskname, "chdir")) {
+		builtin_task = YES
+	    } else if (prtype == PR_CONNECTED && streq (taskname, "_go_")) {
+		# Restore the normal standard output streams, following
+		# completion of process startup.  Reenable interrupts.
+		call close (STDOUT)
+		call close (STDERR)
+		call intr_enable()
+		state = IDLE
+		next
+	    } else if (taskname[1] == '!') {
+		# Send a command to the host system.
+		junk = oscmd (cmd[arglist_offset], "", "", "")
+		next
+	    } else
+		state = EXECUTING
+
+	    if (builtin_task == NO) {
+		if (timeit == YES)
+		    call sys_mtime (save_time)
+
+		# Clear the parameter cache.
+		call clc_init()
+
+		# Set the name of the root pset.
+		call clc_newtask (taskname)
+
+		# Process the argument list, consisting of any mixture of
+		# parameter=value directives and i/o redirection directives.
+
+		call sys_scanarglist (cmdin, cmd[arglist_offset])
+	    }
+
+	    # Call sys_runtask (the code for which was generated automatically
+	    # by the preprocessor in place of the TASK statement) to search
+	    # the dictionary and run the named task.
+
+	    errstat = OK
+            call mem_init (taskname)
+	    if (sys_runtask (taskname,cmd,arglist_offset,interactive) == ERR) {
+		call flush (STDOUT)
+		call sprintf (cmd, SZ_CMDBUF,
+		    "ERROR (0, \"Iraf Main: Unknown task name (%s)\")\n")
+		    call pargstr (taskname)
+		call putline (CLOUT, cmd)
+		call flush (CLOUT)
+		state = IDLE
+		next
+	    }
+            call mem_fini (taskname)
+
+	    # Cleanup after successful termination of command.  Flush the
+	    # standard output, cancel any unread standard input so the next
+	    # task won't try to read it, print elapsed time if enabled,
+	    # check for an incorrect error handler, call any user posted
+	    # termination procedures, close open files, close any redirected
+	    # i/o and restore the normal standard i/o streams.
+
+	    if (builtin_task == NO) {
+
+		call flush (STDOUT)
+		call fseti (STDIN, F_CANCEL, OK)
+
+		if (timeit == YES)
+		    call sys_ptime (STDERR, taskname, save_time)
+
+		call xer_verify()
+		call xonerror (OK)
+		call fio_cleanup (OK)
+
+		if (prtype == PR_CONNECTED) {
+		    call putline (CLOUT, "bye\n")
+		    call flush (CLOUT)
+		}
+		if (state != STARTUP)
+		    state = IDLE
+	    }
+	}
+
+	# The interpreter has exited after receipt of "bye" or EOF.  Redirect
+	# stdout and stderr to the null file (since the parent is no longer
+	# listening to us), call the user exit procedures if any, and exit.
+
+shutdown_
+	state = SHUTDOWN
+	if (prtype == PR_CONNECTED) {
+	    call fredir (STDOUT, nullfile, WRITE_ONLY, TEXT_FILE)
+	    call fredir (STDERR, nullfile, WRITE_ONLY, TEXT_FILE)
+	} else if (prtype == PR_HOST && cmd[1] == EOS && interpret == YES) {
+	    call putci (CLOUT, '\n')
+	    call flush (CLOUT)
+	}
+
+	call xonexit (OK)
+	call fio_cleanup (OK)
+	call clclose()
+
+	return (errstat)
+end
+
+
+# SYS_GETCOMMAND -- Get the next command from the input file.  Ignore blank
+# lines and comment lines.  Parse the command and return the components as
+# output arguments.  EOF is returned as the function value when eof file is
+# reached on the input file.
+
+int procedure sys_getcommand (fd, cmd, taskname, arglist_offset, timeit, prtype)
+
+int	fd			#I command input file
+char	cmd[SZ_CMDBUF]		#O command line
+char	taskname[SZ_TASKNAME]	#O extracted taskname, lower case
+int	arglist_offset		#O offset into CMD of first argument
+int	timeit			#O if YES, time the command
+int	prtype			#I process type code
+
+int	ip, op
+int	getlline(), stridx()
+
+begin
+	repeat {
+	    # Get command line.  Issue prompt first if process is being run
+	    # interactively.
+
+	    if (prtype == PR_HOST && fd == CLIN) {
+		call putline (CLOUT, "> ")
+		call flush (CLOUT)
+	    }					
+	    if (getlline (fd, cmd, SZ_CMDBUF) == EOF)
+		return (EOF)
+
+	    # Check for timeit character and advance to first character of
+	    # the task name.
+
+	    timeit = NO
+	    for (ip=1;  cmd[ip] != EOS;  ip=ip+1) {
+		if (cmd[ip] == TIMEIT_CHAR && timeit == NO)
+		    timeit = YES
+		else if (!IS_WHITE (cmd[ip]))
+		    break
+	    }
+
+	    # Skip blank lines and comment lines.
+	    switch (cmd[ip]) {
+	    case '#', '\n', EOS:
+		next
+	    case '?', '!':
+		taskname[1] = cmd[ip]
+		taskname[2] = EOS
+		arglist_offset = ip + 1
+		return (OK)
+	    }
+
+	    # Extract task name.
+	    op = 1
+	    while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) {
+		taskname[op] = cmd[ip]
+		ip = ip + 1
+		op = min (SZ_TASKNAME + 1, op + 1)
+	    }
+	    taskname[op] = EOS
+
+	    # Determine index of argument list.
+	    while (IS_WHITE (cmd[ip]))
+		ip = ip + 1
+	    arglist_offset = ip
+
+	    # Get rid of the newline.
+	    for (;  cmd[ip] != EOS;  ip=ip+1)
+		if (cmd[ip] == '\n') {
+		    cmd[ip] = EOS
+		    break
+		}
+
+	    return (OK)
+	}
+end
+
+
+# SYS_SCANARGLIST -- Parse the argument list of a task.  At the level of the
+# iraf main the command syntax is very simple.  There are two types of
+# arguments, parameter assignments (including switches) and i/o redirection
+# directives.  All param assignments are of the form  "param=value",  where
+# PARAM must start with a lower case alpha and where VALUE is either quoted or
+# is delimited by one of the metacharacters [ \t\n<>\\].  A redirection argument
+# is anything which is not a parameter set argument, i.e., any argument which
+# does not start with a lower case alpha.
+
+procedure sys_scanarglist (cmdin, i_args)
+
+int	cmdin			# command input stream
+char	i_args[ARB]		# (first part of) argument list
+
+int	fd
+char	ch
+bool	skip
+pointer	sp, fname, args, ip, op
+int	getlline()
+
+begin
+	call smark (sp)
+	call salloc (args, SZ_CMDBUF, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	call strcpy (i_args, Memc[args], SZ_CMDBUF)
+
+	# Do not skip whitespace for param=value args on the command line.
+	skip = false
+
+	# Inform FIO that all standard i/o streams are unredirected (overridden
+	# below if redirected by an argument).
+
+	for (fd=1;  fd < FIRST_FD;  fd=fd+1)
+	    call fseti (fd, F_REDIR, NO)
+
+	# Process each argument in the argument list.  If the command line ends
+	# with an escaped newline then continuation is assumed.  Arguments are
+	# delimited by whitespace.
+
+	for (ip=args;  Memc[ip] != '\n' && Memc[ip] != EOS;  ) {
+	    # Advance to the next argument.
+	    while (IS_WHITE (Memc[ip]))
+		ip = ip + 1
+
+	    # Check for continuation.
+	    ch = Memc[ip]
+	    if (ch == '\\' && (Memc[ip+1] == '\n' || Memc[ip+1] == EOS)) {
+		if (getlline (cmdin, Memc[args], SZ_CMDBUF) == EOF) {
+		    call sfree (sp)
+		    return
+		}
+		ip = args
+		next
+	    } else if (ch == '\n' || ch == EOS)
+		break
+
+	    # If the argument begins with an alpha, _, or $ (e.g., $nargs)
+	    # then it is a param=value argument, otherwise it must be a redir.
+	    # The form @filename causes param=value pairs to be read from
+	    # the named file.
+
+	    if (ch == '@') {
+		op = fname
+		for (ip=ip+1;  Memc[ip] != EOS;  ip=ip+1)
+		    if (IS_WHITE (Memc[ip]) || Memc[ip] == '\n')
+			break
+		    else if (Memc[ip] == '\\' && Memc[ip+1] == '\n')
+			break
+		    else {
+			Memc[op] = Memc[ip]
+			op = op + 1
+		    }
+		Memc[op] = EOS
+		call sys_getpars (Memc[fname])
+
+	    } else if (IS_ALPHA(ch) || ch == '_' || ch == '$') {
+		call sys_paramset (Memc, ip, skip)
+	    } else
+		call sys_redirect (Memc, ip)
+	}
+
+	call sfree (sp)
+end
+
+
+# SYS_GETPARS -- Read a sequence of param=value parameter assignments from
+# the named file and enter them into the CLIO cache for the task.
+
+procedure sys_getpars (fname)
+
+char	fname			# pset file
+
+bool	skip
+int	lineno, fd
+pointer	sp, lbuf, ip
+int	open(), getlline()
+errchk	open, getlline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_CMDBUF, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	# Skip whitespace for param = value args in a par file.
+	skip = true
+
+	lineno = 0
+	while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) {
+	    lineno = lineno + 1
+	    for (ip=lbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#' || Memc[ip] == '\n')
+		next
+	    iferr (call sys_paramset (Memc, ip, skip)) {
+		for (;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+		    ;
+		Memc[ip] = EOS
+		call eprintf ("Bad param assignment, line %d: `%s'\n")
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# SYS_PARAMSET -- Extract the param and value substrings from a param=value
+# or switch argument and enter them into the CL parameter cache.  (see also
+# clio.clcache).
+
+procedure sys_paramset (args, ip, skip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of argument
+bool	skip			# skip whitespace within "param=value" args
+
+pointer	sp, param, value, op
+int	stridx()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_VALSTR, TY_CHAR)
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) {
+	    Memc[op] = args[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance to the switch character or assignment operator.
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '+':
+	    # Boolean switch "yes".
+	    ip = ip + 1
+	    call strcpy ("yes", Memc[value], SZ_VALSTR)
+	
+	case '-':
+	    # Boolean switch "no".
+	    ip = ip + 1
+	    call strcpy ("no", Memc[value], SZ_VALSTR)
+
+	case '=':
+	    # Extract the value field.  This is either a quoted string or a
+	    # string delimited by any of the metacharacters listed below.
+
+	    ip = ip + 1
+	    if (skip) {
+		while (IS_WHITE (args[ip]))
+		    ip = ip + 1
+	    }
+	    call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR)
+
+	default:
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Enter the param=value pair into the CL parameter cache.
+	call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end
+
+
+# SYS_REDIRECT -- Process a single redirection argument.  The syntax of an
+# argument to redirect the standard input is
+#
+#	< [fname]
+#
+# If the filename is omitted it is understood that STDIN has been redirected
+# in the CL.  The syntax to redirect a standard output stream is
+#
+#	[45678][TB](>|>>)[fname]
+#
+# where [4567] is the FD number of a standard output stream (STDOUT, STDERR,
+# STDGRAPH, STDIMAGE, or STDPLOT), and [TB] indicates if the file is text or
+# binary.  If the stream is redirected at the CL level the output filename
+# will be given as `$', serving only to indicate that the stream is redirected.
+
+procedure sys_redirect (args, ip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of redir arg
+
+pointer	sp, fname
+int	fd, mode, type
+int	ctoi()
+define	badredir_ 91
+errchk	fredir, fseti
+
+begin
+	call smark (sp)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Get number of stream (0 if not given).
+	if (ctoi (args, ip, fd) <= 0)
+	    fd = 0
+
+	# Get file type (optional).
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case 'T', 't':
+	    type = TEXT_FILE
+	    ip = ip + 1
+	case 'B', 'b':
+	    type = BINARY_FILE
+	    ip = ip + 1
+	default:
+	    type = 0
+	}
+
+	# Check for "<", ">", or ">>".
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '<':
+	    ip = ip + 1
+	    mode = READ_ONLY
+	    if (fd == 0)
+		fd = STDIN
+	    else if (fd != STDIN || fd != CLIN)
+		goto badredir_
+
+	case '>':
+	    ip = ip + 1
+	    if (args[ip] == '>') {
+		ip = ip + 1
+		mode = APPEND
+	    } else
+		mode = NEW_FILE
+
+	    if (fd == 0)
+		fd = STDOUT
+	    else {
+		switch (fd) {
+		case CLOUT, STDOUT, STDERR, STDGRAPH, STDIMAGE, STDPLOT:
+		    ;
+		default:
+		    goto badredir_
+		}
+	    }
+
+	default:
+	    # Not a redirection argument.
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Set default file type for given stream if no type specified.
+	if (type == 0)
+	    switch (fd) {
+	    case CLIN, CLOUT, STDIN, STDOUT, STDERR:
+		type = TEXT_FILE
+	    default:
+		type = BINARY_FILE
+	    }
+
+	# Extract the filename, if any.  If the CL has redirected the output
+	# and is merely using the redirection syntax to inform us of this,
+	# the metafilename "$" is given.
+
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+	
+	if (args[ip] == '$') {
+	    Memc[fname] = EOS
+	    ip = ip + 1
+	} else
+	    call sys_gstrarg (args, ip, Memc[fname], SZ_FNAME)
+
+	# At this point we have FD, FNAME, MODE and TYPE.  If no file is
+	# named the stream has already been redirected by the parent and
+	# all we need to is inform FIO that the stream has been redirected.
+	# Otherwise we redirect the stream in the local process.  A locally
+	# redirected stream will be closed and the normal direction restored
+	# during FIO cleanup, at program termination or during error
+	# recovery.
+
+	if (Memc[fname] != EOS)
+	    call fredir (fd, Memc[fname], mode, type)
+	else
+	    call fseti (fd, F_REDIR, YES)
+
+	call sfree (sp)
+	return
+
+badredir_
+	call error (2, "IRAF Main: illegal redirection")
+end
+
+
+# SYS_GSTRARG -- Extract a string field.  This is either a quoted string or a
+# string delimited by any of the metacharacters " \t\n<>\\".
+
+procedure sys_gstrarg (args, ip, outstr, maxch)
+
+char	args[ARB]		# input string
+int	ip			# pointer into input string
+char	outstr[maxch]		# receives string field
+int	maxch
+
+char	delim, ch
+int	op
+int	stridx()
+
+begin
+	op = 1
+	if (args[ip] == '"' || args[ip] == '\'') {
+	    # Quoted value string.
+
+	    delim = args[ip]
+	    for (ip=ip+1;  args[ip] != delim && args[ip] != EOS;  ip=ip+1) {
+		if (args[ip] == '\n') {
+		    break
+		} else if (args[ip] == '\\' && args[ip+1] == delim) {
+		    outstr[op] = delim
+		    op = op + 1
+		    ip = ip + 1
+		} else {
+		    outstr[op] = args[ip]
+		    op = op + 1
+		}
+	    }
+
+	} else {
+	    # Nonquoted value string.
+
+	    for (delim=-1;  args[ip] != EOS;  ip=ip+1) {
+		ch = args[ip]
+		if (ch == '\\' && (args[ip+1] == '\n' || args[ip+1] == EOS))
+		    break
+		else if (stridx (ch, " \t\n<>\\") > 0)
+		    break
+		else {
+		    outstr[op] = ch
+		    op = op + 1
+		}
+	    }
+	}
+
+	outstr[op] = EOS
+	if (args[ip] == delim)
+	    ip = ip + 1
+end
diff --git a/sys/nmemio/malloc.x b/sys/nmemio/malloc.x
new file mode 100644
index 00000000..d5886c36
--- /dev/null
+++ b/sys/nmemio/malloc.x
@@ -0,0 +1,24 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+# MALLOC -- Allocate space on the heap.  An array of at least NELEMS elements
+# of data type DTYPE is allocated, aligned to SZ_MEMALIGN (the biggest type)
+# with the global common Mem.
+
+procedure malloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_MEMALIGN
+	call zlocva (Memc, fwa_align)
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/nmemio/malloc1.x b/sys/nmemio/malloc1.x
new file mode 100644
index 00000000..e5cfd0d3
--- /dev/null
+++ b/sys/nmemio/malloc1.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+.help malloc1
+.nf -------------------------------------------------------------------------
+MEMIO -- Internal data structures.
+
+If "p" is the pointer returned by malloc, the first element of storage is
+referenced by the expression "Mem_[p]", where the underscore is replaced
+by the appropriate type suffix.  A pointer to an object of one data type
+is NOT equivalent to a pointer to another data type, even if both pointers
+reference the same physical address.
+
+The actual physical address of the physical buffer area allocated is stored
+in the integer cell immediately preceeding the buffer returned to the user.
+If this cell is corrupted, the condition will later be detected, and a fatal
+error ("memory corrupted") will result.
+
+For example, for a machine with a 4 byte integer, the first part of the
+buffer area might appear as follows (the first few unused cells may or
+may not be needed to satisfy the alignment criteria):
+
+      offset			allocation
+	
+	0		start of the physical buffer (from zmaloc)
+	1
+	2
+	3
+	4		byte 1 of saved fwa (address of cell 0)
+	5		byte 2	"   "    "
+	6		byte 3	"   "    "
+	7		byte 4	"   "    "
+	8		first cell available to user (maximum alignment)
+
+
+New Scheme allowing for 64-bit architectures(10/15/2009):
+
+      offset			allocation
+	
+	 0		start of the physical buffer (from zmaloc)
+	 0-7		alignment space
+	 8-15		bytes 1-8 of saved fwa (address of cell 0)
+	16-23		Bytes 1-8 of upper sentinal location
+	24-31		Bytes 1-8 of pointer type
+	32-39		Bytes 1-8 of nbytes of storage
+	40-47		Bytes 1-8 of lower sentinal value
+	48		first cell available to user (maximum alignment)
+	N+1		Bytes 1-8 of upper sentinal value
+
+   Total storage required is
+
+      [ ((nelems + 1) * sizeof(dtype)) + sz-align + (5 * SZ_INT) ] * SZB_CHAR
+	
+
+MALLOC, given the CHAR address of the buffer allocated by the z-routine,
+adds space for the saved fwa (an integer), and determines the address of the
+next cell which is sufficiently aligned, relative to the Mem common.  This
+cell marks the start of the user buffer area.  The buffer fwa is saved in an
+integer location preceding the "first cell".
+
+MFREE, called with a pointer to the buffer to be returned, fetches the location
+of the physical buffer from the save area.  If this does not agree with the
+buffer pointer, either (1) the buffer pointer is invalid or of the wrong
+datatype, or (2), the save area has been overwritten (memory has been
+corrupted).  If everything checks out, the buffer fwa is passed to a z-routine
+to free the physical buffer space.
+
+TODO:	- Add debugging routine to summarize allocated buffer space and
+		check for buffer overruns (add sentinel at end of buffer).
+	- Keep track of buffers allocated while a program is running and
+		return at program termination, like closing open files.
+.endhelp ---------------------------------------------------------------------
+
+
+
+# MALLOC1 -- Low level procedure which does the actual buffer allocation.
+
+int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+int	sz_align		# number of chars of alignment required
+int	fwa_align		# address to which buffer is to be aligned
+
+int	fwa, nchars, nuser, status
+pointer	cp
+
+int	sizeof()
+pointer	msvfwa(), coerce()
+
+include "nmemio.com"
+
+begin
+	if (dtype == TY_CHAR)
+	    nuser = nelems + 1  			# add space for EOS
+	else
+	    nuser = nelems * sizeof (dtype) + 1
+	nchars = nuser + (8 * SZ_INT) + sz_align
+
+	call zmaloc (fwa, (nchars * SZB_CHAR), status)
+
+	if (status == ERR)
+	    return (ERR)
+
+	else {
+	    output_pointer = msvfwa (fwa, dtype, nelems, sz_align, fwa_align)
+
+	    if (mclear > 0) {
+		# Clear the user area only.
+	        cp = coerce (output_pointer, dtype, TY_CHAR)
+                call aclrc (Memc[cp], (nuser * SZB_CHAR))
+	    }
+
+	    # Update usage stats.
+	    if (mreport > 0) {
+	        nalloc = nalloc + 1
+	        mem_used = mem_used + (nchars * SZB_CHAR)
+	        if ((nchars * SZB_CHAR) > max_alloc)
+		    max_alloc = (nchars * SZB_CHAR)
+	    }
+
+	    # Save the ptr in the GC buffer.
+	    if (mcollect > 0)
+		call mgc_save (output_pointer, dtype)
+
+	    return (OK)
+	}
+end
diff --git a/sys/nmemio/merror.x b/sys/nmemio/merror.x
new file mode 100644
index 00000000..d69eb6cd
--- /dev/null
+++ b/sys/nmemio/merror.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+
+
+# MERROR -- Provide a convenient trap for a memory error.
+
+procedure merror (msg)
+
+char	msg[ARB]
+
+include "nmemio.com"
+
+begin
+	if (in_task > 0)
+	    call error (EA_ERROR, msg)
+end
diff --git a/sys/nmemio/mfini.x b/sys/nmemio/mfini.x
new file mode 100644
index 00000000..f3933fa1
--- /dev/null
+++ b/sys/nmemio/mfini.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+
+define	MDEBUG		false
+
+# MEM_FINI --  Close out the MEMIO use in this task.  We perform the memory
+# garbage collection and report usage statistics if requested.
+
+procedure mem_fini (task)
+
+char 	task[ARB]			# task name
+
+int	sv_report
+
+include	"nmemio.com"
+
+begin
+	# Do garbage collection.
+	call mgc_collect()
+            
+	# Turn off reporting so the print statements below don't add
+	# to the reported values.
+	sv_report = mreport
+	mreport   = 0
+	mdebug    = 0
+	in_task   = 0
+
+	if (MDEBUG) {
+	    call eprintf ("\nTask '%s':\n")
+                call pargstr (task)
+	    call eprintf ("     mwatch:\t%d\n") ; call pargi (mwatch)
+	    call eprintf ("     mclear:\t%d\n") ; call pargi (mclear)
+	    call eprintf ("   mcollect:\t%d\n") ; call pargi (mcollect)
+	    call eprintf ("    mreport:\t%d\n") ; call pargi (mreport)
+	}
+
+	# Report memory usage.
+	if (sv_report > 0) {
+            call eprintf ("\nTask '%s':\n")
+                call pargstr (task)
+	    call eprintf ("       Memory:\t%9d used   (%9d max )\n")
+		call pargl (mem_used)
+		call pargi (max_alloc)
+	    call eprintf ("     Pointers:\t%9d alloc  (%9d free)\n")
+		call pargi (nalloc)
+		call pargi (nfree)
+	    call eprintf ("       Leaked:\t%9d bytes  (%9d ptrs)\n\n")
+		call pargl (leaked)
+		call pargl (nleaked)
+	}
+
+	# Free the GC buffer.
+	call mgc_close ()
+end
diff --git a/sys/nmemio/mfree.x b/sys/nmemio/mfree.x
new file mode 100644
index 00000000..d83149c3
--- /dev/null
+++ b/sys/nmemio/mfree.x
@@ -0,0 +1,118 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<error.h>
+
+
+# MFREE -- Free a previously allocated buffer.  If the buffer has already been
+# returned (NULL pointer), ignore the request.  Once the buffer has been
+# returned, the old pointer value is of not useful (and invalid), so set it
+# to NULL.
+
+procedure mfree (ptr, dtype)
+
+pointer	ptr
+int	dtype
+
+pointer	bp
+int	fwa, gc_type, status, lwl
+char	emsg[SZ_LINE]
+
+int	mgtfwa(), coerce(), mgc_gettype()
+errchk	mgtfwa
+
+include "nmemio.com"
+
+begin
+	# Check for NULL or already-freed pointers.  We only invoke an error 
+	# rather than sys_panic to allow for recovery.
+	if (ptr < 0) {
+	    call merror ("Attempt to free already freed pointer")
+	    return 
+	}
+	if (mdebug > 0 && ptr == NULL) {
+	    call merror ("Attempt to free NULL pointer")
+	    return 
+	}
+	if (mcollect > 0) {
+	    gc_type = mgc_gettype (ptr)
+	    if ((gc_type != NULL && gc_type != dtype) && in_task > 0) {
+	        call merror ("Attempt to free pointer of wrong type")
+		dtype = gc_type
+	    }
+	}
+
+	if (ptr != NULL) {
+	    fwa = mgtfwa (ptr, dtype)
+
+	    bp = coerce (ptr, dtype, TY_INT)
+	    if (mwatch  > 0) {
+
+	        # Check the lower sentinal value.  Any serious underflow 
+		# would have corrupted the fwa and been detected above in
+		# mgtfwa(), we really only use this to check for 0/1 indexing
+		# problems that write before the start od the data.
+	        if (Memi[bp-1] != lsentinal) {
+	    	    call aclrc (emsg, SZ_LINE)
+		    call sprintf (emsg, SZ_LINE, 
+			"Pointer underflow: addr=0x%x  nelem=%d  type=%s\n")
+			    call pargi (ptr)
+			    call pargi (Memi[bp-2])
+			    call ptype (dtype)
+		    if (mreport > 0)
+			call eprintf (emsg)
+		    call merror (emsg)
+		}
+
+	        # Check the upper sentinal value.  Note that the setinal is
+		# aligned to the INT boundary so depending on the type we
+		# might still allow a slight overrun.
+	        lwl = Memi[bp-4]
+	        if (Memi[lwl] != usentinal) {
+	    	    call aclrc (emsg, SZ_LINE)
+		    call sprintf (emsg, SZ_LINE, 
+			"Pointer overflow: addr=0x%x  nelem=%d  type=%s\n")
+			    call pargi (ptr)
+			    call pargi (Memi[bp-2])
+			    call ptype (dtype)
+		    if (mreport > 0)
+			call eprintf (emsg)
+		    call merror (emsg)
+		}
+	    }
+
+	    call zmfree (fwa, status)
+	    if (status == ERR)
+		call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	    # Negate the pointer so we can detect another attempt to free it.
+	    if (mcollect > 0 && in_task > 0)
+	        call mgc_update (ptr)
+	    if (mcollect >= 0)
+	        nfree = nfree + 1
+	    ptr   = - ptr
+	    ptr   = NULL
+	}
+end
+
+
+# PTYPE -- Convert a pointer type code t its string equivalent.
+
+procedure ptype (dtype)
+
+int     dtype
+
+begin
+	switch (dtype) {
+	case TY_BOOL:       call pargstr ("TY_BOOL")
+	case TY_CHAR:       call pargstr ("TY_CHAR")
+	case TY_SHORT:      call pargstr ("TY_SHORT")
+	case TY_INT:        call pargstr ("TY_INT")
+	case TY_LONG:       call pargstr ("TY_LONG")
+	case TY_REAL:       call pargstr ("TY_REAL")
+	case TY_DOUBLE:     call pargstr ("TY_DOUBLE")
+	case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+	case TY_STRUCT:     call pargstr ("TY_STRUCT")
+	case TY_POINTER:    call pargstr ("TY_POINTER")
+	}
+end
diff --git a/sys/nmemio/mgc.x b/sys/nmemio/mgc.x
new file mode 100644
index 00000000..8ef2b58c
--- /dev/null
+++ b/sys/nmemio/mgc.x
@@ -0,0 +1,222 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+#  MGC Interface - Simple memory garbage collector interface.  Our strategy
+#  here is simply to store the pointer and its type (so we can dereference to
+#  a host pointer).  As pointers are allocated they are saved here, and when
+#  freed the pointer value is made negative to indicate it is invalid and
+#  that slot is available for later reuse.
+#	When a task completes, we run through the buffer looking for un-freed
+#  pointers and manually reclaim the space.  This is not especially clever but
+#  we are only used (presumably by developers) when requested so normal use
+#  of MEMIO should see no added overhead.
+#
+#               mgc_init  ()
+#              mgc_close  ()
+#               mgc_save  (ptr, dtype)
+#             mgc_update  (ptr)
+#   index = mgc_getindex  (ptr)
+#     type = mgc_gettype  (ptr)
+#            mgc_collect  ()
+
+
+define	SZ_GC_BUFFER		10240
+
+# A zero-indexed structure saving the (ptr,type) pairs.
+define	GC_PTR			Memi[$1+($2 * 2)]
+define	GC_TYPE			Memi[$1+($2 * 2 + 1)]
+
+
+# MGC_INIT -- Initialize the MGC interface.
+
+procedure mgc_init ()
+
+include "nmemio.com"
+
+begin
+       	if (mcollect > 0)
+            call calloc (mgc, SZ_GC_BUFFER, TY_STRUCT)
+	else
+	    mgc = NULL
+end
+
+
+# MGC_CLOSE -- Close the MGC buffer.
+
+procedure mgc_close ()
+
+include "nmemio.com"
+
+begin
+        if (mcollect > 0 && mgc != NULL) {
+            call mfree (mgc, TY_STRUCT)
+	    mgc = NULL
+	}
+end
+
+
+# MGC_SAVE -- Save a pointer in the GC buffer.
+
+procedure mgc_save (ptr, dtype)
+
+pointer	ptr					#i pointer to save
+int	dtype					#i pointer type
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	for (i=0; i < bmax; i=i+1) {
+	    if (GC_PTR(mgc,i) <= 0) {
+		# Space is re-used if negative, otherwise first free slot.
+		GC_PTR(mgc,i) = ptr
+		GC_TYPE(mgc,i) = dtype
+
+		if (mdebug > 0) {
+		    call eprintf ("save %d: ptr 0x%x\n")
+		        call pargi (i); call pargi (GC_PTR(mgc,i))
+		}
+		return
+	    }
+	}
+
+	# If we get this far we've exhausted the GC buffer.  Print a warning
+	# if reporting and just ignore it since the chances this would be 
+	# a leaked pointer are rather small.
+	if (mreport > 0)
+	    call eprintf ("Warning:  GC buffer overflow\n")
+end
+
+
+# MGC_UPDATE -- Update the status of the pointer in the GC buffer.
+
+procedure mgc_update (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mgc == NULL || in_task == 0)
+	    return
+
+	if (in_task > 0 && mdebug > 0) {
+	  call eprintf ("update  0x%x  collect = %d\n")
+	    call pargi (ptr)
+	    call pargi (mcollect)
+	}
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (GC_PTR(mgc,i) == ptr) {
+		if (in_task > 0 && mdebug > 0) {
+	  	    call eprintf ("update  %d:  0x%x  %d\n")
+	    	    call pargi (i); call pargi (GC_PTR(mgc,i)); call pargi (ptr)
+		}
+	        GC_PTR(mgc,i) = (- ptr)
+		return
+	    }
+	    if (GC_PTR(mgc,i) == NULL)
+		return
+	}
+end
+
+
+# MGC_GETINDEX -- Given a pointer, return its GC index.
+
+int procedure mgc_getindex (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (abs (GC_PTR(mgc,i)) == ptr)
+		return (i)
+	    if (GC_PTR(mgc,i) == NULL)
+		return (NULL)
+	}
+
+	return (NULL)
+end
+
+
+# MGC_GETTYPE -- Given a pointer, return its type.
+
+int procedure mgc_gettype (ptr)
+
+pointer	ptr					#i pointer to save
+
+int	i, bmax
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (abs (GC_PTR(mgc,i)) == ptr)
+		return (GC_TYPE(mgc,i))
+	    if (GC_PTR(mgc,i) == NULL)
+		return (NULL)
+	}
+
+	return (NULL)
+end
+
+
+# MGC_COLLECT -- Do the final garbage collection.
+
+procedure mgc_collect ()
+
+int	i, bmax, nchars
+pointer	bp
+
+int	sizeof ()
+pointer	coerce ()
+
+include "nmemio.com"
+
+begin
+	if (mcollect <= 0 || mgc == NULL)
+	    return
+	mcollect = -1
+
+	bmax = SZ_GC_BUFFER - 1
+	do i = 0, bmax {
+	    if (GC_PTR(mgc,i) > 0) {
+		if (mdebug > 0) {
+		    call eprintf ("collect %d: recovering ptr 0x%x\n")
+		        call pargi (i); call pargi (GC_PTR(mgc,i))
+		}
+
+                bp = coerce (GC_PTR(mgc,i), GC_TYPE(mgc,i), TY_INT)
+
+		nleaked = nleaked + 1
+		nchars = Memi[bp - 2] * sizeof (GC_TYPE(mgc,i))
+		leaked = leaked + (nchars * SZB_CHAR)
+
+		call mfree (GC_PTR(mgc,i), GC_TYPE(mgc,i))
+
+	    } else if (GC_PTR(mgc,i) == NULL)
+		return
+	}
+end
diff --git a/sys/nmemio/mgdptr.x b/sys/nmemio/mgdptr.x
new file mode 100644
index 00000000..81328132
--- /dev/null
+++ b/sys/nmemio/mgdptr.x
@@ -0,0 +1,33 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# MGDPTR -- Given the fwa of a memory area, compute a pointer to the start
+# of the data area which satisfies the desired alignment criteria.  Memory
+# is allocated in units of chars, and ZLOCVA, ZMALOC, etc., return pointers
+# in units of chars.
+
+pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+long	bufadr
+pointer	bufptr
+int	modulus, loc_Mem
+int	sizeof()
+data	loc_Mem /NULL/
+
+begin
+	# Compute the address of the start of the user buffer area, which
+	# must be aligned with fwa_align (usually Mem) for all data types.
+
+	if (loc_Mem == NULL)
+	    call zlocva (Memc, loc_Mem)
+	bufadr = fwa + (5 * SZ_INT)
+
+	modulus = mod (bufadr - fwa_align, sz_align)
+	if (modulus != 0)
+	    bufadr = bufadr + (sz_align - modulus)
+
+	# Compute the buffer pointer for the desired datatype.
+	bufptr = (bufadr - loc_Mem) / sizeof(dtype) + 1
+
+	return (bufptr)
+end
diff --git a/sys/nmemio/mgtfwa.x b/sys/nmemio/mgtfwa.x
new file mode 100644
index 00000000..8d3452fd
--- /dev/null
+++ b/sys/nmemio/mgtfwa.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTFWA -- Given a user buffer pointer, retrieve physical address of buffer.
+# If physical address of buffer does not seem reasonable, memory has probably
+# been overwritten, a fatal error.
+
+int procedure mgtfwa (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	locbuf, fwa
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	fwa = Memi[bufptr-5]
+	call zlocva (Memi[bufptr-5], locbuf)
+
+	if (abs (locbuf - fwa) > (6 * SZ_VMEMALIGN))
+	    call sys_panic (SYS_MCORRUPTED, "Memory fwa has been corrupted")
+
+	return (fwa)
+end
diff --git a/sys/nmemio/mgtlwl.x b/sys/nmemio/mgtlwl.x
new file mode 100644
index 00000000..3a7d3ac1
--- /dev/null
+++ b/sys/nmemio/mgtlwl.x
@@ -0,0 +1,18 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# MGTLWL -- Given a user buffer pointer, retrieve location of the last word.
+
+int procedure mgtlwl (ptr, dtype)
+
+pointer	ptr, bufptr
+int	dtype
+int	coerce()
+
+begin
+	bufptr = coerce (ptr, dtype, TY_INT)
+	return (Memi[bufptr-4])
+end
diff --git a/sys/nmemio/minit.x b/sys/nmemio/minit.x
new file mode 100644
index 00000000..06214137
--- /dev/null
+++ b/sys/nmemio/minit.x
@@ -0,0 +1,127 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <syserr.h>
+include	<config.h>
+
+
+define  L_SENTINAL      20030125
+define  U_SENTINAL      20040922
+
+
+# MEM_INIT -- Initialize the MEMIO interface for the task.
+
+procedure mem_init (task)
+
+char	task[ARB]			# task name
+
+int	mgtenv()
+
+include "nmemio.com"
+
+begin
+	# Initialize I/O buffers for stdout/stderr.  We do this here to
+	# create the file buffers without counting these in the memory 
+	# usage stats.
+#	call fmkbfs (STDOUT)
+#	call fmkbfs (STDERR)
+
+	# Allocate the garbage collection buffer.
+	mcollect  = mgtenv ("MEMIO_COLLECT")
+	call mgc_init()
+
+	# Initialize the sentinal values.
+	lsentinal   = L_SENTINAL
+	usentinal   = U_SENTINAL
+
+	mwatch    = mgtenv ("MEMIO_WATCH")
+	mreport   = mgtenv ("MEMIO_REPORT")
+	mclear    = mgtenv ("MEMIO_CLEAR")
+	mdebug    = mgtenv ("MEMIO_DEBUG")
+
+	max_alloc = 0
+	mem_used  = 0
+	leaked	  = 0
+	nleaked	  = 0
+	nalloc	  = 0
+	nfree	  = 0
+
+	in_task	  = 1
+end
+
+
+# MGTENV -- Get an environment variable for MEMIO control.
+
+int procedure mgtenv (varname)
+
+char	varname[ARB]			# env variable to find
+
+int	ival, ip, status, junk
+char	key[SZ_LINE], value[SZ_LINE]
+
+int	ctoi()
+
+begin
+	ip = 1				# init
+        ival = 0
+	call aclrc (key, SZ_LINE)
+	call aclrc (value, SZ_LINE)
+
+        call strpak (varname, key, SZ_LINE)
+        call zgtenv (key, value, SZ_LINE, status)
+        call strupk (value, value, SZ_LINE)
+
+	if (status == 0)		# variable defined w/out value
+	    ival = 1
+	else if (status > 0)		# get environment variable value
+	    junk = ctoi (value, ip, ival)
+
+	return (ival)
+end
+
+
+# MEM_PTYPE -- Print a pointer type.  Used in error messages.
+
+procedure mem_ptype (dtype)
+
+int     dtype
+
+begin
+	switch (dtype) {
+	case TY_BOOL:       call pargstr ("TY_BOOL")
+	case TY_CHAR:       call pargstr ("TY_CHAR")
+	case TY_SHORT:      call pargstr ("TY_SHORT")
+	case TY_INT:        call pargstr ("TY_INT")
+	case TY_LONG:       call pargstr ("TY_LONG")
+	case TY_REAL:       call pargstr ("TY_REAL")
+	case TY_DOUBLE:     call pargstr ("TY_DOUBLE")
+	case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+	case TY_STRUCT:     call pargstr ("TY_STRUCT")
+	case TY_POINTER:    call pargstr ("TY_POINTER")
+	default:    	    call pargstr ("unknown")
+	}
+end
+
+
+# MIO_INIT -- Initialize the MEMIO interface for the task.
+
+procedure mio_init ()
+
+include "nmemio.com"
+
+begin
+	mgc       = NULL
+	mcollect  = 0
+	mwatch    = 0
+	mreport   = 0
+	mclear    = 0
+	mdebug    = 0
+
+	max_alloc = 0
+	mem_used  = 0
+	leaked	  = 0
+	nleaked	  = 0
+	nalloc	  = 0
+	nfree	  = 0
+
+	in_task	  = 0
+end
diff --git a/sys/nmemio/mkpkg b/sys/nmemio/mkpkg
new file mode 100644
index 00000000..94cfaed9
--- /dev/null
+++ b/sys/nmemio/mkpkg
@@ -0,0 +1,31 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	#$set XFLAGS	= "$(XFLAGS) -g"
+
+	begmem.x	<mach.h>
+	calloc.x	
+	coerce.x	<szdtype.inc>
+	kmalloc.x	<config.h>
+	krealloc.x	<config.h> <mach.h>
+	malloc1.x	<mach.h> nmemio.com
+	malloc.x	<config.h>
+	merror.x	<error.h> nmemio.com
+	mfini.x		<config.h> nmemio.com
+	mfree.x		<error.h> nmemio.com
+	mgc.x		<mach.h> nmemio.com
+	mgdptr.x	
+	mgtfwa.x	<config.h> <mach.h>
+	mgtlwl.x	<config.h> <mach.h>
+	minit.x		<config.h> nmemio.com
+	msvfwa.x	<mach.h> nmemio.com
+	realloc.x	
+	salloc.x	<config.h> <szdtype.inc>
+	sizeof.x	<szdtype.inc>
+	vmalloc.x	<config.h> <mach.h>
+	;
diff --git a/sys/nmemio/msvfwa.x b/sys/nmemio/msvfwa.x
new file mode 100644
index 00000000..cd3313c5
--- /dev/null
+++ b/sys/nmemio/msvfwa.x
@@ -0,0 +1,55 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+
+# MSVFWA -- Determine the buffer address which satisfies the maximum alignment
+# criteria, save the buffer fwa in the integer cell immediately preceding
+# this, and return a pointer to the user area of the buffer.
+
+pointer procedure msvfwa (fwa, dtype, nelem, sz_align, fwa_align)
+
+int	fwa, dtype, nelem, sz_align, fwa_align, nbits
+pointer	bufptr, lwl, offset
+
+pointer	mgdptr()
+int	coerce(), sizeof()
+
+include "nmemio.com"
+
+begin
+	# Compute the pointer to the data area which satisfies the desired
+	# alignment criteria.  Store the fwa of the actual OS allocated buffer
+	# in the integer cell preceeding the data area.
+
+	bufptr = mgdptr (fwa, TY_INT, sz_align, fwa_align)
+
+	nbits = sizeof(TY_INT) * 8 * SZB_CHAR
+	if (nbits == 64) {
+	    if (sizeof (dtype) == sizeof (TY_CHAR))
+	        offset = (nelem / SZ_INT + 1)
+	    else if (sizeof (dtype) == sizeof (TY_REAL))
+	        offset = (nelem / SZ_REAL + 1)
+	    else
+	        offset = nelem
+
+	} else if (nbits == 32) { 
+
+	    if (sizeof(dtype) < sz_align)
+	        offset = (nelem / (SZ_INT / sizeof(dtype))) + 1
+	    else
+	        offset = (nelem * sizeof (dtype)) / SZB_CHAR
+	}
+
+	lwl = bufptr + offset
+
+	Memi[bufptr-5] = fwa				# first word address
+	Memi[bufptr-4] = lwl				# last word location
+	Memi[bufptr-3] = dtype				# data type
+	Memi[bufptr-2] = nelem				# no. of elements
+	Memi[bufptr-1] = lsentinal			# lower sentinal
+	Memi[lwl]      = usentinal 			# upper sentinal
+
+	# Return pointer of type dtype to the first cell of the data area.
+	return (coerce (bufptr, TY_INT, dtype))
+end
diff --git a/sys/nmemio/nmemio.com b/sys/nmemio/nmemio.com
new file mode 100644
index 00000000..126475c0
--- /dev/null
+++ b/sys/nmemio/nmemio.com
@@ -0,0 +1,26 @@
+
+int	mclear				# clear newly allocated memory?
+int	mwatch				# check buffer sentinals on FREE?
+int	mcollect			# garbage collect on exit?
+int	mreport				# report memio usage stats?
+
+int	lsentinal			# lower sentinal value
+int	usentinal			# upper sentinal value
+
+long	mem_used			# total mem usage
+long	max_alloc			# largest allocated pointer size
+long	leaked				# total leaked bytes
+int 	nleaked				# number leaked pointers
+int 	nalloc				# total number of allocations
+int 	nfree				# total number of frees
+
+int	mdebug				# debugging memory use in tasks?
+int	in_task				# in task or iraf main?
+
+pointer	mgc				# garbage collection buffer
+
+#  Debug common
+common	/nmemio/ mclear, mwatch, mcollect, mreport, lsentinal, usentinal,
+		 mem_used, max_alloc, nleaked, leaked, nalloc, nfree, 
+		 mdebug, in_task, mgc
+
diff --git a/sys/nmemio/realloc.x b/sys/nmemio/realloc.x
new file mode 100644
index 00000000..40229b8f
--- /dev/null
+++ b/sys/nmemio/realloc.x
@@ -0,0 +1,22 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+
+# REALLOC -- Change the size of a previously allocated buffer, moving the
+# buffer if necessary.  If there is no old buffer (NULL pointer) simply
+# allocate a new buffer.
+
+procedure realloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# buffer to be reallocated
+int	nelems			# new size of buffer
+int	dtype			# buffer datatype
+
+int	krealloc()
+
+begin
+	if (krealloc (ubufp, nelems, dtype) == ERR) {
+	    ubufp = NULL
+	    call syserr (SYS_MFULL)
+	}
+end
diff --git a/sys/nmemio/salloc.x b/sys/nmemio/salloc.x
new file mode 100644
index 00000000..34f06217
--- /dev/null
+++ b/sys/nmemio/salloc.x
@@ -0,0 +1,155 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<config.h>
+include	<syserr.h>
+
+# SALLOC.X -- Stack management routines.  Stack storage is allocated in
+# segments.  Space for each segment is dynamically allocated on the heap.
+# Each segment contains a pointer to the previous segment to permit
+# reclamation of the space (see "Mem.hlp" for additional details).
+# This is a low level facility, hence any failure to allocate or deallocate
+# stack storage is fatal.
+
+
+# Segment header structure.  The header size parameter SZ_STKHDR is defined
+# in <config.h> because it is potentially machine dependent.  SZ_STKHDR
+# must be chosen such that the maximum alignment criteria is maintained.
+
+define	SH_BASE		Memi[$1]	# char pointer to base of segment
+define	SH_TOP		Memi[$1+1]	# char pointer to top of segment + 1
+define	SH_OLDSEG	Memi[$1+2]	# struct pointer to header of prev.seg.
+
+
+# SALLOC -- Allocate space on the stack.
+
+procedure salloc (output_pointer, nelem, datatype)
+
+pointer	output_pointer		# buffer pointer (output)
+int	nelem			# number of elements of storage required
+int	datatype		# datatype of the storage elements
+
+int	nchars, dtype
+include	<szdtype.inc>
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	dtype = datatype
+	if (dtype < 1 || dtype > MAX_DTYPE)
+	    call sys_panic (500, "salloc: bad datatype code")
+
+	# Align stack pointer for any data type.  Compute amount of
+	# storage to be allocated.  Always add space for at least one
+	# extra char for the EOS in case a string is stored in the buffer.
+
+	sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1
+	if (dtype == TY_CHAR)
+	    nchars = nelem + 1				# add space for EOS
+	else
+	    nchars = nelem * ty_size[dtype] + 1
+
+	# Check for stack overflow, add new segment if out of room.
+	# Since SMARK must be called before SALLOC, cur_seg cannot be
+	# null, but we check anyhow.
+
+	if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg))
+	    call stk_mkseg (cur_seg, sp, nchars)
+
+	if (dtype == TY_CHAR)
+	    output_pointer = sp
+	else
+	    output_pointer = (sp-1) / ty_size[dtype] + 1
+
+	sp = sp + nchars			# bump stack pointer
+end
+
+
+# SMARK -- Mark the position of the stack pointer, so that stack space
+# can be freed by a subsequent call to SFREE.  This routine also performs
+# initialization of the stack, since it the very first routine called
+# during task startup.
+
+procedure smark (old_sp)
+
+pointer	old_sp			# value of the stack pointer (output)
+bool	first_time
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+data	first_time /true/
+
+begin
+	if (first_time) {
+	    sp = NULL
+	    cur_seg = NULL
+	    call stk_mkseg (cur_seg, sp, SZ_STACK)
+	    first_time = false
+	}
+
+	old_sp = sp
+end
+
+
+# SFREE -- Free space on the stack.  Return whole segments until segment
+# containing the old stack pointer is reached.
+
+procedure sfree (old_sp)
+
+pointer	old_sp			# previous value of the stack pointer
+
+pointer	old_seg
+pointer	sp, cur_seg
+common	/salcom/ sp, cur_seg
+
+begin
+	# The following is needed to avoid recursion when SFREE is called
+	# by the IRAF main during processing of SYS_MSSTKUNFL.
+
+	if (cur_seg == NULL)
+	    return
+	    
+	# If the stack underflows (probably because of an invalid pointer)
+	# it is a fatal error.
+
+	while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) {
+	    if (SH_OLDSEG(cur_seg) == NULL)
+		call sys_panic (SYS_MSSTKUNFL, "Salloc underflow")
+
+	    old_seg = SH_OLDSEG(cur_seg)		# discard segment
+	    call mfree (cur_seg, TY_STRUCT)
+	    cur_seg = old_seg
+	}
+
+	sp = old_sp					# pop stack
+end
+
+
+# STK_MKSEG -- Create and add a new stack segment (link at head of the
+# segment list).  Called during initialization, and upon stack overflow.
+
+procedure stk_mkseg (cur_seg, sp, segment_size)
+
+pointer	cur_seg			# current segment
+pointer	sp			# salloc stack pointer
+int	segment_size		# size of new stack segment
+
+int	nchars, new_seg
+pointer	coerce() 
+int	kmalloc()
+
+begin
+	# Compute size of new segment, allocate the buffer.
+	nchars = max (SZ_STACK, segment_size) + SZ_STKHDR
+	if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR)
+	    call sys_panic (SYS_MFULL, "Out of memory")
+
+	# Output new stack pointer.
+	sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR
+
+	# Set up the segment descriptor.
+	SH_BASE(new_seg) = sp
+	SH_TOP(new_seg) = sp - SZ_STKHDR + nchars
+	SH_OLDSEG(new_seg) = cur_seg
+
+	# Make new segment the current segment.
+	cur_seg = new_seg
+end
diff --git a/sys/nmemio/sizeof.x b/sys/nmemio/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/nmemio/sizeof.x
@@ -0,0 +1,12 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# SIZEOF -- Return the size in chars of one of the fundamental datatypes.
+
+int procedure sizeof (dtype)
+
+int	dtype
+include	<szdtype.inc>
+
+begin
+	return (ty_size[dtype])
+end
diff --git a/sys/nmemio/vmalloc.x b/sys/nmemio/vmalloc.x
new file mode 100644
index 00000000..25e2de0d
--- /dev/null
+++ b/sys/nmemio/vmalloc.x
@@ -0,0 +1,28 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<config.h>
+include	<mach.h>
+
+# VMALLOC -- Like malloc, but force the buffer to be aligned on a virtual
+# memory page boundary.  This feature can be used, e.g., in 4.XBSD UNIX
+# to "bypass" the system buffer cache (to avoid copying file data from the
+# system cache into the file buffer).  VMALLOC can be made equivalent to MALLOC
+# via the parameters in <config.h>, if the local machine which does not have
+# virtual memory.
+
+procedure vmalloc (ubufp, nelems, dtype)
+
+pointer	ubufp			# user buffer pointer (output)
+int	nelems			# number of elements of storage required
+int	dtype			# datatype of the storage elements
+
+int	sz_align, fwa_align
+int	malloc1()
+
+begin
+	sz_align = SZ_VMEMALIGN
+	fwa_align = VMEM_BASE
+	if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR)
+	    call syserr (SYS_MFULL)
+end
diff --git a/sys/nmemio/zz.x b/sys/nmemio/zz.x
new file mode 100644
index 00000000..c81f1506
--- /dev/null
+++ b/sys/nmemio/zz.x
@@ -0,0 +1,11 @@
+task hello = t_hello
+
+procedure t_hello()
+pointer	t1, t2
+begin
+	call malloc (t1, SZ_LINE, TY_CHAR)
+	call mfree (t1, TY_CHAR)
+
+	call malloc (t2, SZ_LINE, TY_INT)
+	call mfree (t2, TY_INT)
+end
diff --git a/sys/nmemio/zzdebug.x b/sys/nmemio/zzdebug.x
new file mode 100644
index 00000000..556c4fa1
--- /dev/null
+++ b/sys/nmemio/zzdebug.x
@@ -0,0 +1,86 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Debug MEMIO.
+
+task	stack=t_stack, realloc=t_realloc
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	sza, new_sza, szb, new_szb
+int	clgeti()
+
+begin
+	call malloc (a, SZ_LINE, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	sza = SZ_LINE
+	call malloc (b, SZ_LINE, TY_CHAR)
+	call strcpy ("0123456789", Memc[b], ARB)
+	szb = SZ_LINE
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	repeat {
+	    new_sza = clgeti ("a_bufsize")
+	    if (new_sza == 0)
+		return
+	    call x_realloc (a, new_sza, TY_CHAR)
+	    new_szb = clgeti ("b_bufsize")
+	    if (new_szb == 0)
+		return
+	    call x_realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("a buf %d, size %d --> %d: %s\n")
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("b buf %d, size %d --> %d: %s\n")
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
diff --git a/sys/nmemio/zzfoo.gx b/sys/nmemio/zzfoo.gx
new file mode 100644
index 00000000..5de60c5b
--- /dev/null
+++ b/sys/nmemio/zzfoo.gx
@@ -0,0 +1,587 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Test procedures for the NMEMIO interface.
+#
+
+include <mach.h>
+
+
+define	MT_HEAP		0			# test heap memory
+define	MT_STACK	1			# test stack memory
+
+
+task memtest 	= t_memtest,
+     stack   	= t_stack, 
+     realloc	= t_realloc
+
+
+#  MEMTEST -- Task to test new memio interface.
+
+procedure t_memtest ()
+
+int	model, nerr
+pointer str, ptr
+
+bool	clgetb()
+
+begin
+	if (clgetb ("stack"))
+	    model = MT_STACK
+	else
+	    model = MT_HEAP
+
+	# Check we can allocate a large array.
+	if (model == MT_HEAP) {
+	    call eprintf ("\nBegin large heap malloc tests ....\n\n")
+	    call malloc (str, 256000, TY_STRUCT)
+	    call mfree (str, TY_STRUCT)
+	    call eprintf ("Done\n\n")
+	
+	    # Print the memory layout.
+	    $for (csiblrdx)
+	        call mt_print (TY_PIXEL)
+	    $endfor
+	    call mt_print (TY_STRUCT)
+	    call mt_print (TY_POINTER)
+	}
+
+	# Test Mem common assignments
+	call eprintf ("\nBegin assignment tests ....\n\n");
+	call mt_auto_b ("bool   ", model)
+	call mt_auto_c ("char   ", model)
+	call mt_auto_s ("short  ", model)
+	call mt_auto_i ("int    ", model)
+	call mt_auto_l ("long   ", model)
+	call mt_auto_r ("real   ", model)
+	call mt_auto_d ("double ", model)
+	call mt_auto_x ("complex", model)
+	call eprintf ("\nEnd assignment tests ....\n\n");
+
+
+	# Test string memory
+	call eprintf ("Begin Memc test\t\t");
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[str], SZ_LINE)
+	call strcpy ("test string", Memc[str], SZ_LINE)
+	call eprintf ("str = '%s'  ch[2] = '%c' (should be 's')\n")
+	    call pargstr (Memc[str])
+	    call pargc (Memc[str+2])
+	call mfree (str, TY_CHAR)
+
+
+	# Test the struct memory
+	call eprintf ("\n\n")
+	call eprintf ("Begin struct test\n")
+	call mt_struct (model)
+	call eprintf ("Done\n")
+
+
+	# Test memory overflow and then underflow detection.
+	call eprintf ("\n\n")
+	call eprintf ("Testing overflow:\t")
+	nerr = 0
+	$for (csiblrdx)
+	    iferr ( call mt_overflow (TY_PIXEL) ) 
+		nerr = nerr + 1;
+	$endfor
+	iferr ( call mt_overflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_overflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+	
+
+	call eprintf ("Testing underflow:\t")
+	nerr = 0
+	$for (csiblrdx)
+	    iferr ( call mt_underflow (TY_PIXEL) ) 
+		nerr = nerr + 1;
+	$endfor
+	iferr ( call mt_underflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_underflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+
+
+	# Note this test will leak 1024 bytes because of the error recovery.
+	call eprintf ("Testing invalid free:\t")
+	call calloc (ptr, 256, TY_REAL)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing double free:\t")
+	call calloc (ptr, 256, TY_INT)
+	call mfree (ptr, TY_INT)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing NULL free:\t")
+	iferr ( call mfree (NULL, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing recovered free:\n")
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call eprintf ("Done\n")
+
+	call eprintf ("\n\nEnd of NMEMIO tests\n")
+end
+
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack ()
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	i, sza, new_sza, szb, new_szb
+
+begin
+	sza = SZ_FNAME
+	szb = SZ_LINE
+
+	call malloc (a, sza, TY_CHAR)
+	call malloc (b, szb, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	call strcpy ("0123456789", Memc[b], ARB)
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	for (i=1; i <= 10; i=i+1) {
+	    if (i < 5) {
+	        new_sza = sza + 512 ; new_szb = szb + 256
+	    } else {
+	        new_sza = sza + 256 ; new_szb = szb + 512
+	    }
+	    call realloc (a, new_sza, TY_CHAR)
+	    call realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("%2d: a buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("%2d: b buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
+
+
+
+define	SZ_TEST		640
+define  F_I1		Memi[$1]
+define  F_I2		Memi[$1+1]
+define  F_L1		Meml[$1+2]
+define  F_L2		Meml[$1+3]
+define  F_R1		Memr[$1+4]
+define  F_R2		Memr[$1+5]
+define  F_D1		Memd[P2D($1+8)]
+define  F_D2		Memd[P2D($1+10)]
+define  F_I3		Memi[$1+12]
+define  F_I4		Memi[$1+13]
+define  F_S1		Mems[P2S($1+14)]
+define  F_S2		Mems[P2S($1+15)]
+
+
+procedure mt_struct (model)
+
+int	model
+
+pointer	sp, str
+real	x, y, z
+double  d1, d2, d3
+
+int	locva()
+
+begin
+	if (model == MT_HEAP) {
+	    call malloc (str, SZ_TEST, TY_STRUCT)
+	} else {
+	    call smark (sp)
+	    call salloc (str, SZ_TEST, TY_STRUCT)
+	}
+
+
+	F_I1(str) = 1
+	F_I2(str) = 2
+	F_L1(str) = 3
+	F_L2(str) = 4
+	F_R1(str) = 5.0
+	F_R2(str) = 6.0
+	F_D1(str) = 7.0
+	F_D2(str) = 8.0
+	F_I3(str) = 9
+	F_I4(str) = 10
+	F_S1(str) = 11
+	F_S2(str) = 12
+
+	x 	   = 2.717	;   d1 	   = F_R1(str)
+	y 	   = 2.717	;   d2 	   = 3.14159d0	;
+	z 	   = double(x)  ;   d3 	   = double(3.14159)
+
+	call eprintf ("\nd1=%.6g d2=%.6g d3=%.6g    x=%.6g y=%.6g z=%.6g)\n\n")
+	    call pargd (d1)  ; call pargd (d2) ; call pargd (d3)
+	    call pargr (x)   ; call pargr (y)  ; call pargr (z)
+
+	call eprintf ("Done Setting values ....\n\ntest = %d  %d  %d\n\n")
+	    call pargi (str) 
+	    call pargi (locva(str))
+	    call pargi (locva(F_I1(str)))
+
+	# call mdump (str, 64)
+
+	call eprintf ("I1 = %4d  I2 = %4d   \t%d %d\n")
+	    call pargi (F_I1(str))        ; call pargi (F_I2(str))
+	    call pargi (locva(F_I1(str))) ; call pargi (locva(F_I2(str)))
+
+	call eprintf ("L1 = %4d  L2 = %4d   \t%d %d\n")
+	    call pargl (F_L1(str))        ; call pargl (F_L2(str))
+	    call pargi (locva(F_L1(str))) ; call pargi (locva(F_L2(str)))
+
+	call eprintf ("R1 = %4.1f  R2 = %4.1f   \t%d %d\n")
+	    call pargr (F_R1(str))	  ; call pargr (F_R2(str))
+	    call pargi (locva(F_R1(str))) ; call pargi (locva(F_R2(str)))
+
+	call eprintf ("D1 = %4.1f  D2 = %4.1f   \t%d %d\n")
+	    call pargd (F_D1(str))	  ; call pargd (F_D2(str))
+	    call pargi (locva(F_D1(str))) ; call pargi (locva(F_D2(str)))
+
+	call eprintf ("I3 = %4d  I4 = %4d   \t%d %d\n")
+	    call pargi (F_I3(str))        ; call pargi (F_I4(str))
+	    call pargi (locva(F_I3(str))) ; call pargi (locva(F_I4(str)))
+
+	call eprintf ("S1 = %4d  S2 = %4d   \t%d %d\n")
+	    call pargs (F_S1(str))        ; call pargs (F_S2(str))
+	    call pargi (locva(F_S1(str))) ; call pargi (locva(F_S2(str)))
+
+
+        if (model == MT_HEAP)
+    	    call mfree (str, TY_STRUCT)
+        else
+    	    call sfree (sp)
+end
+
+
+define	NVALS		3
+
+procedure mt_print (dtype)
+
+int	dtype
+
+int	i, locva(), coerce()
+real	x
+double	xx
+pointer	p, bp, lwl
+
+begin
+    call calloc (p, NVALS, dtype)
+    bp = coerce (p, dtype, TY_INT)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    # Print the ptr header.
+    call eprintf ("\n")
+    call eprintf ("         p = 0x%-15x  %-16d\t%d\n")
+	call pargi (p)  ;  call pargi (p)  ;   call pargi (locva(Memi[bp]))
+    call eprintf ("       fwa = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-5)	; call pargi (Memi[bp-5])
+	call pargi (locva (Memi[bp-5]))
+    call eprintf ("       lwl = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-4)	; call pargi (Memi[bp-4])
+	call pargi (locva (Memi[bp-4]))
+    call eprintf ("     dtype = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-3)	; call mptype (dtype)
+	call pargi (locva (Memi[bp-3]))
+    call eprintf ("     nelem = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-2)	; call pargi (Memi[bp-2])
+	call pargi (locva (Memi[bp-2]))
+    call eprintf ("L sentinal = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-1)	; call pargi (Memi[bp-1])
+	call pargi (locva (Memi[bp-1]))
+
+
+    # Print the values.
+    call eprintf ("      data =    ")
+    for (i=0; i < NVALS; i=i+1) {
+	switch (dtype) {
+	case TY_BOOL:
+	    call eprintf (" %3b\t\t\t\t\t%-15d")
+		call pargb (Memb[p+i])
+		call pargi (locva(Memb[p+i]))
+	case TY_CHAR:
+	    call eprintf (" %3c\t\t\t\t\t%-15d")
+		call pargc (Memc[p+i])
+		call pargi (locva(Memc[p+i]))
+	case TY_SHORT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargs (Mems[p+i])
+		call pargi (locva(Mems[p+i]))
+	case TY_INT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_LONG:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargl (Meml[p+i])
+		call pargi (locva(Meml[p+i]))
+	case TY_REAL:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargr (Memr[p+i])
+		call pargi (locva(Memr[p+i]))
+	case TY_DOUBLE:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargd (Memd[p+i])
+		call pargi (locva(Memd[p+i]))
+	case TY_COMPLEX:
+	    call eprintf (" %3x\t\t\t\t\t%-15d")
+		call pargx (Memx[p+i])
+		call pargi (locva(Memx[p+i]))
+	case TY_STRUCT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_POINTER:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	}
+	call eprintf ("\n")
+	if (i < (NVALS-1))
+	    call eprintf ("\t\t")
+    }
+
+    lwl = Memi[bp-4]
+    call eprintf ("U sentinal = 0x%-15x  %-15d\t\t%d\n\n")
+	call pargi (lwl)	; call pargi (Memi[lwl])
+	call pargi (locva (Memi[lwl]))
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_overflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS + 4; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_underflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE		; Memb[p-1] = FALSE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i		; Memc[p-1] = '0'
+	case TY_SHORT:	  Mems[p+i] = i			; Mems[p-1] = 999
+	case TY_INT:	  Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_LONG:	  Meml[p+i] = i			; Meml[p-1] = 999
+	case TY_REAL:	  Memr[p+i] = x			; Memr[p-1] = 999
+	case TY_DOUBLE:	  Memd[p+i] = xx		; Memd[p-1] = 999
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)	; Memx[p-1] = 999
+	case TY_STRUCT:   Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_POINTER:  Memi[p+i] = i			; Memi[p-1] = 999
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mptype (dtype)
+int	dtype
+begin
+    switch (dtype) {
+    case TY_BOOL:	call pargstr ("TY_BOOL   ")
+    case TY_CHAR:	call pargstr ("TY_CHAR   ")
+    case TY_SHORT:	call pargstr ("TY_SHORT  ")
+    case TY_INT:	call pargstr ("TY_INT    ")
+    case TY_LONG:	call pargstr ("TY_LONG   ")
+    case TY_REAL:	call pargstr ("TY_REAL   ")
+    case TY_DOUBLE:	call pargstr ("TY_DOUBLE ")
+    case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+    case TY_STRUCT:     call pargstr ("TY_STRUCT ")
+    case TY_POINTER:    call pargstr ("TY_POINTER")
+    }
+end
+
+
+
+# Generic Mem_ test assignment.
+
+define	NAVALS		4
+
+$for (bcsilrdx)
+
+procedure mt_auto_$t (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_PIXEL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_PIXEL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+    $if (datatype == b)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = TRUE
+	call eprintf ("[ %b %b %b %b ]\n")
+    $endif
+    $if (datatype == c)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = 'a' + i
+	call eprintf ("[ %-3c %-3c %-3c %-3c ]\n")
+    $endif
+    $if (datatype == x)
+        for (i=0; i < NAVALS; i=i+1) {
+	    x = i
+	    Mem$t[ip+i] = cmplx(x,0.1)
+	}
+	call eprintf ("[ %x  %x  %x  %x  ]\n")
+    $endif
+    $if (datatype == sil)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+    $endif
+    $if (datatype == rd)
+        for (i=0; i < NAVALS; i=i+1)
+	    Mem$t[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+    $endif
+        for (i=0; i < NAVALS; i=i+1)
+	    call parg$t (Mem$t[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_PIXEL)
+    else
+    	call sfree (sp)
+end
+
+$endfor
diff --git a/sys/nmemio/zzfoo.x b/sys/nmemio/zzfoo.x
new file mode 100644
index 00000000..a9e51dcf
--- /dev/null
+++ b/sys/nmemio/zzfoo.x
@@ -0,0 +1,908 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Test procedures for the NMEMIO interface.
+#
+
+include <mach.h>
+
+
+define	MT_HEAP		0			# test heap memory
+define	MT_STACK	1			# test stack memory
+
+
+task memtest 	= t_memtest,
+     stack   	= t_stack, 
+     realloc	= t_realloc
+
+
+#  MEMTEST -- Task to test new memio interface.
+
+procedure t_memtest ()
+
+int	model, nerr
+pointer str, ptr
+
+bool	clgetb()
+
+begin
+	if (clgetb ("stack"))
+	    model = MT_STACK
+	else
+	    model = MT_HEAP
+
+	# Check we can allocate a large array.
+	if (model == MT_HEAP) {
+	    call eprintf ("\nBegin large heap malloc tests ....\n\n")
+	    call malloc (str, 256000, TY_STRUCT)
+	    call mfree (str, TY_STRUCT)
+	    call eprintf ("Done\n\n")
+	
+	    # Print the memory layout.
+
+	        call mt_print (TY_CHAR)
+
+	        call mt_print (TY_SHORT)
+
+	        call mt_print (TY_INT)
+
+	        call mt_print (TY_BOOL)
+
+	        call mt_print (TY_LONG)
+
+	        call mt_print (TY_REAL)
+
+	        call mt_print (TY_DOUBLE)
+
+	        call mt_print (TY_COMPLEX)
+
+	    call mt_print (TY_STRUCT)
+	    call mt_print (TY_POINTER)
+	}
+
+	# Test Mem common assignments
+	call eprintf ("\nBegin assignment tests ....\n\n");
+	call mt_auto_b ("bool   ", model)
+	call mt_auto_c ("char   ", model)
+	call mt_auto_s ("short  ", model)
+	call mt_auto_i ("int    ", model)
+	call mt_auto_l ("long   ", model)
+	call mt_auto_r ("real   ", model)
+	call mt_auto_d ("double ", model)
+	call mt_auto_x ("complex", model)
+	call eprintf ("\nEnd assignment tests ....\n\n");
+
+
+	# Test string memory
+	call eprintf ("Begin Memc test\t\t");
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call aclrc (Memc[str], SZ_LINE)
+	call strcpy ("test string", Memc[str], SZ_LINE)
+	call eprintf ("str = '%s'  ch[2] = '%c' (should be 's')\n")
+	    call pargstr (Memc[str])
+	    call pargc (Memc[str+2])
+	call mfree (str, TY_CHAR)
+
+
+	# Test the struct memory
+	call eprintf ("\n\n")
+	call eprintf ("Begin struct test\n")
+	call mt_struct (model)
+	call eprintf ("Done\n")
+
+
+	# Test memory overflow and then underflow detection.
+	call eprintf ("\n\n")
+	call eprintf ("Testing overflow:\t")
+	nerr = 0
+
+	    iferr ( call mt_overflow (TY_CHAR) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_SHORT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_INT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_BOOL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_LONG) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_REAL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_DOUBLE) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_overflow (TY_COMPLEX) ) 
+		nerr = nerr + 1;
+
+	iferr ( call mt_overflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_overflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+	
+
+	call eprintf ("Testing underflow:\t")
+	nerr = 0
+
+	    iferr ( call mt_underflow (TY_CHAR) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_SHORT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_INT) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_BOOL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_LONG) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_REAL) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_DOUBLE) ) 
+		nerr = nerr + 1;
+
+	    iferr ( call mt_underflow (TY_COMPLEX) ) 
+		nerr = nerr + 1;
+
+	iferr ( call mt_underflow (TY_STRUCT) ) 
+	    nerr = nerr + 1;
+	iferr ( call mt_underflow (TY_POINTER) ) 
+	    nerr = nerr + 1;
+	call eprintf ("No. errors detected = %d  of 10\t\tDone\n")
+	    call pargi (nerr)
+
+
+	# Note this test will leak 1024 bytes because of the error recovery.
+	call eprintf ("Testing invalid free:\t")
+	call calloc (ptr, 256, TY_REAL)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing double free:\t")
+	call calloc (ptr, 256, TY_INT)
+	call mfree (ptr, TY_INT)
+	iferr ( call mfree (ptr, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing NULL free:\t")
+	iferr ( call mfree (NULL, TY_INT) )
+	    call eprintf ("Detected\t\t\t\t")
+	else
+	    call eprintf ("Undetected\t\t\t\t")
+	call eprintf ("Done\n")
+
+	call eprintf ("Testing recovered free:\n")
+	call calloc (str, SZ_LINE, TY_CHAR)
+	call eprintf ("Done\n")
+
+	call eprintf ("\n\nEnd of NMEMIO tests\n")
+end
+
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack ()
+
+int	bufsize
+pointer	sp, junk
+int	clglpi()
+
+begin
+	call smark (sp)
+
+	while (clglpi ("buffer_size", bufsize) != EOF) {
+	    call salloc (junk, bufsize, TY_CHAR)
+	    call printf ("buffer pointer=%d, size=%d\n")
+		call pargi (junk)
+		call pargi (bufsize)
+	    call flush (STDOUT)
+	}
+
+	call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer	a, b
+int	i, sza, new_sza, szb, new_szb
+
+begin
+	sza = SZ_FNAME
+	szb = SZ_LINE
+
+	call malloc (a, sza, TY_CHAR)
+	call malloc (b, szb, TY_CHAR)
+	call strcpy ("abcdefghijk", Memc[a], ARB)
+	call strcpy ("0123456789", Memc[b], ARB)
+
+	call eprintf ("a is at %d, size %d: %s\n")
+	    call pargi (a)
+	    call pargi (sza)
+	    call pargstr (Memc[a])
+	call eprintf ("b is at %d, size %d: %s\n")
+	    call pargi (b)
+	    call pargi (szb)
+	    call pargstr (Memc[b])
+	call eprintf ("-------------------------------\n")
+
+	for (i=1; i <= 10; i=i+1) {
+	    if (i < 5) {
+	        new_sza = sza + 512 ; new_szb = szb + 256
+	    } else {
+	        new_sza = sza + 256 ; new_szb = szb + 512
+	    }
+	    call realloc (a, new_sza, TY_CHAR)
+	    call realloc (b, new_szb, TY_CHAR)
+
+	    call eprintf ("%2d: a buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (a)
+		call pargi (sza)
+		call pargi (new_sza)
+		call pargstr (Memc[a])
+	    call eprintf ("%2d: b buf %d, size %d --> %d: %s\n")
+		call pargi (i)
+		call pargi (b)
+		call pargi (szb)
+		call pargi (new_szb)
+		call pargstr (Memc[b])
+
+	    sza = new_sza
+	    szb = new_szb
+	}
+
+	call mfree (a, TY_CHAR)
+	call mfree (b, TY_CHAR)
+end
+
+
+
+define	SZ_TEST		640
+define  F_I1		Memi[$1]
+define  F_I2		Memi[$1+1]
+define  F_L1		Meml[$1+2]
+define  F_L2		Meml[$1+3]
+define  F_R1		Memr[$1+4]
+define  F_R2		Memr[$1+5]
+define  F_D1		Memd[P2D($1+8)]
+define  F_D2		Memd[P2D($1+10)]
+define  F_I3		Memi[$1+12]
+define  F_I4		Memi[$1+13]
+define  F_S1		Mems[P2S($1+14)]
+define  F_S2		Mems[P2S($1+15)]
+
+
+procedure mt_struct (model)
+
+int	model
+
+pointer	sp, str
+real	x, y, z
+double  d1, d2, d3
+
+int	locva()
+
+begin
+	if (model == MT_HEAP) {
+	    call malloc (str, SZ_TEST, TY_STRUCT)
+	} else {
+	    call smark (sp)
+	    call salloc (str, SZ_TEST, TY_STRUCT)
+	}
+
+
+	F_I1(str) = 1
+	F_I2(str) = 2
+	F_L1(str) = 3
+	F_L2(str) = 4
+	F_R1(str) = 5.0
+	F_R2(str) = 6.0
+	F_D1(str) = 7.0
+	F_D2(str) = 8.0
+	F_I3(str) = 9
+	F_I4(str) = 10
+	F_S1(str) = 11
+	F_S2(str) = 12
+
+	x 	   = 2.717	;   d1 	   = F_R1(str)
+	y 	   = 2.717	;   d2 	   = 3.14159d0	;
+	z 	   = double(x)  ;   d3 	   = double(3.14159)
+
+	call eprintf ("\nd1=%.6g d2=%.6g d3=%.6g    x=%.6g y=%.6g z=%.6g)\n\n")
+	    call pargd (d1)  ; call pargd (d2) ; call pargd (d3)
+	    call pargr (x)   ; call pargr (y)  ; call pargr (z)
+
+	call eprintf ("Done Setting values ....\n\ntest = %d  %d  %d\n\n")
+	    call pargi (str) 
+	    call pargi (locva(str))
+	    call pargi (locva(F_I1(str)))
+
+	# call mdump (str, 64)
+
+	call eprintf ("I1 = %4d  I2 = %4d   \t%d %d\n")
+	    call pargi (F_I1(str))        ; call pargi (F_I2(str))
+	    call pargi (locva(F_I1(str))) ; call pargi (locva(F_I2(str)))
+
+	call eprintf ("L1 = %4d  L2 = %4d   \t%d %d\n")
+	    call pargl (F_L1(str))        ; call pargl (F_L2(str))
+	    call pargi (locva(F_L1(str))) ; call pargi (locva(F_L2(str)))
+
+	call eprintf ("R1 = %4.1f  R2 = %4.1f   \t%d %d\n")
+	    call pargr (F_R1(str))	  ; call pargr (F_R2(str))
+	    call pargi (locva(F_R1(str))) ; call pargi (locva(F_R2(str)))
+
+	call eprintf ("D1 = %4.1f  D2 = %4.1f   \t%d %d\n")
+	    call pargd (F_D1(str))	  ; call pargd (F_D2(str))
+	    call pargi (locva(F_D1(str))) ; call pargi (locva(F_D2(str)))
+
+	call eprintf ("I3 = %4d  I4 = %4d   \t%d %d\n")
+	    call pargi (F_I3(str))        ; call pargi (F_I4(str))
+	    call pargi (locva(F_I3(str))) ; call pargi (locva(F_I4(str)))
+
+	call eprintf ("S1 = %4d  S2 = %4d   \t%d %d\n")
+	    call pargs (F_S1(str))        ; call pargs (F_S2(str))
+	    call pargi (locva(F_S1(str))) ; call pargi (locva(F_S2(str)))
+
+
+        if (model == MT_HEAP)
+    	    call mfree (str, TY_STRUCT)
+        else
+    	    call sfree (sp)
+end
+
+
+define	NVALS		3
+
+procedure mt_print (dtype)
+
+int	dtype
+
+int	i, locva(), coerce()
+real	x
+double	xx
+pointer	p, bp, lwl
+
+begin
+    call calloc (p, NVALS, dtype)
+    bp = coerce (p, dtype, TY_INT)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    # Print the ptr header.
+    call eprintf ("\n")
+    call eprintf ("         p = 0x%-15x  %-16d\t%d\n")
+	call pargi (p)  ;  call pargi (p)  ;   call pargi (locva(Memi[bp]))
+    call eprintf ("       fwa = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-5)	; call pargi (Memi[bp-5])
+	call pargi (locva (Memi[bp-5]))
+    call eprintf ("       lwl = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-4)	; call pargi (Memi[bp-4])
+	call pargi (locva (Memi[bp-4]))
+    call eprintf ("     dtype = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-3)	; call mptype (dtype)
+	call pargi (locva (Memi[bp-3]))
+    call eprintf ("     nelem = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-2)	; call pargi (Memi[bp-2])
+	call pargi (locva (Memi[bp-2]))
+    call eprintf ("L sentinal = 0x%-15x  %-16d\t%d\n")
+	call pargi (bp-1)	; call pargi (Memi[bp-1])
+	call pargi (locva (Memi[bp-1]))
+
+
+    # Print the values.
+    call eprintf ("      data =    ")
+    for (i=0; i < NVALS; i=i+1) {
+	switch (dtype) {
+	case TY_BOOL:
+	    call eprintf (" %3b\t\t\t\t\t%-15d")
+		call pargb (Memb[p+i])
+		call pargi (locva(Memb[p+i]))
+	case TY_CHAR:
+	    call eprintf (" %3c\t\t\t\t\t%-15d")
+		call pargc (Memc[p+i])
+		call pargi (locva(Memc[p+i]))
+	case TY_SHORT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargs (Mems[p+i])
+		call pargi (locva(Mems[p+i]))
+	case TY_INT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_LONG:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargl (Meml[p+i])
+		call pargi (locva(Meml[p+i]))
+	case TY_REAL:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargr (Memr[p+i])
+		call pargi (locva(Memr[p+i]))
+	case TY_DOUBLE:
+	    call eprintf (" %3g\t\t\t\t\t%-15d")
+		call pargd (Memd[p+i])
+		call pargi (locva(Memd[p+i]))
+	case TY_COMPLEX:
+	    call eprintf (" %3x\t\t\t\t\t%-15d")
+		call pargx (Memx[p+i])
+		call pargi (locva(Memx[p+i]))
+	case TY_STRUCT:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	case TY_POINTER:
+	    call eprintf (" %3d\t\t\t\t\t%-15d")
+		call pargi (Memi[p+i])
+		call pargi (locva(Memi[p+i]))
+	}
+	call eprintf ("\n")
+	if (i < (NVALS-1))
+	    call eprintf ("\t\t")
+    }
+
+    lwl = Memi[bp-4]
+    call eprintf ("U sentinal = 0x%-15x  %-15d\t\t%d\n\n")
+	call pargi (lwl)	; call pargi (Memi[lwl])
+	call pargi (locva (Memi[lwl]))
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_overflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS + 4; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i
+	case TY_SHORT:	  Mems[p+i] = i
+	case TY_INT:	  Memi[p+i] = i
+	case TY_LONG:	  Meml[p+i] = i
+	case TY_REAL:	  Memr[p+i] = x
+	case TY_DOUBLE:	  Memd[p+i] = xx
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)
+	case TY_STRUCT:   Memi[p+i] = i
+	case TY_POINTER:  Memi[p+i] = i
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mt_underflow (dtype)
+
+int	dtype
+
+int	i
+real	x
+double	xx
+pointer	p
+
+begin
+    call calloc (p, NVALS, dtype)
+
+    # Set the values.
+    for (i=0; i < NVALS; i=i+1) {
+	x = i 	; xx = i
+	switch (dtype) {
+	case TY_BOOL:	  Memb[p+i] = TRUE		; Memb[p-1] = FALSE
+	case TY_CHAR:	  Memc[p+i] = 'a' + i		; Memc[p-1] = '0'
+	case TY_SHORT:	  Mems[p+i] = i			; Mems[p-1] = 999
+	case TY_INT:	  Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_LONG:	  Meml[p+i] = i			; Meml[p-1] = 999
+	case TY_REAL:	  Memr[p+i] = x			; Memr[p-1] = 999
+	case TY_DOUBLE:	  Memd[p+i] = xx		; Memd[p-1] = 999
+	case TY_COMPLEX:  Memx[p+i] = cmplx(x,-x)	; Memx[p-1] = 999
+	case TY_STRUCT:   Memi[p+i] = i			; Memi[p-1] = 999
+	case TY_POINTER:  Memi[p+i] = i			; Memi[p-1] = 999
+	}
+    }
+
+    call mfree (p, dtype)
+end
+
+
+procedure mptype (dtype)
+int	dtype
+begin
+    switch (dtype) {
+    case TY_BOOL:	call pargstr ("TY_BOOL   ")
+    case TY_CHAR:	call pargstr ("TY_CHAR   ")
+    case TY_SHORT:	call pargstr ("TY_SHORT  ")
+    case TY_INT:	call pargstr ("TY_INT    ")
+    case TY_LONG:	call pargstr ("TY_LONG   ")
+    case TY_REAL:	call pargstr ("TY_REAL   ")
+    case TY_DOUBLE:	call pargstr ("TY_DOUBLE ")
+    case TY_COMPLEX:    call pargstr ("TY_COMPLEX")
+    case TY_STRUCT:     call pargstr ("TY_STRUCT ")
+    case TY_POINTER:    call pargstr ("TY_POINTER")
+    }
+end
+
+
+
+# Generic Mem_ test assignment.
+
+define	NAVALS		4
+
+
+
+procedure mt_auto_b (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_BOOL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_BOOL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memb[ip+i] = TRUE
+	call eprintf ("[ %b %b %b %b ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargb (Memb[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_BOOL)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_c (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_CHAR)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_CHAR)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memc[ip+i] = 'a' + i
+	call eprintf ("[ %-3c %-3c %-3c %-3c ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargc (Memc[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_CHAR)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_s (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_SHORT)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_SHORT)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Mems[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargs (Mems[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_SHORT)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_i (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_INT)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_INT)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memi[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargi (Memi[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_INT)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_l (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_LONG)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_LONG)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Meml[ip+i] = i
+	call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargl (Meml[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_LONG)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_r (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_REAL)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_REAL)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memr[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargr (Memr[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_REAL)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_d (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_DOUBLE)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_DOUBLE)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1)
+	    Memd[ip+i] = i
+	call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargd (Memd[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_DOUBLE)
+    else
+    	call sfree (sp)
+end
+
+
+
+procedure mt_auto_x (ty, model)
+
+char	ty[ARB]
+int	model
+
+int	i
+real	x
+pointer	sp, ip
+
+begin
+    call eprintf ("  %s\t    ")
+	call pargstr (ty)
+
+    if (model == MT_HEAP) {
+    	call malloc (ip, NAVALS, TY_COMPLEX)
+    } else {
+    	call smark (sp)
+    	call salloc (ip, NAVALS, TY_COMPLEX)
+    }
+
+
+    call eprintf ("0x%-15x %-15d\t   ")
+	call pargi(ip)
+	call pargi(ip)
+
+    x = 0.0
+        for (i=0; i < NAVALS; i=i+1) {
+	    x = i
+	    Memx[ip+i] = cmplx(x,0.1)
+	}
+	call eprintf ("[ %x  %x  %x  %x  ]\n")
+        for (i=0; i < NAVALS; i=i+1)
+	    call pargx (Memx[ip+i])
+
+
+    if (model == MT_HEAP)
+    	call mfree (ip, TY_COMPLEX)
+    else
+    	call sfree (sp)
+end
+
+