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/tcheck/cmdsplit.x | 57 +++++++++++++++++++++ pkg/utilities/nttools/tcheck/mkpkg | 13 +++++ pkg/utilities/nttools/tcheck/tcheck.h | 4 ++ pkg/utilities/nttools/tcheck/tcheck.x | 91 +++++++++++++++++++++++++++++++++ pkg/utilities/nttools/tcheck/wrtcheck.x | 61 ++++++++++++++++++++++ 5 files changed, 226 insertions(+) create mode 100644 pkg/utilities/nttools/tcheck/cmdsplit.x create mode 100644 pkg/utilities/nttools/tcheck/mkpkg create mode 100644 pkg/utilities/nttools/tcheck/tcheck.h create mode 100644 pkg/utilities/nttools/tcheck/tcheck.x create mode 100644 pkg/utilities/nttools/tcheck/wrtcheck.x (limited to 'pkg/utilities/nttools/tcheck') 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 "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 +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 -- cgit