aboutsummaryrefslogtreecommitdiff
path: root/unix/as.macosx
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /unix/as.macosx
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'unix/as.macosx')
-rw-r--r--unix/as.macosx/README68
-rw-r--r--unix/as.macosx/aclrb.c16
-rw-r--r--unix/as.macosx/aclrc.c16
-rw-r--r--unix/as.macosx/aclrd.c16
-rw-r--r--unix/as.macosx/aclri.c16
-rw-r--r--unix/as.macosx/aclrl.c16
-rw-r--r--unix/as.macosx/aclrr.c16
-rw-r--r--unix/as.macosx/aclrs.c16
-rw-r--r--unix/as.macosx/amovc.c17
-rw-r--r--unix/as.macosx/amovd.c17
-rw-r--r--unix/as.macosx/amovi.c17
-rw-r--r--unix/as.macosx/amovl.c17
-rw-r--r--unix/as.macosx/amovr.c17
-rw-r--r--unix/as.macosx/amovs.c17
-rw-r--r--unix/as.macosx/bytmov.c23
-rw-r--r--unix/as.macosx/ieee.gx391
-rw-r--r--unix/as.macosx/ieeed.x356
-rw-r--r--unix/as.macosx/ieeer.x345
-rw-r--r--unix/as.macosx/zsvjmp.s123
-rw-r--r--unix/as.macosx/zsvjmp.s.OLD124
-rw-r--r--unix/as.macosx/zsvjmp_i386.s95
-rw-r--r--unix/as.macosx/zsvjmp_ppc.s123
-rw-r--r--unix/as.macosx/zz.c10
-rw-r--r--unix/as.macosx/zzdebug.c48
24 files changed, 1920 insertions, 0 deletions
diff --git a/unix/as.macosx/README b/unix/as.macosx/README
new file mode 100644
index 00000000..d19b2a3e
--- /dev/null
+++ b/unix/as.macosx/README
@@ -0,0 +1,68 @@
+# LinuxPPC Assembler - LinuxPPC 2000, Aug 2000
+
+ .file "zz.c"
+# zsvjmp_(buf,status)
+# int *buf;
+# int *status;
+# {
+# *status = 0;
+# buf[0] = *status;
+# setjmp (&buf[1]);
+# }
+
+gcc2_compiled.:
+ .section ".text"
+ .align 2
+ .globl zsvjmp_
+ .type zsvjmp_,@function
+
+ # Addressing: 12(31) means effective address (EA) is r31+12
+ # lwz 9,12(31) means move value at EA to r9
+
+ # REGISTERS: r1 = stack pointer, r31 = frame pointer, r3+ = args
+ # Function always saves r1, r31 on stack. Sets up frame with
+ # required auto storage. Saves LR as well if any functions will
+ # be called.
+
+zsvjmp_:
+ # -- Push old r1 on stack; start new stack frame at r1
+ stwu 1,-32(1) # Store word with update (push on stack)
+ # EA = r1-32; (r1) -> (EA), EA -> r1
+
+ # -- Save LR, r31 in stack frame
+ mflr 0 # Move from Link Register: LR -> r0
+ stw 31,28(1) # Store word: r31 -> r1+28
+ stw 0,36(1) # Store word: r0 -> r1+36
+
+ # -- Save r3 (arg1), r4 (arg2) on stack
+ mr 31,1 # Move register: r1 -> r31
+ stw 3,8(31) # r3 -> r31+8
+ stw 4,12(31) # r4 -> r31+12
+
+ # -- *status = 0;
+ lwz 9,12(31) # Load word and zero: (r31+12) -> r9
+ li 0,0 # Load zero: 0 -> r0
+ stw 0,0(9) # Store: r0 -> r9+0
+
+ # -- buf[0] = *status;
+ lwz 9,8(31) # buf -> r9
+ lwz 11,12(31) # status -> r11
+ lwz 0,0(11) # *status -> r0
+ stw 0,0(9) # r0 -> buf[0]
+
+ # -- setjmp (&buf[1]);
+ lwz 9,8(31) # buf -> r9
+ addi 0,9,4 # Add immediate; r9+4 -> r0
+ mr 3,0 # R3 is first arg
+ crxor 6,6,6 # Condition reg XOR: xor(b6,b6) -> b6
+ bl setjmp # Branch to setjmp; addr(.L2) -> LR
+.L2:
+ lwz 11,0(1) # load old r1 into r11
+ lwz 0,4(11) # load old LR into r0
+ mtlr 0 # restore return addr to LR
+ lwz 31,-4(11) # restore old r31
+ mr 1,11 # restore old r1
+ blr # Branch unconditionally (to LR addr)
+.Lfe1:
+ .size zsvjmp_,.Lfe1-zsvjmp_
+ .ident "GCC: (GNU) 2.95.2 19991024 (release/franzo)"
diff --git a/unix/as.macosx/aclrb.c b/unix/as.macosx/aclrb.c
new file mode 100644
index 00000000..8c03c7a1
--- /dev/null
+++ b/unix/as.macosx/aclrb.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRB -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRB (a, n)
+XCHAR *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n);
+}
diff --git a/unix/as.macosx/aclrc.c b/unix/as.macosx/aclrc.c
new file mode 100644
index 00000000..04e0e19b
--- /dev/null
+++ b/unix/as.macosx/aclrc.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRC -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRC (a, n)
+XCHAR *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/aclrd.c b/unix/as.macosx/aclrd.c
new file mode 100644
index 00000000..0cf06b01
--- /dev/null
+++ b/unix/as.macosx/aclrd.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRD -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRD (a, n)
+XDOUBLE *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/aclri.c b/unix/as.macosx/aclri.c
new file mode 100644
index 00000000..7d5b8ada
--- /dev/null
+++ b/unix/as.macosx/aclri.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRI -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRI (a, n)
+XINT *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/aclrl.c b/unix/as.macosx/aclrl.c
new file mode 100644
index 00000000..91f2a0ef
--- /dev/null
+++ b/unix/as.macosx/aclrl.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRL -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRL (a, n)
+XLONG *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/aclrr.c b/unix/as.macosx/aclrr.c
new file mode 100644
index 00000000..0426aa73
--- /dev/null
+++ b/unix/as.macosx/aclrr.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRR -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRR (a, n)
+XREAL *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/aclrs.c b/unix/as.macosx/aclrs.c
new file mode 100644
index 00000000..b4ff02a4
--- /dev/null
+++ b/unix/as.macosx/aclrs.c
@@ -0,0 +1,16 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* ACLRS -- Clear a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+ACLRS (a, n)
+XSHORT *a;
+XINT *n;
+{
+ memset ((char *)a, 0, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovc.c b/unix/as.macosx/amovc.c
new file mode 100644
index 00000000..ecba2573
--- /dev/null
+++ b/unix/as.macosx/amovc.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVC -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVC (a, b, n)
+XCHAR *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovd.c b/unix/as.macosx/amovd.c
new file mode 100644
index 00000000..0cfa8906
--- /dev/null
+++ b/unix/as.macosx/amovd.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVD -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVD (a, b, n)
+XDOUBLE *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovi.c b/unix/as.macosx/amovi.c
new file mode 100644
index 00000000..91bc2060
--- /dev/null
+++ b/unix/as.macosx/amovi.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVI -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVI (a, b, n)
+XINT *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovl.c b/unix/as.macosx/amovl.c
new file mode 100644
index 00000000..815fd651
--- /dev/null
+++ b/unix/as.macosx/amovl.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVL -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVL (a, b, n)
+XLONG *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovr.c b/unix/as.macosx/amovr.c
new file mode 100644
index 00000000..94522ea6
--- /dev/null
+++ b/unix/as.macosx/amovr.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVR -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVR (a, b, n)
+XREAL *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/amovs.c b/unix/as.macosx/amovs.c
new file mode 100644
index 00000000..8aa12ae7
--- /dev/null
+++ b/unix/as.macosx/amovs.c
@@ -0,0 +1,17 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* AMOVS -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVS (a, b, n)
+XSHORT *a, *b;
+XINT *n;
+{
+ if (a != b)
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.macosx/bytmov.c b/unix/as.macosx/bytmov.c
new file mode 100644
index 00000000..aa43f6d1
--- /dev/null
+++ b/unix/as.macosx/bytmov.c
@@ -0,0 +1,23 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#define import_spp
+#define import_knames
+#include <iraf.h>
+
+/* BYTMOV -- Byte move from array "a" to array "b". The move must be
+ * nondestructive, allowing a byte array to be shifted left or right a
+ * few bytes, hence comparison of the addresses of the arrays is necessary
+ * to determine if they overlap.
+ * [Specially optimized version for Sun/IRAF].
+ */
+BYTMOV (a, aoff, b, boff, nbytes)
+XCHAR *a; /* input byte array */
+XINT *aoff; /* first byte in A to be moved */
+XCHAR *b; /* output byte array */
+XINT *boff; /* first byte in B to be written */
+XINT *nbytes; /* number of bytes to move */
+{
+ if ((a + *aoff) != (b + *boff))
+ memmove ((char *)b + (*boff-1), (char *)a + (*aoff-1), *nbytes);
+}
diff --git a/unix/as.macosx/ieee.gx b/unix/as.macosx/ieee.gx
new file mode 100644
index 00000000..64659cd3
--- /dev/null
+++ b/unix/as.macosx/ieee.gx
@@ -0,0 +1,391 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+ ieepak[rd] (datum) # scalar conversions
+ ieeupk[rd] (datum)
+ ieevpak[rd] (native, ieee, nelem) # vector conversions
+ ieevupk[rd] (ieee, native, nelem)
+ iee[sg]nan[rd] (NaN) # NaN handling
+ iee[sg]map[rd] (mapin, mapout)
+ ieestat[rd] (nin, nout)
+ ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions. The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system. The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEF). If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions. The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format. NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+$if (datatype == r)
+define IEEE_SWAP IEEE_SWAP4
+define BSWAP bswap4
+define NSWAP 4
+define IOFF 1
+$else
+define IEEE_SWAP IEEE_SWAP8
+define BSWAP bswap8
+define NSWAP 8
+define IOFF 2 # MACHDEP (normally 1, 2 on e.g. Intel)
+$endif
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format. The input and output arrays can be the same.
+
+procedure ieevpak$t (native, ieee, nelem)
+
+PIXEL native[ARB] #I input native floating format array
+PIXEL ieee[ARB] #O output IEEE floating format array
+int nelem #I number of floating point numbers
+
+int i
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout == NO) {
+ if (IEEE_SWAP == YES)
+ call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+ else
+ call amov$t (native, ieee, nelem)
+ } else {
+ do i = 1, nelem
+ if (native[i] == native_NaN) {
+ ieee(i) = ieee_NaN
+ nout = nout + 1
+ } else
+ ieee[i] = native[i]
+
+ # Byteswap if necessary.
+ if (IEEE_SWAP == YES)
+ call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+ }
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format. The input and output arrays can be the same.
+
+procedure ieevupk$t (ieee, native, nelem)
+
+PIXEL ieee[ARB] #I input IEEE floating format array
+PIXEL native[ARB] #O output native floating format array
+int nelem #I number of floating point numbers
+
+int expon, i, val
+$if (datatype == r)
+real fval
+int ival[1]
+% equivalence (fval, ival)
+$else
+double fval
+int ival[2]
+% equivalence (fval, ival)
+int iand32()
+$endif
+% equivalence (ival, val)
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES) {
+ call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO) {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = native[i]
+$if (datatype == r)
+ expon = and (ival[IOFF], NaNmask)
+$else
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+$endif
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amov$t (ieee, native, nelem)
+ else {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = ieee[i]
+$if (datatype == r)
+ expon = and (ival[IOFF], NaNmask)
+$else
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+$endif
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ } else
+ native[i] = ieee[i]
+ }
+ }
+ }
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepak$t (x)
+
+PIXEL x #U datum to be converted
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout != NO)
+ if (x == native_NaN) {
+ x = ieee_NaN
+ nout = nout + 1
+ }
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupk$t (x)
+
+PIXEL x #U datum to be converted
+
+int expon, val
+$if (datatype == r)
+real fval
+int ival[1]
+% equivalence (fval, ival)
+$else
+double fval
+int ival[2]
+% equivalence (fval, ival)
+int iand32()
+$endif
+% equivalence (val, ival)
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+
+ # Check for IEEE exceptional values and map NaN to the native NaN
+ # value, and denormalized numbers (zero exponent) to zero.
+
+ if (mapin != NO) {
+ fval = x
+$if (datatype == r)
+ expon = and (ival[IOFF], NaNmask)
+$else
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+$endif
+ if (expon == 0)
+ x = 0
+ else if (expon == NaNmask) {
+ x = native_NaN
+ nin = nin + 1
+ }
+ }
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native. This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnan$t (x)
+
+PIXEL x #I native value which will replace NaN
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ native_NaN = x
+ nin = 0
+ nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnan$t (x)
+
+PIXEL x #O native value which will replace NaN
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestat$t (o_nin, o_nout)
+
+int o_nin #O number of NaN seen on input
+int o_nout #O number of NaN values output
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ o_nin = nin
+ o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstat$t ()
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ nin = 0
+ nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP. Retained for backwards compatibility.
+
+procedure ieemap$t (inval, outval)
+
+int inval #I enable mapping on input
+int outval #I enable mapping on output
+
+begin
+ call ieesmap$t (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmap$t (inval, outval)
+
+int inval #O get input mapping enable flag
+int outval #O get output mapping enable flag
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ inval = mapin
+ outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+# 3 2 1 0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+# 7 f 8 0 0 0 0 0
+
+procedure ieesmap$t (inval, outval)
+
+int inval #I enable NaN mapping for input?
+int outval #I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#% real r_quiet_nan
+#$else
+#% double precision d_quiet_nan
+#$endif
+
+PIXEL native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ mapin = inval
+ mapout = outval
+
+ # MACHDEP.
+# if (mapout == YES)
+# $if (datatype == r)
+#% ieeenn = r_quiet_NaN()
+# $else
+#% ieeenn = d_quiet_NaN()
+# $endif
+
+ if (mapin == YES)
+ $if (datatype == r)
+ NaNmask = 7F800000X
+ $else
+ NaNmask = 7FF00000X
+ $endif
+end
diff --git a/unix/as.macosx/ieeed.x b/unix/as.macosx/ieeed.x
new file mode 100644
index 00000000..f29c1aa3
--- /dev/null
+++ b/unix/as.macosx/ieeed.x
@@ -0,0 +1,356 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+ ieepak[rd] (datum) # scalar conversions
+ ieeupk[rd] (datum)
+ ieevpak[rd] (native, ieee, nelem) # vector conversions
+ ieevupk[rd] (ieee, native, nelem)
+ iee[sg]nan[rd] (NaN) # NaN handling
+ iee[sg]map[rd] (mapin, mapout)
+ ieestat[rd] (nin, nout)
+ ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions. The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system. The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEFD). If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions. The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format. NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+define IEEE_SWAP IEEE_SWAP8
+define BSWAP bswap8
+define NSWAP 8
+define IOFF 2 # MACHDEP (normally 1, 2 on e.g. Intel)
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format. The input and output arrays can be the same.
+
+procedure ieevpakd (native, ieee, nelem)
+
+double native[ARB] #I input native floating format array
+double ieee[ARB] #O output IEEE floating format array
+int nelem #I number of floating point numbers
+
+int i
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout == NO) {
+ if (IEEE_SWAP == YES)
+ call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+ else
+ call amovd (native, ieee, nelem)
+ } else {
+ do i = 1, nelem
+ if (native[i] == native_NaN) {
+ ieee(i) = ieee_NaN
+ nout = nout + 1
+ } else
+ ieee[i] = native[i]
+
+ # Byteswap if necessary.
+ if (IEEE_SWAP == YES)
+ call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+ }
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format. The input and output arrays can be the same.
+
+procedure ieevupkd (ieee, native, nelem)
+
+double ieee[ARB] #I input IEEE floating format array
+double native[ARB] #O output native floating format array
+int nelem #I number of floating point numbers
+
+int expon, i, val
+double fval
+int ival[2]
+% equivalence (fval, ival)
+int iand32()
+% equivalence (ival, val)
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES) {
+ call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO) {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = native[i]
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amovd (ieee, native, nelem)
+ else {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = ieee[i]
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ } else
+ native[i] = ieee[i]
+ }
+ }
+ }
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepakd (x)
+
+double x #U datum to be converted
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout != NO)
+ if (x == native_NaN) {
+ x = ieee_NaN
+ nout = nout + 1
+ }
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupkd (x)
+
+double x #U datum to be converted
+
+int expon, val
+double fval
+int ival[2]
+% equivalence (fval, ival)
+int iand32()
+% equivalence (val, ival)
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+
+ # Check for IEEE exceptional values and map NaN to the native NaN
+ # value, and denormalized numbers (zero exponent) to zero.
+
+ if (mapin != NO) {
+ fval = x
+ if (SZ_INT == SZ_INT32)
+ expon = and (ival[IOFF], NaNmask)
+ else
+ expon = iand32 (val, NaNmask)
+ if (expon == 0)
+ x = 0
+ else if (expon == NaNmask) {
+ x = native_NaN
+ nin = nin + 1
+ }
+ }
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native. This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnand (x)
+
+double x #I native value which will replace NaN
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ native_NaN = x
+ nin = 0
+ nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnand (x)
+
+double x #O native value which will replace NaN
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestatd (o_nin, o_nout)
+
+int o_nin #O number of NaN seen on input
+int o_nout #O number of NaN values output
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ o_nin = nin
+ o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstatd ()
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ nin = 0
+ nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP. Retained for backwards compatibility.
+
+procedure ieemapd (inval, outval)
+
+int inval #I enable mapping on input
+int outval #I enable mapping on output
+
+begin
+ call ieesmapd (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmapd (inval, outval)
+
+int inval #O get input mapping enable flag
+int outval #O get output mapping enable flag
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ inval = mapin
+ outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+# 3 2 1 0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+# 7 f 8 0 0 0 0 0
+
+procedure ieesmapd (inval, outval)
+
+int inval #I enable NaN mapping for input?
+int outval #I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#% real r_quiet_nan
+#$else
+#% double precision d_quiet_nan
+#$endif
+
+double native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenand/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ mapin = inval
+ mapout = outval
+
+ # MACHDEP.
+# if (mapout == YES)
+# $if (datatype == r)
+#% ieeenn = r_quiet_NaN()
+# $else
+#% ieeenn = d_quiet_NaN()
+# $endif
+
+ if (mapin == YES)
+ NaNmask = 7FF00000X
+end
diff --git a/unix/as.macosx/ieeer.x b/unix/as.macosx/ieeer.x
new file mode 100644
index 00000000..59ce8566
--- /dev/null
+++ b/unix/as.macosx/ieeer.x
@@ -0,0 +1,345 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+.help IEEE
+.nf ------------------------------------------------------------------------
+Low level primitives for IEEE to native floating point datatype conversions.
+See also the MII package, which provides a higher level interface, and the
+IEEE related definitions in <mach.h>.
+
+ ieepak[rd] (datum) # scalar conversions
+ ieeupk[rd] (datum)
+ ieevpak[rd] (native, ieee, nelem) # vector conversions
+ ieevupk[rd] (ieee, native, nelem)
+ iee[sg]nan[rd] (NaN) # NaN handling
+ iee[sg]map[rd] (mapin, mapout)
+ ieestat[rd] (nin, nout)
+ ieezstat[rd] ()
+
+The first two routines handle scalar conversions, the second two routines
+vector conversions. The input and output vectors may be the same.
+Unfortunately, for portability reasons, functions cannot be used, so the
+scalar operators do an in-place conversion instead, and are a no-op on an
+unswapped IEEE system. The routines iee[sg]nan[rd] set/get the native
+floating value used to replace NaNs or overflows occuring when converting
+IEEE to the native floating format (any floating value will do, e.g., zero or
+INDEFR). If NaN mapping is enabled, the ieestat[rd] routines may be used to
+determine the number of input or output NaN conversions occuring since the
+last call to ieezstat[rd].
+
+The NaN mapping enable switch and statistics counters are UNDEFINED at
+process startup; programs which use the IEEE conversion package should call
+ieesmap[rd] to enable or disable NaN mapping, and ieezstat[rd] to initialize
+the statistics counters.
+
+The routines in this file are the "portable" versions. The "portable"
+solution it to merely copy the array, swapping the bytes if necessary - this
+works on any host that uses the IEEE floating format. NaN mapping is
+implemented in the portable code, but will work properly only for input
+conversions; for output, the IEEE NaN value is undefined in the portable
+version of the code (it is trivial to supply this value in an as$ieee.gx
+version of the code).
+If the local host does
+not use IEEE floating, or if a significant efficiency gain can be realized
+by programming in assembler or C, a host specific version of this file should
+be written, placed in AS, and referenced in the MKPKG special file list.
+.endhelp -------------------------------------------------------------------
+
+
+# Give the generic preprocessor some help.
+define IEEE_SWAP IEEE_SWAP4
+define BSWAP bswap4
+define NSWAP 4
+define IOFF 1
+
+
+# IEEVPAK -- Convert an array in the native floating point format into an
+# array in IEEE floating format. The input and output arrays can be the same.
+
+procedure ieevpakr (native, ieee, nelem)
+
+real native[ARB] #I input native floating format array
+real ieee[ARB] #O output IEEE floating format array
+int nelem #I number of floating point numbers
+
+int i
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout == NO) {
+ if (IEEE_SWAP == YES)
+ call BSWAP (native, 1, ieee, 1, nelem * NSWAP)
+ else
+ call amovr (native, ieee, nelem)
+ } else {
+ do i = 1, nelem
+ if (native[i] == native_NaN) {
+ ieee(i) = ieee_NaN
+ nout = nout + 1
+ } else
+ ieee[i] = native[i]
+
+ # Byteswap if necessary.
+ if (IEEE_SWAP == YES)
+ call BSWAP (ieee, 1, ieee, 1, nelem * NSWAP)
+ }
+end
+
+
+# IEEVUPK -- Convert an array in IEEE floating format into the native
+# floating point format. The input and output arrays can be the same.
+
+procedure ieevupkr (ieee, native, nelem)
+
+real ieee[ARB] #I input IEEE floating format array
+real native[ARB] #O output native floating format array
+int nelem #I number of floating point numbers
+
+int expon, i, val
+real fval
+int ival[1]
+% equivalence (fval, ival)
+% equivalence (ival, val)
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES) {
+ call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO) {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = native[i]
+ expon = and (ival[IOFF], NaNmask)
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amovr (ieee, native, nelem)
+ else {
+ # Check for IEEE exceptional values and map NaN to the native
+ # NaN value, and denormalized numbers (zero exponent) to zero.
+
+ do i = 1, nelem {
+ fval = ieee[i]
+ expon = and (ival[IOFF], NaNmask)
+ if (expon == 0) {
+ native[i] = 0
+ } else if (expon == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ } else
+ native[i] = ieee[i]
+ }
+ }
+ }
+end
+
+
+# IEEPAK -- Convert a native floating point number into IEEE format.
+
+procedure ieepakr (x)
+
+real x #U datum to be converted
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (mapout != NO)
+ if (x == native_NaN) {
+ x = ieee_NaN
+ nout = nout + 1
+ }
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+end
+
+
+# IEEUPK -- Convert an IEEE format number into native floating point.
+
+procedure ieeupkr (x)
+
+real x #U datum to be converted
+
+int expon, val
+real fval
+int ival[1]
+% equivalence (fval, ival)
+% equivalence (val, ival)
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+
+ # Check for IEEE exceptional values and map NaN to the native NaN
+ # value, and denormalized numbers (zero exponent) to zero.
+
+ if (mapin != NO) {
+ fval = x
+ expon = and (ival[IOFF], NaNmask)
+ if (expon == 0)
+ x = 0
+ else if (expon == NaNmask) {
+ x = native_NaN
+ nin = nin + 1
+ }
+ }
+end
+
+
+# IEESNAN -- Set the native floating point value used to replace NaNs and
+# overflows when converting IEEE to native. This must be a legal (finite)
+# native floating point value.
+
+procedure ieesnanr (x)
+
+real x #I native value which will replace NaN
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ native_NaN = x
+ nin = 0
+ nout = 0
+end
+
+
+# IEEGNAN -- Get the NaN value.
+
+procedure ieegnanr (x)
+
+real x #O native value which will replace NaN
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ x = native_NaN
+end
+
+
+# IEESTAT -- Return statistics on the number of NaNs encountered in input
+# conversions (unpack) and output conversions (pack).
+
+procedure ieestatr (o_nin, o_nout)
+
+int o_nin #O number of NaN seen on input
+int o_nout #O number of NaN values output
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ o_nin = nin
+ o_nout = nout
+end
+
+
+# IEEZSTAT -- Zero the statistics counters.
+
+procedure ieezstatr ()
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ nin = 0
+ nout = 0
+end
+
+
+# IEEMAP -- Same as IEESMAP. Retained for backwards compatibility.
+
+procedure ieemapr (inval, outval)
+
+int inval #I enable mapping on input
+int outval #I enable mapping on output
+
+begin
+ call ieesmapr (inval, outval)
+end
+
+
+# IEEGMAP -- Query the current values of the input and output mapping
+# enables.
+
+procedure ieegmapr (inval, outval)
+
+int inval #O get input mapping enable flag
+int outval #O get output mapping enable flag
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ inval = mapin
+ outval = mapout
+end
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEESMAP -- Enable or disable NaN mapping.
+#
+# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
+# 3 2 1 0
+# 1098 7654 3210 9876 5432 1098 7654 3210
+# 7 f 8 0 0 0 0 0
+
+procedure ieesmapr (inval, outval)
+
+int inval #I enable NaN mapping for input?
+int outval #I enable NaN mapping for output?
+
+# MACHDEP.
+#$if (datatype == r)
+#% real r_quiet_nan
+#$else
+#% double precision d_quiet_nan
+#$endif
+
+real native_NaN, ieee_NaN
+int mapin, mapout, nin, nout, NaNmask
+common /ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout
+
+begin
+ mapin = inval
+ mapout = outval
+
+ # MACHDEP.
+# if (mapout == YES)
+# $if (datatype == r)
+#% ieeenn = r_quiet_NaN()
+# $else
+#% ieeenn = d_quiet_NaN()
+# $endif
+
+ if (mapin == YES)
+ NaNmask = 7F800000X
+end
diff --git a/unix/as.macosx/zsvjmp.s b/unix/as.macosx/zsvjmp.s
new file mode 100644
index 00000000..23308bf1
--- /dev/null
+++ b/unix/as.macosx/zsvjmp.s
@@ -0,0 +1,123 @@
+# ZSVJMP.S -- MacOS X version, September 2001, March 2002.
+
+.file "zsvjmp.s"
+
+ # ZSVJMP -- SPP callable SETJMP.
+.text
+ .align 2
+ .globl _zsvjmp_
+_zsvjmp_:
+ # R3 = buf, R4 = &status
+ li r11,0 ; r11 = 0
+ stw r11,0(r4) ; set *status to zero
+ stw r4,0(r3) ; store &status in buf[0]
+ addi r3,r3,4 ; reference buf[1] for setjmp
+ b L_setjmp$stub
+L2:
+ lwz r1,0(r1)
+ lwz r0,8(r1)
+ mtlr r0
+ lmw r30,-8(r1)
+ blr
+
+ # The setjmp code is only available in a dynamic library on 10.1.
+.picsymbol_stub
+L_setjmp$stub:
+ .indirect_symbol _setjmp
+ mflr r0
+ bcl 20,31,L1$pb
+L1$pb:
+ mflr r11
+ addis r11,r11,ha16(L1$lz-L1$pb)
+ mtlr r0
+ lwz r12,lo16(L1$lz-L1$pb)(r11)
+ mtctr r12
+ addi r11,r11,lo16(L1$lz-L1$pb)
+ bctr
+.lazy_symbol_pointer
+L1$lz:
+ .indirect_symbol _setjmp
+ .long dyld_stub_binding_helper
+.text
+.Lfe1:
+
+ # Set the address of the MEM common to zero.
+ .globl _mem_
+ _mem_ = 0
+
+
+ # GFPSCR -- Return the contents of the PowerPC FPSCR register.
+.text
+ .align 2
+.globl _gfpscr_
+_gfpscr_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L2$pb
+L2$pb:
+ mflr r31
+ mtlr r0
+
+ mffs f0
+ stfd f0, 16(r30)
+ lwz r0, 20(r30)
+ mr r3, r0
+
+ b L3
+L3:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
+
+
+ # SFPSCR -- Set the contents of the PowerPC FPSCR register.
+.text
+ .align 2
+.globl _sfpscr_
+_sfpscr_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L4$pb
+L4$pb:
+ mflr r31
+ mtlr r0
+
+ lis r0, 0xfff8
+ stw r0, 16(r30)
+ lwz r0, 0(r3)
+ stw r0, 20(r30)
+ lfd f0, 16(r30)
+ mtfsf 255, f0
+
+ b L5
+L5:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
+
+
+ # GXER -- Return the contents of the PowerPC XER register.
+.text
+ .align 2
+.globl _gxer_
+_gxer_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L3$pb
+L3$pb:
+ mflr r31
+ mtlr r0
+
+ mfspr r3,1
+
+ b L4
+L4:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
diff --git a/unix/as.macosx/zsvjmp.s.OLD b/unix/as.macosx/zsvjmp.s.OLD
new file mode 100644
index 00000000..7d631357
--- /dev/null
+++ b/unix/as.macosx/zsvjmp.s.OLD
@@ -0,0 +1,124 @@
+# ZSVJMP.S -- LinuxPPC version, September 2001.
+
+.file "zsvjmp.s"
+
+ # ZSVJMP -- SPP callable SETJMP.
+.text
+ .align 2
+ .globl _zsvjmp_
+_zsvjmp_:
+ # R3 = buf, R4 = &status
+ li r11,0 ; r11 = 0
+ stw r11,0(r4) ; set *status to zero
+ stw r4,0(r3) ; store &status in buf[0]
+ addi r3,r3,4 ; reference buf[1] for setjmp
+ b L_setjmp$stub
+L2:
+ lwz r1,0(r1)
+ lwz r0,8(r1)
+ mtlr r0
+ lmw r30,-8(r1)
+ blr
+
+ # The setjmp code is only available in a dynamic library on 10.1.
+.picsymbol_stub
+L_setjmp$stub:
+ .indirect_symbol _setjmp
+ mflr r0
+ bcl 20,31,L1$pb
+L1$pb:
+ mflr r11
+ addis r11,r11,ha16(L1$lz-L1$pb)
+ mtlr r0
+ lwz r12,lo16(L1$lz-L1$pb)(r11)
+ mtctr r12
+ addi r11,r11,lo16(L1$lz-L1$pb)
+ bctr
+.lazy_symbol_pointer
+L1$lz:
+ .indirect_symbol _setjmp
+ .long dyld_stub_binding_helper
+.text
+.Lfe1:
+
+ # Set the address of the MEM common to zero.
+ .globl mem_
+ mem_ = 0
+
+
+ # GFPUCW -- Get the FPU control register.
+ .globl _gfpucw_
+_gfpucw_:
+ stwu r1, -32(r1)
+ stw r31, 28(r1)
+ mr r31, r1
+ stw r3, 8(r31)
+ mffs f0
+ stfd f0, 16(r31)
+ lwz r0, 20(r31)
+ mr r9, r0
+ lwz r9, 8(r31)
+ stw r0, 0(r9)
+.L3:
+ lwz r11, 0(r1)
+ lwz r31, -4(r11)
+ mr r1, r11
+ blr
+.Lfe2:
+
+
+ # SFPUCW -- Set the FPU control register.
+
+ .globl _sfpucw_
+_sfpucw_:
+ stwu r1, -32(r1)
+ stw r31, 28(r1)
+ mr r31, r1
+ stw r3, 8(r31)
+ lis r0, 0xfff8
+ stw r0, 16(r31)
+ lwz r9, 8(r31)
+ lwz r0, 0(r9)
+ stw r0, 20(r31)
+ lfd f0, 16(r31)
+ mtfsf 255, f0
+.L4:
+ lwz r11, 0(r1)
+ lwz r31, -4(r11)
+ mr r1, r11
+ blr
+.Lfe3:
+
+
+ # CFPUCW -- Clear the exception flags in the FPU control register.
+ # So far I have not been able to find a way to make this work, at
+ # least with the current version of LinuxPPC. All of the instructions
+ # below fail, raising another SIGFPE if an exception condition is
+ # already present. ANY instruction involving the FPU will raise
+ # SIGFPE once the exception condition exists. Also, LinuxPPC
+ # sigaction does not block SIGFPE in the called exception handler,
+ # contrary to the manpage. It appears that the exception handling
+ # in the kernel needs to clear the exception condition but is not
+ # doing so. Supervisor level instructions appear to be required to
+ # clear the exception condition, so this has to be done in the kernel
+ # before the user level signal handler is called.
+
+ .globl _cfpucw_
+_cfpucw_:
+ stwu r1, -32(r1)
+ stw r31, 28(r1)
+ mr r31, r1
+ #mcrfs r0, 0
+ #mtfsfi r0, 0
+ #mtfsfi r3, 0
+ #mtfsfi r3, 0
+ #mtfsfi r5, 0
+ #mtfsfb0 r3
+ #mtfsfb0 r5
+ #mtfsfb0 r7
+.L5:
+ lwz r11, 0(r1)
+ lwz r31, -4(r11)
+ mr r1, r11
+ blr
+.Lfe4:
diff --git a/unix/as.macosx/zsvjmp_i386.s b/unix/as.macosx/zsvjmp_i386.s
new file mode 100644
index 00000000..113fba8a
--- /dev/null
+++ b/unix/as.macosx/zsvjmp_i386.s
@@ -0,0 +1,95 @@
+ .file "zsvjmp.s"
+
+# ZSVJMP, ZDOJMP -- Set up a jump (non-local goto) by saving the processor
+# registers in the buffer jmpbuf. A subsequent call to ZDOJMP restores
+# the registers, effecting a call in the context of the procedure which
+# originally called ZSVJMP, but with the new status code. These are Fortran
+# callable procedures.
+#
+# zsvjmp (jmp_buf, status) # (returns status)
+# zdojmp (jmp_buf, status) # (passes status to zsvjmp)
+#
+# These routines are directly comparable to the UNIX setjmp/longjmp, except
+# that they are Fortran callable kernel routines, i.e., trailing underscore,
+# call by reference, and no function returns. ZSVJMP requires an assembler
+# jacket routine to avoid modifying the call stack, but relies upon setjmp
+# to do the real work. ZDOJMP is implemented as a portable C routine in OS,
+# calling longjmp to do the restore. In these routines, JMP_BUF consists
+# of one longword containing the address of the STATUS variable, followed
+# by the "jmp_buf" used by setjmp/longjmp.
+#
+# This file contains the OS X Intel (x86) version of ZSVJMP.
+# Modified to remove leading underscore for ELF (Jan99).
+
+ .globl _zsvjmp_
+ .globl _sfpucw_
+ .globl _gfpucw_
+ .globl _gfpusw_
+
+ # The following has nothing to do with ZSVJMP, and is included here
+ # only because this assembler module is loaded with every process.
+ # This code sets the value of the symbol MEM (the VOS or Fortran Mem
+ # common) to zero, setting the origin for IRAF pointers to zero
+ # rather than some arbitrary value, and ensuring that the MEM common
+ # is aligned for all datatypes as well as page aligned. A further
+ # advantage is that references to NULL pointers are likely to cause a
+ # memory violation.
+
+ .globl mem_
+ mem_ = 0
+ .globl _mem_
+ _mem_ = 0
+
+ .text
+_zsvjmp_:
+ movl 4(%esp), %edx # &jmpbuf to EDX
+ movl 8(%esp), %eax # &status to EAX
+ movl %eax, (%edx) # store value-of &status in &jmpbuf[0]
+ movl $0, (%eax) # zero the value of status
+ addl $4, %edx # change stack to point to &jmpbuf[1]
+ movl %edx, 4(%esp)
+ jmp L_setjmp$stub
+ leave
+ ret
+_gfpucw_: # Get fpucw: gfpucw_ (&cur_fpucw)
+ pushl %ebp
+ movl %esp,%ebp
+ subl $0x4,%esp
+ movl 0x8(%ebp), %eax
+ fnstcw 0xfffffffe(%ebp)
+ movw 0xfffffffe(%ebp), %dx
+ movl %edx,(%eax)
+ movl %ebp, %esp
+ popl %ebp
+ ret
+
+_sfpucw_: # Set fpucw: sfpucw_ (&new_fpucw)
+ pushl %ebp
+ movl %esp,%ebp
+ subl $0x4,%esp
+ movl 0x8(%ebp), %eax
+ movl (%eax), %eax
+ andl $0xf3f, %eax
+ fclex
+ movw %ax, 0xfffffffe(%ebp)
+ fldcw 0xfffffffe(%ebp)
+ leave
+ ret
+
+_gfpusw_: # Get fpusw: gfpusw_ (&cur_fpusw)
+ pushl %ebp
+ movl %esp,%ebp
+ subl $0x4,%esp
+ movl 0x8(%ebp), %eax
+ fstsw 0xfffffffe(%ebp)
+ movw 0xfffffffe(%ebp), %dx
+ movl %edx,(%eax)
+ movl %ebp, %esp
+ popl %ebp
+ ret
+
+ .section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5
+L_setjmp$stub:
+ .indirect_symbol _setjmp
+ hlt ; hlt ; hlt ; hlt ; hlt
+ .subsections_via_symbols
diff --git a/unix/as.macosx/zsvjmp_ppc.s b/unix/as.macosx/zsvjmp_ppc.s
new file mode 100644
index 00000000..23308bf1
--- /dev/null
+++ b/unix/as.macosx/zsvjmp_ppc.s
@@ -0,0 +1,123 @@
+# ZSVJMP.S -- MacOS X version, September 2001, March 2002.
+
+.file "zsvjmp.s"
+
+ # ZSVJMP -- SPP callable SETJMP.
+.text
+ .align 2
+ .globl _zsvjmp_
+_zsvjmp_:
+ # R3 = buf, R4 = &status
+ li r11,0 ; r11 = 0
+ stw r11,0(r4) ; set *status to zero
+ stw r4,0(r3) ; store &status in buf[0]
+ addi r3,r3,4 ; reference buf[1] for setjmp
+ b L_setjmp$stub
+L2:
+ lwz r1,0(r1)
+ lwz r0,8(r1)
+ mtlr r0
+ lmw r30,-8(r1)
+ blr
+
+ # The setjmp code is only available in a dynamic library on 10.1.
+.picsymbol_stub
+L_setjmp$stub:
+ .indirect_symbol _setjmp
+ mflr r0
+ bcl 20,31,L1$pb
+L1$pb:
+ mflr r11
+ addis r11,r11,ha16(L1$lz-L1$pb)
+ mtlr r0
+ lwz r12,lo16(L1$lz-L1$pb)(r11)
+ mtctr r12
+ addi r11,r11,lo16(L1$lz-L1$pb)
+ bctr
+.lazy_symbol_pointer
+L1$lz:
+ .indirect_symbol _setjmp
+ .long dyld_stub_binding_helper
+.text
+.Lfe1:
+
+ # Set the address of the MEM common to zero.
+ .globl _mem_
+ _mem_ = 0
+
+
+ # GFPSCR -- Return the contents of the PowerPC FPSCR register.
+.text
+ .align 2
+.globl _gfpscr_
+_gfpscr_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L2$pb
+L2$pb:
+ mflr r31
+ mtlr r0
+
+ mffs f0
+ stfd f0, 16(r30)
+ lwz r0, 20(r30)
+ mr r3, r0
+
+ b L3
+L3:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
+
+
+ # SFPSCR -- Set the contents of the PowerPC FPSCR register.
+.text
+ .align 2
+.globl _sfpscr_
+_sfpscr_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L4$pb
+L4$pb:
+ mflr r31
+ mtlr r0
+
+ lis r0, 0xfff8
+ stw r0, 16(r30)
+ lwz r0, 0(r3)
+ stw r0, 20(r30)
+ lfd f0, 16(r30)
+ mtfsf 255, f0
+
+ b L5
+L5:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
+
+
+ # GXER -- Return the contents of the PowerPC XER register.
+.text
+ .align 2
+.globl _gxer_
+_gxer_:
+ stmw r30,-8(r1)
+ stwu r1,-48(r1)
+ mr r30,r1
+ mflr r0
+ bcl 20,31,L3$pb
+L3$pb:
+ mflr r31
+ mtlr r0
+
+ mfspr r3,1
+
+ b L4
+L4:
+ lwz r1,0(r1)
+ lmw r30,-8(r1)
+ blr
diff --git a/unix/as.macosx/zz.c b/unix/as.macosx/zz.c
new file mode 100644
index 00000000..68aa838b
--- /dev/null
+++ b/unix/as.macosx/zz.c
@@ -0,0 +1,10 @@
+/* Compile with gcc -S to get demo assembler code.
+ */
+zsvjmp_(buf,status)
+int *buf;
+int *status;
+{
+ *status = 0;
+ buf[0] = *status;
+ setjmp (&buf[1]);
+}
diff --git a/unix/as.macosx/zzdebug.c b/unix/as.macosx/zzdebug.c
new file mode 100644
index 00000000..81247e78
--- /dev/null
+++ b/unix/as.macosx/zzdebug.c
@@ -0,0 +1,48 @@
+/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+ */
+
+#include <stdio.h>
+#define import_spp
+#define import_kernel
+#define import_knames
+#include <iraf.h>
+
+/*
+ * ZZDEBUG -- Test program for ZSVJMP/ZDOJMP. Will return "exit status 1"
+ * if it runs successfully.
+ */
+
+
+int jmpbuf[LEN_JUMPBUF];
+int status;
+
+main()
+{
+ zsvjmp_((char *)jmpbuf, &status);
+ if (status) {
+ printf ("exit status %d\n", status);
+ exit (status);
+ }
+
+ a(1);
+ exit (0);
+}
+
+
+a(status)
+int status;
+{
+ ZDOJMP(jmpbuf, &status);
+}
+
+
+/* ZDOJMP -- Restore the saved processor context (non-local goto). See also
+ * as$zsvjmp.s, where most of the work is done.
+ */
+ZDOJMP (jmpbuf, status)
+XINT *jmpbuf;
+XINT *status;
+{
+ *((int *)jmpbuf[0]) = *status;
+ longjmp (&jmpbuf[1], *status);
+}