aboutsummaryrefslogtreecommitdiff
path: root/unix/as.ssol
diff options
context:
space:
mode:
authorJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
committerJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
commit40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch)
tree4464880c571602d54f6ae114729bf62a89518057 /unix/as.ssol
downloadiraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'unix/as.ssol')
-rw-r--r--unix/as.ssol/aclrb.c16
-rw-r--r--unix/as.ssol/aclrc.c16
-rw-r--r--unix/as.ssol/aclrd.c16
-rw-r--r--unix/as.ssol/aclri.c16
-rw-r--r--unix/as.ssol/aclrl.c16
-rw-r--r--unix/as.ssol/aclrr.c16
-rw-r--r--unix/as.ssol/aclrs.c16
-rw-r--r--unix/as.ssol/amovc.c16
-rw-r--r--unix/as.ssol/amovd.c16
-rw-r--r--unix/as.ssol/amovi.c16
-rw-r--r--unix/as.ssol/amovl.c16
-rw-r--r--unix/as.ssol/amovr.c16
-rw-r--r--unix/as.ssol/amovs.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrb.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrc.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrd.c16
-rw-r--r--unix/as.ssol/as.ssol/aclri.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrl.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrr.c16
-rw-r--r--unix/as.ssol/as.ssol/aclrs.c16
-rw-r--r--unix/as.ssol/as.ssol/amovc.c17
-rw-r--r--unix/as.ssol/as.ssol/amovd.c17
-rw-r--r--unix/as.ssol/as.ssol/amovi.c17
-rw-r--r--unix/as.ssol/as.ssol/amovl.c17
-rw-r--r--unix/as.ssol/as.ssol/amovr.c17
-rw-r--r--unix/as.ssol/as.ssol/amovs.c17
-rw-r--r--unix/as.ssol/as.ssol/bytmov.c23
-rw-r--r--unix/as.ssol/as.ssol/enbint.s20
-rw-r--r--unix/as.ssol/as.ssol/ieee.gx366
-rw-r--r--unix/as.ssol/as.ssol/ieeed.x335
-rw-r--r--unix/as.ssol/as.ssol/ieeer.x335
-rw-r--r--unix/as.ssol/as.ssol/oscmd.s369
-rw-r--r--unix/as.ssol/as.ssol/zrtadr.s6
-rw-r--r--unix/as.ssol/as.ssol/zsvjmp.s32
-rw-r--r--unix/as.ssol/as.ssol/zsvjmp.s.OLD59
-rw-r--r--unix/as.ssol/as.ssol/zzdebug.c48
-rw-r--r--unix/as.ssol/bytmov.c22
-rw-r--r--unix/as.ssol/enbint.s20
-rw-r--r--unix/as.ssol/ieee.gx318
-rw-r--r--unix/as.ssol/ieeed.x287
-rw-r--r--unix/as.ssol/ieeer.x287
-rw-r--r--unix/as.ssol/oscmd.s369
-rw-r--r--unix/as.ssol/zrtadr.s6
-rw-r--r--unix/as.ssol/zsvjmp.s32
-rw-r--r--unix/as.ssol/zsvjmp.s.OLD59
-rw-r--r--unix/as.ssol/zzdebug.c48
46 files changed, 3463 insertions, 0 deletions
diff --git a/unix/as.ssol/aclrb.c b/unix/as.ssol/aclrb.c
new file mode 100644
index 00000000..8c03c7a1
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclrc.c b/unix/as.ssol/aclrc.c
new file mode 100644
index 00000000..04e0e19b
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclrd.c b/unix/as.ssol/aclrd.c
new file mode 100644
index 00000000..0cf06b01
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclri.c b/unix/as.ssol/aclri.c
new file mode 100644
index 00000000..7d5b8ada
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclrl.c b/unix/as.ssol/aclrl.c
new file mode 100644
index 00000000..91f2a0ef
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclrr.c b/unix/as.ssol/aclrr.c
new file mode 100644
index 00000000..0426aa73
--- /dev/null
+++ b/unix/as.ssol/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.ssol/aclrs.c b/unix/as.ssol/aclrs.c
new file mode 100644
index 00000000..b4ff02a4
--- /dev/null
+++ b/unix/as.ssol/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.ssol/amovc.c b/unix/as.ssol/amovc.c
new file mode 100644
index 00000000..4cdcbe97
--- /dev/null
+++ b/unix/as.ssol/amovc.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>
+
+/* AMOVC -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVC (a, b, n)
+XCHAR *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/amovd.c b/unix/as.ssol/amovd.c
new file mode 100644
index 00000000..caac4d07
--- /dev/null
+++ b/unix/as.ssol/amovd.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>
+
+/* AMOVD -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVD (a, b, n)
+XDOUBLE *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/amovi.c b/unix/as.ssol/amovi.c
new file mode 100644
index 00000000..ff61c96d
--- /dev/null
+++ b/unix/as.ssol/amovi.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>
+
+/* AMOVI -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVI (a, b, n)
+XINT *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/amovl.c b/unix/as.ssol/amovl.c
new file mode 100644
index 00000000..751efc7f
--- /dev/null
+++ b/unix/as.ssol/amovl.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>
+
+/* AMOVL -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVL (a, b, n)
+XLONG *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/amovr.c b/unix/as.ssol/amovr.c
new file mode 100644
index 00000000..f57617bf
--- /dev/null
+++ b/unix/as.ssol/amovr.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>
+
+/* AMOVR -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVR (a, b, n)
+XREAL *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/amovs.c b/unix/as.ssol/amovs.c
new file mode 100644
index 00000000..ba9ac5e1
--- /dev/null
+++ b/unix/as.ssol/amovs.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>
+
+/* AMOVS -- Copy a block of memory.
+ * [Specially optimized for Sun/IRAF].
+ */
+AMOVS (a, b, n)
+XSHORT *a, *b;
+XINT *n;
+{
+ memmove ((char *)b, (char *)a, *n * sizeof(*a));
+}
diff --git a/unix/as.ssol/as.ssol/aclrb.c b/unix/as.ssol/as.ssol/aclrb.c
new file mode 100644
index 00000000..8c03c7a1
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclrc.c b/unix/as.ssol/as.ssol/aclrc.c
new file mode 100644
index 00000000..04e0e19b
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclrd.c b/unix/as.ssol/as.ssol/aclrd.c
new file mode 100644
index 00000000..0cf06b01
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclri.c b/unix/as.ssol/as.ssol/aclri.c
new file mode 100644
index 00000000..7d5b8ada
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclrl.c b/unix/as.ssol/as.ssol/aclrl.c
new file mode 100644
index 00000000..91f2a0ef
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclrr.c b/unix/as.ssol/as.ssol/aclrr.c
new file mode 100644
index 00000000..0426aa73
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/aclrs.c b/unix/as.ssol/as.ssol/aclrs.c
new file mode 100644
index 00000000..b4ff02a4
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovc.c b/unix/as.ssol/as.ssol/amovc.c
new file mode 100644
index 00000000..ecba2573
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovd.c b/unix/as.ssol/as.ssol/amovd.c
new file mode 100644
index 00000000..0cfa8906
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovi.c b/unix/as.ssol/as.ssol/amovi.c
new file mode 100644
index 00000000..91bc2060
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovl.c b/unix/as.ssol/as.ssol/amovl.c
new file mode 100644
index 00000000..815fd651
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovr.c b/unix/as.ssol/as.ssol/amovr.c
new file mode 100644
index 00000000..94522ea6
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/amovs.c b/unix/as.ssol/as.ssol/amovs.c
new file mode 100644
index 00000000..8aa12ae7
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/bytmov.c b/unix/as.ssol/as.ssol/bytmov.c
new file mode 100644
index 00000000..aa43f6d1
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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.ssol/as.ssol/enbint.s b/unix/as.ssol/as.ssol/enbint.s
new file mode 100644
index 00000000..ad73e9bf
--- /dev/null
+++ b/unix/as.ssol/as.ssol/enbint.s
@@ -0,0 +1,20 @@
+ .seg "text"
+ .global _ieee_enbint
+
+! _IEEE_ENBINT -- Enable the floating point exceptions indicated by the
+! bitmask passed as the only argument. The current bitmask is returned as
+! the function value.
+
+_ieee_enbint:
+ set 0x0f800000,%o4
+ sll %o0,23,%o1
+ st %fsr,[%sp+0x44]
+ ld [%sp+0x44],%o0
+ and %o1,%o4,%o1
+ andn %o0,%o4,%o2
+ or %o1,%o2,%o1
+ st %o1,[%sp+0x44]
+ ld [%sp+0x44],%fsr
+ and %o0,%o4,%o0
+ retl
+ srl %o0,23,%o0
diff --git a/unix/as.ssol/as.ssol/ieee.gx b/unix/as.ssol/as.ssol/ieee.gx
new file mode 100644
index 00000000..4a00c759
--- /dev/null
+++ b/unix/as.ssol/as.ssol/ieee.gx
@@ -0,0 +1,366 @@
+# 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 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 expon, 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) {
+ # 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 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]
+ 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 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
+$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)
+
+ # 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 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.ssol/as.ssol/ieeed.x b/unix/as.ssol/as.ssol/ieeed.x
new file mode 100644
index 00000000..391cf8ba
--- /dev/null
+++ b/unix/as.ssol/as.ssol/ieeed.x
@@ -0,0 +1,335 @@
+# 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 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 expon, 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) {
+ # 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 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]
+ 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 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
+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)
+
+ # 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 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.
+% 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.ssol/as.ssol/ieeer.x b/unix/as.ssol/as.ssol/ieeer.x
new file mode 100644
index 00000000..01815d30
--- /dev/null
+++ b/unix/as.ssol/as.ssol/ieeer.x
@@ -0,0 +1,335 @@
+# 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
+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) {
+ # 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
+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)
+
+ # 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.
+% 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.ssol/as.ssol/oscmd.s b/unix/as.ssol/as.ssol/oscmd.s
new file mode 100644
index 00000000..bfa82811
--- /dev/null
+++ b/unix/as.ssol/as.ssol/oscmd.s
@@ -0,0 +1,369 @@
+ .seg "text" ! [internal]
+ .proc 4
+ .global oscmd_
+oscmd_:
+!#PROLOGUE# 0
+!#PROLOGUE# 1
+ save %sp,-104,%sp
+ sethi %hi(VAR_SEG1+16),%l0 ! [internal]
+ or %l0,%lo(VAR_SEG1+16),%l0 ! [internal]
+ st %i1,[%fp+72]
+ st %i3,[%fp+80]
+ call _smark_,1
+ mov %l0,%o0
+ sethi %hi(L1D168),%o0
+ add %o0,%lo(L1D168),%i3
+ sethi %hi(L1D169),%o1
+ add %l0,16,%o0
+ add %o1,%lo(L1D169),%i4
+ mov %i4,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ sethi %hi(VAR_SEG1+32),%o2
+ ld [%o2+%lo(VAR_SEG1+32)],%l5
+ sethi %hi(L1D164),%o3
+ add %o3,%lo(L1D164),%i5
+ inc 20,%l0 ! [internal]
+ mov %l0,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-8,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-12,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-16,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ sethi %hi(L1D148),%o0
+ call _clstai_,1
+ or %o0,%lo(L1D148),%o0 ! [internal]
+ cmp %o0,1
+ be L77048
+ nop
+ ld [%fp+72],%l6
+ sethi %hi(_mem_-2),%o5
+ or %o5,%lo(_mem_-2),%o5 ! [internal]
+ sll %l5,1,%o4
+ add %o5,%o4,%o7
+ mov %o7,%l7
+ mov %l7,%o1
+ mov %i4,%o2
+ call _strpak_,3
+ mov %i0,%o0
+ ldsh [%l6],%l0
+ tst %l0
+ bne,a LY14
+ sethi %hi(VAR_SEG1+36),%o0
+ sethi %hi(VAR_SEG1+36),%l1
+ ld [%l1+%lo(VAR_SEG1+36)],%l1
+ sethi %hi(_mem_-2),%l3
+ or %l3,%lo(_mem_-2),%l3 ! [internal]
+ sll %l1,1,%i0
+ add %l3,%i0,%i0
+ sethi %hi(v.16),%o0
+ or %o0,%lo(v.16),%o0 ! [internal]
+ mov %i0,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY13
+ ld [%fp+80],%i1
+LY14: ! [internal]
+ ld [%o0+%lo(VAR_SEG1+36)],%o0
+ sethi %hi(_mem_-2),%o2
+ sll %o0,1,%o1
+ or %o2,%lo(_mem_-2),%o2 ! [internal]
+ add %o2,%o1,%o3
+ mov %o3,%i0
+ mov %i0,%o1
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %l6,%o0
+ ld [%fp+80],%i1
+LY13: ! [internal]
+ call _fnulle_,1
+ mov %i2,%o0
+ tst %o0
+ bne,a LY12
+ sethi %hi(VAR_SEG1+20),%o4
+ call _fnulle_,1
+ mov %i1,%o0
+ tst %o0
+ be,a LY11
+ sethi %hi(VAR_SEG1+20),%l1
+ sethi %hi(VAR_SEG1+20),%o4
+LY12: ! [internal]
+ ld [%o4+%lo(VAR_SEG1+20)],%o4
+ sethi %hi(_mem_-2),%o7
+ sll %o4,1,%o5
+ or %o7,%lo(_mem_-2),%o7 ! [internal]
+ add %o7,%o5,%l0
+ mov %l0,%i3
+ sethi %hi(v.17),%o0
+ or %o0,%lo(v.17),%o0 ! [internal]
+ mov %i3,%o1
+ call _xmktep_,3
+ mov %i5,%o2
+ b LY10
+ ldsh [%i2],%o0
+LY11: ! [internal]
+ ld [%l1+%lo(VAR_SEG1+20)],%l1
+ sethi %hi(_mem_-2),%l3
+ or %l3,%lo(_mem_-2),%l3 ! [internal]
+ sll %l1,1,%l2
+ add %l3,%l2,%l2
+ mov %l2,%i3
+ sth %g0,[%i3]
+ ldsh [%i2],%o0
+LY10: ! [internal]
+ tst %o0
+ bne L77021
+ sethi %hi(VAR_SEG1+28),%o1
+ ld [%o1+%lo(VAR_SEG1+28)],%o1
+ sethi %hi(_mem_-2),%o3
+ or %o3,%lo(_mem_-2),%o3 ! [internal]
+ sll %o1,1,%i4
+ add %o3,%i4,%i4
+ sethi %hi(v.18),%o0
+ or %o0,%lo(v.18),%o0 ! [internal]
+ mov %i4,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY9
+ ldsh [%i1],%o1
+L77021:
+ call _fnulle_,1
+ mov %i2,%o0
+ tst %o0
+ be,a LY8
+ sethi %hi(VAR_SEG1+28),%l2
+ sethi %hi(VAR_SEG1+28),%o5
+ ld [%o5+%lo(VAR_SEG1+28)],%o5
+ sethi %hi(_mem_-2),%l0
+ or %l0,%lo(_mem_-2),%l0 ! [internal]
+ sll %o5,1,%o7
+ add %l0,%o7,%l1
+ mov %i3,%o0
+ b LY1
+ mov %l1,%i4
+LY8: ! [internal]
+ ld [%l2+%lo(VAR_SEG1+28)],%l2
+ sethi %hi(_mem_-2),%l4
+ or %l4,%lo(_mem_-2),%l4 ! [internal]
+ sll %l2,1,%l3
+ add %l4,%l3,%i4
+ mov %i2,%o0
+LY1: ! [internal]
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %i4,%o1
+ ldsh [%i1],%o1
+LY9: ! [internal]
+ tst %o1
+ bne L77031
+ sethi %hi(VAR_SEG1+24),%o2
+ ld [%o2+%lo(VAR_SEG1+24)],%o2
+ sethi %hi(_mem_-2),%o4
+ sll %o2,1,%o3
+ or %o4,%lo(_mem_-2),%o4 ! [internal]
+ add %o4,%o3,%o5
+ mov %o5,%i2
+ sethi %hi(v.19),%o0
+ or %o0,%lo(v.19),%o0 ! [internal]
+ mov %i2,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY7
+ sethi %hi(VAR_SEG1),%o4
+L77031:
+ call _fnulle_,1
+ mov %i1,%o0
+ tst %o0
+ be,a LY6
+ sethi %hi(VAR_SEG1+24),%l3
+ sethi %hi(VAR_SEG1+24),%o7
+ ld [%o7+%lo(VAR_SEG1+24)],%o7
+ sethi %hi(_mem_-2),%l1
+ or %l1,%lo(_mem_-2),%l1 ! [internal]
+ sll %o7,1,%i2
+ mov %i3,%o0
+ b LY2
+ add %l1,%i2,%i2
+LY6: ! [internal]
+ ld [%l3+%lo(VAR_SEG1+24)],%l3
+ sethi %hi(_mem_-2),%o0
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %l3,1,%l4
+ add %o0,%l4,%o1
+ mov %o1,%i2
+ mov %i1,%o0
+LY2: ! [internal]
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %i2,%o1
+ sethi %hi(VAR_SEG1),%o4
+LY7: ! [internal]
+ or %o4,%lo(VAR_SEG1),%o4 ! [internal]
+ mov %i2,%o3
+ mov %i4,%o2
+ mov %i0,%o1
+ call _koscmd_,5
+ mov %l7,%o0
+ ldsh [%i3],%o3
+ sethi %hi(VAR_SEG1),%o2
+ ld [%o2+%lo(VAR_SEG1)],%i5
+ tst %o3
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ call _xerpsh_,0
+ nop
+ call _xfdele_,1
+ mov %i3,%o0
+ call _xerpop_,0
+ nop
+ tst %o0
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ sethi %hi(L1D54),%o0
+ call _erract_,1
+ or %o0,%lo(L1D54),%o0 ! [internal]
+ sethi %hi(_xercom_),%o4
+ ld [%o4+%lo(_xercom_)],%o4
+ tst %o4
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ b LY5
+ sethi %hi(VAR_SEG1),%o0 ! [internal]
+L77048:
+ call _xffluh_,1
+ mov %i3,%o0
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ add %l5,1,%l1
+ mov %l1,%i2
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %i2,1,%l3
+ mov %l3,%i3
+ mov 2,%i5
+ inc -2,%i0
+ add %i5,%i0,%i0
+ add %i3,%o0,%o1
+ mov %o0,%o7
+ sll %l5,1,%o5
+ mov 33,%l0
+ sth %l0,[%o5+%o7]
+ mov %o1,%i3
+ mov %i0,%i5
+L77049:
+ ldsh [%i5],%i4
+ tst %i4
+ be,a LY4
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ ldsh [%i5],%i0
+ cmp %i4,10
+ be,a LY4
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ sth %i0,[%i3]
+ inc %i2
+ inc 2,%i5
+ b L77049
+ inc 2,%i3
+LY4: ! [internal]
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %i2,1,%i2
+ mov %i2,%i5
+ mov %o0,%o3
+ mov 10,%o4
+ sth %o4,[%i5+%o3]
+ add %o0,2,%o5
+ sth %g0,[%i5+%o5]
+ mov %o0,%o1
+ sethi %hi(L1D168),%o7
+ add %o7,%lo(L1D168),%i5
+ sll %l5,1,%l0
+ add %o1,%l0,%o1
+ call _putlie_,2
+ mov %i5,%o0
+ call _xffluh_,1
+ mov %i5,%o0
+ sethi %hi(L1D148),%l1
+ add %l1,%lo(L1D148),%i3
+ mov 0,%i5
+L77055:
+ sethi %hi(VAR_SEG1+4),%o1
+ or %o1,%lo(VAR_SEG1+4),%o1 ! [internal]
+ call _getci_,2
+ mov %i3,%o0
+ cmp %o0,-2
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ sethi %hi(VAR_SEG1+4),%l2
+ ld [%l2+%lo(VAR_SEG1+4)],%l2
+ cmp %l2,10
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ mov %i5,%o0
+ sll %o0,1,%o0
+ mov %o0,%o1
+ sethi %hi(VAR_SEG1+4),%l3
+ ld [%l3+%lo(VAR_SEG1+4)],%l3
+ sll %o1,2,%o1
+ add %o0,%o1,%o0
+ add %l3,-48,%l4
+ add %o0,%l4,%o0
+ b L77055
+ mov %o0,%i5
+LY3: ! [internal]
+ call _sfree_,1
+ or %o0,%lo(VAR_SEG1+16),%o0 ! [internal]
+ mov %i5,%i3
+ sethi %hi(VAR_SEG1),%o0 ! [internal]
+LY5: ! [internal]
+ or %o0,%lo(VAR_SEG1),%o0 ! [internal]
+ st %i5,[%o0]
+ st %l5,[%o0+32]
+ ret
+ restore %g0,%i3,%o0
+ .seg "data" ! [internal]
+ .common _mem_,8
+ .common _xercom_,4
+ .align 8
+ .align 4
+L1D168:
+ .word 2
+ .align 4
+L1D169:
+ .word 0x400
+ .align 4
+L1D164:
+ .word 127
+ .align 4
+L1D148:
+ .word 1
+ .align 4
+L1D54:
+ .word 3
+ .align 4
+v.16:
+ .half 0
+ .align 4
+v.17:
+ .word 0x74006d
+ .word 0x700024
+ .word 0x6e0075
+ .word 0x6c006c
+ .skip 2
+ .align 4
+v.18:
+ .skip 2
+ .align 4
+v.19:
+ .skip 2
+ .seg "bss" ! [internal]
+ .align 8
+VAR_SEG1:
+ .skip 40
diff --git a/unix/as.ssol/as.ssol/zrtadr.s b/unix/as.ssol/as.ssol/zrtadr.s
new file mode 100644
index 00000000..22523154
--- /dev/null
+++ b/unix/as.ssol/as.ssol/zrtadr.s
@@ -0,0 +1,6 @@
+ .seg "text"
+ .global zrtadr_
+zrtadr_:
+ mov %i7,%o0
+ retl
+ nop
diff --git a/unix/as.ssol/as.ssol/zsvjmp.s b/unix/as.ssol/as.ssol/zsvjmp.s
new file mode 100644
index 00000000..b4d03439
--- /dev/null
+++ b/unix/as.ssol/as.ssol/zsvjmp.s
@@ -0,0 +1,32 @@
+!# 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 sparc version)
+
+ .seg "text"
+ .global 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.
+
+ .global _mem_
+ _mem_ = 0
+
+ .proc 0
+zsvjmp_:
+ st %o1, [%o0] ! save &status in jmpbuf[0]
+ clr %o2
+ st %o2, [%o1] ! zero the value of status
+ add %o0, 0x4, %o0
+ set setjmp, %o1
+ jmp %o1
+ nop
+ .seg "data"
diff --git a/unix/as.ssol/as.ssol/zsvjmp.s.OLD b/unix/as.ssol/as.ssol/zsvjmp.s.OLD
new file mode 100644
index 00000000..7f6bb7eb
--- /dev/null
+++ b/unix/as.ssol/as.ssol/zsvjmp.s.OLD
@@ -0,0 +1,59 @@
+!# 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 sparc version)
+
+ .seg "text"
+ .global _zsvjmp_
+ .global _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.
+
+ .global _mem_
+ _mem_ = 0
+
+ !# The following requires a jmpbuf of length at least 6 ints.
+ .proc 0
+_zsvjmp_:
+ save %sp, -0x60, %sp
+ call _sigblock
+ clr %o0
+ st %o0, [%i0 + 0x8]
+ st %i1, [%i0 + 0x14]
+ clr %o0
+ st %o0, [%i1]
+ st %i7, [%i0]
+ st %fp, [%i0 + 0x4]
+ add %i0, 0xc, %o1
+ call _sigstack
+ clr %o0
+ ret
+ restore %g0, 0x0, %o0
+
+ .proc 0
+_zdojmp_:
+ save %sp, -0x40, %sp
+ ta 0x3
+ ld [%i0 + 0x4], %fp
+ sub %fp, 0x60, %sp
+ call _sigsetmask
+ ld [%i0 + 0x8], %o0
+ add %i0, 0xc, %o0
+ call _sigstack
+ clr %o1
+ ld [%i0 + 0x14], %o0
+ ld [%i1], %i1
+ st %i1, [%o0]
+ ld [%i0], %i7
+ ret
+ restore %i1, 0x0, %o0
+ .seg "data"
diff --git a/unix/as.ssol/as.ssol/zzdebug.c b/unix/as.ssol/as.ssol/zzdebug.c
new file mode 100644
index 00000000..81247e78
--- /dev/null
+++ b/unix/as.ssol/as.ssol/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);
+}
diff --git a/unix/as.ssol/bytmov.c b/unix/as.ssol/bytmov.c
new file mode 100644
index 00000000..98a08fa4
--- /dev/null
+++ b/unix/as.ssol/bytmov.c
@@ -0,0 +1,22 @@
+/* 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 */
+{
+ memmove ((char *)b + (*boff-1), (char *)a + (*aoff-1), *nbytes);
+}
diff --git a/unix/as.ssol/enbint.s b/unix/as.ssol/enbint.s
new file mode 100644
index 00000000..ad73e9bf
--- /dev/null
+++ b/unix/as.ssol/enbint.s
@@ -0,0 +1,20 @@
+ .seg "text"
+ .global _ieee_enbint
+
+! _IEEE_ENBINT -- Enable the floating point exceptions indicated by the
+! bitmask passed as the only argument. The current bitmask is returned as
+! the function value.
+
+_ieee_enbint:
+ set 0x0f800000,%o4
+ sll %o0,23,%o1
+ st %fsr,[%sp+0x44]
+ ld [%sp+0x44],%o0
+ and %o1,%o4,%o1
+ andn %o0,%o4,%o2
+ or %o1,%o2,%o1
+ st %o1,[%sp+0x44]
+ ld [%sp+0x44],%fsr
+ and %o0,%o4,%o0
+ retl
+ srl %o0,23,%o0
diff --git a/unix/as.ssol/ieee.gx b/unix/as.ssol/ieee.gx
new file mode 100644
index 00000000..fb3e34a4
--- /dev/null
+++ b/unix/as.ssol/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.ssol/ieeed.x b/unix/as.ssol/ieeed.x
new file mode 100644
index 00000000..081b4760
--- /dev/null
+++ b/unix/as.ssol/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.ssol/ieeer.x b/unix/as.ssol/ieeer.x
new file mode 100644
index 00000000..ab4fee53
--- /dev/null
+++ b/unix/as.ssol/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.ssol/oscmd.s b/unix/as.ssol/oscmd.s
new file mode 100644
index 00000000..bfa82811
--- /dev/null
+++ b/unix/as.ssol/oscmd.s
@@ -0,0 +1,369 @@
+ .seg "text" ! [internal]
+ .proc 4
+ .global oscmd_
+oscmd_:
+!#PROLOGUE# 0
+!#PROLOGUE# 1
+ save %sp,-104,%sp
+ sethi %hi(VAR_SEG1+16),%l0 ! [internal]
+ or %l0,%lo(VAR_SEG1+16),%l0 ! [internal]
+ st %i1,[%fp+72]
+ st %i3,[%fp+80]
+ call _smark_,1
+ mov %l0,%o0
+ sethi %hi(L1D168),%o0
+ add %o0,%lo(L1D168),%i3
+ sethi %hi(L1D169),%o1
+ add %l0,16,%o0
+ add %o1,%lo(L1D169),%i4
+ mov %i4,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ sethi %hi(VAR_SEG1+32),%o2
+ ld [%o2+%lo(VAR_SEG1+32)],%l5
+ sethi %hi(L1D164),%o3
+ add %o3,%lo(L1D164),%i5
+ inc 20,%l0 ! [internal]
+ mov %l0,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-8,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-12,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ add %l0,-16,%o0
+ mov %i5,%o1
+ call _salloc_,3
+ mov %i3,%o2
+ sethi %hi(L1D148),%o0
+ call _clstai_,1
+ or %o0,%lo(L1D148),%o0 ! [internal]
+ cmp %o0,1
+ be L77048
+ nop
+ ld [%fp+72],%l6
+ sethi %hi(_mem_-2),%o5
+ or %o5,%lo(_mem_-2),%o5 ! [internal]
+ sll %l5,1,%o4
+ add %o5,%o4,%o7
+ mov %o7,%l7
+ mov %l7,%o1
+ mov %i4,%o2
+ call _strpak_,3
+ mov %i0,%o0
+ ldsh [%l6],%l0
+ tst %l0
+ bne,a LY14
+ sethi %hi(VAR_SEG1+36),%o0
+ sethi %hi(VAR_SEG1+36),%l1
+ ld [%l1+%lo(VAR_SEG1+36)],%l1
+ sethi %hi(_mem_-2),%l3
+ or %l3,%lo(_mem_-2),%l3 ! [internal]
+ sll %l1,1,%i0
+ add %l3,%i0,%i0
+ sethi %hi(v.16),%o0
+ or %o0,%lo(v.16),%o0 ! [internal]
+ mov %i0,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY13
+ ld [%fp+80],%i1
+LY14: ! [internal]
+ ld [%o0+%lo(VAR_SEG1+36)],%o0
+ sethi %hi(_mem_-2),%o2
+ sll %o0,1,%o1
+ or %o2,%lo(_mem_-2),%o2 ! [internal]
+ add %o2,%o1,%o3
+ mov %o3,%i0
+ mov %i0,%o1
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %l6,%o0
+ ld [%fp+80],%i1
+LY13: ! [internal]
+ call _fnulle_,1
+ mov %i2,%o0
+ tst %o0
+ bne,a LY12
+ sethi %hi(VAR_SEG1+20),%o4
+ call _fnulle_,1
+ mov %i1,%o0
+ tst %o0
+ be,a LY11
+ sethi %hi(VAR_SEG1+20),%l1
+ sethi %hi(VAR_SEG1+20),%o4
+LY12: ! [internal]
+ ld [%o4+%lo(VAR_SEG1+20)],%o4
+ sethi %hi(_mem_-2),%o7
+ sll %o4,1,%o5
+ or %o7,%lo(_mem_-2),%o7 ! [internal]
+ add %o7,%o5,%l0
+ mov %l0,%i3
+ sethi %hi(v.17),%o0
+ or %o0,%lo(v.17),%o0 ! [internal]
+ mov %i3,%o1
+ call _xmktep_,3
+ mov %i5,%o2
+ b LY10
+ ldsh [%i2],%o0
+LY11: ! [internal]
+ ld [%l1+%lo(VAR_SEG1+20)],%l1
+ sethi %hi(_mem_-2),%l3
+ or %l3,%lo(_mem_-2),%l3 ! [internal]
+ sll %l1,1,%l2
+ add %l3,%l2,%l2
+ mov %l2,%i3
+ sth %g0,[%i3]
+ ldsh [%i2],%o0
+LY10: ! [internal]
+ tst %o0
+ bne L77021
+ sethi %hi(VAR_SEG1+28),%o1
+ ld [%o1+%lo(VAR_SEG1+28)],%o1
+ sethi %hi(_mem_-2),%o3
+ or %o3,%lo(_mem_-2),%o3 ! [internal]
+ sll %o1,1,%i4
+ add %o3,%i4,%i4
+ sethi %hi(v.18),%o0
+ or %o0,%lo(v.18),%o0 ! [internal]
+ mov %i4,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY9
+ ldsh [%i1],%o1
+L77021:
+ call _fnulle_,1
+ mov %i2,%o0
+ tst %o0
+ be,a LY8
+ sethi %hi(VAR_SEG1+28),%l2
+ sethi %hi(VAR_SEG1+28),%o5
+ ld [%o5+%lo(VAR_SEG1+28)],%o5
+ sethi %hi(_mem_-2),%l0
+ or %l0,%lo(_mem_-2),%l0 ! [internal]
+ sll %o5,1,%o7
+ add %l0,%o7,%l1
+ mov %i3,%o0
+ b LY1
+ mov %l1,%i4
+LY8: ! [internal]
+ ld [%l2+%lo(VAR_SEG1+28)],%l2
+ sethi %hi(_mem_-2),%l4
+ or %l4,%lo(_mem_-2),%l4 ! [internal]
+ sll %l2,1,%l3
+ add %l4,%l3,%i4
+ mov %i2,%o0
+LY1: ! [internal]
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %i4,%o1
+ ldsh [%i1],%o1
+LY9: ! [internal]
+ tst %o1
+ bne L77031
+ sethi %hi(VAR_SEG1+24),%o2
+ ld [%o2+%lo(VAR_SEG1+24)],%o2
+ sethi %hi(_mem_-2),%o4
+ sll %o2,1,%o3
+ or %o4,%lo(_mem_-2),%o4 ! [internal]
+ add %o4,%o3,%o5
+ mov %o5,%i2
+ sethi %hi(v.19),%o0
+ or %o0,%lo(v.19),%o0 ! [internal]
+ mov %i2,%o1
+ call _strpak_,3
+ mov %i5,%o2
+ b LY7
+ sethi %hi(VAR_SEG1),%o4
+L77031:
+ call _fnulle_,1
+ mov %i1,%o0
+ tst %o0
+ be,a LY6
+ sethi %hi(VAR_SEG1+24),%l3
+ sethi %hi(VAR_SEG1+24),%o7
+ ld [%o7+%lo(VAR_SEG1+24)],%o7
+ sethi %hi(_mem_-2),%l1
+ or %l1,%lo(_mem_-2),%l1 ! [internal]
+ sll %o7,1,%i2
+ mov %i3,%o0
+ b LY2
+ add %l1,%i2,%i2
+LY6: ! [internal]
+ ld [%l3+%lo(VAR_SEG1+24)],%l3
+ sethi %hi(_mem_-2),%o0
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %l3,1,%l4
+ add %o0,%l4,%o1
+ mov %o1,%i2
+ mov %i1,%o0
+LY2: ! [internal]
+ mov %i5,%o2
+ call _fmapfn_,3
+ mov %i2,%o1
+ sethi %hi(VAR_SEG1),%o4
+LY7: ! [internal]
+ or %o4,%lo(VAR_SEG1),%o4 ! [internal]
+ mov %i2,%o3
+ mov %i4,%o2
+ mov %i0,%o1
+ call _koscmd_,5
+ mov %l7,%o0
+ ldsh [%i3],%o3
+ sethi %hi(VAR_SEG1),%o2
+ ld [%o2+%lo(VAR_SEG1)],%i5
+ tst %o3
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ call _xerpsh_,0
+ nop
+ call _xfdele_,1
+ mov %i3,%o0
+ call _xerpop_,0
+ nop
+ tst %o0
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ sethi %hi(L1D54),%o0
+ call _erract_,1
+ or %o0,%lo(L1D54),%o0 ! [internal]
+ sethi %hi(_xercom_),%o4
+ ld [%o4+%lo(_xercom_)],%o4
+ tst %o4
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ b LY5
+ sethi %hi(VAR_SEG1),%o0 ! [internal]
+L77048:
+ call _xffluh_,1
+ mov %i3,%o0
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ add %l5,1,%l1
+ mov %l1,%i2
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %i2,1,%l3
+ mov %l3,%i3
+ mov 2,%i5
+ inc -2,%i0
+ add %i5,%i0,%i0
+ add %i3,%o0,%o1
+ mov %o0,%o7
+ sll %l5,1,%o5
+ mov 33,%l0
+ sth %l0,[%o5+%o7]
+ mov %o1,%i3
+ mov %i0,%i5
+L77049:
+ ldsh [%i5],%i4
+ tst %i4
+ be,a LY4
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ ldsh [%i5],%i0
+ cmp %i4,10
+ be,a LY4
+ sethi %hi(_mem_-2),%o0 ! [internal]
+ sth %i0,[%i3]
+ inc %i2
+ inc 2,%i5
+ b L77049
+ inc 2,%i3
+LY4: ! [internal]
+ or %o0,%lo(_mem_-2),%o0 ! [internal]
+ sll %i2,1,%i2
+ mov %i2,%i5
+ mov %o0,%o3
+ mov 10,%o4
+ sth %o4,[%i5+%o3]
+ add %o0,2,%o5
+ sth %g0,[%i5+%o5]
+ mov %o0,%o1
+ sethi %hi(L1D168),%o7
+ add %o7,%lo(L1D168),%i5
+ sll %l5,1,%l0
+ add %o1,%l0,%o1
+ call _putlie_,2
+ mov %i5,%o0
+ call _xffluh_,1
+ mov %i5,%o0
+ sethi %hi(L1D148),%l1
+ add %l1,%lo(L1D148),%i3
+ mov 0,%i5
+L77055:
+ sethi %hi(VAR_SEG1+4),%o1
+ or %o1,%lo(VAR_SEG1+4),%o1 ! [internal]
+ call _getci_,2
+ mov %i3,%o0
+ cmp %o0,-2
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ sethi %hi(VAR_SEG1+4),%l2
+ ld [%l2+%lo(VAR_SEG1+4)],%l2
+ cmp %l2,10
+ be,a LY3
+ sethi %hi(VAR_SEG1+16),%o0
+ mov %i5,%o0
+ sll %o0,1,%o0
+ mov %o0,%o1
+ sethi %hi(VAR_SEG1+4),%l3
+ ld [%l3+%lo(VAR_SEG1+4)],%l3
+ sll %o1,2,%o1
+ add %o0,%o1,%o0
+ add %l3,-48,%l4
+ add %o0,%l4,%o0
+ b L77055
+ mov %o0,%i5
+LY3: ! [internal]
+ call _sfree_,1
+ or %o0,%lo(VAR_SEG1+16),%o0 ! [internal]
+ mov %i5,%i3
+ sethi %hi(VAR_SEG1),%o0 ! [internal]
+LY5: ! [internal]
+ or %o0,%lo(VAR_SEG1),%o0 ! [internal]
+ st %i5,[%o0]
+ st %l5,[%o0+32]
+ ret
+ restore %g0,%i3,%o0
+ .seg "data" ! [internal]
+ .common _mem_,8
+ .common _xercom_,4
+ .align 8
+ .align 4
+L1D168:
+ .word 2
+ .align 4
+L1D169:
+ .word 0x400
+ .align 4
+L1D164:
+ .word 127
+ .align 4
+L1D148:
+ .word 1
+ .align 4
+L1D54:
+ .word 3
+ .align 4
+v.16:
+ .half 0
+ .align 4
+v.17:
+ .word 0x74006d
+ .word 0x700024
+ .word 0x6e0075
+ .word 0x6c006c
+ .skip 2
+ .align 4
+v.18:
+ .skip 2
+ .align 4
+v.19:
+ .skip 2
+ .seg "bss" ! [internal]
+ .align 8
+VAR_SEG1:
+ .skip 40
diff --git a/unix/as.ssol/zrtadr.s b/unix/as.ssol/zrtadr.s
new file mode 100644
index 00000000..22523154
--- /dev/null
+++ b/unix/as.ssol/zrtadr.s
@@ -0,0 +1,6 @@
+ .seg "text"
+ .global zrtadr_
+zrtadr_:
+ mov %i7,%o0
+ retl
+ nop
diff --git a/unix/as.ssol/zsvjmp.s b/unix/as.ssol/zsvjmp.s
new file mode 100644
index 00000000..b4d03439
--- /dev/null
+++ b/unix/as.ssol/zsvjmp.s
@@ -0,0 +1,32 @@
+!# 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 sparc version)
+
+ .seg "text"
+ .global 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.
+
+ .global _mem_
+ _mem_ = 0
+
+ .proc 0
+zsvjmp_:
+ st %o1, [%o0] ! save &status in jmpbuf[0]
+ clr %o2
+ st %o2, [%o1] ! zero the value of status
+ add %o0, 0x4, %o0
+ set setjmp, %o1
+ jmp %o1
+ nop
+ .seg "data"
diff --git a/unix/as.ssol/zsvjmp.s.OLD b/unix/as.ssol/zsvjmp.s.OLD
new file mode 100644
index 00000000..7f6bb7eb
--- /dev/null
+++ b/unix/as.ssol/zsvjmp.s.OLD
@@ -0,0 +1,59 @@
+!# 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 sparc version)
+
+ .seg "text"
+ .global _zsvjmp_
+ .global _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.
+
+ .global _mem_
+ _mem_ = 0
+
+ !# The following requires a jmpbuf of length at least 6 ints.
+ .proc 0
+_zsvjmp_:
+ save %sp, -0x60, %sp
+ call _sigblock
+ clr %o0
+ st %o0, [%i0 + 0x8]
+ st %i1, [%i0 + 0x14]
+ clr %o0
+ st %o0, [%i1]
+ st %i7, [%i0]
+ st %fp, [%i0 + 0x4]
+ add %i0, 0xc, %o1
+ call _sigstack
+ clr %o0
+ ret
+ restore %g0, 0x0, %o0
+
+ .proc 0
+_zdojmp_:
+ save %sp, -0x40, %sp
+ ta 0x3
+ ld [%i0 + 0x4], %fp
+ sub %fp, 0x60, %sp
+ call _sigsetmask
+ ld [%i0 + 0x8], %o0
+ add %i0, 0xc, %o0
+ call _sigstack
+ clr %o1
+ ld [%i0 + 0x14], %o0
+ ld [%i1], %i1
+ st %i1, [%o0]
+ ld [%i0], %i7
+ ret
+ restore %i1, 0x0, %o0
+ .seg "data"
diff --git a/unix/as.ssol/zzdebug.c b/unix/as.ssol/zzdebug.c
new file mode 100644
index 00000000..81247e78
--- /dev/null
+++ b/unix/as.ssol/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);
+}