aboutsummaryrefslogtreecommitdiff
path: root/sys/memdbg
diff options
context:
space:
mode:
Diffstat (limited to 'sys/memdbg')
-rw-r--r--sys/memdbg/README107
-rw-r--r--sys/memdbg/begmem.x65
-rw-r--r--sys/memdbg/calloc.x20
-rw-r--r--sys/memdbg/coerce.x25
-rw-r--r--sys/memdbg/kmalloc.x24
-rw-r--r--sys/memdbg/krealloc.x118
-rw-r--r--sys/memdbg/malloc.x42
-rw-r--r--sys/memdbg/malloc1.x92
-rw-r--r--sys/memdbg/memdbg.com4
-rw-r--r--sys/memdbg/memlog.c175
-rw-r--r--sys/memdbg/mfree.x31
-rw-r--r--sys/memdbg/mgdptr.x33
-rw-r--r--sys/memdbg/mgtfwa.x27
-rw-r--r--sys/memdbg/mkpkg27
-rw-r--r--sys/memdbg/msvfwa.x23
-rw-r--r--sys/memdbg/realloc.x25
-rw-r--r--sys/memdbg/salloc.x164
-rw-r--r--sys/memdbg/sizeof.x12
-rw-r--r--sys/memdbg/vmalloc.x31
-rw-r--r--sys/memdbg/zrtadr.c14
-rw-r--r--sys/memdbg/zzdebug.x190
21 files changed, 1249 insertions, 0 deletions
diff --git a/sys/memdbg/README b/sys/memdbg/README
new file mode 100644
index 00000000..1632e355
--- /dev/null
+++ b/sys/memdbg/README
@@ -0,0 +1,107 @@
+MEMDBG -- Debug version of MEMIO.
+
+This library may be linked with an application to perform runtime checks on
+the memory allocation subsystem to check for memory leaks. This library is
+used only for debugging and is not supported on all IRAF host systems.
+
+To use this package link the iraf process with the flags
+
+ -z -lmemdbg
+
+e.g.
+ xc -c zz.x; xc -z -o zz.e zz.o -lmemdbg
+
+or include -lmemdbg on the $link line in the mkpkg file.
+
+It may be desirable to edit the IRAF source code to insert MEMLOG messages
+or change the logging defaults. The following routines are provided for this
+purpose.
+
+ memlog (message)
+ memlog1 (message, arg1)
+ memlog2 (message, arg1, arg2)
+ memlogs (message, strarg)
+ memlev (loglevel)
+
+MEMLOG logs a simple message string. MEMLOG[12] allow one or two integer
+arguments. MEMLOGS allows one string argument.
+
+The debug level may be set with MEMLEV, as follows:
+
+ level = 1 log malloc/realloc/mfree calls
+ level = 2 log smark/sfree calls
+ level = 3 log both types of calls
+
+The default debug level is 3.
+
+Run one or more IRAF tasks in the process you want to debug and then type
+flpr to exit the process (debug logging is process level and ALL calls during
+the process lifetime are logged). When the IRAF process is run a file
+
+ mem.log
+
+will be left in the current directory. This contains a long sequence of lines
+such as the following:
+
+ 215738 00000696 18d74 A 1 malloc 572 type 10
+ 21929d 00000697 59e34 A 2 smark
+ 21929d 00000698 5a0aa F 2 sfree
+
+The columns are as follows.
+
+ bufadr Buffer address for malloc, mfree, smark, etc.
+ seqno Sequence number - order in which the calls were made
+ retadr Return address - identifies routine which made the call
+ action Action code - A (alloc), R (realloc), F (free)
+ class Class of allocator (1=malloc/mfree, 2=smark/sfree)
+ comment Describes the type of call, may give extra info
+
+This is just the raw debug output. To check the debug output to see if there
+are any calls that don't match up, the task MEMCHK in SOFTOOLS is used, e.g.,
+
+ cl> sort mem.log | memchk | sort col=2 > mem.log2
+
+This can also be run at the host level as follows.
+
+ % sort mem.log | x_softools.e memchk fname=STDIN passall+ | sort +1 > ...
+
+This may take a while for very large (> 10K lines) mem.log files. The
+output file will look like the input file except that any bad calls will be
+flagged with the string "####" at the end of the line.
+
+The RETADR field (printed in hex) can be used to determine what IRAF procedure
+made a particular call. On a Sun one can run
+
+ % nm -n x_whatever.e
+
+To list the symbol table sorted by address. The routine which made the call
+will be the .text routine with the greatest address which is less than
+retadr, i.e., retadr is an address within the text of the calling procedure.
+
+On a SysV system NM produces "pretty" output and is harder to use. The
+following command produces the necessary sorted list on my A/UX system.
+
+ % nm -e -x imexpr.e | sort -t\| +1
+
+Another way to do this is to let a debugger look up the symbol in the
+symbol table for us. Here is an example using adb.
+
+ % adb zz.e
+ 0x25f0?i
+ _foo_+0x28: call _xmallc_
+
+In this example the value of retadr is 0x25f0, the executable is the file
+zz.e, and the procedure which called the MEMIO (MEMDBG) routine malloc
+was "foo" according to adb.
+
+Note that memory debug logging starts during process startup and the first
+messages logged will record the MEMIO calls made by the system code. It is
+normal for the system code to allocate some buffers which are used for the
+lifetime of the process hence are never freed. A simple way to determine
+where the system MEMIO calls end and your task execution begins is to put a
+call such as
+
+ call memlog ("--------- start task -----------")
+
+in the first executable line of your IRAF task. Comments such as this will
+be preserved in the mem.log file.
diff --git a/sys/memdbg/begmem.x b/sys/memdbg/begmem.x
new file mode 100644
index 00000000..e61f6e1e
--- /dev/null
+++ b/sys/memdbg/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/memdbg/calloc.x b/sys/memdbg/calloc.x
new file mode 100644
index 00000000..c1b7ffb4
--- /dev/null
+++ b/sys/memdbg/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/memdbg/coerce.x b/sys/memdbg/coerce.x
new file mode 100644
index 00000000..7d42f3bf
--- /dev/null
+++ b/sys/memdbg/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/memdbg/kmalloc.x b/sys/memdbg/kmalloc.x
new file mode 100644
index 00000000..39f21ae0
--- /dev/null
+++ b/sys/memdbg/kmalloc.x
@@ -0,0 +1,24 @@
+# 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()
+int zrtadr()
+include "memdbg.com"
+
+begin
+ retaddr = zrtadr()
+ sz_align = SZ_MEMALIGN
+ call zlocva (Memc, fwa_align)
+ return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align))
+end
diff --git a/sys/memdbg/krealloc.x b/sys/memdbg/krealloc.x
new file mode 100644
index 00000000..7d61b998
--- /dev/null
+++ b/sys/memdbg/krealloc.x
@@ -0,0 +1,118 @@
+# 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/
+int zrtadr()
+include "memdbg.com"
+
+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)
+ }
+
+ if (retaddr == 0)
+ retaddr = zrtadr()
+ if (new_fwa != old_fwa) {
+ call zmemlg (old_fwa, retaddr, 'F', 1,
+ "realloc frees old buf", 0, 0)
+ call zmemlg (new_fwa, retaddr, 'A', 1,
+ "realloc allocs new buf", nelems * sizeof(dtype), 0)
+ } else {
+ call zmemlg (old_fwa, retaddr, 'R', 1,
+ "realloc %d", nelems * sizeof(dtype), 0)
+ }
+ retaddr = 0
+
+ # 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/memdbg/malloc.x b/sys/memdbg/malloc.x
new file mode 100644
index 00000000..4e5affba
--- /dev/null
+++ b/sys/memdbg/malloc.x
@@ -0,0 +1,42 @@
+# 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
+
+extern kmalloc(), krealloc(), mfree(), realloc(), salloc(), vmalloc()
+int first_time, locpr()
+
+int sz_align, fwa_align
+int malloc1()
+int zrtadr()
+include "memdbg.com"
+data first_time /0/
+
+begin
+ # Reference the other MEMDEBUG routines to force them to be loaded.
+ if (first_time == 0) {
+ retaddr = locpr (kmalloc)
+ retaddr = locpr (krealloc)
+ retaddr = locpr (mfree)
+ retaddr = locpr (realloc)
+ retaddr = locpr (salloc)
+ retaddr = locpr (vmalloc)
+ first_time = 1
+ }
+
+ retaddr = zrtadr()
+ 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/memdbg/malloc1.x b/sys/memdbg/malloc1.x
new file mode 100644
index 00000000..02682a59
--- /dev/null
+++ b/sys/memdbg/malloc1.x
@@ -0,0 +1,92 @@
+# 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()
+int zrtadr()
+include "memdbg.com"
+
+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 (retaddr == 0)
+ retaddr = zrtadr()
+ call zmemlg (fwa, retaddr, 'A', 1,
+ "malloc %d type %d", nelems * sizeof(dtype), dtype)
+ retaddr = 0
+
+ if (status == ERR)
+ return (ERR)
+ else {
+ output_pointer = msvfwa (fwa, dtype, sz_align, fwa_align)
+ return (OK)
+ }
+end
diff --git a/sys/memdbg/memdbg.com b/sys/memdbg/memdbg.com
new file mode 100644
index 00000000..f6688943
--- /dev/null
+++ b/sys/memdbg/memdbg.com
@@ -0,0 +1,4 @@
+# MEMDBG.COM -- Memory debug common.
+
+int retaddr
+common /memdbg/ retaddr
diff --git a/sys/memdbg/memlog.c b/sys/memdbg/memlog.c
new file mode 100644
index 00000000..c8e84281
--- /dev/null
+++ b/sys/memdbg/memlog.c
@@ -0,0 +1,175 @@
+#include <stdio.h>
+
+/* MEMLOG -- SPP callable routines for logging MEMIO debug messages and
+ * user application messages in sequence to the mem.log file.
+ *
+ * memlog (message)
+ * memlog1 (message, arg1)
+ * memlog2 (message, arg1, arg2)
+ * memlogs (message, strarg)
+ * memlev (loglevel)
+ *
+ * Memlog logs a simple message string. Memlog[12] allow one or two integer
+ * arguments. Memlogs allows one string argument.
+ */
+
+#define FNAME "mem.log"
+#define XCHAR short
+
+static FILE *fp = NULL;
+static int loglevel = 3;
+static int number = 0;
+
+#define LOG_MALLOC 0001
+#define LOG_SALLOC 0002
+
+static void memput();
+
+
+/* MEMLOG -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlog_ (message)
+XCHAR *message;
+{
+ register XCHAR *ip;
+ register char *op;
+ char p_message[1024];
+
+ for (ip=message, op=p_message; *op++ = *ip++; )
+ ;
+ memput (p_message);
+}
+
+
+/* MEMLEV -- Set the logging level.
+ */
+memlev_ (level)
+int *level;
+{
+ loglevel = *level;
+}
+
+
+/* MEMLOG1 -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlo1_ (format, arg1)
+XCHAR *format;
+int *arg1;
+{
+ register XCHAR *ip;
+ register char *op;
+ char p_format[1024];
+ char message[1024];
+
+ /* Output user message. */
+ for (ip=format, op=p_format; *op++ = *ip++; )
+ ;
+ sprintf (message, p_format, *arg1);
+ memput (message);
+}
+
+
+/* MEMLOG2 -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlo2_ (format, arg1, arg2)
+XCHAR *format;
+int *arg1;
+int *arg2;
+{
+ register XCHAR *ip;
+ register char *op;
+ char p_format[1024];
+ char message[1024];
+
+ /* Output user message. */
+ for (ip=format, op=p_format; *op++ = *ip++; )
+ ;
+ sprintf (message, p_format, *arg1, *arg2);
+ memput (message);
+}
+
+
+/* MEMLOGS -- User routine to log a message in sequence to the memio debug
+ * log file.
+ */
+memlos_ (format, strarg)
+XCHAR *format;
+XCHAR *strarg;
+{
+ register XCHAR *ip;
+ register char *op;
+ char p_format[1024];
+ char p_strarg[1024];
+ char message[1024];
+
+ /* Output user message. */
+ for (ip=format, op=p_format; *op++ = *ip++; )
+ ;
+ for (ip=strarg, op=p_strarg; *op++ = *ip++; )
+ ;
+ sprintf (message, p_format, p_strarg);
+ memput (message);
+}
+
+
+/* MEMPUT -- Log a message in sequence to the memio debug log file.
+ */
+static void
+memput (message)
+char *message;
+{
+ /* Open logfile. */
+ if (fp == NULL) {
+ unlink (FNAME);
+ if ((fp = fopen (FNAME, "a")) == NULL)
+ return;
+ }
+
+ /* Output sequence number. */
+ fprintf (fp, "%10s %08d %8s - - ",
+ "------", number++, "------");
+
+ /* Output message. */
+ fprintf (fp, message);
+ fprintf (fp, "\n");
+
+ fflush (fp);
+}
+
+
+/* ZMEMLG -- Used internally by the MEMIO routines.
+ */
+zmemlg_ (addr, retaddr, action, class, format, arg1, arg2)
+int *addr, *retaddr;
+int *action, *class;
+XCHAR *format;
+int *arg1, *arg2;
+{
+ register XCHAR *ip;
+ register char *op;
+ char p_format[1024];
+ char s_action[2];
+
+ if (!(loglevel & *class))
+ return;
+
+ for (ip=format, op=p_format; *op++ = *ip++; )
+ ;
+ s_action[0] = *action;
+ s_action[1] = '\0';
+
+ if (fp == NULL) {
+ unlink (FNAME);
+ if ((fp = fopen (FNAME, "a")) == NULL)
+ return;
+ }
+
+ fprintf (fp, "%10x %08d %8x %s %d ",
+ *addr, number++, *retaddr, s_action, *class);
+ fprintf (fp, p_format, *arg1, *arg2);
+ fprintf (fp, "\n");
+ fflush (fp);
+}
diff --git a/sys/memdbg/mfree.x b/sys/memdbg/mfree.x
new file mode 100644
index 00000000..e3dbef97
--- /dev/null
+++ b/sys/memdbg/mfree.x
@@ -0,0 +1,31 @@
+# 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
+int zrtadr()
+include "memdbg.com"
+
+begin
+ if (ptr != NULL) {
+ fwa = mgtfwa (ptr, dtype)
+ call zmemlg (fwa, zrtadr(), 'F', 1, "mfree", 0, 0)
+ retaddr = 0
+
+ call zmfree (fwa, status)
+ if (status == ERR)
+ call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted")
+
+ ptr = NULL
+ }
+end
diff --git a/sys/memdbg/mgdptr.x b/sys/memdbg/mgdptr.x
new file mode 100644
index 00000000..4c6cce22
--- /dev/null
+++ b/sys/memdbg/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 + 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/memdbg/mgtfwa.x b/sys/memdbg/mgtfwa.x
new file mode 100644
index 00000000..9b39f6eb
--- /dev/null
+++ b/sys/memdbg/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/memdbg/mkpkg b/sys/memdbg/mkpkg
new file mode 100644
index 00000000..985d6bdf
--- /dev/null
+++ b/sys/memdbg/mkpkg
@@ -0,0 +1,27 @@
+# Memory i/o (MEMIO) portion of the system library.
+
+$checkout libmemdbg.a lib$
+$update libmemdbg.a
+$checkin libmemdbg.a lib$
+$exit
+
+libmemdbg.a:
+ zrtadr.c
+ memlog.c
+
+ begmem.x <mach.h>
+ calloc.x
+ coerce.x <szdtype.inc>
+ kmalloc.x memdbg.com <config.h>
+ krealloc.x memdbg.com <config.h> <mach.h>
+ malloc.x memdbg.com <config.h>
+ malloc1.x memdbg.com <mach.h>
+ mfree.x memdbg.com
+ mgdptr.x
+ mgtfwa.x <config.h> <mach.h>
+ msvfwa.x
+ realloc.x memdbg.com
+ salloc.x memdbg.com <config.h> <szdtype.inc>
+ sizeof.x <szdtype.inc>
+ vmalloc.x memdbg.com <config.h> <mach.h>
+ ;
diff --git a/sys/memdbg/msvfwa.x b/sys/memdbg/msvfwa.x
new file mode 100644
index 00000000..d5df074d
--- /dev/null
+++ b/sys/memdbg/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/memdbg/realloc.x b/sys/memdbg/realloc.x
new file mode 100644
index 00000000..a3d1c866
--- /dev/null
+++ b/sys/memdbg/realloc.x
@@ -0,0 +1,25 @@
+# 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()
+int zrtadr()
+include "memdbg.com"
+
+begin
+ retaddr = zrtadr()
+ if (krealloc (ubufp, nelems, dtype) == ERR) {
+ ubufp = NULL
+ call syserr (SYS_MFULL)
+ }
+end
diff --git a/sys/memdbg/salloc.x b/sys/memdbg/salloc.x
new file mode 100644
index 00000000..7895b837
--- /dev/null
+++ b/sys/memdbg/salloc.x
@@ -0,0 +1,164 @@
+# 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/
+include "memdbg.com"
+int zrtadr()
+
+begin
+ if (first_time) {
+ sp = NULL
+ cur_seg = NULL
+ call stk_mkseg (cur_seg, sp, SZ_STACK)
+ first_time = false
+ }
+
+ call zmemlg (sp, zrtadr(), 'A', 2, " smark", 0, 0)
+ retaddr = 0
+ 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
+include "memdbg.com"
+int zrtadr()
+
+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
+
+ call zmemlg (old_sp, zrtadr(), 'F', 2, " sfree", 0, 0)
+ retaddr = 0
+
+ # 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/memdbg/sizeof.x b/sys/memdbg/sizeof.x
new file mode 100644
index 00000000..3b4977fe
--- /dev/null
+++ b/sys/memdbg/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/memdbg/vmalloc.x b/sys/memdbg/vmalloc.x
new file mode 100644
index 00000000..5b1dc7d0
--- /dev/null
+++ b/sys/memdbg/vmalloc.x
@@ -0,0 +1,31 @@
+# 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()
+int zrtadr()
+include "memdbg.com"
+
+begin
+ retaddr = zrtadr()
+ 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/memdbg/zrtadr.c b/sys/memdbg/zrtadr.c
new file mode 100644
index 00000000..7bf9dc2f
--- /dev/null
+++ b/sys/memdbg/zrtadr.c
@@ -0,0 +1,14 @@
+/* ZRTADR -- Return the program address from which the routine calling zrtadr
+ * was called. If zrtadr is called in procedure B and B is called from
+ * procedure A, the address returned by zrtadr will be the address in A
+ * following the call to procedure B. This can be used to determine which
+ * procedure called B.
+ *
+ * This is a portable stub for the actual routine, which is machine dependent
+ * and normally written in assembler.
+ */
+
+zrtadr_()
+{
+ return (0);
+}
diff --git a/sys/memdbg/zzdebug.x b/sys/memdbg/zzdebug.x
new file mode 100644
index 00000000..57fb1874
--- /dev/null
+++ b/sys/memdbg/zzdebug.x
@@ -0,0 +1,190 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <ctype.h>
+
+# ZZDEBUG.X -- Debug MEMIO.
+
+task memchk = t_memchk,
+ stack = t_stack,
+ realloc = t_realloc
+
+
+# MEMCHK -- Scan the mem.log output produced by the debug version of MEMIO
+# (this must be sorted first) and check for memory which is allocated but
+# never freed.
+
+procedure t_memchk()
+
+int fd, ip
+bool passall, mark
+int addr, retaddr, seqno, action, class
+int old_addr, old_seqno, old_action
+char lbuf[SZ_LINE], old_lbuf[SZ_LINE]
+char descr[SZ_LINE], old_descr[SZ_LINE]
+char tokbuf[SZ_FNAME], fname[SZ_FNAME]
+
+bool clgetb()
+int open(), getline(), nscan(), gctol()
+define print_ 91
+
+begin
+ call clgstr ("fname", fname, SZ_FNAME)
+ fd = open (fname, READ_ONLY, TEXT_FILE)
+
+ passall = clgetb ("passall")
+ old_addr = 0
+ old_action = 0
+
+ while (getline (fd, lbuf) != EOF) {
+ # Scan next line.
+ call sscan (lbuf)
+ call gargwrd (tokbuf, SZ_FNAME)
+ ip = 1; ip = gctol (tokbuf, ip, addr, 16)
+ call gargi (seqno)
+ call gargwrd (tokbuf, SZ_FNAME)
+ ip = 1; ip = gctol (tokbuf, ip, retaddr, 16)
+ call gargwrd (tokbuf, SZ_FNAME)
+ action = tokbuf[1]
+ call gargi (class)
+ call gargstr (descr, SZ_LINE)
+
+ if (nscan() < 4) {
+ if (passall)
+ call putline (STDOUT, lbuf)
+ next
+ }
+
+ if (addr != old_addr) {
+ # Starting a log for a new buffer address.
+ if (old_lbuf[1] != EOS) {
+ if (IS_ALPHA(old_action) && old_action != 'F') {
+ ip = 1
+ while (old_lbuf[ip] != '\n' && old_lbuf[ip] != EOS)
+ ip = ip + 1
+ old_lbuf[ip] = EOS
+ call printf ("%s %70t####\n")
+ call pargstr (old_lbuf)
+
+ } else if (passall)
+ call putline (STDOUT, old_lbuf)
+ }
+
+ } else {
+ # Verify operation on a particular buffer address.
+
+ if (old_lbuf[1] != EOS && passall)
+ call putline (STDOUT, old_lbuf)
+
+ mark = false
+ if (IS_ALPHA(action) && class == 1)
+ switch (old_action) {
+ case 'A', 'R':
+ if (action != 'R' && action != 'F')
+ mark = true
+ case 'F':
+ if (action != 'A')
+ mark = true
+ }
+
+ if (mark) {
+ ip = 1
+ while (lbuf[ip] != '\n' && lbuf[ip] != EOS)
+ ip = ip + 1
+ lbuf[ip] = EOS
+ call printf ("%s %70t####\n")
+ call pargstr (lbuf)
+ lbuf[1] = EOS
+ }
+ }
+
+ old_addr = addr
+ old_seqno = seqno
+ old_action = action
+ call strcpy (descr, old_descr, SZ_LINE)
+ call strcpy (lbuf, old_lbuf, SZ_LINE)
+ }
+
+ if (old_lbuf[1] != EOS && passall)
+ call putline (STDOUT, old_lbuf)
+end
+
+
+# STACK -- 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
+
+
+# REALLOC -- 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