diff options
author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
---|---|---|
committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
tree | 4464880c571602d54f6ae114729bf62a89518057 /unix/as.rs6000 | |
download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'unix/as.rs6000')
-rw-r--r-- | unix/as.rs6000/aclrb.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclrc.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclrd.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclri.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclrl.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclrr.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/aclrs.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovc.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovd.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovi.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovl.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovr.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/amovs.c | 16 | ||||
-rw-r--r-- | unix/as.rs6000/bytmov.c | 22 | ||||
-rw-r--r-- | unix/as.rs6000/ieee.gx | 318 | ||||
-rw-r--r-- | unix/as.rs6000/ieeed.x | 289 | ||||
-rw-r--r-- | unix/as.rs6000/ieeer.x | 289 | ||||
-rw-r--r-- | unix/as.rs6000/zsvjmp.s | 29 | ||||
-rw-r--r-- | unix/as.rs6000/zzdebug.c | 48 |
19 files changed, 1203 insertions, 0 deletions
diff --git a/unix/as.rs6000/aclrb.c b/unix/as.rs6000/aclrb.c new file mode 100644 index 00000000..0ad8e775 --- /dev/null +++ b/unix/as.rs6000/aclrb.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRB -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRB (a, n) +XCHAR *a; +XINT *n; +{ + bzero ((char *)a, *n); +} diff --git a/unix/as.rs6000/aclrc.c b/unix/as.rs6000/aclrc.c new file mode 100644 index 00000000..5f65a082 --- /dev/null +++ b/unix/as.rs6000/aclrc.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRC -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRC (a, n) +XCHAR *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/aclrd.c b/unix/as.rs6000/aclrd.c new file mode 100644 index 00000000..2336f5ee --- /dev/null +++ b/unix/as.rs6000/aclrd.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRD -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRD (a, n) +XDOUBLE *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/aclri.c b/unix/as.rs6000/aclri.c new file mode 100644 index 00000000..8dff5b08 --- /dev/null +++ b/unix/as.rs6000/aclri.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRI -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRI (a, n) +XINT *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/aclrl.c b/unix/as.rs6000/aclrl.c new file mode 100644 index 00000000..0fc61dd4 --- /dev/null +++ b/unix/as.rs6000/aclrl.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRL -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRL (a, n) +XLONG *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/aclrr.c b/unix/as.rs6000/aclrr.c new file mode 100644 index 00000000..78a56125 --- /dev/null +++ b/unix/as.rs6000/aclrr.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRR -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRR (a, n) +XREAL *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/aclrs.c b/unix/as.rs6000/aclrs.c new file mode 100644 index 00000000..2dc2da7a --- /dev/null +++ b/unix/as.rs6000/aclrs.c @@ -0,0 +1,16 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_knames +#include <iraf.h> + +/* ACLRS -- Clear a block of memory. + * [Specially optimized for Sun/IRAF]. + */ +ACLRS (a, n) +XSHORT *a; +XINT *n; +{ + bzero ((char *)a, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovc.c b/unix/as.rs6000/amovc.c new file mode 100644 index 00000000..1eecb74b --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovd.c b/unix/as.rs6000/amovd.c new file mode 100644 index 00000000..a56f3c09 --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovi.c b/unix/as.rs6000/amovi.c new file mode 100644 index 00000000..930f93ae --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovl.c b/unix/as.rs6000/amovl.c new file mode 100644 index 00000000..e125c081 --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovr.c b/unix/as.rs6000/amovr.c new file mode 100644 index 00000000..68abfd24 --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/amovs.c b/unix/as.rs6000/amovs.c new file mode 100644 index 00000000..2864f699 --- /dev/null +++ b/unix/as.rs6000/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; +{ + bcopy ((char *)a, (char *)b, *n * sizeof(*a)); +} diff --git a/unix/as.rs6000/bytmov.c b/unix/as.rs6000/bytmov.c new file mode 100644 index 00000000..8c5bb351 --- /dev/null +++ b/unix/as.rs6000/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 */ +{ + bcopy ((char *)a + (*aoff-1), (char *)b + (*boff-1), *nbytes); +} diff --git a/unix/as.rs6000/ieee.gx b/unix/as.rs6000/ieee.gx new file mode 100644 index 00000000..3b10d02d --- /dev/null +++ b/unix/as.rs6000/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 +$else +define IEEE_SWAP IEEE_SWAP8 +define BSWAP bswap8 +define NSWAP 8 +$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 /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 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 /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[1], 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[1], 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 /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 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 /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[1], 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 /ieenanr/ 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 /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 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 /ieenanr/ 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 /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 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 fval +int ival[1] +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x / +$else +double fval +int ival[2] +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x /, ival(2) /-1/ +$endif + +PIXEL 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) + ieee_NaN = fval + + if (mapin == YES) + $if (datatype == r) + NaNmask = 7F800000X + $else + NaNmask = 7FF00000X + $endif +end diff --git a/unix/as.rs6000/ieeed.x b/unix/as.rs6000/ieeed.x new file mode 100644 index 00000000..7634ac73 --- /dev/null +++ b/unix/as.rs6000/ieeed.x @@ -0,0 +1,289 @@ +# 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 + + +# 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 /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 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 /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[1], 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[1], 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 /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 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 /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[1], 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 /ieenanr/ 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 /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 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 /ieenanr/ 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 /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 ieemapd (inval, outval) + +int inval #I enable NaN mapping for input? +int outval #I enable NaN mapping for output? + +# MACHDEP. +double fval +int ival[2] +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x /, ival(2) /-1/ + +double 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) + ieee_NaN = fval + + if (mapin == YES) + NaNmask = 7FF00000X +end diff --git a/unix/as.rs6000/ieeer.x b/unix/as.rs6000/ieeer.x new file mode 100644 index 00000000..a431e337 --- /dev/null +++ b/unix/as.rs6000/ieeer.x @@ -0,0 +1,289 @@ +# 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 + + +# 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[1], 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[1], 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[1], 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 fval +int ival[1] +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x / + +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) + ieee_NaN = fval + + if (mapin == YES) + NaNmask = 7F800000X +end diff --git a/unix/as.rs6000/zsvjmp.s b/unix/as.rs6000/zsvjmp.s new file mode 100644 index 00000000..38740322 --- /dev/null +++ b/unix/as.rs6000/zsvjmp.s @@ -0,0 +1,29 @@ + .toc + .extern setjmp[DS] + .extern .setjmp +.csect [PR] + .align 2 + .globl zsvjmp + .globl .zsvjmp + .csect zsvjmp[DS] +zsvjmp: + .long .zsvjmp, TOC[tc0], 0 + .csect [PR] +.zsvjmp: + st 4, 0(3) + cal 0, 0(0) + st 0, 0(4) + ai 3, 3, 4 + b .setjmp + cror 15,15,15 +LT..zsvjmp: + .long 0 + .byte 0,0,32,97,128,1,2,1 + .long 0 + .long LT..zsvjmp-.zsvjmp + .short 6 + .byte "zsvjmp" + .byte 31 +_section_.text: +.csect .data[RW] + .long _section_.text diff --git a/unix/as.rs6000/zzdebug.c b/unix/as.rs6000/zzdebug.c new file mode 100644 index 00000000..81247e78 --- /dev/null +++ b/unix/as.rs6000/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); +} |