/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:            C.alpha/src/afloat.s
 * Purpose:
 * Author:          John Gibson, Oct 12 1994
 */

;;; ----------------- FLOATING POINT ROUTINES -----------------------------

#_<

#_INCLUDE 'asm.ph'

constant
	procedure Sys$-Float_qrem
	;

#_IF DEF VMS

lconstant macro CHOP = '/c';

#_ELSE

lconstant macro CHOP = 'c';

#_ENDIF

#_IF DEF IEEE_FLOAT
lconstant macro (
	_eEXCESS	= _:1022, ;;; excess value on exponents
	_eLSHIFT	= _:1, 	  ;;; left shift to align 11-bit expo at top
	);
#_ELSE
lconstant macro (
	_eEXCESS	= _:1024,
	_eLSHIFT	= _:49,
	);
#_ENDIF

define lconstant DF = nonop >< (% DFLOAT_SUFFIX %) enddefine;

lconstant macro (
	_DD_1		= @@DD_1,

	addDF		= 'add'.DF,
	subDF		= 'sub'.DF,
	mulDF		= 'mul'.DF,
	divDF		= 'div'.DF,
	cvtqDF		= 'cvtq'.DF,
	cvtDFq		= 'cvt'.DF <> 'q' <> CHOP,
	);

#_IF WORD_BITS/==DOUBLE_BITS
lconstant macro _DD_2 = @@DD_2;
#_ENDIF

>_#


ASM_START_FILE


ASM_CODE_PSECT


;;; ------------------------------------------------------------------------

	;;; _pfcopy(__________dst_addr, __________src_addr)
	;;; copy a double float from one address to another

ASM_ALIGN_QUAD
DEF_C_LAB (_pfcopy)
	ldW	rt0, 0(rusp)		;;; __________src_addr
	ldW	rt1, _WOFFS(rusp)	;;; __________dst_addr
	ldDF	ft0, 0(rt0)
	lda	rusp, _WOFFS*2(rusp)
	stDF	ft0, 0(rt1)
	ret	rzero, (rret)


;;; --- BASIC ARITHMETIC -------------------------------------------------

ASM_ALIGN_QUAD
fpe_error:
	stW	rfalse, 0(rusp)
	ret	rzero, (rret)


/* 	These routines return their 1st arg (_________dfaddr1) rather than true
	(just quicker, and nothing relies on them returning true).
	false is returned for overflow, etc.
*/

