# 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