Initial commit

20 files changed, 1455 insertions, 0 deletions

diff --git a/sys/memio/README b/sys/memio/README
new file mode 100644
index 00000000..597f1114
--- /dev/null
+++ b/sys/memio/README
@@ -0,0 +1 @@
+MEMIO -- Memory allocation and management facilities.
diff --git a/sys/memio/begmem.x b/sys/memio/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/memio/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/memio/calloc.x b/sys/memio/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/memio/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/memio/coerce.x b/sys/memio/coerce.x
new file mode 100644
index 00000000..7d42f3bf
--- /dev/null
+++ b/sys/memio/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/memio/doc/memio.hlp b/sys/memio/doc/memio.hlp
new file mode 100644
index 00000000..1bc5c0a0
--- /dev/null
+++ b/sys/memio/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/memio/kmalloc.x b/sys/memio/kmalloc.x
new file mode 100644
index 00000000..7bfc4ee0
--- /dev/null
+++ b/sys/memio/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/memio/krealloc.x b/sys/memio/krealloc.x
new file mode 100644
index 00000000..5c6198c8
--- /dev/null
+++ b/sys/memio/krealloc.x
@@ -0,0 +1,103 @@
+# 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, 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)
+		nchars = nelems + 1 + SZ_INT + SZ_MEMALIGN
+	    else
+		nchars = nelems * sizeof(dtype) + 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) {
+		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.
+
+	    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, SZ_MEMALIGN, loc_Mem)
+	}
+
+	return (OK)
+end
diff --git a/sys/memio/malloc.x b/sys/memio/malloc.x
new file mode 100644
index 00000000..d5886c36
--- /dev/null
+++ b/sys/memio/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/memio/malloc1.x b/sys/memio/malloc1.x
new file mode 100644
index 00000000..33001ff1
--- /dev/null
+++ b/sys/memio/malloc1.x
@@ -0,0 +1,84 @@
+# 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)
+
+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 the
+integer location immediately 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, status
+int	sizeof()
+pointer	msvfwa()
+
+begin
+	if (dtype == TY_CHAR)
+	    nchars = nelems + 1 + SZ_INT + sz_align	# add space for EOS
+	else
+	    nchars = nelems * sizeof (dtype) + SZ_INT + sz_align
+
+	call zmaloc (fwa, nchars * SZB_CHAR, status)
+
+	if (status == ERR)
+	    return (ERR)
+	else {
+	    output_pointer = msvfwa (fwa, dtype, sz_align, fwa_align)
+	    return (OK)
+	}
+end
diff --git a/sys/memio/mfree.x b/sys/memio/mfree.x
new file mode 100644
index 00000000..f7c83f1d
--- /dev/null
+++ b/sys/memio/mfree.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.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	fwa, dtype, status
+int	mgtfwa()
+errchk	mgtfwa
+
+begin
+	if (ptr != NULL) {
+	    fwa = mgtfwa (ptr, dtype)
+
+	    call zmfree (fwa, status)
+	    if (status == ERR)
+		call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	    ptr = NULL
+	}
+end
diff --git a/sys/memio/mgdptr.x b/sys/memio/mgdptr.x
new file mode 100644
index 00000000..4efc628c
--- /dev/null
+++ b/sys/memio/mgdptr.x
@@ -0,0 +1,34 @@
+# 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
+int	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 + 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/memio/mgtfwa.x b/sys/memio/mgtfwa.x
new file mode 100644
index 00000000..9b39f6eb
--- /dev/null
+++ b/sys/memio/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-1]
+	call zlocva (Memi[bufptr-1], locbuf)
+
+	if (abs (locbuf - fwa) > SZ_VMEMALIGN)
+	    call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+	return (fwa)
+end
diff --git a/sys/memio/mkpkg b/sys/memio/mkpkg
new file mode 100644
index 00000000..c9c86f23
--- /dev/null
+++ b/sys/memio/mkpkg
@@ -0,0 +1,24 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+libsys.a:
+	begmem.x	<mach.h>
+	calloc.x	
+	coerce.x	<szdtype.inc>
+	kmalloc.x	<config.h>
+	krealloc.x	<config.h> <mach.h>
+	malloc.x	<config.h>
+	malloc1.x	<mach.h>
+	mfree.x	
+	mgdptr.x	
+	mgtfwa.x	<config.h> <mach.h>
+	msvfwa.x	
+	realloc.x	
+	salloc.x	<config.h> <szdtype.inc>
+	sizeof.x	<szdtype.inc>
+	vmalloc.x	<config.h> <mach.h>
+	;
diff --git a/sys/memio/msvfwa.x b/sys/memio/msvfwa.x
new file mode 100644
index 00000000..d5df074d
--- /dev/null
+++ b/sys/memio/msvfwa.x
@@ -0,0 +1,23 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# 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, sz_align, fwa_align)
+
+int	fwa, dtype, sz_align, fwa_align
+pointer	bufptr, mgdptr()
+int	coerce()
+
+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)
+	Memi[bufptr-1] = fwa
+
+	# Return pointer of type dtype to the first cell of the data area.
+	return (coerce (bufptr, TY_INT, dtype))
+end
diff --git a/sys/memio/realloc.x b/sys/memio/realloc.x
new file mode 100644
index 00000000..40229b8f
--- /dev/null
+++ b/sys/memio/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/memio/salloc.x b/sys/memio/salloc.x
new file mode 100644
index 00000000..34f06217
--- /dev/null
+++ b/sys/memio/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/memio/sizeof.x b/sys/memio/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/memio/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/memio/vmalloc.x b/sys/memio/vmalloc.x
new file mode 100644
index 00000000..25e2de0d
--- /dev/null
+++ b/sys/memio/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/memio/zzdebug.c b/sys/memio/zzdebug.c
new file mode 100644
index 00000000..35b0f7ad
--- /dev/null
+++ b/sys/memio/zzdebug.c
@@ -0,0 +1,366 @@
+/* zzdebug.x -- translated by f2c (version 20061008).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+
+/* Common Block Declarations */
+
+struct {
+    logical xerflg, xerpad[84];
+} xercom_;
+
+#define xercom_1 xercom_
+
+struct {
+    doublereal memd[1];
+} mem_;
+
+#define mem_1 mem_
+
+/* Table of constant values */
+
+static integer c__4 = 4;
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c__2 = 2;
+static integer c__1023 = 1023;
+static integer c_b46 = 999999999;
+
+integer sysruk_(task, cmd, rukarf, rukint)
+shortint *task, *cmd;
+integer *rukarf, *rukint;
+{
+    /* Initialized data */
+
+    static shortint dict[14] = { 115,116,97,99,107,0,114,101,97,108,108,111,
+	    99,0 };
+    static shortint st0009[29] = { 105,110,118,97,108,105,100,32,115,101,116,
+	    32,115,116,97,116,101,109,101,110,116,58,32,39,37,115,39,10,0 };
+    static shortint st0010[25] = { 105,110,118,97,108,105,100,32,83,69,84,32,
+	    105,110,32,73,82,65,70,32,77,97,105,110,0 };
+    static integer dp[3] = { 1,7,0 };
+    static integer lmarg = 5;
+    static integer maxch = 0;
+    static integer ncol = 0;
+    static integer rukean = 3;
+    static integer ntasks = 0;
+    static shortint st0001[9] = { 116,116,121,110,99,111,108,115,0 };
+    static shortint st0002[6] = { 99,104,100,105,114,0 };
+    static shortint st0003[3] = { 99,100,0 };
+    static shortint st0004[6] = { 104,111,109,101,36,0 };
+    static shortint st0005[6] = { 72,79,77,69,36,0 };
+    static shortint st0006[4] = { 115,101,116,0 };
+    static shortint st0007[6] = { 114,101,115,101,116,0 };
+    static shortint st0008[2] = { 9,0 };
+
+    /* System generated locals */
+    integer ret_val;
+
+    /* Local variables */
+    static integer i__, rmarg;
+    extern logical streq_();
+    extern /* Subroutine */ integer trealc_();
+    extern integer envgei_();
+    extern /* Subroutine */ integer xfchdr_(), erract_(), eprinf_(), tstack_()
+	    ;
+    extern integer envscn_();
+    extern /* Subroutine */ integer xffluh_(), pargsr_(), envlit_(), syspac_()
+	    , xerpsh_(), strtbl_();
+    extern logical xerpop_();
+    extern /* Subroutine */ integer zzepro_();
+
+    /* Parameter adjustments */
+    --cmd;
+    --task;
+
+    /* Function Body */
+    if (! (ntasks == 0)) {
+	goto L110;
+    }
+    i__ = 1;
+L120:
+    if (! (dp[i__ - 1] != 0)) {
+	goto L122;
+    }
+/* L121: */
+    ++i__;
+    goto L120;
+L122:
+    ntasks = i__ - 1;
+L110:
+    if (! (task[1] == 63)) {
+	goto L130;
+    }
+    xerpsh_();
+    rmarg = envgei_(st0001);
+    if (! xerpop_()) {
+	goto L140;
+    }
+    rmarg = 80;
+L140:
+    strtbl_(&c__4, dict, dp, &ntasks, &lmarg, &rmarg, &maxch, &ncol);
+    ret_val = 0;
+    goto L100;
+L130:
+    if (! (streq_(&task[1], st0002) || streq_(&task[1], st0003))) {
+	goto L150;
+    }
+    xerpsh_();
+    if (! (cmd[*rukarf] == 0)) {
+	goto L170;
+    }
+    xerpsh_();
+    xfchdr_(st0004);
+    if (! xerpop_()) {
+	goto L180;
+    }
+    xfchdr_(st0005);
+L180:
+    goto L171;
+L170:
+    xfchdr_(&cmd[*rukarf]);
+L171:
+/* L162: */
+    if (! xerpop_()) {
+	goto L160;
+    }
+    if (! (*rukint == 1)) {
+	goto L190;
+    }
+    erract_(&rukean);
+    if (xercom_1.xerflg) {
+	goto L100;
+    }
+    goto L191;
+L190:
+L191:
+L160:
+    ret_val = 0;
+    goto L100;
+L150:
+    if (! (streq_(&task[1], st0006) || streq_(&task[1], st0007))) {
+	goto L200;
+    }
+    xerpsh_();
+    if (! (cmd[*rukarf] == 0)) {
+	goto L220;
+    }
+    envlit_(&c__4, st0008, &c__1);
+    xffluh_(&c__4);
+    goto L221;
+L220:
+    if (! (envscn_(&cmd[1]) <= 0)) {
+	goto L230;
+    }
+    if (! (*rukint == 1)) {
+	goto L240;
+    }
+    eprinf_(st0009);
+    pargsr_(&cmd[1]);
+    goto L241;
+L240:
+    goto L91;
+L241:
+L230:
+L221:
+/* L212: */
+    if (! xerpop_()) {
+	goto L210;
+    }
+    if (! (*rukint == 1)) {
+	goto L250;
+    }
+    erract_(&rukean);
+    if (xercom_1.xerflg) {
+	goto L100;
+    }
+    goto L251;
+L250:
+L91:
+    syspac_(&c__0, st0010);
+L251:
+L210:
+    ret_val = 0;
+    goto L100;
+L200:
+/* L151: */
+/* L131: */
+    if (! streq_(&task[1], &dict[dp[0] - 1])) {
+	goto L260;
+    }
+    tstack_();
+    ret_val = 0;
+    goto L100;
+L260:
+    if (! streq_(&task[1], &dict[dp[1] - 1])) {
+	goto L270;
+    }
+    trealc_();
+    ret_val = 0;
+    goto L100;
+L270:
+    ret_val = -1;
+    goto L100;
+L100:
+    zzepro_();
+    return ret_val;
+} /* sysruk_ */
+
+/* Subroutine */ integer tstack_()
+{
+    /* Initialized data */
+
+    static shortint st0001[12] = { 98,117,102,102,101,114,95,115,105,122,101,
+	    0 };
+    static shortint st0002[28] = { 98,117,102,102,101,114,32,112,111,105,110,
+	    116,101,114,61,37,100,44,32,115,105,122,101,61,37,100,10,0 };
+
+    /* Local variables */
+    static integer sp;
+#define memb ((logical *)&mem_1)
+#define memc ((shortint *)&mem_1)
+#define memi ((integer *)&mem_1)
+#define meml ((integer *)&mem_1)
+#define memr ((real *)&mem_1)
+#define mems ((shortint *)&mem_1)
+#define memx ((complex *)&mem_1)
+    static integer junk;
+    extern /* Subroutine */ integer pargi_(), sfree_(), smark_();
+    extern integer clglpi_();
+    static integer bufsie;
+    extern /* Subroutine */ integer salloc_(), xffluh_(), xprinf_(), zzepro_()
+	    ;
+
+    smark_(&sp);
+L110:
+    if (! (clglpi_(st0001, &bufsie) != -2)) {
+	goto L111;
+    }
+    salloc_(&junk, &bufsie, &c__2);
+    xprinf_(st0002);
+    pargi_(&junk);
+    pargi_(&bufsie);
+    xffluh_(&c__4);
+    goto L110;
+L111:
+    sfree_(&sp);
+/* L100: */
+    zzepro_();
+    return 0;
+} /* tstack_ */
+
+#undef memx
+#undef mems
+#undef memr
+#undef meml
+#undef memi
+#undef memc
+#undef memb
+
+
+/* Subroutine */ integer trealc_()
+{
+    /* Initialized data */
+
+    static shortint st0001[12] = { 97,98,99,100,101,102,103,104,105,106,107,0 
+	    };
+    static shortint st0002[11] = { 48,49,50,51,52,53,54,55,56,57,0 };
+    static shortint st0003[25] = { 97,32,105,115,32,97,116,32,37,100,44,32,
+	    115,105,122,101,32,37,100,58,32,37,115,10,0 };
+    static shortint st0004[25] = { 98,32,105,115,32,97,116,32,37,100,44,32,
+	    115,105,122,101,32,37,100,58,32,37,115,10,0 };
+    static shortint st0005[33] = { 45,45,45,45,45,45,45,45,45,45,45,45,45,45,
+	    45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,10,0 };
+    static shortint st0006[10] = { 97,95,98,117,102,115,105,122,101,0 };
+    static shortint st0007[10] = { 98,95,98,117,102,115,105,122,101,0 };
+    static shortint st0008[30] = { 97,32,98,117,102,32,37,100,44,32,115,105,
+	    122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 };
+    static shortint st0009[30] = { 98,32,98,117,102,32,37,100,44,32,115,105,
+	    122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 };
+
+    /* Local variables */
+    static integer a, b, sza, szb;
+#define memb ((logical *)&mem_1)
+#define memc ((shortint *)&mem_1)
+#define memi ((integer *)&mem_1)
+#define meml ((integer *)&mem_1)
+#define memr ((real *)&mem_1)
+#define mems ((shortint *)&mem_1)
+#define memx ((complex *)&mem_1)
+    extern /* Subroutine */ integer pargi_();
+    extern integer clgeti_();
+    extern /* Subroutine */ integer xrealc_(), xmallc_(), eprinf_(), xmfree_()
+	    , pargsr_();
+    static integer newsza, newszb;
+    extern /* Subroutine */ integer zzepro_(), xstrcy_();
+
+    xmallc_(&a, &c__1023, &c__2);
+    xstrcy_(st0001, &memc[a - 1], &c_b46);
+    sza = 1023;
+    xmallc_(&b, &c__1023, &c__2);
+    xstrcy_(st0002, &memc[b - 1], &c_b46);
+    szb = 1023;
+    eprinf_(st0003);
+    pargi_(&a);
+    pargi_(&sza);
+    pargsr_(&memc[a - 1]);
+    eprinf_(st0004);
+    pargi_(&b);
+    pargi_(&szb);
+    pargsr_(&memc[b - 1]);
+    eprinf_(st0005);
+L110:
+    newsza = clgeti_(st0006);
+    if (! (newsza == 0)) {
+	goto L120;
+    }
+    goto L100;
+L120:
+    xrealc_(&a, &newsza, &c__2);
+    newszb = clgeti_(st0007);
+    if (! (newszb == 0)) {
+	goto L130;
+    }
+    goto L100;
+L130:
+    xrealc_(&b, &newszb, &c__2);
+    eprinf_(st0008);
+    pargi_(&a);
+    pargi_(&sza);
+    pargi_(&newsza);
+    pargsr_(&memc[a - 1]);
+    eprinf_(st0009);
+    pargi_(&b);
+    pargi_(&szb);
+    pargi_(&newszb);
+    pargsr_(&memc[b - 1]);
+    sza = newsza;
+    szb = newszb;
+/* L111: */
+    goto L110;
+/* L112: */
+    xmfree_(&a, &c__2);
+    xmfree_(&b, &c__2);
+L100:
+    zzepro_();
+    return 0;
+} /* trealc_ */
+
+#undef memx
+#undef mems
+#undef memr
+#undef meml
+#undef memi
+#undef memc
+#undef memb
+
+
diff --git a/sys/memio/zzdebug.x b/sys/memio/zzdebug.x
new file mode 100644
index 00000000..556c4fa1
--- /dev/null
+++ b/sys/memio/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