#_<
define lconstant macro ARITH_ROUTINE S op;
lvars op, S, gop = allbutlast(1,op);
[
	ldW   \t rt0, _WOFFS(rusp)  \n		;;; _________dfaddr1
\t	ldW   \t rt1, _0(rusp)	    \n		;;; _________dfaddr2
\t	ldDF  \t ft0, _0(rt0)	    \n
\t	ldDF  \t ft1, _0(rt1)	    \n
\t	lda   \t rusp, _WOFFS(rusp) \n
% 'fpe_s_' >< gop % :		    \n
\t	^op   \t ft0, ft1, ft0	    \n
\t	stDF  \t ft0, _0(rt0)	    \n
\t	trapb			    \n		;;; signal any error
% 'fpe_e_' >< gop % :		    \n
\t	ret  \t	rzero, (rret)	    \n		;;; return _________dfaddr1
].dl
enddefine;
>_#


	;;; _pfadd(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false
	;;; add _________dfaddr2 destructively into _________dfaddr1

ASM_ALIGN_QUAD
DEF_C_LAB (_pfadd)
	ARITH_ROUTINE addDF


	;;; _pfsub(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false
	;;; subtract _________dfaddr2 destructively from _________dfaddr1

ASM_ALIGN_QUAD
DEF_C_LAB (_pfsub)
	ARITH_ROUTINE subDF


	;;; _pfmult(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false
	;;; multiply _________dfaddr1 destructively by _________dfaddr2

ASM_ALIGN_QUAD
DEF_C_LAB (_pfmult)
	ARITH_ROUTINE mulDF


	;;; _pfdiv(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false
	;;; divide _________dfaddr1 destructively by _________dfaddr2

ASM_ALIGN_QUAD
DEF_C_LAB (_pfdiv)
	ARITH_ROUTINE divDF



;;; --- OTHER ARITHMETIC OPERATIONS ---------------------------------------

	;;; _pfabs(________dfaddr)  (absolute value)

ASM_ALIGN_QUAD
DEF_C_LAB (_pfabs)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldDF	ft0, 0(rt0)
	lda	rusp, _WOFFS(rusp)
	cpys	fzero, ft0, ft0		;;; set 0 sign bit
	stDF	ft0, 0(rt0)
	ret	rzero, (rret)


	;;; _pfnegate(________dfaddr)  (negate)

ASM_ALIGN_QUAD
DEF_C_LAB (_pfnegate)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldDF	ft0, 0(rt0)
	lda	rusp, _WOFFS(rusp)
	cpysn	ft0, ft0, ft1		;;; negate sign bit ...
	fcmovne	ft0, ft1, ft0		;;; ... but only if nonzero
	stDF	ft0, 0(rt0)
	ret	rzero, (rret)


	;;; Dummy that just chains to Float_qrem

ASM_ALIGN_QUAD
DEF_C_LAB (_pfqrem)
	ldW	rpb, _SVB_OFFS(Sys$-Float_qrem)(rsvb)
	ldW	rt0, 0(rpb)
	jmp	rzero, (rt0)


;;; --- PREDICATES --------------------------------------------------------

#_<
define lconstant macro CMP_ROUTINE S cmp_op S br_op;
lvars cmp_op = 'cmp'.DF >< cmp_op, br_op, S;
[
	ldW  \t	 rt0, _WOFFS(rusp)  \n		;;; _________dfaddr1
\t	ldW  \t	 rt1, _0(rusp)	    \n		;;; _________dfaddr2
\t	ldDF \t	 ft0, _0(rt0)	    \n
\t	ldDF \t	 ft1, _0(rt1)	    \n
\t	lda  \t	 rusp, _WOFFS(rusp) \n
\t	^cmp_op	\t ft0, ft1, ft0    \n
\t	^br_op  \t ft0, !$ \1f	    \n
\t	lda  \t	 rt0, _TRUEOFFS(rfalse) \n
\t	stW  \t	 rt0, _0(rusp)	    \n
\t	ret  \t	 rzero, (rret)		    \n
!$ \1: \t stW \t rfalse, _0(rusp)	    \n
\t	ret  \t	 rzero, (rret)		    \n
].dl
enddefine;
>_#

	;;; _pfeq(_________dfaddr1, _________dfaddr2) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_pfeq)
	CMP_ROUTINE eq fbeq

	;;; _pfsgr(_________dfaddr1, _________dfaddr2) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_pfsgr)
	CMP_ROUTINE le fbne

	;;; _pfsgreq(_________dfaddr1, _________dfaddr2) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_pfsgreq)
	CMP_ROUTINE lt fbne


#_<
define lconstant macro TST_ROUTINE S br_op;
lvars br_op, S;
[
	ldW  \t	 rt0, _0(rusp)	\n		;;; ________dfaddr
\t	lda  \t	 rt1, _TRUEOFFS(rfalse) \n
\t	ldDF \t	 ft0, _0(rt0)	\n
\t	^br_op \t  ft0, !$ \1f	\n
\t	stW  \t	 rt1, _0(rusp)	\n
\t	ret  \t	 rzero, (rret)		\n
!$ \1: \t stW \t rfalse, _0(rusp)	\n
\t	ret  \t	 rzero, (rret)		\n
].dl
enddefine;
>_#

	;;; _pfneg(________dfaddr) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_pfneg)
	TST_ROUTINE fbge

	;;; _pfzero(________dfaddr) -> ____bool
ASM_ALIGN_QUAD
DEF_C_LAB (_pfzero)
	TST_ROUTINE fbne



;;; --- CONVERSION -------------------------------------------------------

;;; ---- Routines to float sysints, decimals and ddecimals

	;;; _pf_sfloat_dec(_______decimal) -> ________sfloat

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_sfloat_dec)
	ldW	rt0, 0(rusp)		;;; _______decimal
	bic	rt0, 1, rt0		;;; clear tag bit
#_IF WORD_BITS==DOUBLE_BITS
	;;; convert double to single
	stq	rt0, 0(rusp)		;;; store in mem
	ldt	ft0, 0(rusp)		;;; reload image as T/G float
	cvtDFSF	ft0, ft0		;;; checks T/G float okay as S/F float
	stSF	ft0, 0(rusp)		;;; returns junk in hi 32 bits
