Repatch (from linux) of OSX IRAF

4 files changed, 539 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/atools/mkpkg b/pkg/utilities/nttools/atools/mkpkg
new file mode 100644
index 00000000..7c969a01
--- /dev/null
+++ b/pkg/utilities/nttools/atools/mkpkg
@@ -0,0 +1,10 @@
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	taextract.x		<tbset.h> 
+	tainsert.x		<tbset.h> 
+	taincr.x
+	;
diff --git a/pkg/utilities/nttools/atools/taextract.x b/pkg/utilities/nttools/atools/taextract.x
new file mode 100644
index 00000000..a89be676
--- /dev/null
+++ b/pkg/utilities/nttools/atools/taextract.x
@@ -0,0 +1,214 @@
+include <tbset.h>
+
+define	BUFSIZE		1024	# max number of elements copied at one time
+
+# taextract -- copy an entry from one table to another
+# This task extracts an entry at a specified row & column (presumably
+# an array of values) and writes it as a column of scalar values to
+# another table.  If the output table exists it will be written to in-place;
+# otherwise, it will be created.  The same column name is used in both
+# tables.  The input row number is written to the header of the output
+# table using keyword ORIG_ROW.
+#
+# Phil Hodge, 28-Jul-1994  Task created.
+# Phil Hodge, 15-Dec-1995  Add nremain, fix while loop on ncopy.
+# Phil Hodge, 29-Jul-1997  Rename delete to delete_flag to avoid confusion
+#			with the delete subroutine.
+# Phil Hodge, 30-Jan-1998  Add optional parameters to define new column.
+# Phil Hodge,  8-Apr-1999  Call tbfpri.
+
+procedure taextract()
+
+pointer intable
+pointer outtable
+int	row			# row number at which to extract
+char	column[SZ_COLNAME]	# name of column from which to extract
+char	outcolumn[SZ_COLNAME]	# name to use for column in output table
+char	colunits[SZ_COLUNITS]	# units for new column
+char	colfmt[SZ_COLFMT]	# display format for new column
+pointer dtype			# data type of new column
+#--
+pointer sp
+pointer x			# scratch for array of data
+pointer itp, otp		# pointers to table structs
+pointer icp, ocp		# pointers to column structs
+int	datatype		# data type of column
+char	icolname[SZ_COLNAME]	# from tbcinf for input table column
+char	icolunits[SZ_COLUNITS]	# from tbcinf, units for column
+char	icolfmt[SZ_COLFMT]	# from tbcinf, display format
+int	idatatype		# from tbcinf, data type of column
+int	colnum, lenfmt		# output from tbcinf and ignored
+int	nelem			# input length of array, output number of rows
+int	nremain			# number of elements that remain to be copied
+int	ncopy			# number of elements to copy at once
+int	i			# loop index
+int	first, last		# first and last elements (or rows)
+int	slen			# length of string to copy
+int	phu_copied		# set by tbfpri and ignored
+bool	inplace			# true if output table already exists
+bool	newcolumn		# true if output column does not already exist
+int	delete_flag		# should we delete output table if error?
+pointer tbtopn()
+int	clgeti(), tbpsta(), tbtacc(), tbcigi()
+int	tbagtr(), tbagtd(), tbagti(), tbagts(), tbagtb(), tbagtt()
+bool	isblank()
+
+begin
+	call smark (sp)
+	call salloc (intable, SZ_FNAME, TY_CHAR)
+	call salloc (outtable, SZ_FNAME, TY_CHAR)
+	call salloc (dtype, SZ_FNAME, TY_CHAR)
+
+	call clgstr ("intable", Memc[intable], SZ_FNAME)
+	call clgstr ("outtable", Memc[outtable], SZ_FNAME)
+	row = clgeti ("row")
+	call clgstr ("column", column, SZ_COLNAME)
+	call clgstr ("outcolumn", outcolumn, SZ_COLNAME)
+
+	# The input column name is the default for the output.
+	if (isblank (outcolumn))
+	    call strcpy (column, outcolumn, SZ_COLNAME)
+
+	# Open input and output tables.
+	itp = tbtopn (Memc[intable], READ_ONLY, NULL)
+	if (tbtacc (Memc[outtable]) == YES) {
+	    otp = tbtopn (Memc[outtable], READ_WRITE, NULL)
+	    inplace = true
+	} else {
+	    call tbfpri (Memc[intable], Memc[outtable], phu_copied)
+	    otp = tbtopn (Memc[outtable], NEW_FILE, NULL)
+	    inplace = false
+	}
+	if (inplace)
+	    delete_flag = NO
+	else
+	    delete_flag = YES	# delete output table in case of error
+
+	if (row < 1 || row > tbpsta (itp, TBL_NROWS)) {
+	    call taex_disaster (itp, otp, NO, "row not found in input table")
+	}
+
+	# Find input column.
+	call tbcfnd (itp, column, icp, 1)
+	if (icp == NULL)
+	    call taex_disaster (itp, otp, NO, "column not found in input table")
+
+	# Find or create output column.
+	call tbcfnd (otp, outcolumn, ocp, 1)
+	if (ocp == NULL) {
+	    # Column not found in output.  Create it using the input column
+	    # as a template, except that the output will not be an array.
+	    # The name might also be different.
+	    call tbcinf (icp, colnum, icolname, icolunits, icolfmt,
+		    idatatype, nelem, lenfmt)
+	    # Get optional parameters if creating new column.
+	    call clgstr ("colunits", colunits, SZ_COLUNITS)
+	    call clgstr ("colfmt", colfmt, SZ_COLFMT)
+	    call clgstr ("datatype", Memc[dtype], SZ_FNAME)
+	    # Assign default values if not specified.
+	    if (isblank (colunits))
+		call strcpy (icolunits, colunits, SZ_COLUNITS)
+	    if (isblank (colfmt))
+		call strcpy (icolfmt, colfmt, SZ_COLFMT)
+	    if (isblank (Memc[dtype]))
+		datatype = idatatype
+	    else
+		call tbbtyp (Memc[dtype], datatype)
+	    call tbcdef (otp, ocp, outcolumn, colunits, colfmt,
+		    datatype, 1, 1)			# a column of scalars
+	    newcolumn = true
+	} else {
+	    newcolumn = false
+	}
+	if (!inplace)
+	    call tbtcre (otp)
+
+	# Save the row number as a header parameter.
+	call tbhadi (otp, "orig_row", row)
+
+	# Get number of elements to copy.
+	nelem = tbcigi (icp, TBL_COL_LENDATA)
+	nremain = nelem			# initialize to total number to copy
+	ncopy = min (nremain, BUFSIZE)
+	first = 1
+	last = ncopy
+
+	# Copy the data.
+	datatype = tbcigi (icp, TBL_COL_DATATYPE)
+	if (datatype == TY_REAL) {
+	    call salloc (x, ncopy, TY_REAL)
+	    while (ncopy > 0) {
+		if (tbagtr (itp, icp, row, Memr[x], first, ncopy) < ncopy)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbcptr (otp, ocp, Memr[x], first, last)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_DOUBLE) {
+	    call salloc (x, ncopy, TY_DOUBLE)
+	    while (ncopy > 0) {
+		if (tbagtd (itp, icp, row, Memd[x], first, ncopy) < ncopy)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbcptd (otp, ocp, Memd[x], first, last)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_INT) {
+	    call salloc (x, ncopy, TY_INT)
+	    while (ncopy > 0) {
+		if (tbagti (itp, icp, row, Memi[x], first, ncopy) < ncopy)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbcpti (otp, ocp, Memi[x], first, last)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_SHORT) {
+	    call salloc (x, ncopy, TY_SHORT)
+	    while (ncopy > 0) {
+		if (tbagts (itp, icp, row, Mems[x], first, ncopy) < ncopy)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbcpts (otp, ocp, Mems[x], first, last)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_BOOL) {
+	    call salloc (x, ncopy, TY_BOOL)
+	    while (ncopy > 0) {
+		if (tbagtb (itp, icp, row, Memb[x], first, ncopy) < ncopy)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbcptb (otp, ocp, Memb[x], first, last)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype < 0) {		# character string
+	    slen = -datatype + 3		# a little extra space
+	    call salloc (x, slen, TY_CHAR)
+	    do i = 1, nelem {
+		if (tbagtt (itp, icp, row, Memc[x], slen, i, 1) < 1)
+		    call taex_disaster (itp, otp, delete_flag,
+				"error reading input")
+		call tbeptt (otp, ocp, i, Memc[x])
+	    }
+
+	} else {
+	    call taex_disaster (itp, otp, delete_flag, "unknown data type")
+	}
+
+	# If we wrote to an existing column in an existing table, and the
+	# output table has more rows than we just wrote, then we should set
+	# the remaining rows in this column to INDEF.
+	if (!newcolumn) {
+	    do i = nelem+1, tbpsta (otp, TBL_NROWS)
+		call tbrudf (otp, ocp, 1, i)
+	}
+
+	call tbtclo (otp)
+	call tbtclo (itp)
+
+	call sfree (sp)
+end
diff --git a/pkg/utilities/nttools/atools/taincr.x b/pkg/utilities/nttools/atools/taincr.x
new file mode 100644
index 00000000..7d297e23
--- /dev/null
+++ b/pkg/utilities/nttools/atools/taincr.x
@@ -0,0 +1,55 @@
+# This file contains taex_incr and taex_disaster, which are used by
+# both tainsert and taextract.
+#
+# Phil Hodge,  7-Mar-1996  Extracted from taextract.x.
+# Phil Hodge, 29-Jul-1997  In taex_disaster, get table name before closing
+#			the table; rename delete to delete_flag to avoid
+#			confusion with the delete subroutine.
+
+# taex_incr -- increment variables
+
+# On input, ncopy is the number of elements that were copied in
+# the previous step.  We decrement nremain and increment first by
+# this amount.  Then we determine the appropriate value of ncopy
+# for the next step and update last.
+
+procedure taex_incr (nremain, ncopy, first, last, bufsize)
+
+int	nremain		# io: number of elements remaining to be copied
+int	ncopy		# io: number of elements copied/to copy next
+int	first		# io: first element (or row number)
+int	last		# io: last element (or row number)
+int	bufsize		# i: maximum number to copy in one step
+
+begin
+	nremain = nremain - ncopy
+	first = first + ncopy
+	ncopy = min (nremain, bufsize)
+	last = first + ncopy - 1
+end
+
+# taex_disaster -- clean up and call error
+
+procedure taex_disaster (itp, otp, delete_flag, message)
+
+pointer itp, otp	# io: pointers to table struct
+int	delete_flag	# i: YES if we should delete the output table
+char	message[ARB]	# i: error message
+#--
+pointer sp
+pointer outtable	# scratch for name of output table
+
+begin
+	call tbtclo (itp)
+	if (delete_flag == YES) {
+	    call smark (sp)
+	    call salloc (outtable, SZ_FNAME, TY_CHAR)
+	    call tbtnam (otp, Memc[outtable], SZ_FNAME)
+	    call tbtclo (otp)
+	    call tbtdel (Memc[outtable])
+	    call sfree (sp)
+	} else {
+	    call tbtclo (otp)
+	}
+	call error (1, message)
+end
diff --git a/pkg/utilities/nttools/atools/tainsert.x b/pkg/utilities/nttools/atools/tainsert.x
new file mode 100644
index 00000000..125ed348
--- /dev/null
+++ b/pkg/utilities/nttools/atools/tainsert.x
@@ -0,0 +1,260 @@
+include <tbset.h>
+
+define	BUFSIZE		1024	# max number of elements copied at one time
+
+# tainsert -- copy a column from one table to an entry in another
+# This task inserts an array of values into a row for a column that contains
+# array entries.  If the output table exists it will be written to in-place;
+# otherwise, it will be created.  The same column name is used in both
+# tables.  If the row number is less than one, the output row number will be
+# taken from the keyword ORIG_ROW in the input table.
+#
+# Phil Hodge, 28-Jul-1994  Task created.
+# Phil Hodge, 15-Dec-1995  Add nremain, fix while loop on ncopy.
+# Phil Hodge,  4-Apr-1996  Remove slen from calling sequence of tbaptr, etc.,
+#			for writing indef to extra elements of array.
+# Phil Hodge, 30-Jan-1998  Add optional parameters to define new column;
+#			call tbhgti as a function, not a subroutine.
+# Phil Hodge,  8-Apr-1999  Call tbfpri.
+# Phil Hodge, 13-Apr-2000  Add column name to warning message.
+
+procedure tainsert()
+
+pointer intable
+pointer outtable
+int	row			# row number at which to insert
+char	column[SZ_COLNAME]	# name of column to copy
+char	outcolumn[SZ_COLNAME]	# name to use for column in output table
+int	size			# length of output array for new column
+char	colunits[SZ_COLUNITS]	# units for new column
+char	colfmt[SZ_COLFMT]	# display format for new column
+pointer dtype			# data type of new column
+#--
+pointer sp
+pointer x			# scratch for array of data
+pointer nbuf			# scratch for array of null flags
+pointer itp, otp		# pointers to table structs
+pointer icp, ocp		# pointers to column structs
+int	datatype		# data type of column
+char	icolname[SZ_COLNAME]	# from tbcinf for input table column
+char	icolunits[SZ_COLUNITS]	# from tbcinf, units for column
+char	icolfmt[SZ_COLFMT]	# from tbcinf, display format
+int	idatatype		# from tbcinf, data type of column
+int	colnum, lenfmt		# output from tbcinf and ignored
+int	nrows			# number of rows in input table
+int	nelem			# input number of rows, output length of array
+int	nremain			# number of elements that remain to be copied
+int	ncopy			# number of elements to copy at once
+int	i			# loop index
+int	first, last		# first and last elements (or rows)
+int	slen			# length of string to copy
+int	phu_copied		# set by tbfpri and ignored
+bool	inplace			# true if output table already exists
+bool	newcolumn		# true if output column does not already exist
+int	delete			# should we delete output table if error?
+pointer tbtopn()
+int	clgeti(), tbpsta(), tbtacc(), tbcigi(), tbhgti()
+bool	isblank()
+
+# INDEF values for use in a calling sequence:
+#   (The problem is that INDEFS is an int, not a short; the others may be OK.)
+double	undefd
+real	undefr
+int	undefi
+short	undefs
+
+begin
+	call smark (sp)
+	call salloc (intable, SZ_FNAME, TY_CHAR)
+	call salloc (outtable, SZ_FNAME, TY_CHAR)
+	call salloc (dtype, SZ_FNAME, TY_CHAR)
+
+	call clgstr ("intable", Memc[intable], SZ_FNAME)
+	call clgstr ("outtable", Memc[outtable], SZ_FNAME)
+	row = clgeti ("row")
+	call clgstr ("column", column, SZ_COLNAME)
+	call clgstr ("outcolumn", outcolumn, SZ_COLNAME)
+
+	# The input column name is the default for the output.
+	if (isblank (outcolumn))
+	    call strcpy (column, outcolumn, SZ_COLNAME)
+
+	# Open input and output tables.
+	itp = tbtopn (Memc[intable], READ_ONLY, NULL)
+	if (tbtacc (Memc[outtable]) == YES) {
+	    otp = tbtopn (Memc[outtable], READ_WRITE, NULL)
+	    inplace = true
+	} else {
+	    call tbfpri (Memc[intable], Memc[outtable], phu_copied)
+	    otp = tbtopn (Memc[outtable], NEW_FILE, NULL)
+	    inplace = false
+	}
+	if (inplace)
+	    delete = NO
+	else
+	    delete = YES	# delete output table in case of error
+
+	undefd = INDEFD
+	undefr = INDEFR
+	undefi = INDEFI
+	undefs = INDEFS
+
+	if (row < 1 || IS_INDEFI(row)) {
+	    iferr (row = tbhgti (itp, "orig_row"))
+		call taex_disaster (itp, otp, NO,
+	"row number not specified, and ORIG_ROW not found in intable")
+	}
+
+	# This will be the number of elements in the output array,
+	# unless the user explicitly specifies a different size.
+	nrows = tbpsta (itp, TBL_NROWS)
+
+	# Find input column.
+	call tbcfnd (itp, column, icp, 1)
+	if (icp == NULL)
+	    call taex_disaster (itp, otp, NO, "column not found in input table")
+
+	# Find or create output column.  If we're creating a new column,
+	# use the input column as a template, except that the output will be
+	# an array of length 'size', which defaults to nrows but can be
+	# different if the user specifies a value.  The name of the output
+	# column can also be different from the input.
+	call tbcfnd (otp, outcolumn, ocp, 1)
+	if (ocp == NULL) {
+	    # Column not found in output, so create it.
+	    call tbcinf (icp, colnum, icolname, icolunits, icolfmt,
+		    idatatype, nelem, lenfmt)
+	    if (nelem > 1)
+		call taex_disaster (itp, otp, NO,
+			"column in input table contains arrays")
+	    # Get optional parameters if creating new column.
+	    size = clgeti ("size")
+	    call clgstr ("colunits", colunits, SZ_COLUNITS)
+	    call clgstr ("colfmt", colfmt, SZ_COLFMT)
+	    call clgstr ("datatype", Memc[dtype], SZ_FNAME)
+	    # Assign default values if not specified.
+	    if (IS_INDEFI(size) || size < 1)
+		size = nrows
+	    if (isblank (colunits))
+		call strcpy (icolunits, colunits, SZ_COLUNITS)
+	    if (isblank (colfmt))
+		call strcpy (icolfmt, colfmt, SZ_COLFMT)
+	    if (isblank (Memc[dtype])) {
+		datatype = idatatype
+	    } else {
+		# convert e.g. "real" to 6
+		call tbbtyp (Memc[dtype], datatype)
+	    }
+	    call tbcdef (otp, ocp, outcolumn, colunits, colfmt,
+		    datatype, size, 1)			# an array
+	    newcolumn = true
+	} else {
+	    newcolumn = false
+	}
+	if (!inplace)
+	    call tbtcre (otp)
+
+	# Get number of elements to copy.
+	nelem = tbcigi (ocp, TBL_COL_LENDATA)
+	if (nrows > nelem) {
+	    call eprintf (
+"Warning:  The number of input rows (%d) in column %s\n")
+		call pargi (nrows)
+		call pargstr (column)
+	    call eprintf (
+"  is greater than the array size (%d); the extra rows will be ignored.\n")
+		call pargi (nelem)
+	}
+	nremain = min (nrows, nelem)		# total number to copy
+	ncopy = min (nremain, BUFSIZE)
+	first = 1
+	last = ncopy
+
+	# Copy the data.
+	datatype = tbcigi (icp, TBL_COL_DATATYPE)
+	call salloc (nbuf, ncopy, TY_BOOL)
+	if (datatype == TY_REAL) {
+	    call salloc (x, ncopy, TY_REAL)
+	    while (ncopy > 0) {
+		call tbcgtr (itp, icp, Memr[x], Memb[nbuf], first, last)
+		call tbaptr (otp, ocp, row, Memr[x], first, ncopy)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_DOUBLE) {
+	    call salloc (x, ncopy, TY_DOUBLE)
+	    while (ncopy > 0) {
+		call tbcgtd (itp, icp, Memd[x], Memb[nbuf], first, last)
+		call tbaptd (otp, ocp, row, Memd[x], first, ncopy)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_INT) {
+	    call salloc (x, ncopy, TY_INT)
+	    while (ncopy > 0) {
+		call tbcgti (itp, icp, Memi[x], Memb[nbuf], first, last)
+		call tbapti (otp, ocp, row, Memi[x], first, ncopy)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_SHORT) {
+	    call salloc (x, ncopy, TY_SHORT)
+	    while (ncopy > 0) {
+		call tbcgts (itp, icp, Mems[x], Memb[nbuf], first, last)
+		call tbapts (otp, ocp, row, Mems[x], first, ncopy)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype == TY_BOOL) {
+	    call salloc (x, ncopy, TY_BOOL)
+	    while (ncopy > 0) {
+		call tbcgtb (itp, icp, Memb[x], Memb[nbuf], first, last)
+		call tbaptb (otp, ocp, row, Memb[x], first, ncopy)
+		call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+	    }
+
+	} else if (datatype < 0) {		# character string
+	    slen = -datatype + 3		# a little extra space
+	    call salloc (x, slen, TY_CHAR)
+	    do i = 1, nelem {
+		call tbegtt (itp, icp, i, Memc[x], slen)
+		call tbaptt (otp, ocp, row, Memc[x], slen, i, 1)
+	    }
+
+	} else {
+	    call eprintf ("datatype = %d\n")
+		call pargi (datatype)
+	    call taex_disaster (itp, otp, delete, "unknown data type")
+	}
+
+	# If we wrote to an existing column in an existing table, and the
+	# output column array has more elements than input rows, then we
+	# should set the remaining elements in this entry to INDEF.
+	if (!newcolumn) {
+	    if (datatype == TY_REAL) {
+		do i = nrows+1, nelem
+		    call tbaptr (otp, ocp, row, undefr, i, 1)
+	    } else if (datatype == TY_DOUBLE) {
+		do i = nrows+1, nelem
+		    call tbaptd (otp, ocp, row, undefd, i, 1)
+	    } else if (datatype == TY_INT) {
+		do i = nrows+1, nelem
+		    call tbapti (otp, ocp, row, undefi, i, 1)
+	    } else if (datatype == TY_SHORT) {
+		do i = nrows+1, nelem
+		    call tbapts (otp, ocp, row, undefs, i, 1)
+	    } else if (datatype == TY_BOOL) {
+		do i = nrows+1, nelem
+		    call tbaptb (otp, ocp, row, false, i, 1)
+	    } else if (datatype < 0) {
+		slen = -datatype
+		do i = nrows+1, nelem
+		    call tbaptt (otp, ocp, row, "", slen, i, 1)
+	    }
+	}
+
+	call tbtclo (otp)
+	call tbtclo (itp)
+
+	call sfree (sp)
+end