Repatch (from linux) of OSX IRAF

1 files changed, 142 insertions, 0 deletions

diff --git a/pkg/xtools/xtbitarray.x b/pkg/xtools/xtbitarray.x
new file mode 100644
index 00000000..b02fcb90
--- /dev/null
+++ b/pkg/xtools/xtbitarray.x
@@ -0,0 +1,142 @@
+include	<mach.h>
+
+# XT_BAITARRAY -- Routines to manage a 2D bit array.
+# One use for this is to hold a large boolean mask in the minimum amount of
+# memory for random I/O.
+
+define	BA_LEN	6				# Length of structure
+define	BA_NC	Memi[$1]			# Number of columns
+define	BA_NL	Memi[$1+1]			# Number of lines 
+define	BA_NBE	Memi[$1+2]			# Number of bits per element
+define	BA_NEW	Memi[$1+3]			# Number of elements per word
+define	BA_MAX	Memi[$1+4]			# Maximum value
+define	BA_DATA	Memi[$1+5]			# Data pointer
+
+
+# XT_BAOPEN -- Open the bit array by allocating a structure and memory.
+
+pointer procedure xt_baopen (nc, nl, maxval)
+
+int	nc, nl				#I Size of bit array to open
+int	maxval				#I Maximum value
+pointer	ba				#R Bitarray structure
+
+int	nbits
+errchk	calloc
+
+begin
+	nbits = SZB_CHAR * SZ_INT * 8
+
+	call calloc (ba, BA_LEN, TY_STRUCT)
+	BA_NC(ba) = nc
+	BA_NL(ba) = nl
+	BA_MAX(ba) = maxval
+        BA_NBE(ba) = int (log(real(maxval))/log(2.)+1.)
+	BA_NBE(ba) = min (BA_NBE(ba), nbits)
+	BA_NEW(ba) = nbits / BA_NBE(ba)
+	call calloc (BA_DATA(ba),
+	    (BA_NC(ba) * BA_NL(ba) + BA_NEW(ba) - 1) / BA_NEW(ba), TY_INT)
+	return (ba)
+end
+
+
+# XT_BACLOSE -- Close the bit array by freeing memory.
+
+procedure xt_baclose (ba)
+
+pointer	ba				#U Bitarray structure
+
+begin
+	call mfree (BA_DATA(ba), TY_INT)
+	call mfree (ba, TY_STRUCT)
+end
+
+
+# XT_BAPS -- Put short data.
+
+procedure xt_baps (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+short	data[n]				#I Input data array
+int	n				#I Number of data values
+
+int	i, j, k, m, val
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    val = min (data[m], BA_MAX(ba))
+	    call bitpak (val, Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAGS -- Get short data.
+
+procedure xt_bags (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+short	data[n]				#I Output data array
+int	n				#I Number of data values
+
+int	i, j, k, m, bitupk()
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    data[m] = bitupk (Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAPI -- Put integer data.
+
+procedure xt_bapi (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+int	data[n]				#I Input data array
+int	n				#I Number of data values
+
+int	i, j, k, m, val
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    val = min (data[m], BA_MAX(ba))
+	    call bitpak (val, Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end
+
+
+# XT_BAGI -- Get integer data.
+
+procedure xt_bagi (ba, c, l, data, n)
+
+pointer	ba				#I Bitarray structure
+int	c, l				#I Starting element
+int	data[n]				#I Output data array
+int	n				#I Number of data values
+
+int	i, j, k, m, bitupk()
+
+begin
+	k = (c - 1) + BA_NC(ba) * (l - 1) - 1
+	do m = 1, n {
+	    k = k + 1
+	    j = k / BA_NEW(ba)
+	    i = BA_NBE(ba) * mod (k, BA_NEW(ba)) + 1
+	    data[m] = bitupk (Memi[BA_DATA(ba)+j], i, BA_NBE(ba))
+	}
+end