path: root/unix/as.linuxppc/ieeer.x

# 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 {
	    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 ieevupkr (ieee, native, nelem)

real	ieee[ARB]		#I input IEEE floating format array
real	native[ARB]		#O output native floating format array
int	nelem			#I number of floating point numbers

int	expon, i
real	fval
int	ival[1]
%	equivalence (fval, ival)

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin

	if (IEEE_SWAP == YES) {
	    call BSWAP (ieee, 1, native, 1, nelem * NSWAP)
	    if (mapin != NO) {
		# Check for IEEE exceptional values and map NaN to the native
		# NaN value, and denormalized numbers (zero exponent) to zero.

		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 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.

		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 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) {
	    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 ieeupkr (x)

real	x			#U datum to be converted

int	expon
real	fval
int	ival[1]
%	equivalence (fval, ival)

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	if (IEEE_SWAP == YES)
	    call BSWAP (x, 1, x, 1, NSWAP)

	# Check for IEEE exceptional values and map NaN to the native NaN
	# value, and denormalized numbers (zero exponent) to zero.

	if (mapin != NO) {
	    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 ieesnanr (x)

real	x			#I native value which will replace NaN

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	native_NaN = x
	nin = 0
	nout = 0
end


# IEEGNAN -- Get the NaN value.

procedure ieegnanr (x)

real	x			#O native value which will replace NaN

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	x = native_NaN
end


# IEESTAT -- Return statistics on the number of NaNs encountered in input
# conversions (unpack) and output conversions (pack).

procedure ieestatr (o_nin, o_nout)

int	o_nin				#O number of NaN seen on input
int	o_nout				#O number of NaN values output

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	o_nin = nin
	o_nout = nout
end


# IEEZSTAT -- Zero the statistics counters.

procedure ieezstatr ()

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	nin = 0
	nout = 0
end


# IEEMAP -- Same as IEESMAP.  Retained for backwards compatibility.

procedure ieemapr (inval, outval)

int	inval				#I enable mapping on input
int	outval				#I enable mapping on output

begin
	call ieesmapr (inval, outval)
end


# IEEGMAP -- Query the current values of the input and output mapping
# enables.

procedure ieegmapr (inval, outval)

int	inval				#O get input mapping enable flag
int	outval				#O get output mapping enable flag

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

begin
	inval = mapin
	outval = mapout
end


# MACHINE DEPENDENT PART.
# ---------------------------

# IEESMAP -- Enable or disable NaN mapping.
#
# sEEE EEEE Emmm mmmm mmmm mmmm mmmm mmmm
#  3           2            1           0
# 1098 7654 3210 9876 5432 1098 7654 3210
#    7    f    8    0    0    0    0    0

procedure ieesmapr (inval, outval)

int	inval				#I enable NaN mapping for input?
int	outval				#I enable NaN mapping for output?

# MACHDEP.
real	fval
int	ival[1]

real	native_NaN, ieee_NaN
int	mapin, mapout, nin, nout, NaNmask
common	/ieenanr/ native_NaN, ieee_NaN, NaNmask, mapin, mapout, nin, nout

%	equivalence (fval, ival)
%	data	ival(1) / '7ff7ffff'x /

begin
	mapin = inval
	mapout = outval

	# MACHDEP.
	if (mapout == YES)
	    ieee_NaN = fval

	if (mapin == YES)
	    NaNmask = 7F800000X
end



# 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