#_ELSE
  #_IF not(DEF IEEE_FLOAT)
	inswl	rt0, 2, rt1		;;; rot lo 32 right 16 to get F float
	extwl	rt0, 2, rt0
	or	rt0, rt1, rt0		;;; or to make ________sfloat
  #_ENDIF
	stW	rt0, 0(rusp)		;;; return ________sfloat
#_ENDIF
	ret	rzero, (rret)


	;;; _pf_dfloat_int(_____int, ________dfaddr)

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_dfloat_int)
#_IF WORD_BITS==DOUBLE_BITS
	ldt	ft0, _WOFFS(rusp)	;;; quad _____int
#_ELSE
	lds	ft0, _WOFFS(rusp)	;;; long _____int
	cvtlq	ft0, ft0		;;; extend _____int to quad
#_ENDIF
	ldW	rt2, 0(rusp)		;;; ________dfaddr
	cvtqDF	ft0, ft0		;;; quad _____int -> ________dfloat
	lda	rusp, _WOFFS*2(rusp)
	stDF	ft0, 0(rt2)		;;; store at ________dfaddr
	ret	rzero, (rret)


	;;; _pf_dfloat_dec(_______decimal, ________dfaddr)

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_dfloat_dec)
	ldW	rt0, _WOFFS(rusp)	;;; _______decimal
	ldW	rt2, 0(rusp)		;;; ________dfaddr
	bic	rt0, 1, rt0		;;; clear tag bit on _______decimal
#_IF WORD_BITS==DOUBLE_BITS and DEF IEEE_FLOAT
	stq	rt0, 0(rt2)		;;; store ________dfloat at ________dfaddr
	lda	rusp, _WOFFS*2(rusp)
#_ELSE
  #_IF WORD_BITS==DOUBLE_BITS
	stq	rt0, 0(rt2)		;;; back in mem
	ldt	ft0, 0(rt2)		;;; load image to float reg
  #_ELSE
    #_IF not(DEF IEEE_FLOAT)
	inswl	rt0, 2, rt1		;;; rot lo 32 right 16 to get F float
	extwl	rt0, 2, rt0
	or	rt0, rt1, rt0
    #_ENDIF
	stl	rt0, 0(rt2)		;;; store in mem
	ldSF	ft0, 0(rt2)		;;; reload as float
  #_ENDIF
	lda	rusp, _WOFFS*2(rusp)
	stDF	ft0, 0(rt2)		;;; store ________dfloat at ________dfaddr
#_ENDIF
	ret	rzero, (rret)


	;;; _pf_dfloat_ddec(________ddecimal, ________dfaddr)

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_dfloat_ddec)
	ldW	rt0, _WOFFS(rusp)	;;; ________ddecimal
	ldW	rt3, 0(rusp)		;;; ________dfaddr
	ldW	rt1, _DD_1(rt0)
#_IF WORD_BITS/==DOUBLE_BITS
	ldl	rt2, _DD_2(rt0)
#_ENDIF
	lda	rusp, _WOFFS*2(rusp)
	stW	rt1, 0(rt3)
#_IF WORD_BITS/==DOUBLE_BITS
	stl	rt2, 4(rt3)
#_ENDIF
	ret	rzero, (rret)



;;; ---- Routines to convert back from a double float

	;;; _pf_intof(________dfaddr) -> (_____int, ________dfaddr)  or -> false
	;;; get integer part of double floating as an integer

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_intof)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldDF	ft0, 0(rt0)		;;; load the T/G float
	ldq	rt1, 0(rt0)		;;; get expo part for overflow check
	cvtDFq	ft0, ft1		;;; T/G float -> quad int
	sll	rt1, _eLSHIFT, rt1	;;; get exponent for check
	srl	rt1, 53, rt1

#_IF WORD_BITS/==DOUBLE_BITS
	cvtql	ft1, ft1		;;; quad int -> long int
#_ENDIF
	lda	rt2, _eEXCESS+_:WORD_BITS(rzero)
	subq	rt1, rt2, rt1		;;; expo - (_eEXCESS+WORD_BITS)
	bge	rt1, !$2f		;;; overflow poss if expo >= (_eEXCESS+WORD_BITS)

	;;; else OK
!$1:	lda	rusp, -_WOFFS(rusp)
#_IF WORD_BITS==DOUBLE_BITS
	stt	ft1, _WOFFS(rusp)	;;; store quad int result
