3 files changed, 178 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/tselect/mkpkg b/pkg/utilities/nttools/tselect/mkpkg
new file mode 100644
index 00000000..69d01d6c
--- /dev/null
+++ b/pkg/utilities/nttools/tselect/mkpkg
@@ -0,0 +1,12 @@
+# Update the tselect application code in the ttools package library
+# Author: B.Simon, 25-NOV-1987
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	subset.x	<tbset.h>
+	tselect.x
+	;
diff --git a/pkg/utilities/nttools/tselect/subset.x b/pkg/utilities/nttools/tselect/subset.x
new file mode 100644
index 00000000..06f574a3
--- /dev/null
+++ b/pkg/utilities/nttools/tselect/subset.x
@@ -0,0 +1,83 @@
+include <tbset.h>
+define	SYNTAX		1
+
+# SUBSET -- Select subset of table rows
+#
+# This procedure evaluates a boolean expession for selected rows in a table.
+# If the expression is true, it is written to the output table
+#
+# B.Simon	 7-Oct-87	First Code
+# B.Simon	16-Dec-87	Changed to handle table subsets
+# B.Simon	06-Jan-93	Changed to use ftnexpr
+# B.Simon	25-Aug-98	Changed to write directly to output table
+
+procedure subset (itp, otp, expr)
+
+pointer	itp		# i: Input table descriptor
+pointer	otp		# o: Output table descriptor
+char	expr[ARB]	# i: Algebraic expression used in subset
+#--
+char	nl
+pointer	sp, newexp, ch
+int	fd, sd, ic, irow, orow, first, last
+
+int	open(), stropen(), stridx(), tbpsta(), tbl_search()
+
+data	nl	/ '\n' /
+string	badtype	"Expression is not valid"
+
+errchk	open, stropen, tbl_search
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (newexp, SZ_COMMAND, TY_CHAR)
+
+	# Check to see if the expression is a file name
+
+	if (expr[1] != '@') {
+	    # Copy the expression into string
+
+	    call strcpy (expr, Memc[newexp], SZ_COMMAND)
+
+	} else {
+	    # Copy the file into a string
+
+	    fd = open (expr[2], READ_ONLY, TEXT_FILE)
+	    sd = stropen (Memc[newexp], SZ_COMMAND, WRITE_ONLY)
+	    call fcopyo (fd, sd)
+	    call close (fd)
+	    call strclose (sd)
+
+	    # Replace the newlines with blanks
+
+	    ch = newexp
+	    repeat {
+		ic = stridx (nl, Memc[ch])
+		if (ic == 0)
+		    break
+		ch = ch + ic
+		Memc[ch-1] = ' '
+	    }
+	}
+
+	orow = 1
+	first = 1
+	last = tbpsta (itp, TBL_NROWS)
+
+	while (first <= last) {
+	    irow = tbl_search (itp, Memc[newexp], first, last)
+	    if (irow < 1)
+		break
+
+	    call tbrcpy (itp, otp, irow, orow)
+	    first = irow + 1
+	    orow = orow + 1
+	}
+
+	if (irow == ERR)
+	    call error (SYNTAX, badtype)
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/tselect/tselect.x b/pkg/utilities/nttools/tselect/tselect.x
new file mode 100644
index 00000000..266753c5
--- /dev/null
+++ b/pkg/utilities/nttools/tselect/tselect.x
@@ -0,0 +1,83 @@
+include <fset.h>		# to check whether I/O is redirected
+
+define	SYNTAX		   1
+
+# TSELECT -- Create a new table from selected rows of an old table
+#
+# B.Simon	 7-Oct-1987	First Code
+# Phil Hodge	 7-Sep-1988	Change parameter names for tables.
+# Phil Hodge	 4-Oct-1995	Use table name template routines tbnopenp, etc.
+# B.Simon	25-Aug-1998	Changed to write directly to output table
+# Phil Hodge	 8-Apr-1999	Call tbfpri.
+# Phil Hodge	 9-Jun-1999	Set input/output to STDIN/STDOUT if redirected.
+
+procedure t_tselect()
+
+pointer ilist			# Input table name template
+pointer olist			# Output table name template
+pointer	expr			# Expression used to select rows
+#--
+int	junk
+int	phu_copied		# set by tbfpri and ignored
+pointer sp, itp, otp, intable, outtable
+
+string	nomatch	"Number of input tables must match output tables"
+
+int	fstati()
+int	tbnget(), tbnlen()
+pointer	tbtopn(), tbnopenp(), tbnopen()
+
+begin
+	# Allocate stack memory for strings
+
+	call smark (sp)
+	call salloc (intable, SZ_FNAME, TY_CHAR)
+	call salloc (outtable, SZ_FNAME, TY_CHAR)
+	call salloc (expr, SZ_LINE, TY_CHAR)
+
+	# Read the task parameters
+
+	if (fstati (STDIN, F_REDIR) == YES)
+	    ilist = tbnopen ("STDIN")
+	else
+	    ilist = tbnopenp ("intable")
+
+	if (fstati (STDOUT, F_REDIR) == YES)
+	    olist = tbnopen ("STDOUT")
+	else
+	    olist = tbnopenp ("outtable")
+
+	call clgstr ("expr", Memc[expr], SZ_LINE)
+
+	# Loop over all table names in the input file name template
+
+	if (tbnlen (ilist) != tbnlen (olist))
+	    call error (SYNTAX, nomatch)
+
+	while (tbnget (ilist, Memc[intable], SZ_FNAME) != EOF) {
+	    junk = tbnget (olist, Memc[outtable], SZ_FNAME)
+
+	    # Open the tables
+
+	    itp = tbtopn (Memc[intable], READ_ONLY, NULL)
+	    call tbfpri (Memc[intable], Memc[outtable], phu_copied)
+	    otp = tbtopn (Memc[outtable], NEW_COPY, itp)
+
+	    # Copy header and selected rows to output table
+
+	    call tbtcre (otp)
+	    call tbhcal (itp, otp)
+	    call subset (itp, otp, Memc[expr])
+
+	    # Close the tables
+
+	    call tbtclo (itp)
+	    call tbtclo (otp)
+	}
+
+	# Close the filename template lists
+
+	call tbnclose (ilist)
+	call tbnclose (olist)
+	call sfree (sp)
+end