Initial commit

1 files changed, 106 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/copyone/puttabdat.x b/pkg/utilities/nttools/copyone/puttabdat.x
new file mode 100644
index 00000000..b5742f98
--- /dev/null
+++ b/pkg/utilities/nttools/copyone/puttabdat.x
@@ -0,0 +1,106 @@
+include	<tbset.h>
+define	USRERR		1
+
+# PUTTABDAT -- Write a value passed as a string into a table element
+#
+# B.Simon	17-Aug-87	First Code
+
+procedure puttabdat (hd, colname, rownum, value, undef, eltype)
+
+pointer hd		# i: Table descriptor
+char	colname[ARB]	# i: Table column name
+int	rownum		# i: Table row number
+char	value[ARB]	# i: Table element value
+bool	undef		# i: Is table element undefined?
+int	eltype		# i: Type of table element
+
+bool	bvalue[1]
+double	dvalue[1]
+int	ivalue[1]
+pointer	colptr[1]
+real	rvalue[1]
+
+int	coltype, lendata, ip, junk, maxch
+pointer	sp, errtxt
+
+string	badtyperr	"Type mismatch in table column (%s)"
+string	badnamerr	"Column name not found in table (%s)"
+
+int	ctod()
+int	stridx(), strlen(), tbcigi()
+
+begin
+	# Allocate dynamic memory to hold strings
+
+	call smark (sp)
+	call salloc (errtxt, SZ_LINE, TY_CHAR)
+
+	# Get the column pointer from the column name
+
+	call tbcfnd (hd, colname, colptr, 1)
+
+	# If the pointer is NULL, the column was not found
+
+	if (colptr[1] == NULL) {
+	    call sprintf (Memc[errtxt], SZ_LINE, badnamerr)
+	    call pargstr (colname)
+	    call error (USRERR, Memc[errtxt])
+	}
+
+	# Get the column data type. Store in coltype
+
+	coltype = tbcigi (colptr[1], TBL_COL_DATATYPE)
+	if (coltype < 0) {
+	    lendata = - coltype
+	    coltype = TY_CHAR
+	}
+
+	if (undef)
+
+	    # Set table element to undefined
+
+	    call tbrudf (hd, colptr, 1, rownum)
+
+	else {
+
+	    # Convert element value to a double
+
+	    ip = 1
+	    junk = ctod (value, ip, dvalue[1])
+
+	    # Check for illegal type conversions
+
+	    if ((coltype == TY_BOOL && eltype != TY_BOOL) ||
+		(!(coltype == eltype || coltype == TY_CHAR) &&
+		  (eltype == TY_BOOL || eltype == TY_CHAR)   ) ) {
+
+		call sprintf (Memc[errtxt], SZ_LINE, badtyperr)
+		call pargstr (colname)
+		call error (USRERR, Memc[errtxt])
+
+	    }
+
+	    # Use the proper procedure to write the new element value
+
+	    switch (coltype) {
+	    case TY_BOOL :
+		bvalue[1] = stridx (value[1], "TtYy") > 0
+		call tbrptb (hd, colptr, bvalue, 1, rownum)
+	    case TY_CHAR :
+		maxch = strlen (value) + 1
+		call tbrptt (hd, colptr, value, maxch, 1, rownum)
+	    case TY_SHORT,TY_INT,TY_LONG :
+		ivalue[1] = int (dvalue[1])
+		call tbrpti (hd, colptr, ivalue, 1, rownum)
+	    case TY_REAL :
+		rvalue[1] = real (dvalue[1])
+		call tbrptr (hd, colptr, rvalue, 1, rownum)
+	    case TY_DOUBLE :
+		call tbrptd (hd, colptr, dvalue, 1, rownum)
+	    }
+	}
+
+	call sfree (sp)
+
+	return
+end