#_ELSE
	sts	ft1, _WOFFS(rusp)	;;; store long int result
#_ENDIF
	stW	rt0, 0(rusp)		;;; return ________dfaddr also
	ret	rzero, (rret)

	;;; expo >= (_eEXCESS+WORD_BITS), overflow possible
!$2:	bgt	rt1, !$3f		;;; overflow if expo > (_eEXCESS+WORD_BITS)
	;;; expo = (_eEXCESS+WORD_BITS) -- overflows if +ve, or -ve and result not -ve
	fbgt	ft0, !$3f		;;; overflows if positive
	fblt	ft1, !$1b		;;; else OK if result negative (-2**31/63)

	;;; overflow
!$3:	stW	rfalse, 0(rusp)
	ret	rzero, (rret)


	;;; _pf_cvt_to_dec(________dfaddr) -> _______decimal or false
	;;; convert double to decimal (rounded appropriately),
	;;; or return false if too large

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_cvt_to_dec)
	ldW	rt0, 0(rusp)		;;; ________dfaddr

#_IF WORD_BITS==DOUBLE_BITS
  #_IF DEF IEEE_FLOAT
	ldq	rt1, 0(rt0)
	addq	rt1, 4, rt2		;;; round up 3 bits ...
	and	rt1, 15, rt3		;;; ... but not if lo 4 bits = 0100
	cmpeq	rt3, 4, rt3
	cmovlbs	rt3, rt1, rt2
	mov	1, rt3
	sll	rt3, 52, rt3		;;; 1 in expo position
	addq	rt2, rt3, rt3		;;; expo+1 will overflow if too large
	xor	rt3, rt1, rt3		;;; neg if sign bit changed
  #_ELSE
	ldg	ft0, 0(rt0)
	stt	ft0, 0(rusp)
	ldq	rt1, 0(rusp)		;;; now in T format
	addq	rt1, 4, rt2		;;; round up 3 bits
	xor	rt2, rt1, rt3		;;; neg if sign bit changed
  #_ENDIF
	blt	rt3, fpe_error		;;; too large if expo overflowed to sign
	cmoveq	rt1, rt1, rt2		;;; use original if zero
	bic	rt2, 7, rt2
	bis	rt2, 1, rt2		;;; set simple tag bit
	stq	rt2, 0(rusp)		;;; return _______decimal

#_ELSE
  #_IF DEF IEEE_FLOAT
	;;; set bits to force rounding of 22nd bit of mantissa in all
	;;; cases except where tied and 21st bit is 0 (even)
	ldah	rt3, 14336(rzero)	;;; 16:38000000 = 23rd, 24th, 25th bits
	ldah	rt2, 16384(rzero)	;;; 16:40000000 = 22nd bit
	ldl	rt1, 0(rt0)		;;; part with ls 32 bits
	ldt	ft0, 0(rt0)		;;; get original to test zero
	bis	rt1, rt3, rt3		;;; set 23rd, 24th, 25th bits
	cmpeq	rt1, rt2, rt2		;;; test tied and even
	cmovlbs	rt2, rt1, rt3		;;; use original if so
	stl	rt3, 0(rt0)		;;; replace in mem
	ldt	ft1, 0(rt0)		;;; then after loading as float ...
	stl	rt1, 0(rt0)		;;; ... restore part we altered
  #_ELSE
	;;; set bits to force rounding of 22nd bit of mantissa
	mov	12288, rt3		;;; 16:3000 = 23rd and 24th bits
	ldl	rt1, 4(rt0)		;;; part with ls 32 bits
	ldg	ft0, 0(rt0)		;;; get original to test zero
	bis	rt1, rt3, rt3		;;; set 23rd and 24th bits of mantissa
	stl	rt3, 4(rt0)		;;; replace in mem
	ldg	ft1, 0(rt0)		;;; then after loading as float ...
	stl	rt1, 4(rt0)		;;; ... restore part we altered
  #_ENDIF
	fcmovne	ft0, ft1, ft0		;;; changed flt to ft0 if org nonzero
fpe_s_cvtdec:
	cvtDFSF	ft0, ft0		;;; round T/G float to S/F float
	;;; For VAX G format the "sts" will swap hi and lo 16-bits (can't
	;;; use "lds" the other way round, because an exponent of 255 would
	;;; get interpreted as IEEE Inf)
	sts	ft0, 0(rusp)		;;; store (with halves swapped for G)
	ldl	rt0, 0(rusp)		;;; reload into int reg
	bis	rt0, 1, rt0		;;; set simple tag bit
	bic	rt0, 2, rt0		;;; clear integer tag bit
	stW	rt0, 0(rusp)		;;; return _______decimal
	trapb				;;; signal any error
