diff options
Diffstat (limited to 'unix/as.linuxppc/ieee.gx')
| -rw-r--r-- | unix/as.linuxppc/ieee.gx | 420 |
1 files changed, 420 insertions, 0 deletions
diff --git a/unix/as.linuxppc/ieee.gx b/unix/as.linuxppc/ieee.gx new file mode 100644 index 00000000..61a7caf0 --- /dev/null +++ b/unix/as.linuxppc/ieee.gx @@ -0,0 +1,420 @@ +# 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 { + call ieee_sigmask() + 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) + call ieee_sigrestore() + } +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. + + call ieee_sigmask() + 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 + } + } + call ieee_sigrestore() + } + } 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. + + call ieee_sigmask() + 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] + } + call ieee_sigrestore() + } + } + + +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) { + call ieee_sigmask() + if (x == native_NaN) { + x = ieee_NaN + nout = nout + 1 + } + call ieee_sigrestore() + } + 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) { + call ieee_sigmask() + fval = x + expon = and (ival[IOFF], NaNmask) + if (expon == 0) + x = 0 + else if (expon == NaNmask) { + x = native_NaN + nin = nin + 1 + } + call ieee_sigrestore() + } +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 fval +int ival[1] +$else +double fval +int ival[2] +$endif + +PIXEL native_NaN, ieee_NaN +int mapin, mapout, nin, nout, NaNmask +common /ieenan$t/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout + +$if (datatype == r) +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x / +$else +% equivalence (fval, ival) +% data ival(1) / '7ff7ffff'x /, ival(2) /-1/ +$endif + +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 + + +$if (datatype == r) + +# IEEE_SIGMASK, IEEE_SIGRESTORE -- Routines for masking IEEE exceptions. +# +# ieee_sigmask() +# ieee_sigrestore() +# +# These routines are meant to be used only internally by the routines in +# this file. iee_sigmask saves the current IEEE FPU exception mask, and +# sets a new mask which masks the invalid operand exception. This is +# necessary to permit the routines in this file to handle NaN values without +# raising the IEEE invalid operand exception. iee_sigrestore restores +# the original exception mask. These routines are meant to be called as +# pairs to temporarily block the invalid operand exception within an IEEE +# conversion routine. + +procedure ieee_sigmask() +int fpucw +common /ieesig/ fpucw +begin + call gfpucw (fpucw) + call sfpucw (or (fpucw, 80X)) +end + +procedure ieee_sigrestore() +int fpucw +common /ieesig/ fpucw +begin + call sfpucw (fpucw) +end + +$endif |