From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/utilities/nttools/tselect/mkpkg | 12 +++++ pkg/utilities/nttools/tselect/subset.x | 83 +++++++++++++++++++++++++++++++++ pkg/utilities/nttools/tselect/tselect.x | 83 +++++++++++++++++++++++++++++++++ 3 files changed, 178 insertions(+) create mode 100644 pkg/utilities/nttools/tselect/mkpkg create mode 100644 pkg/utilities/nttools/tselect/subset.x create mode 100644 pkg/utilities/nttools/tselect/tselect.x (limited to 'pkg/utilities/nttools/tselect') 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 + 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 +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 # 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 -- cgit