Initial commit

5 files changed, 226 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/tcheck/cmdsplit.x b/pkg/utilities/nttools/tcheck/cmdsplit.x
new file mode 100644
index 00000000..7fa7e714
--- /dev/null
+++ b/pkg/utilities/nttools/tcheck/cmdsplit.x
@@ -0,0 +1,57 @@
+include "tcheck.h"
+
+# CMDSPLIT -- Split a command into keyword and expression strings
+
+procedure cmdsplit (command, keystart, cmdstart)
+
+char	command[ARB]	# io: Command line
+int	keystart	#  o: Start of keyword substring
+int	cmdstart	#  o: Start of command substring
+#--
+char	comment
+int	ic, jc
+pointer	sp, keyword
+
+data	comment  / '#' /
+
+string	noexpress  "No expression following when"
+
+bool	streq()
+int	stridx(), word_fetch()
+
+begin
+	call smark (sp)
+	call salloc (keyword, SZ_FNAME, TY_CHAR)
+
+	# Strip comments from command line
+
+	ic = stridx (comment, command)
+	if (ic > 0)
+	    command[ic] = EOS
+
+	# Set output variables to default values
+
+	keystart = 1
+	cmdstart = 0
+
+	# Find location of "when" in command and split the line there
+
+	ic = 1
+	jc = 0
+	while (word_fetch (command, ic, Memc[keyword], SZ_FNAME) > 0) {
+	    if (jc > 0 && streq (Memc[keyword], "when")) {
+		command[jc] = EOS
+		cmdstart = ic
+		break
+	    }
+	    jc = ic
+	}
+
+	# Exit with error if no expression was found
+
+	if (cmdstart == 0 && jc > 0)
+	    call error (SYNTAX, noexpress)
+
+	call sfree (sp)
+end
+
diff --git a/pkg/utilities/nttools/tcheck/mkpkg b/pkg/utilities/nttools/tcheck/mkpkg
new file mode 100644
index 00000000..a5a0812b
--- /dev/null
+++ b/pkg/utilities/nttools/tcheck/mkpkg
@@ -0,0 +1,13 @@
+# Update the tcheck application code in the ttools package library
+# Author: B.Simon, 22-AUG-1990
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	cmdsplit.x	"tcheck.h"
+	tcheck.x	<tbset.h>  "tcheck.h"
+	wrtcheck.x
+	;
diff --git a/pkg/utilities/nttools/tcheck/tcheck.h b/pkg/utilities/nttools/tcheck/tcheck.h
new file mode 100644
index 00000000..6f08cede
--- /dev/null
+++ b/pkg/utilities/nttools/tcheck/tcheck.h
@@ -0,0 +1,4 @@
+# TCHECK.H -- Symbolic constants used by tcheck
+
+define SYNTAX		1	# Syntax errors in evexpr
+
diff --git a/pkg/utilities/nttools/tcheck/tcheck.x b/pkg/utilities/nttools/tcheck/tcheck.x
new file mode 100644
index 00000000..e23408e0
--- /dev/null
+++ b/pkg/utilities/nttools/tcheck/tcheck.x
@@ -0,0 +1,91 @@
+include <tbset.h>
+include "tcheck.h"
+
+# TCHECK -- Perform a consistency check on the rows of a table
+#
+# B.Simon	20-Aug-90	Original
+# B.Simon	29-Jul-92	Fixed bug occuring when irow > nrow
+# Phil Hodge	 4-Oct-95	Use table name template routines tbnopenp, etc.
+
+procedure tcheck ()
+
+#--
+pointer	input		# Table file name template
+pointer	chkfile		# Text file containing consistency checks
+
+bool	title		
+int	fd, iline, nc
+int	keystart, cmdstart, irow, jrow, nrow
+pointer	sp, tabname, errmsg, command, tp
+
+string	badexpr  "Syntax error: %s"
+
+int	open(), tbnget(), getlongline()
+int	tbpsta(), strlen(), tbl_search()
+pointer	tbnopenp(), tbtopn()
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (chkfile, SZ_FNAME, TY_CHAR)
+	call salloc (tabname, SZ_FNAME, TY_CHAR)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+	call salloc (command, SZ_COMMAND, TY_CHAR)
+
+	# Read the task parameters
+
+	input = tbnopenp ("input")
+	call clgstr ("chkfile", Memc[chkfile], SZ_FNAME)
+
+	fd = open (Memc[chkfile], READ_ONLY, TEXT_FILE)
+
+	# Check each table
+
+	while (tbnget (input, Memc[tabname], SZ_FNAME) != EOF) {
+	    call seek (fd, BOF)
+	    tp = tbtopn (Memc[tabname], READ_ONLY, NULL)
+	    nrow = tbpsta (tp, TBL_NROWS)
+	    title = true
+
+	    # Get each line from the command file
+
+	    repeat {
+		nc  = getlongline (fd, Memc[command], SZ_COMMAND, iline)
+		if (nc <= 0)
+		    break
+
+		Memc[command+nc-1] = EOS
+		call cmdsplit (Memc[command], keystart, cmdstart)
+		if (cmdstart > 0) {
+		    irow = 1
+		    while (irow <= nrow) {
+			jrow = tbl_search (tp, Memc[command+cmdstart-1], 
+					   irow, nrow)
+			if (jrow == 0) {
+			    break
+
+			} else if (jrow == ERR) {
+			    call xer_reset
+			    if (strlen (Memc[command+cmdstart-1]) > 60)
+				call strcat (" ...", Memc[command+cmdstart+60],
+					     SZ_COMMAND)
+
+			    call sprintf (Memc[errmsg], SZ_LINE, badexpr)
+			    call pargstr (Memc[command+cmdstart-1])
+			    call error (SYNTAX, Memc[errmsg])
+
+			} else {
+			    call wrt_check (tp, jrow, Memc[command+keystart-1],
+					    Memc[command+cmdstart-1], title)
+			    irow = jrow + 1
+			}
+		    }
+		}
+	    }
+	    call tbtclo (tp)
+	}	
+
+	call tbnclose (input)
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/tcheck/wrtcheck.x b/pkg/utilities/nttools/tcheck/wrtcheck.x
new file mode 100644
index 00000000..b14ec542
--- /dev/null
+++ b/pkg/utilities/nttools/tcheck/wrtcheck.x
@@ -0,0 +1,61 @@
+# WRT_CHECK -- Write the table values that pass the check
+
+procedure wrt_check (tp, irow, keylist, command, title)
+
+pointer	tp		#  i: Table descriptor
+int	irow		#  i: Table row number
+char	keylist[ARB]	#  i: List of keywords to print
+char	command[ARB]	# io: Expression used in check
+bool	title		# io: Print title?
+#--
+int	ic
+pointer	sp, tabname, ldir, keyword, newcmd, value, root, col
+
+int	fnldir(), gstrcpy(), word_fetch()
+
+begin
+	call smark (sp)
+	call salloc (tabname, SZ_FNAME, TY_CHAR)
+	call salloc (ldir, SZ_FNAME, TY_CHAR)
+	call salloc (keyword, SZ_FNAME, TY_CHAR)
+	call salloc (newcmd, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_LINE, TY_CHAR)
+
+	# Print title if this is the first error found in this table
+
+	if (title) {
+	    title = false
+	    call tbtnam (tp, Memc[tabname], SZ_FNAME)
+	    root = tabname + fnldir (Memc[tabname], Memc[ldir], SZ_FNAME)
+
+	    call printf ("#\n#%11t%-60s\n#\n")
+	    call pargstr (Memc[root])
+	}
+
+	# Truncate command to 60 characters
+
+	if (gstrcpy (command, Memc[newcmd], 60) == 60)
+	    call strcat (" ...", Memc[newcmd], SZ_FNAME)
+
+	# Print each keyword name, value, and associated command
+
+	ic = 1
+	while (word_fetch (keylist, ic, Memc[keyword], SZ_FNAME) > 0) {
+	    call tbcfnd (tp, Memc[keyword], col, 1)
+	    if (col != NULL) {
+		call tbegtt (tp, col, irow, Memc[value], SZ_LINE)
+
+		call printf ("%-5d%-20s%-20s%-30s\n")
+		call pargi (irow)
+		call pargstr (Memc[keyword])
+		call pargstr (Memc[value])
+		call pargstr (Memc[newcmd])
+
+	    } else {
+		call printf ("%-5d%-20s missing\n")
+		call pargi (irow)
+		call pargstr (Memc[keyword])
+	    }
+	}
+	call sfree (sp)
+end