1 files changed, 102 insertions, 0 deletions
diff --git a/pkg/softools/memchk.x b/pkg/softools/memchk.x
new file mode 100644
index 00000000..8fc5eef4
--- /dev/null
+++ b/pkg/softools/memchk.x
@@ -0,0 +1,102 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+
+# 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