aboutsummaryrefslogtreecommitdiff
path: root/unix/as.mc68020
diff options
context:
space:
mode:
Diffstat (limited to 'unix/as.mc68020')
-rw-r--r--unix/as.mc68020/README4
-rw-r--r--unix/as.mc68020/aclrb.c16
-rw-r--r--unix/as.mc68020/aclrc.c16
-rw-r--r--unix/as.mc68020/aclrd.c16
-rw-r--r--unix/as.mc68020/aclri.c16
-rw-r--r--unix/as.mc68020/aclrl.c16
-rw-r--r--unix/as.mc68020/aclrr.c16
-rw-r--r--unix/as.mc68020/aclrs.c16
-rw-r--r--unix/as.mc68020/amovc.c17
-rw-r--r--unix/as.mc68020/amovd.c17
-rw-r--r--unix/as.mc68020/amovi.c17
-rw-r--r--unix/as.mc68020/amovl.c17
-rw-r--r--unix/as.mc68020/amovr.c17
-rw-r--r--unix/as.mc68020/amovs.c17
-rw-r--r--unix/as.mc68020/bytmov.c23
-rw-r--r--unix/as.mc68020/ieee.gx318
-rw-r--r--unix/as.mc68020/ieeed.x287
-rw-r--r--unix/as.mc68020/ieeer.x287
-rw-r--r--unix/as.mc68020/ishift.s44
-rw-r--r--unix/as.mc68020/zsvjmp.s37
-rw-r--r--unix/as.mc68020/zsvjmp.s.ORIG49
21 files changed, 1263 insertions, 0 deletions
diff --git a/unix/as.mc68020/README b/unix/as.mc68020/README
new file mode 100644
index 00000000..b931f6ca
--- /dev/null
+++ b/unix/as.mc68020/README
@@ -0,0 +1,4 @@
+AS -- Routines specially optimized (not necessary in assembler) for the local
+host machine. This is done without compromising the portability of the system
+(see hlib$mkpkg.sf.*).
+
diff --git a/unix/as.mc68020/aclrb.c b/unix/as.mc68020/aclrb.c
new file mode 100644
index 00000000..0ad8e775
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n);
+}
diff --git a/unix/as.mc68020/aclrc.c b/unix/as.mc68020/aclrc.c
new file mode 100644
index 00000000..5f65a082
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/aclrd.c b/unix/as.mc68020/aclrd.c
new file mode 100644
index 00000000..2336f5ee
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/aclri.c b/unix/as.mc68020/aclri.c
new file mode 100644
index 00000000..8dff5b08
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/aclrl.c b/unix/as.mc68020/aclrl.c
new file mode 100644
index 00000000..0fc61dd4
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/aclrr.c b/unix/as.mc68020/aclrr.c
new file mode 100644
index 00000000..78a56125
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/aclrs.c b/unix/as.mc68020/aclrs.c
new file mode 100644
index 00000000..2dc2da7a
--- /dev/null
+++ b/unix/as.mc68020/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;
+{
+ bzero ((char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovc.c b/unix/as.mc68020/amovc.c
new file mode 100644
index 00000000..90c59c15
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovd.c b/unix/as.mc68020/amovd.c
new file mode 100644
index 00000000..6cca4dc6
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovi.c b/unix/as.mc68020/amovi.c
new file mode 100644
index 00000000..5cd72417
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovl.c b/unix/as.mc68020/amovl.c
new file mode 100644
index 00000000..2d8be93b
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovr.c b/unix/as.mc68020/amovr.c
new file mode 100644
index 00000000..62981c44
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/amovs.c b/unix/as.mc68020/amovs.c
new file mode 100644
index 00000000..855d2882
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a, (char *)b, *n * sizeof(*a));
+}
diff --git a/unix/as.mc68020/bytmov.c b/unix/as.mc68020/bytmov.c
new file mode 100644
index 00000000..c02dd4c5
--- /dev/null
+++ b/unix/as.mc68020/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)
+ bcopy ((char *)a + (*aoff-1), (char *)b + (*boff-1), *nbytes);
+}
diff --git a/unix/as.mc68020/ieee.gx b/unix/as.mc68020/ieee.gx
new file mode 100644
index 00000000..fb3e34a4
--- /dev/null
+++ b/unix/as.mc68020/ieee.gx
@@ -0,0 +1,318 @@
+# 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
+ ieemap[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
+ieemap[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 1 # 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 i
+$if (datatype == r)
+real fval
+int ival[1]
+% equivalence (fval, ival)
+$else
+double fval
+int ival[2]
+% equivalence (fval, ival)
+$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
+ if (IEEE_SWAP == YES) {
+ call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO)
+ do i = 1, nelem {
+ fval = native[i]
+ if (and (ival[IOFF], NaNmask) == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amov$t (ieee, native, nelem)
+ else {
+ do i = 1, nelem {
+ fval = ieee[i]
+ if (and (ival[IOFF], NaNmask) == 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
+
+$if (datatype == r)
+real fval
+int ival[1]
+% equivalence (fval, ival)
+$else
+double fval
+int ival[2]
+% equivalence (fval, ival)
+$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
+ if (IEEE_SWAP == YES)
+ call BSWAP (x, 1, x, 1, NSWAP)
+ if (mapin != NO) {
+ fval = x
+ if (and (ival[IOFF], NaNmask) == 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. Setting the reserved native pseudo-NaN value
+# has the side effect of enabling NaN mapping and zeroing the statistics
+# counters.
+
+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
+ call ieemap$t (YES, YES)
+ 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
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEEMAP -- 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 ieemap$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.mc68020/ieeed.x b/unix/as.mc68020/ieeed.x
new file mode 100644
index 00000000..081b4760
--- /dev/null
+++ b/unix/as.mc68020/ieeed.x
@@ -0,0 +1,287 @@
+# 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
+ ieemap[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
+ieemap[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 1 # 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 i
+double fval
+int ival[2]
+% equivalence (fval, 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 (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO)
+ do i = 1, nelem {
+ fval = native[i]
+ if (and (ival[IOFF], NaNmask) == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amovd (ieee, native, nelem)
+ else {
+ do i = 1, nelem {
+ fval = ieee[i]
+ if (and (ival[IOFF], NaNmask) == 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
+
+double fval
+int ival[2]
+% equivalence (fval, 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)
+ if (mapin != NO) {
+ fval = x
+ if (and (ival[IOFF], NaNmask) == 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. Setting the reserved native pseudo-NaN value
+# has the side effect of enabling NaN mapping and zeroing the statistics
+# counters.
+
+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
+ call ieemapd (YES, YES)
+ 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
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEEMAP -- 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 ieemapd (inval, outval)
+
+int inval #I enable NaN mapping for input?
+int outval #I enable NaN mapping for output?
+
+# MACHDEP.
+% double precision d_quiet_nan
+
+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)
+% ieeenn = d_quiet_NaN()
+
+ if (mapin == YES)
+ NaNmask = 7FF00000X
+end
diff --git a/unix/as.mc68020/ieeer.x b/unix/as.mc68020/ieeer.x
new file mode 100644
index 00000000..ab4fee53
--- /dev/null
+++ b/unix/as.mc68020/ieeer.x
@@ -0,0 +1,287 @@
+# 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
+ ieemap[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
+ieemap[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 i
+real fval
+int ival[1]
+% equivalence (fval, 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 (ieee, 1, native, 1, nelem * NSWAP)
+ if (mapin != NO)
+ do i = 1, nelem {
+ fval = native[i]
+ if (and (ival[IOFF], NaNmask) == NaNmask) {
+ native[i] = native_NaN
+ nin = nin + 1
+ }
+ }
+ } else {
+ if (mapin == NO)
+ call amovr (ieee, native, nelem)
+ else {
+ do i = 1, nelem {
+ fval = ieee[i]
+ if (and (ival[IOFF], NaNmask) == 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
+
+real fval
+int ival[1]
+% equivalence (fval, 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)
+ if (mapin != NO) {
+ fval = x
+ if (and (ival[IOFF], NaNmask) == 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. Setting the reserved native pseudo-NaN value
+# has the side effect of enabling NaN mapping and zeroing the statistics
+# counters.
+
+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
+ call ieemapr (YES, YES)
+ 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
+
+
+# MACHINE DEPENDENT PART.
+# ---------------------------
+
+# IEEMAP -- 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 ieemapr (inval, outval)
+
+int inval #I enable NaN mapping for input?
+int outval #I enable NaN mapping for output?
+
+# MACHDEP.
+% real r_quiet_nan
+
+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)
+% ieeenn = r_quiet_NaN()
+
+ if (mapin == YES)
+ NaNmask = 7F800000X
+end
diff --git a/unix/as.mc68020/ishift.s b/unix/as.mc68020/ishift.s
new file mode 100644
index 00000000..cfd6d7e9
--- /dev/null
+++ b/unix/as.mc68020/ishift.s
@@ -0,0 +1,44 @@
+|# IAND, IOR, ISHIFT -- Bitwise boolean integer functions for the NCAR
+|# package. The shift function must rotate the bits left and around
+|# if the nbits to shift argument is positive, and zero fill at the left
+|# if the shift is negative (right shift).
+|#
+|# (SUN/UNIX MC68xxx version)
+
+|# AND -- Bitwise boolean AND: C = AND (A, B)
+ .text
+ .globl _iand_
+_iand_:
+ movl sp@(4),a0
+ movl a0@,d0
+ movl sp@(8),a0
+ andl a0@,d0
+ rts
+
+
+|# OR -- Bitwise boolean OR: C = OR (A, B)
+ .text
+ .globl _ior_
+_ior_:
+ movl sp@(4),a0
+ movl a0@,d0
+ movl sp@(8),a0
+ orl a0@,d0
+ rts
+
+
+|# ISHIFT -- Bitwise shift: C = ISHIFT (A, NBITS), +=left
+ .text
+ .globl _ishift_
+_ishift_:
+ movl sp@(4),a0
+ movl a0@,d0
+ movl sp@(8),a0
+ movl a0@,d1
+ blt L1
+ roll d1,d0 |# left rotate (high bits come in at right)
+ rts
+L1:
+ negl d1
+ lsrl d1,d0 |# logical shift right (zero at left)
+ rts
diff --git a/unix/as.mc68020/zsvjmp.s b/unix/as.mc68020/zsvjmp.s
new file mode 100644
index 00000000..efebe43e
--- /dev/null
+++ b/unix/as.mc68020/zsvjmp.s
@@ -0,0 +1,37 @@
+|# 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.
+|#
+|# (SUN/UNIX MC68xxx version)
+
+ .text
+ .globl _zsvjmp_
+
+ |# 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 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 will cause a memory violation.
+
+ .globl _mem_
+ _mem_ = 0
+
+ JMPBUF = 4
+ STATUS = 8
+
+ |# The strategy here is to build on the services provided by the C
+ |# setjmp/longjmp. Note that we cannot do this by writing a C function
+ |# which calls setjmp, because the procedure which calls setjmp cannot
+ |# return before the longjmp is executed.
+
+_zsvjmp_: |# CALL ZSVJMP (JMPBUF, STATUS)
+ movl sp@(JMPBUF),a0 |# set A0 to point to jmp_buf
+ movl sp@(STATUS),a1 |# A1 = status variable
+ movl a1,a0@ |# JB[0] = addr of status variable
+ clrl a1@ |# return zero status
+ addql #4,sp@(JMPBUF) |# skip first cell of jmp_buf
+ jmp _setjmp |# let setjmp do the rest.
diff --git a/unix/as.mc68020/zsvjmp.s.ORIG b/unix/as.mc68020/zsvjmp.s.ORIG
new file mode 100644
index 00000000..4789d053
--- /dev/null
+++ b/unix/as.mc68020/zsvjmp.s.ORIG
@@ -0,0 +1,49 @@
+|# 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.
+|#
+|# (SUN/UNIX MC68xxx version)
+
+ .text
+ .globl _zsvjmp_
+ .globl _zdojmp_
+
+ |# 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 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 will cause a memory violation.
+
+ .globl _mem_
+ _mem_ = 0
+
+ JMPBUF = 4
+ STATUS = 8
+ REGMASK = 0xfcfc |# D2-D7,A2-A5,A6,A7=sp
+
+_zsvjmp_:
+ movl sp@(JMPBUF),a0 |# set A0 to point to jmpbuf
+ movl sp@(STATUS),a1 |# A1 = status variable
+ movl a1,a0@ |# JB[1] = addr of status variable
+ clrl a1@ |# status = 0
+ movl sp@+,a1 |# A1 = return address
+ movl a1,a0@(4) |# JB[2] = return address for longjmp
+ moveml #REGMASK,a0@(8) |# save register
+ jmp a1@ |# return from subroutine
+
+_zdojmp_:
+ movl sp@(STATUS),a0
+ movl a0@,d0 |# D0 = status value
+ bne L1 |# branch if not equal to zero
+ moveq #1,d0 |# status must be nonzero
+L1:
+ movl sp@(JMPBUF),a0 |# set A0 to point to jmpbuf
+ movl a0@,a1 |# get addr of zsvjmp status variable
+ movl d0,a1@ |# set the status value
+ moveml a0@(8),#REGMASK |# restore registers
+ movl a0@(4),a1 |# get return address of zsvjmp
+ jmp a1@ |# return from zsvjmp
generated by cgit (git 2.34.1) at 2025-09-20 06:54:08 -0400