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