fpe_e_cvtdec:
#_ENDIF
	ret	rzero, (rret)


	;;; _pf_cvt_to_ddec(________dfaddr, ________ddecimal)
	;;; fill in given ddecimal

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_cvt_to_ddec)
	ldW	rt0, _WOFFS(rusp)	;;; ________dfaddr
	ldW	rt1, 0(rusp)		;;; ________ddecimal
	ldq	rt2, 0(rt0)		;;; load double in int reg
	lda	rusp, _WOFFS*2(rusp)
#_IF DEF IEEE_FLOAT
	;;; replace denormal values with 0
	addq	rt2, rt2, rt3		;;; clear sign bit ...
	srl	rt3, 53, rt3		;;; ... and shift to get exponent alone
	cmoveq	rt3, 0, rt2		;;; zero value if zero exponent
#_ENDIF
#_IF WORD_BITS==DOUBLE_BITS
	stq	rt2, _DD_1(rt1)
#_ELSE
	extll	rt2, 4, rt3		;;; get hi addr part
	stl	rt2, _DD_1(rt1)		;;; lo addr part
	stl	rt3, _DD_2(rt1)		;;; hi addr part
#_ENDIF
	ret	rzero, (rret)


	;;; _pfmodf(__________fracaddr, ________dfaddr)
	;;; frac part of ________dfaddr into __________fracaddr, int part back into ________dfaddr

ASM_ALIGN_QUAD
DEF_C_LAB (_pfmodf)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldW	rt1, _WOFFS(rusp)	;;; __________fracaddr
	ldDF	ft0, 0(rt0)		;;; load the T/G float
	lda	rusp, _WOFFS*2(rusp)
	stt	ft0, 0(rt0)		;;; store image of float reg
	ldq	rt2, 0(rt0)		;;; ... and load into int reg
	sll	rt2, 1, rt3		;;; clear sign bit ...
	srl	rt3, 53, rt3		;;; ... and shift to get exponent alone
	lda	rt4, _eEXCESS+1(rzero)
	subq	rt4, rt3, rt3		;;; (_eEXCESS+1) - exponent
	bgt	rt3, !$1f		;;; br if expo <= _eEXCESS, no int part
	;;; has nonzero int part
	addq	rt3, 52, rt3		;;; number of fractional ls bits
	ble	rt3, !$2f		;;; if <= 0, no fractional bits
	;;; has both parts
	srl	rt2, rt3, rt2		;;; clear the frac bits
	sll	rt2, rt3, rt2
	stq	rt2, 0(rt0)		;;; store revised image ...
	ldt	ft1, 0(rt0)		;;; ... and back into float reg
	subDF	ft0, ft1, ft0		;;; subtract int part from original
	stDF	ft1, 0(rt0)		;;; store int part in ________dfaddr
	stDF	ft0, 0(rt1)		;;; and frac remainder in __________fracaddr
	ret	rzero, (rret)

	;;; entirely fractional
!$1:	stDF	ft0, 0(rt1)		;;; store num in __________fracaddr
	stDF	fzero, 0(rt0)		;;; and zero in ________dfaddr
	ret	rzero, (rret)

	;;; entirely integral
!$2:	stDF	ft0, 0(rt0)		;;; store num in ________dfaddr
	stDF	fzero, 0(rt1)		;;; and zero in __________fracaddr
	ret	rzero, (rret)


;;; --- Routines to extract/update sfloat and dfloat field values ----

	;;; _pf_extend_s_to_d(________dfaddr) -> ________dfaddr or false
	;;; extend single at ________dfaddr into double

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_extend_s_to_d)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldSF	ft0, 0(rt0)		;;; load the single float
#_IF DEF IEEE_FLOAT
	;;; single could be Inf or NaN -- return false if so
	ldl	rt1, 0(rt0)
	srl	rt1, 23, rt1		;;; 8-bit exponent to bottom
	and	rt1, 255, rt1
	cmpeq	rt1, 255, rt1
	blbs	rt1, fpe_error		;;; return false
;;; else VAX floats have no infinities so never returns false
#_ENDIF
	stDF	ft0, 0(rt0)		;;; store as double
	ret	rzero, (rret)


	;;; _pf_check_d(________dfaddr) -> ________dfaddr or false
	;;; check normal double at ________dfaddr

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_check_d)
#_IF DEF IEEE_FLOAT
	;;; double could be Inf or NaN
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	lda	rt1, 2047(rzero)	;;; max exponent 16:7FF
	ldq	rt0, 0(rt0)
	srl	rt0, 52, rt0		;;; exponent to bottom
	and	rt0, rt1, rt0		;;; and out
	cmpeq	rt0, rt1, rt0		;;; Inf or NaN?
	blbs	rt0, fpe_error		;;; return false if so
;;; else VAX floats have no infinities so nothing to do
#_ENDIF
	ret	rzero, (rret)


	;;; _pf_round_d_to_s(________dfaddr) -> ________dfaddr or false
	;;; round double to single back into ________dfaddr

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_round_d_to_s)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	ldDF	ft0, 0(rt0)		;;; the double
fpe_s_rdtos:
	cvtDFSF	ft0, ft0		;;; *** OVERFLOW ***
	stSF	ft0, 0(rt0)
	trapb				;;; signal any error
fpe_e_rdtos:
	ret	rzero, (rret)



;;; --- GET/SET EXPONENT --------------------------------------------------

	;;; get and set exponent ___E of a double float, where ___E is
	;;; the number of bits needed for the integer part, e.g. 1 for 1.0,
	;;; 0 for 0.5, -1 for 0.05, etc.

	;;; _pf_expof(________dfaddr) -> ___E

ASM_ALIGN_QUAD
DEF_C_LAB (_pf_expof)
	ldW	rt0, 0(rusp)		;;; ________dfaddr
	lda	rt1, _eEXCESS(rzero)
	ldq	rt0, 0(rt0)		;;; get float in int reg
	sll	rt0, _eLSHIFT, rt0
	srl	rt0, 53, rt0		;;; exponent
	subq	rt0, rt1, rt0		;;; ___E = expo - _eEXCESS
	stW	rt0, 0(rusp)		;;; return it
	ret	rzero, (rret)


	;;; ___E -> _pf_expof(________dfaddr) -> ________dfaddr or false
	;;; (false if ___E too big/small )

ASM_ALIGN_QUAD
DEF_C_LAB (-> _pf_expof)
	ldW	rt0, _WOFFS(rusp)	;;; ___E
	lda	rt2, _eEXCESS(rzero)
	ldW	rt1, 0(rusp)		;;; ________dfaddr
	lda	rusp, _WOFFS(rusp)
	addq	rt0, rt2, rt0		;;; new expo = ___E + _eEXCESS
	ble	rt0, fpe_error		;;; underflow if 0 or neg

	ldq	rt3, 0(rt1)		;;; get float in int reg
	lda	rt2, 2047(rzero)	;;; mask for float exponent (16:7FF)
	bic	rt0, rt2, rt4		;;; overflow if nonzero
	bne	rt4, fpe_error
	sll	rt2, 53-_eLSHIFT, rt2	;;; expo mask in position
	sll	rt0, 53-_eLSHIFT, rt0	;;; new expo in position
	bic	rt3, rt2, rt3		;;; clear old expo
	or	rt3, rt0, rt3		;;; or in new
	stq	rt3, 0(rt1)		;;; update float in mem
	stW	rt1, 0(rusp)		;;; return ________dfaddr
	ret	rzero, (rret)


;;; ---------------------------------------------------------------------

ASM_NWRIT_PSECT

#_IF DEF VMS
__pop_fpe_table::
#_ELSE
.globl __pop_fpe_table
__pop_fpe_table:
#_ENDIF
	.WORD	fpe_s_add,   fpe_e_add,     fpe_error
	.WORD	fpe_s_sub,   fpe_e_sub,     fpe_error
	.WORD	fpe_s_mul,   fpe_e_mul,     fpe_error
	.WORD	fpe_s_div,   fpe_e_div,	    fpe_error
#_IF WORD_BITS/==DOUBLE_BITS
	.WORD	fpe_s_cvtdec, fpe_e_cvtdec, fpe_error
#_ENDIF
	.WORD	fpe_s_rdtos,  fpe_e_rdtos,  fpe_error
	.WORD	0, 0, 0


ASM_END_FILE
