ifpsp060/src/fpsp.S [22927:24785]:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#########################################################################
# XDEF ****************************************************************	#
#	get_packed(): fetch a packed operand from memory and then	#
#		      convert it to a floating-point binary number.	#
#									#
# XREF ****************************************************************	#
#	_dcalc_ea() - calculate the correct <ea>			#
#	_mem_read() - fetch the packed operand from memory		#
#	facc_in_x() - the fetch failed so jump to special exit code	#
#	decbin()    - convert packed to binary extended precision	#
#									#
# INPUT ***************************************************************	#
#	None								#
#									#
# OUTPUT **************************************************************	#
#	If no failure on _mem_read():					#
#	FP_SRC(a6) = packed operand now as a binary FP number		#
#									#
# ALGORITHM ***********************************************************	#
#	Get the correct <ea> which is the value on the exception stack	#
# frame w/ maybe a correction factor if the <ea> is -(an) or (an)+.	#
# Then, fetch the operand from memory. If the fetch fails, exit		#
# through facc_in_x().							#
#	If the packed operand is a ZERO,NAN, or INF, convert it to	#
# its binary representation here. Else, call decbin() which will	#
# convert the packed value to an extended precision binary value.	#
#									#
#########################################################################

# the stacked <ea> for packed is correct except for -(An).
# the base reg must be updated for both -(An) and (An)+.
	global		get_packed
get_packed:
	mov.l		&0xc,%d0		# packed is 12 bytes
	bsr.l		_dcalc_ea		# fetch <ea>; correct An

	lea		FP_SRC(%a6),%a1		# pass: ptr to super dst
	mov.l		&0xc,%d0		# pass: 12 bytes
	bsr.l		_dmem_read		# read packed operand

	tst.l		%d1			# did dfetch fail?
	bne.l		facc_in_x		# yes

# The packed operand is an INF or a NAN if the exponent field is all ones.
	bfextu		FP_SRC(%a6){&1:&15},%d0	# get exp
	cmpi.w		%d0,&0x7fff		# INF or NAN?
	bne.b		gp_try_zero		# no
	rts					# operand is an INF or NAN

# The packed operand is a zero if the mantissa is all zero, else it's
# a normal packed op.
gp_try_zero:
	mov.b		3+FP_SRC(%a6),%d0	# get byte 4
	andi.b		&0x0f,%d0		# clear all but last nybble
	bne.b		gp_not_spec		# not a zero
	tst.l		FP_SRC_HI(%a6)		# is lw 2 zero?
	bne.b		gp_not_spec		# not a zero
	tst.l		FP_SRC_LO(%a6)		# is lw 3 zero?
	bne.b		gp_not_spec		# not a zero
	rts					# operand is a ZERO
gp_not_spec:
	lea		FP_SRC(%a6),%a0		# pass: ptr to packed op
	bsr.l		decbin			# convert to extended
	fmovm.x		&0x80,FP_SRC(%a6)	# make this the srcop
	rts

#########################################################################
# decbin(): Converts normalized packed bcd value pointed to by register	#
#	    a0 to extended-precision value in fp0.			#
#									#
# INPUT ***************************************************************	#
#	a0 = pointer to normalized packed bcd value			#
#									#
# OUTPUT **************************************************************	#
#	fp0 = exact fp representation of the packed bcd value.		#
#									#
# ALGORITHM ***********************************************************	#
#	Expected is a normal bcd (i.e. non-exceptional; all inf, zero,	#
#	and NaN operands are dispatched without entering this routine)	#
#	value in 68881/882 format at location (a0).			#
#									#
#	A1. Convert the bcd exponent to binary by successive adds and	#
#	muls. Set the sign according to SE. Subtract 16 to compensate	#
#	for the mantissa which is to be interpreted as 17 integer	#
#	digits, rather than 1 integer and 16 fraction digits.		#
#	Note: this operation can never overflow.			#
#									#
#	A2. Convert the bcd mantissa to binary by successive		#
#	adds and muls in FP0. Set the sign according to SM.		#
#	The mantissa digits will be converted with the decimal point	#
#	assumed following the least-significant digit.			#
#	Note: this operation can never overflow.			#
#									#
#	A3. Count the number of leading/trailing zeros in the		#
#	bcd string.  If SE is positive, count the leading zeros;	#
#	if negative, count the trailing zeros.  Set the adjusted	#
#	exponent equal to the exponent from A1 and the zero count	#
#	added if SM = 1 and subtracted if SM = 0.  Scale the		#
#	mantissa the equivalent of forcing in the bcd value:		#
#									#
#	SM = 0	a non-zero digit in the integer position		#
#	SM = 1	a non-zero digit in Mant0, lsd of the fraction		#
#									#
#	this will insure that any value, regardless of its		#
#	representation (ex. 0.1E2, 1E1, 10E0, 100E-1), is converted	#
#	consistently.							#
#									#
#	A4. Calculate the factor 10^exp in FP1 using a table of		#
#	10^(2^n) values.  To reduce the error in forming factors	#
#	greater than 10^27, a directed rounding scheme is used with	#
#	tables rounded to RN, RM, and RP, according to the table	#
#	in the comments of the pwrten section.				#
#									#
#	A5. Form the final binary number by scaling the mantissa by	#
#	the exponent factor.  This is done by multiplying the		#
#	mantissa in FP0 by the factor in FP1 if the adjusted		#
#	exponent sign is positive, and dividing FP0 by FP1 if		#
#	it is negative.							#
#									#
#	Clean up and return. Check if the final mul or div was inexact.	#
#	If so, set INEX1 in USER_FPSR.					#
#									#
#########################################################################

#
#	PTENRN, PTENRM, and PTENRP are arrays of powers of 10 rounded
#	to nearest, minus, and plus, respectively.  The tables include
#	10**{1,2,4,8,16,32,64,128,256,512,1024,2048,4096}.  No rounding
#	is required until the power is greater than 27, however, all
#	tables include the first 5 for ease of indexing.
#
RTABLE:
	byte		0,0,0,0
	byte		2,3,2,3
	byte		2,3,3,2
	byte		3,2,2,3

	set		FNIBS,7
	set		FSTRT,0

	set		ESTRT,4
	set		EDIGITS,2

	global		decbin
decbin:
	mov.l		0x0(%a0),FP_SCR0_EX(%a6) # make a copy of input
	mov.l		0x4(%a0),FP_SCR0_HI(%a6) # so we don't alter it
	mov.l		0x8(%a0),FP_SCR0_LO(%a6)

	lea		FP_SCR0(%a6),%a0

	movm.l		&0x3c00,-(%sp)		# save d2-d5
	fmovm.x		&0x1,-(%sp)		# save fp1
#
# Calculate exponent:
#  1. Copy bcd value in memory for use as a working copy.
#  2. Calculate absolute value of exponent in d1 by mul and add.
#  3. Correct for exponent sign.
#  4. Subtract 16 to compensate for interpreting the mant as all integer digits.
#     (i.e., all digits assumed left of the decimal point.)
#
# Register usage:
#
#  calc_e:
#	(*)  d0: temp digit storage
#	(*)  d1: accumulator for binary exponent
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: first word of bcd
#	( )  a0: pointer to working bcd value
#	( )  a6: pointer to original bcd value
#	(*)  FP_SCR1: working copy of original bcd value
#	(*)  L_SCR1: copy of original exponent word
#
calc_e:
	mov.l		&EDIGITS,%d2		# # of nibbles (digits) in fraction part
	mov.l		&ESTRT,%d3		# counter to pick up digits
	mov.l		(%a0),%d4		# get first word of bcd
	clr.l		%d1			# zero d1 for accumulator
e_gd:
	mulu.l		&0xa,%d1		# mul partial product by one digit place
	bfextu		%d4{%d3:&4},%d0		# get the digit and zero extend into d0
	add.l		%d0,%d1			# d1 = d1 + d0
	addq.b		&4,%d3			# advance d3 to the next digit
	dbf.w		%d2,e_gd		# if we have used all 3 digits, exit loop
	btst		&30,%d4			# get SE
	beq.b		e_pos			# don't negate if pos
	neg.l		%d1			# negate before subtracting
e_pos:
	sub.l		&16,%d1			# sub to compensate for shift of mant
	bge.b		e_save			# if still pos, do not neg
	neg.l		%d1			# now negative, make pos and set SE
	or.l		&0x40000000,%d4		# set SE in d4,
	or.l		&0x40000000,(%a0)	# and in working bcd
e_save:
	mov.l		%d1,-(%sp)		# save exp on stack
#
#
# Calculate mantissa:
#  1. Calculate absolute value of mantissa in fp0 by mul and add.
#  2. Correct for mantissa sign.
#     (i.e., all digits assumed left of the decimal point.)
#
# Register usage:
#
#  calc_m:
#	(*)  d0: temp digit storage
#	(*)  d1: lword counter
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: words 2 and 3 of bcd
#	( )  a0: pointer to working bcd value
#	( )  a6: pointer to original bcd value
#	(*) fp0: mantissa accumulator
#	( )  FP_SCR1: working copy of original bcd value
#	( )  L_SCR1: copy of original exponent word
#
calc_m:
	mov.l		&1,%d1			# word counter, init to 1
	fmov.s		&0x00000000,%fp0	# accumulator
#
#
#  Since the packed number has a long word between the first & second parts,
#  get the integer digit then skip down & get the rest of the
#  mantissa.  We will unroll the loop once.
#
	bfextu		(%a0){&28:&4},%d0	# integer part is ls digit in long word
	fadd.b		%d0,%fp0		# add digit to sum in fp0
#
#
#  Get the rest of the mantissa.
#
loadlw:
	mov.l		(%a0,%d1.L*4),%d4	# load mantissa lonqword into d4
	mov.l		&FSTRT,%d3		# counter to pick up digits
	mov.l		&FNIBS,%d2		# reset number of digits per a0 ptr
md2b:
	fmul.s		&0x41200000,%fp0	# fp0 = fp0 * 10
	bfextu		%d4{%d3:&4},%d0		# get the digit and zero extend
	fadd.b		%d0,%fp0		# fp0 = fp0 + digit
#
#
#  If all the digits (8) in that long word have been converted (d2=0),
#  then inc d1 (=2) to point to the next long word and reset d3 to 0
#  to initialize the digit offset, and set d2 to 7 for the digit count;
#  else continue with this long word.
#
	addq.b		&4,%d3			# advance d3 to the next digit
	dbf.w		%d2,md2b		# check for last digit in this lw
nextlw:
	addq.l		&1,%d1			# inc lw pointer in mantissa
	cmp.l		%d1,&2			# test for last lw
	ble.b		loadlw			# if not, get last one
#
#  Check the sign of the mant and make the value in fp0 the same sign.
#
m_sign:
	btst		&31,(%a0)		# test sign of the mantissa
	beq.b		ap_st_z			# if clear, go to append/strip zeros
	fneg.x		%fp0			# if set, negate fp0
#
# Append/strip zeros:
#
#  For adjusted exponents which have an absolute value greater than 27*,
#  this routine calculates the amount needed to normalize the mantissa
#  for the adjusted exponent.  That number is subtracted from the exp
#  if the exp was positive, and added if it was negative.  The purpose
#  of this is to reduce the value of the exponent and the possibility
#  of error in calculation of pwrten.
#
#  1. Branch on the sign of the adjusted exponent.
#  2p.(positive exp)
#   2. Check M16 and the digits in lwords 2 and 3 in descending order.
#   3. Add one for each zero encountered until a non-zero digit.
#   4. Subtract the count from the exp.
#   5. Check if the exp has crossed zero in #3 above; make the exp abs
#	   and set SE.
#	6. Multiply the mantissa by 10**count.
#  2n.(negative exp)
#   2. Check the digits in lwords 3 and 2 in descending order.
#   3. Add one for each zero encountered until a non-zero digit.
#   4. Add the count to the exp.
#   5. Check if the exp has crossed zero in #3 above; clear SE.
#   6. Divide the mantissa by 10**count.
#
#  *Why 27?  If the adjusted exponent is within -28 < expA < 28, than
#   any adjustment due to append/strip zeros will drive the resultane
#   exponent towards zero.  Since all pwrten constants with a power
#   of 27 or less are exact, there is no need to use this routine to
#   attempt to lessen the resultant exponent.
#
# Register usage:
#
#  ap_st_z:
#	(*)  d0: temp digit storage
#	(*)  d1: zero count
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: first word of bcd
#	(*)  d5: lword counter
#	( )  a0: pointer to working bcd value
#	( )  FP_SCR1: working copy of original bcd value
#	( )  L_SCR1: copy of original exponent word
#
#
# First check the absolute value of the exponent to see if this
# routine is necessary.  If so, then check the sign of the exponent
# and do append (+) or strip (-) zeros accordingly.
# This section handles a positive adjusted exponent.
#
ap_st_z:
	mov.l		(%sp),%d1		# load expA for range test
	cmp.l		%d1,&27			# test is with 27
	ble.w		pwrten			# if abs(expA) <28, skip ap/st zeros
	btst		&30,(%a0)		# check sign of exp
	bne.b		ap_st_n			# if neg, go to neg side
	clr.l		%d1			# zero count reg
	mov.l		(%a0),%d4		# load lword 1 to d4
	bfextu		%d4{&28:&4},%d0		# get M16 in d0
	bne.b		ap_p_fx			# if M16 is non-zero, go fix exp
	addq.l		&1,%d1			# inc zero count
	mov.l		&1,%d5			# init lword counter
	mov.l		(%a0,%d5.L*4),%d4	# get lword 2 to d4
	bne.b		ap_p_cl			# if lw 2 is zero, skip it
	addq.l		&8,%d1			# and inc count by 8
	addq.l		&1,%d5			# inc lword counter
	mov.l		(%a0,%d5.L*4),%d4	# get lword 3 to d4
ap_p_cl:
	clr.l		%d3			# init offset reg
	mov.l		&7,%d2			# init digit counter
ap_p_gd:
	bfextu		%d4{%d3:&4},%d0		# get digit
	bne.b		ap_p_fx			# if non-zero, go to fix exp
	addq.l		&4,%d3			# point to next digit
	addq.l		&1,%d1			# inc digit counter
	dbf.w		%d2,ap_p_gd		# get next digit
ap_p_fx:
	mov.l		%d1,%d0			# copy counter to d2
	mov.l		(%sp),%d1		# get adjusted exp from memory
	sub.l		%d0,%d1			# subtract count from exp
	bge.b		ap_p_fm			# if still pos, go to pwrten
	neg.l		%d1			# now its neg; get abs
	mov.l		(%a0),%d4		# load lword 1 to d4
	or.l		&0x40000000,%d4		# and set SE in d4
	or.l		&0x40000000,(%a0)	# and in memory
#
# Calculate the mantissa multiplier to compensate for the striping of
# zeros from the mantissa.
#
ap_p_fm:
	lea.l		PTENRN(%pc),%a1		# get address of power-of-ten table
	clr.l		%d3			# init table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
	mov.l		&3,%d2			# init d2 to count bits in counter
ap_p_el:
	asr.l		&1,%d0			# shift lsb into carry
	bcc.b		ap_p_en			# if 1, mul fp1 by pwrten factor
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
ap_p_en:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		ap_p_el			# if not, get next bit
	fmul.x		%fp1,%fp0		# mul mantissa by 10**(no_bits_shifted)
	bra.b		pwrten			# go calc pwrten
#
# This section handles a negative adjusted exponent.
#
ap_st_n:
	clr.l		%d1			# clr counter
	mov.l		&2,%d5			# set up d5 to point to lword 3
	mov.l		(%a0,%d5.L*4),%d4	# get lword 3
	bne.b		ap_n_cl			# if not zero, check digits
	sub.l		&1,%d5			# dec d5 to point to lword 2
	addq.l		&8,%d1			# inc counter by 8
	mov.l		(%a0,%d5.L*4),%d4	# get lword 2
ap_n_cl:
	mov.l		&28,%d3			# point to last digit
	mov.l		&7,%d2			# init digit counter
ap_n_gd:
	bfextu		%d4{%d3:&4},%d0		# get digit
	bne.b		ap_n_fx			# if non-zero, go to exp fix
	subq.l		&4,%d3			# point to previous digit
	addq.l		&1,%d1			# inc digit counter
	dbf.w		%d2,ap_n_gd		# get next digit
ap_n_fx:
	mov.l		%d1,%d0			# copy counter to d0
	mov.l		(%sp),%d1		# get adjusted exp from memory
	sub.l		%d0,%d1			# subtract count from exp
	bgt.b		ap_n_fm			# if still pos, go fix mantissa
	neg.l		%d1			# take abs of exp and clr SE
	mov.l		(%a0),%d4		# load lword 1 to d4
	and.l		&0xbfffffff,%d4		# and clr SE in d4
	and.l		&0xbfffffff,(%a0)	# and in memory
#
# Calculate the mantissa multiplier to compensate for the appending of
# zeros to the mantissa.
#
ap_n_fm:
	lea.l		PTENRN(%pc),%a1		# get address of power-of-ten table
	clr.l		%d3			# init table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
	mov.l		&3,%d2			# init d2 to count bits in counter
ap_n_el:
	asr.l		&1,%d0			# shift lsb into carry
	bcc.b		ap_n_en			# if 1, mul fp1 by pwrten factor
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
ap_n_en:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		ap_n_el			# if not, get next bit
	fdiv.x		%fp1,%fp0		# div mantissa by 10**(no_bits_shifted)
#
#
# Calculate power-of-ten factor from adjusted and shifted exponent.
#
# Register usage:
#
#  pwrten:
#	(*)  d0: temp
#	( )  d1: exponent
#	(*)  d2: {FPCR[6:5],SM,SE} as index in RTABLE; temp
#	(*)  d3: FPCR work copy
#	( )  d4: first word of bcd
#	(*)  a1: RTABLE pointer
#  calc_p:
#	(*)  d0: temp
#	( )  d1: exponent
#	(*)  d3: PWRTxx table index
#	( )  a0: pointer to working copy of bcd
#	(*)  a1: PWRTxx pointer
#	(*) fp1: power-of-ten accumulator
#
# Pwrten calculates the exponent factor in the selected rounding mode
# according to the following table:
#
#	Sign of Mant  Sign of Exp  Rounding Mode  PWRTEN Rounding Mode
#
#	ANY	  ANY	RN	RN
#
#	 +	   +	RP	RP
#	 -	   +	RP	RM
#	 +	   -	RP	RM
#	 -	   -	RP	RP
#
#	 +	   +	RM	RM
#	 -	   +	RM	RP
#	 +	   -	RM	RP
#	 -	   -	RM	RM
#
#	 +	   +	RZ	RM
#	 -	   +	RZ	RM
#	 +	   -	RZ	RP
#	 -	   -	RZ	RP
#
#
pwrten:
	mov.l		USER_FPCR(%a6),%d3	# get user's FPCR
	bfextu		%d3{&26:&2},%d2		# isolate rounding mode bits
	mov.l		(%a0),%d4		# reload 1st bcd word to d4
	asl.l		&2,%d2			# format d2 to be
	bfextu		%d4{&0:&2},%d0		# {FPCR[6],FPCR[5],SM,SE}
	add.l		%d0,%d2			# in d2 as index into RTABLE
	lea.l		RTABLE(%pc),%a1		# load rtable base
	mov.b		(%a1,%d2),%d0		# load new rounding bits from table
	clr.l		%d3			# clear d3 to force no exc and extended
	bfins		%d0,%d3{&26:&2}		# stuff new rounding bits in FPCR
	fmov.l		%d3,%fpcr		# write new FPCR
	asr.l		&1,%d0			# write correct PTENxx table
	bcc.b		not_rp			# to a1
	lea.l		PTENRP(%pc),%a1		# it is RP
	bra.b		calc_p			# go to init section
not_rp:
	asr.l		&1,%d0			# keep checking
	bcc.b		not_rm
	lea.l		PTENRM(%pc),%a1		# it is RM
	bra.b		calc_p			# go to init section
not_rm:
	lea.l		PTENRN(%pc),%a1		# it is RN
calc_p:
	mov.l		%d1,%d0			# copy exp to d0;use d0
	bpl.b		no_neg			# if exp is negative,
	neg.l		%d0			# invert it
	or.l		&0x40000000,(%a0)	# and set SE bit
no_neg:
	clr.l		%d3			# table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
e_loop:
	asr.l		&1,%d0			# shift next bit into carry
	bcc.b		e_next			# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
e_next:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		e_loop			# not zero, continue shifting
#
#
#  Check the sign of the adjusted exp and make the value in fp0 the
#  same sign. If the exp was pos then multiply fp1*fp0;
#  else divide fp0/fp1.
#
# Register Usage:
#  norm:
#	( )  a0: pointer to working bcd value
#	(*) fp0: mantissa accumulator
#	( ) fp1: scaling factor - 10**(abs(exp))
#
pnorm:
	btst		&30,(%a0)		# test the sign of the exponent
	beq.b		mul			# if clear, go to multiply
div:
	fdiv.x		%fp1,%fp0		# exp is negative, so divide mant by exp
	bra.b		end_dec
mul:
	fmul.x		%fp1,%fp0		# exp is positive, so multiply by exp
#
#
# Clean up and return with result in fp0.
#
# If the final mul/div in decbin incurred an inex exception,
# it will be inex2, but will be reported as inex1 by get_op.
#
end_dec:
	fmov.l		%fpsr,%d0		# get status register
	bclr		&inex2_bit+8,%d0	# test for inex2 and clear it
	beq.b		no_exc			# skip this if no exc
	ori.w		&inx1a_mask,2+USER_FPSR(%a6) # set INEX1/AINEX
no_exc:
	add.l		&0x4,%sp		# clear 1 lw param
	fmovm.x		(%sp)+,&0x40		# restore fp1
	movm.l		(%sp)+,&0x3c		# restore d2-d5
	fmov.l		&0x0,%fpcr
	fmov.l		&0x0,%fpsr
	rts

#########################################################################
# bindec(): Converts an input in extended precision format to bcd format#
#									#
# INPUT ***************************************************************	#
#	a0 = pointer to the input extended precision value in memory.	#
#	     the input may be either normalized, unnormalized, or	#
#	     denormalized.						#
#	d0 = contains the k-factor sign-extended to 32-bits.		#
#									#
# OUTPUT **************************************************************	#
#	FP_SCR0(a6) = bcd format result on the stack.			#
#									#
# ALGORITHM ***********************************************************	#
#									#
#	A1.	Set RM and size ext;  Set SIGMA = sign of input.	#
#		The k-factor is saved for use in d7. Clear the		#
#		BINDEC_FLG for separating normalized/denormalized	#
#		input.  If input is unnormalized or denormalized,	#
#		normalize it.						#
#									#
#	A2.	Set X = abs(input).					#
#									#
#	A3.	Compute ILOG.						#
#		ILOG is the log base 10 of the input value.  It is	#
#		approximated by adding e + 0.f when the original	#
#		value is viewed as 2^^e * 1.f in extended precision.	#
#		This value is stored in d6.				#
#									#
#	A4.	Clr INEX bit.						#
#		The operation in A3 above may have set INEX2.		#
#									#
#	A5.	Set ICTR = 0;						#
#		ICTR is a flag used in A13.  It must be set before the	#
#		loop entry A6.						#
#									#
#	A6.	Calculate LEN.						#
#		LEN is the number of digits to be displayed.  The	#
#		k-factor can dictate either the total number of digits,	#
#		if it is a positive number, or the number of digits	#
#		after the decimal point which are to be included as	#
#		significant.  See the 68882 manual for examples.	#
#		If LEN is computed to be greater than 17, set OPERR in	#
#		USER_FPSR.  LEN is stored in d4.			#
#									#
#	A7.	Calculate SCALE.					#
#		SCALE is equal to 10^ISCALE, where ISCALE is the number	#
#		of decimal places needed to insure LEN integer digits	#
#		in the output before conversion to bcd. LAMBDA is the	#
#		sign of ISCALE, used in A9. Fp1 contains		#
#		10^^(abs(ISCALE)) using a rounding mode which is a	#
#		function of the original rounding mode and the signs	#
#		of ISCALE and X.  A table is given in the code.		#
#									#
#	A8.	Clr INEX; Force RZ.					#
#		The operation in A3 above may have set INEX2.		#
#		RZ mode is forced for the scaling operation to insure	#
#		only one rounding error.  The grs bits are collected in #
#		the INEX flag for use in A10.				#
#									#
#	A9.	Scale X -> Y.						#
#		The mantissa is scaled to the desired number of		#
#		significant digits.  The excess digits are collected	#
#		in INEX2.						#
#									#
#	A10.	Or in INEX.						#
#		If INEX is set, round error occurred.  This is		#
#		compensated for by 'or-ing' in the INEX2 flag to	#
#		the lsb of Y.						#
#									#
#	A11.	Restore original FPCR; set size ext.			#
#		Perform FINT operation in the user's rounding mode.	#
#		Keep the size to extended.				#
#									#
#	A12.	Calculate YINT = FINT(Y) according to user's rounding	#
#		mode.  The FPSP routine sintd0 is used.  The output	#
#		is in fp0.						#
#									#
#	A13.	Check for LEN digits.					#
#		If the int operation results in more than LEN digits,	#
#		or less than LEN -1 digits, adjust ILOG and repeat from	#
#		A6.  This test occurs only on the first pass.  If the	#
#		result is exactly 10^LEN, decrement ILOG and divide	#
#		the mantissa by 10.					#
#									#
#	A14.	Convert the mantissa to bcd.				#
#		The binstr routine is used to convert the LEN digit	#
#		mantissa to bcd in memory.  The input to binstr is	#
#		to be a fraction; i.e. (mantissa)/10^LEN and adjusted	#
#		such that the decimal point is to the left of bit 63.	#
#		The bcd digits are stored in the correct position in	#
#		the final string area in memory.			#
#									#
#	A15.	Convert the exponent to bcd.				#
#		As in A14 above, the exp is converted to bcd and the	#
#		digits are stored in the final string.			#
#		Test the length of the final exponent string.  If the	#
#		length is 4, set operr.					#
#									#
#	A16.	Write sign bits to final string.			#
#									#
#########################################################################

set	BINDEC_FLG,	EXC_TEMP	# DENORM flag

# Constants in extended precision
PLOG2:
	long		0x3FFD0000,0x9A209A84,0xFBCFF798,0x00000000
PLOG2UP1:
	long		0x3FFD0000,0x9A209A84,0xFBCFF799,0x00000000

# Constants in single precision
FONE:
	long		0x3F800000,0x00000000,0x00000000,0x00000000
FTWO:
	long		0x40000000,0x00000000,0x00000000,0x00000000
FTEN:
	long		0x41200000,0x00000000,0x00000000,0x00000000
F4933:
	long		0x459A2800,0x00000000,0x00000000,0x00000000

RBDTBL:
	byte		0,0,0,0
	byte		3,3,2,2
	byte		3,2,2,3
	byte		2,3,3,2

#	Implementation Notes:
#
#	The registers are used as follows:
#
#		d0: scratch; LEN input to binstr
#		d1: scratch
#		d2: upper 32-bits of mantissa for binstr
#		d3: scratch;lower 32-bits of mantissa for binstr
#		d4: LEN
#		d5: LAMBDA/ICTR
#		d6: ILOG
#		d7: k-factor
#		a0: ptr for original operand/final result
#		a1: scratch pointer
#		a2: pointer to FP_X; abs(original value) in ext
#		fp0: scratch
#		fp1: scratch
#		fp2: scratch
#		F_SCR1:
#		F_SCR2:
#		L_SCR1:
#		L_SCR2:

	global		bindec
bindec:
	movm.l		&0x3f20,-(%sp)	#  {%d2-%d7/%a2}
	fmovm.x		&0x7,-(%sp)	#  {%fp0-%fp2}

# A1. Set RM and size ext. Set SIGMA = sign input;
#     The k-factor is saved for use in d7.  Clear BINDEC_FLG for
#     separating  normalized/denormalized input.  If the input
#     is a denormalized number, set the BINDEC_FLG memory word
#     to signal denorm.  If the input is unnormalized, normalize
#     the input and test for denormalized result.
#
	fmov.l		&rm_mode*0x10,%fpcr	# set RM and ext
	mov.l		(%a0),L_SCR2(%a6)	# save exponent for sign check
	mov.l		%d0,%d7		# move k-factor to d7

	clr.b		BINDEC_FLG(%a6)	# clr norm/denorm flag
	cmpi.b		STAG(%a6),&DENORM # is input a DENORM?
	bne.w		A2_str		# no; input is a NORM

#
# Normalize the denorm
#
un_de_norm:
	mov.w		(%a0),%d0
	and.w		&0x7fff,%d0	# strip sign of normalized exp
	mov.l		4(%a0),%d1
	mov.l		8(%a0),%d2
norm_loop:
	sub.w		&1,%d0
	lsl.l		&1,%d2
	roxl.l		&1,%d1
	tst.l		%d1
	bge.b		norm_loop
#
# Test if the normalized input is denormalized
#
	tst.w		%d0
	bgt.b		pos_exp		# if greater than zero, it is a norm
	st		BINDEC_FLG(%a6)	# set flag for denorm
pos_exp:
	and.w		&0x7fff,%d0	# strip sign of normalized exp
	mov.w		%d0,(%a0)
	mov.l		%d1,4(%a0)
	mov.l		%d2,8(%a0)

# A2. Set X = abs(input).
#
A2_str:
	mov.l		(%a0),FP_SCR1(%a6)	# move input to work space
	mov.l		4(%a0),FP_SCR1+4(%a6)	# move input to work space
	mov.l		8(%a0),FP_SCR1+8(%a6)	# move input to work space
	and.l		&0x7fffffff,FP_SCR1(%a6)	# create abs(X)

# A3. Compute ILOG.
#     ILOG is the log base 10 of the input value.  It is approx-
#     imated by adding e + 0.f when the original value is viewed
#     as 2^^e * 1.f in extended precision.  This value is stored
#     in d6.
#
# Register usage:
#	Input/Output
#	d0: k-factor/exponent
#	d2: x/x
#	d3: x/x
#	d4: x/x
#	d5: x/x
#	d6: x/ILOG
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/x
#	a2: x/x
#	fp0: x/float(ILOG)
#	fp1: x/x
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X)/Abs(X) with $3fff exponent
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.b		A3_cont		# if clr, continue with norm
	mov.l		&-4933,%d6	# force ILOG = -4933
	bra.b		A4_str
A3_cont:
	mov.w		FP_SCR1(%a6),%d0	# move exp to d0
	mov.w		&0x3fff,FP_SCR1(%a6)	# replace exponent with 0x3fff
	fmov.x		FP_SCR1(%a6),%fp0	# now fp0 has 1.f
	sub.w		&0x3fff,%d0	# strip off bias
	fadd.w		%d0,%fp0	# add in exp
	fsub.s		FONE(%pc),%fp0	# subtract off 1.0
	fbge.w		pos_res		# if pos, branch
	fmul.x		PLOG2UP1(%pc),%fp0	# if neg, mul by LOG2UP1
	fmov.l		%fp0,%d6	# put ILOG in d6 as a lword
	bra.b		A4_str		# go move out ILOG
pos_res:
	fmul.x		PLOG2(%pc),%fp0	# if pos, mul by LOG2
	fmov.l		%fp0,%d6	# put ILOG in d6 as a lword


# A4. Clr INEX bit.
#     The operation in A3 above may have set INEX2.

A4_str:
	fmov.l		&0,%fpsr	# zero all of fpsr - nothing needed


# A5. Set ICTR = 0;
#     ICTR is a flag used in A13.  It must be set before the
#     loop entry A6. The lower word of d5 is used for ICTR.

	clr.w		%d5		# clear ICTR

# A6. Calculate LEN.
#     LEN is the number of digits to be displayed.  The k-factor
#     can dictate either the total number of digits, if it is
#     a positive number, or the number of digits after the
#     original decimal point which are to be included as
#     significant.  See the 68882 manual for examples.
#     If LEN is computed to be greater than 17, set OPERR in
#     USER_FPSR.  LEN is stored in d4.
#
# Register usage:
#	Input/Output
#	d0: exponent/Unchanged
#	d2: x/x/scratch
#	d3: x/x
#	d4: exc picture/LEN
#	d5: ICTR/Unchanged
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/x
#	a2: x/x
#	fp0: float(ILOG)/Unchanged
#	fp1: x/x
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A6_str:
	tst.l		%d7		# branch on sign of k
	ble.b		k_neg		# if k <= 0, LEN = ILOG + 1 - k
	mov.l		%d7,%d4		# if k > 0, LEN = k
	bra.b		len_ck		# skip to LEN check
k_neg:
	mov.l		%d6,%d4		# first load ILOG to d4
	sub.l		%d7,%d4		# subtract off k
	addq.l		&1,%d4		# add in the 1
len_ck:
	tst.l		%d4		# LEN check: branch on sign of LEN
	ble.b		LEN_ng		# if neg, set LEN = 1
	cmp.l		%d4,&17		# test if LEN > 17
	ble.b		A7_str		# if not, forget it
	mov.l		&17,%d4		# set max LEN = 17
	tst.l		%d7		# if negative, never set OPERR
	ble.b		A7_str		# if positive, continue
	or.l		&opaop_mask,USER_FPSR(%a6)	# set OPERR & AIOP in USER_FPSR
	bra.b		A7_str		# finished here
LEN_ng:
	mov.l		&1,%d4		# min LEN is 1


# A7. Calculate SCALE.
#     SCALE is equal to 10^ISCALE, where ISCALE is the number
#     of decimal places needed to insure LEN integer digits
#     in the output before conversion to bcd. LAMBDA is the sign
#     of ISCALE, used in A9.  Fp1 contains 10^^(abs(ISCALE)) using
#     the rounding mode as given in the following table (see
#     Coonen, p. 7.23 as ref.; however, the SCALE variable is
#     of opposite sign in bindec.sa from Coonen).
#
#	Initial					USE
#	FPCR[6:5]	LAMBDA	SIGN(X)		FPCR[6:5]
#	----------------------------------------------
#	 RN	00	   0	   0		00/0	RN
#	 RN	00	   0	   1		00/0	RN
#	 RN	00	   1	   0		00/0	RN
#	 RN	00	   1	   1		00/0	RN
#	 RZ	01	   0	   0		11/3	RP
#	 RZ	01	   0	   1		11/3	RP
#	 RZ	01	   1	   0		10/2	RM
#	 RZ	01	   1	   1		10/2	RM
#	 RM	10	   0	   0		11/3	RP
#	 RM	10	   0	   1		10/2	RM
#	 RM	10	   1	   0		10/2	RM
#	 RM	10	   1	   1		11/3	RP
#	 RP	11	   0	   0		10/2	RM
#	 RP	11	   0	   1		11/3	RP
#	 RP	11	   1	   0		11/3	RP
#	 RP	11	   1	   1		10/2	RM
#
# Register usage:
#	Input/Output
#	d0: exponent/scratch - final is 0
#	d2: x/0 or 24 for A9
#	d3: x/scratch - offset ptr into PTENRM array
#	d4: LEN/Unchanged
#	d5: 0/ICTR:LAMBDA
#	d6: ILOG/ILOG or k if ((k<=0)&(ILOG<k))
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/ptr to PTENRM array
#	a2: x/x
#	fp0: float(ILOG)/Unchanged
#	fp1: x/10^ISCALE
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A7_str:
	tst.l		%d7		# test sign of k
	bgt.b		k_pos		# if pos and > 0, skip this
	cmp.l		%d7,%d6		# test k - ILOG
	blt.b		k_pos		# if ILOG >= k, skip this
	mov.l		%d7,%d6		# if ((k<0) & (ILOG < k)) ILOG = k
k_pos:
	mov.l		%d6,%d0		# calc ILOG + 1 - LEN in d0
	addq.l		&1,%d0		# add the 1
	sub.l		%d4,%d0		# sub off LEN
	swap		%d5		# use upper word of d5 for LAMBDA
	clr.w		%d5		# set it zero initially
	clr.w		%d2		# set up d2 for very small case
	tst.l		%d0		# test sign of ISCALE
	bge.b		iscale		# if pos, skip next inst
	addq.w		&1,%d5		# if neg, set LAMBDA true
	cmp.l		%d0,&0xffffecd4	# test iscale <= -4908
	bgt.b		no_inf		# if false, skip rest
	add.l		&24,%d0		# add in 24 to iscale
	mov.l		&24,%d2		# put 24 in d2 for A9
no_inf:
	neg.l		%d0		# and take abs of ISCALE
iscale:
	fmov.s		FONE(%pc),%fp1	# init fp1 to 1
	bfextu		USER_FPCR(%a6){&26:&2},%d1	# get initial rmode bits
	lsl.w		&1,%d1		# put them in bits 2:1
	add.w		%d5,%d1		# add in LAMBDA
	lsl.w		&1,%d1		# put them in bits 3:1
	tst.l		L_SCR2(%a6)	# test sign of original x
	bge.b		x_pos		# if pos, don't set bit 0
	addq.l		&1,%d1		# if neg, set bit 0
x_pos:
	lea.l		RBDTBL(%pc),%a2	# load rbdtbl base
	mov.b		(%a2,%d1),%d3	# load d3 with new rmode
	lsl.l		&4,%d3		# put bits in proper position
	fmov.l		%d3,%fpcr	# load bits into fpu
	lsr.l		&4,%d3		# put bits in proper position
	tst.b		%d3		# decode new rmode for pten table
	bne.b		not_rn		# if zero, it is RN
	lea.l		PTENRN(%pc),%a1	# load a1 with RN table base
	bra.b		rmode		# exit decode
not_rn:
	lsr.b		&1,%d3		# get lsb in carry
	bcc.b		not_rp2		# if carry clear, it is RM
	lea.l		PTENRP(%pc),%a1	# load a1 with RP table base
	bra.b		rmode		# exit decode
not_rp2:
	lea.l		PTENRM(%pc),%a1	# load a1 with RM table base
rmode:
	clr.l		%d3		# clr table index
e_loop2:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		e_next2		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp1	# mul by 10**(d3_bit_no)
e_next2:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if ISCALE is zero
	bne.b		e_loop2		# if not, loop

# A8. Clr INEX; Force RZ.
#     The operation in A3 above may have set INEX2.
#     RZ mode is forced for the scaling operation to insure
#     only one rounding error.  The grs bits are collected in
#     the INEX flag for use in A10.
#
# Register usage:
#	Input/Output

	fmov.l		&0,%fpsr	# clr INEX
	fmov.l		&rz_mode*0x10,%fpcr	# set RZ rounding mode

# A9. Scale X -> Y.
#     The mantissa is scaled to the desired number of significant
#     digits.  The excess digits are collected in INEX2. If mul,
#     Check d2 for excess 10 exponential value.  If not zero,
#     the iscale value would have caused the pwrten calculation
#     to overflow.  Only a negative iscale can cause this, so
#     multiply by 10^(d2), which is now only allowed to be 24,
#     with a multiply by 10^8 and 10^16, which is exact since
#     10^24 is exact.  If the input was denormalized, we must
#     create a busy stack frame with the mul command and the
#     two operands, and allow the fpu to complete the multiply.
#
# Register usage:
#	Input/Output
#	d0: FPCR with RZ mode/Unchanged
#	d2: 0 or 24/unchanged
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: ptr to PTENRM array/Unchanged
#	a2: x/x
#	fp0: float(ILOG)/X adjusted for SCALE (Y)
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A9_str:
	fmov.x		(%a0),%fp0	# load X from memory
	fabs.x		%fp0		# use abs(X)
	tst.w		%d5		# LAMBDA is in lower word of d5
	bne.b		sc_mul		# if neg (LAMBDA = 1), scale by mul
	fdiv.x		%fp1,%fp0	# calculate X / SCALE -> Y to fp0
	bra.w		A10_st		# branch to A10

sc_mul:
	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.w		A9_norm		# if norm, continue with mul

# for DENORM, we must calculate:
#	fp0 = input_op * 10^ISCALE * 10^24
# since the input operand is a DENORM, we can't multiply it directly.
# so, we do the multiplication of the exponents and mantissas separately.
# in this way, we avoid underflow on intermediate stages of the
# multiplication and guarantee a result without exception.
	fmovm.x		&0x2,-(%sp)	# save 10^ISCALE to stack

	mov.w		(%sp),%d3	# grab exponent
	andi.w		&0x7fff,%d3	# clear sign
	ori.w		&0x8000,(%a0)	# make DENORM exp negative
	add.w		(%a0),%d3	# add DENORM exp to 10^ISCALE exp
	subi.w		&0x3fff,%d3	# subtract BIAS
	add.w		36(%a1),%d3
	subi.w		&0x3fff,%d3	# subtract BIAS
	add.w		48(%a1),%d3
	subi.w		&0x3fff,%d3	# subtract BIAS

	bmi.w		sc_mul_err	# is result is DENORM, punt!!!

	andi.w		&0x8000,(%sp)	# keep sign
	or.w		%d3,(%sp)	# insert new exponent
	andi.w		&0x7fff,(%a0)	# clear sign bit on DENORM again
	mov.l		0x8(%a0),-(%sp) # put input op mantissa on stk
	mov.l		0x4(%a0),-(%sp)
	mov.l		&0x3fff0000,-(%sp) # force exp to zero
	fmovm.x		(%sp)+,&0x80	# load normalized DENORM into fp0
	fmul.x		(%sp)+,%fp0

#	fmul.x	36(%a1),%fp0	# multiply fp0 by 10^8
#	fmul.x	48(%a1),%fp0	# multiply fp0 by 10^16
	mov.l		36+8(%a1),-(%sp) # get 10^8 mantissa
	mov.l		36+4(%a1),-(%sp)
	mov.l		&0x3fff0000,-(%sp) # force exp to zero
	mov.l		48+8(%a1),-(%sp) # get 10^16 mantissa
	mov.l		48+4(%a1),-(%sp)
	mov.l		&0x3fff0000,-(%sp)# force exp to zero
	fmul.x		(%sp)+,%fp0	# multiply fp0 by 10^8
	fmul.x		(%sp)+,%fp0	# multiply fp0 by 10^16
	bra.b		A10_st

sc_mul_err:
	bra.b		sc_mul_err

A9_norm:
	tst.w		%d2		# test for small exp case
	beq.b		A9_con		# if zero, continue as normal
	fmul.x		36(%a1),%fp0	# multiply fp0 by 10^8
	fmul.x		48(%a1),%fp0	# multiply fp0 by 10^16
A9_con:
	fmul.x		%fp1,%fp0	# calculate X * SCALE -> Y to fp0

# A10. Or in INEX.
#      If INEX is set, round error occurred.  This is compensated
#      for by 'or-ing' in the INEX2 flag to the lsb of Y.
#
# Register usage:
#	Input/Output
#	d0: FPCR with RZ mode/FPSR with INEX2 isolated
#	d2: x/x
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: ptr to PTENxx array/Unchanged
#	a2: x/ptr to FP_SCR1(a6)
#	fp0: Y/Y with lsb adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x

A10_st:
	fmov.l		%fpsr,%d0	# get FPSR
	fmov.x		%fp0,FP_SCR1(%a6)	# move Y to memory
	lea.l		FP_SCR1(%a6),%a2	# load a2 with ptr to FP_SCR1
	btst		&9,%d0		# check if INEX2 set
	beq.b		A11_st		# if clear, skip rest
	or.l		&1,8(%a2)	# or in 1 to lsb of mantissa
	fmov.x		FP_SCR1(%a6),%fp0	# write adjusted Y back to fpu


# A11. Restore original FPCR; set size ext.
#      Perform FINT operation in the user's rounding mode.  Keep
#      the size to extended.  The sintdo entry point in the sint
#      routine expects the FPCR value to be in USER_FPCR for
#      mode and precision.  The original FPCR is saved in L_SCR1.

A11_st:
	mov.l		USER_FPCR(%a6),L_SCR1(%a6)	# save it for later
	and.l		&0x00000030,USER_FPCR(%a6)	# set size to ext,
#					;block exceptions


# A12. Calculate YINT = FINT(Y) according to user's rounding mode.
#      The FPSP routine sintd0 is used.  The output is in fp0.
#
# Register usage:
#	Input/Output
#	d0: FPSR with AINEX cleared/FPCR with size set to ext
#	d2: x/x/scratch
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/Unchanged
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/src ptr for sintdo
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	a6: temp pointer to FP_SCR1(a6) - orig value saved and restored
#	fp0: Y/YINT
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Y adjusted for inex/Y with original exponent
#	L_SCR1:x/original USER_FPCR
#	L_SCR2:first word of X packed/Unchanged

A12_st:
	movm.l	&0xc0c0,-(%sp)	# save regs used by sintd0	 {%d0-%d1/%a0-%a1}
	mov.l	L_SCR1(%a6),-(%sp)
	mov.l	L_SCR2(%a6),-(%sp)

	lea.l		FP_SCR1(%a6),%a0	# a0 is ptr to FP_SCR1(a6)
	fmov.x		%fp0,(%a0)	# move Y to memory at FP_SCR1(a6)
	tst.l		L_SCR2(%a6)	# test sign of original operand
	bge.b		do_fint12		# if pos, use Y
	or.l		&0x80000000,(%a0)	# if neg, use -Y
do_fint12:
	mov.l	USER_FPSR(%a6),-(%sp)
#	bsr	sintdo		# sint routine returns int in fp0

	fmov.l	USER_FPCR(%a6),%fpcr
	fmov.l	&0x0,%fpsr			# clear the AEXC bits!!!
##	mov.l		USER_FPCR(%a6),%d0	# ext prec/keep rnd mode
##	andi.l		&0x00000030,%d0
##	fmov.l		%d0,%fpcr
	fint.x		FP_SCR1(%a6),%fp0	# do fint()
	fmov.l	%fpsr,%d0
	or.w	%d0,FPSR_EXCEPT(%a6)
##	fmov.l		&0x0,%fpcr
##	fmov.l		%fpsr,%d0		# don't keep ccodes
##	or.w		%d0,FPSR_EXCEPT(%a6)

	mov.b	(%sp),USER_FPSR(%a6)
	add.l	&4,%sp

	mov.l	(%sp)+,L_SCR2(%a6)
	mov.l	(%sp)+,L_SCR1(%a6)
	movm.l	(%sp)+,&0x303	# restore regs used by sint	 {%d0-%d1/%a0-%a1}

	mov.l	L_SCR2(%a6),FP_SCR1(%a6)	# restore original exponent
	mov.l	L_SCR1(%a6),USER_FPCR(%a6)	# restore user's FPCR

# A13. Check for LEN digits.
#      If the int operation results in more than LEN digits,
#      or less than LEN -1 digits, adjust ILOG and repeat from
#      A6.  This test occurs only on the first pass.  If the
#      result is exactly 10^LEN, decrement ILOG and divide
#      the mantissa by 10.  The calculation of 10^LEN cannot
#      be inexact, since all powers of ten up to 10^27 are exact
#      in extended precision, so the use of a previous power-of-ten
#      table will introduce no error.
#
#
# Register usage:
#	Input/Output
#	d0: FPCR with size set to ext/scratch final = 0
#	d2: x/x
#	d3: x/scratch final = x
#	d4: LEN/LEN adjusted
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG/ILOG adjusted
#	d7: k-factor/Unchanged
#	a0: pointer into memory for packed bcd string formation
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: int portion of Y/abs(YINT) adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/10^LEN
#	F_SCR1:x/x
#	F_SCR2:Y with original exponent/Unchanged
#	L_SCR1:original USER_FPCR/Unchanged
#	L_SCR2:first word of X packed/Unchanged

A13_st:
	swap		%d5		# put ICTR in lower word of d5
	tst.w		%d5		# check if ICTR = 0
	bne		not_zr		# if non-zero, go to second test
#
# Compute 10^(LEN-1)
#
	fmov.s		FONE(%pc),%fp2	# init fp2 to 1.0
	mov.l		%d4,%d0		# put LEN in d0
	subq.l		&1,%d0		# d0 = LEN -1
	clr.l		%d3		# clr table index
l_loop:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		l_next		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp2	# mul by 10**(d3_bit_no)
l_next:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if LEN is zero
	bne.b		l_loop		# if not, loop
#
# 10^LEN-1 is computed for this test and A14.  If the input was
# denormalized, check only the case in which YINT > 10^LEN.
#
	tst.b		BINDEC_FLG(%a6)	# check if input was norm
	beq.b		A13_con		# if norm, continue with checking
	fabs.x		%fp0		# take abs of YINT
	bra		test_2
#
# Compare abs(YINT) to 10^(LEN-1) and 10^LEN
#
A13_con:
	fabs.x		%fp0		# take abs of YINT
	fcmp.x		%fp0,%fp2	# compare abs(YINT) with 10^(LEN-1)
	fbge.w		test_2		# if greater, do next test
	subq.l		&1,%d6		# subtract 1 from ILOG
	mov.w		&1,%d5		# set ICTR
	fmov.l		&rm_mode*0x10,%fpcr	# set rmode to RM
	fmul.s		FTEN(%pc),%fp2	# compute 10^LEN
	bra.w		A6_str		# return to A6 and recompute YINT
test_2:
	fmul.s		FTEN(%pc),%fp2	# compute 10^LEN
	fcmp.x		%fp0,%fp2	# compare abs(YINT) with 10^LEN
	fblt.w		A14_st		# if less, all is ok, go to A14
	fbgt.w		fix_ex		# if greater, fix and redo
	fdiv.s		FTEN(%pc),%fp0	# if equal, divide by 10
	addq.l		&1,%d6		# and inc ILOG
	bra.b		A14_st		# and continue elsewhere
fix_ex:
	addq.l		&1,%d6		# increment ILOG by 1
	mov.w		&1,%d5		# set ICTR
	fmov.l		&rm_mode*0x10,%fpcr	# set rmode to RM
	bra.w		A6_str		# return to A6 and recompute YINT
#
# Since ICTR <> 0, we have already been through one adjustment,
# and shouldn't have another; this is to check if abs(YINT) = 10^LEN
# 10^LEN is again computed using whatever table is in a1 since the
# value calculated cannot be inexact.
#
not_zr:
	fmov.s		FONE(%pc),%fp2	# init fp2 to 1.0
	mov.l		%d4,%d0		# put LEN in d0
	clr.l		%d3		# clr table index
z_loop:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		z_next		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp2	# mul by 10**(d3_bit_no)
z_next:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if LEN is zero
	bne.b		z_loop		# if not, loop
	fabs.x		%fp0		# get abs(YINT)
	fcmp.x		%fp0,%fp2	# check if abs(YINT) = 10^LEN
	fbneq.w		A14_st		# if not, skip this
	fdiv.s		FTEN(%pc),%fp0	# divide abs(YINT) by 10
	addq.l		&1,%d6		# and inc ILOG by 1
	addq.l		&1,%d4		# and inc LEN
	fmul.s		FTEN(%pc),%fp2	# if LEN++, the get 10^^LEN

# A14. Convert the mantissa to bcd.
#      The binstr routine is used to convert the LEN digit
#      mantissa to bcd in memory.  The input to binstr is
#      to be a fraction; i.e. (mantissa)/10^LEN and adjusted
#      such that the decimal point is to the left of bit 63.
#      The bcd digits are stored in the correct position in
#      the final string area in memory.
#
#
# Register usage:
#	Input/Output
#	d0: x/LEN call to binstr - final is 0
#	d1: x/0
#	d2: x/ms 32-bits of mant of abs(YINT)
#	d3: x/ls 32-bits of mant of abs(YINT)
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG
#	d7: k-factor/Unchanged
#	a0: pointer into memory for packed bcd string formation
#	    /ptr to first mantissa byte in result string
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: int portion of Y/abs(YINT) adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:x/Work area for final result
#	F_SCR2:Y with original exponent/Unchanged
#	L_SCR1:original USER_FPCR/Unchanged
#	L_SCR2:first word of X packed/Unchanged

A14_st:
	fmov.l		&rz_mode*0x10,%fpcr	# force rz for conversion
	fdiv.x		%fp2,%fp0	# divide abs(YINT) by 10^LEN
	lea.l		FP_SCR0(%a6),%a0
	fmov.x		%fp0,(%a0)	# move abs(YINT)/10^LEN to memory
	mov.l		4(%a0),%d2	# move 2nd word of FP_RES to d2
	mov.l		8(%a0),%d3	# move 3rd word of FP_RES to d3
	clr.l		4(%a0)		# zero word 2 of FP_RES
	clr.l		8(%a0)		# zero word 3 of FP_RES
	mov.l		(%a0),%d0	# move exponent to d0
	swap		%d0		# put exponent in lower word
	beq.b		no_sft		# if zero, don't shift
	sub.l		&0x3ffd,%d0	# sub bias less 2 to make fract
	tst.l		%d0		# check if > 1
	bgt.b		no_sft		# if so, don't shift
	neg.l		%d0		# make exp positive
m_loop:
	lsr.l		&1,%d2		# shift d2:d3 right, add 0s
	roxr.l		&1,%d3		# the number of places
	dbf.w		%d0,m_loop	# given in d0
no_sft:
	tst.l		%d2		# check for mantissa of zero
	bne.b		no_zr		# if not, go on
	tst.l		%d3		# continue zero check
	beq.b		zer_m		# if zero, go directly to binstr
no_zr:
	clr.l		%d1		# put zero in d1 for addx
	add.l		&0x00000080,%d3	# inc at bit 7
	addx.l		%d1,%d2		# continue inc
	and.l		&0xffffff80,%d3	# strip off lsb not used by 882
zer_m:
	mov.l		%d4,%d0		# put LEN in d0 for binstr call
	addq.l		&3,%a0		# a0 points to M16 byte in result
	bsr		binstr		# call binstr to convert mant


# A15. Convert the exponent to bcd.
#      As in A14 above, the exp is converted to bcd and the
#      digits are stored in the final string.
#
#      Digits are stored in L_SCR1(a6) on return from BINDEC as:
#
#	 32               16 15                0
#	-----------------------------------------
#	|  0 | e3 | e2 | e1 | e4 |  X |  X |  X |
#	-----------------------------------------
#
# And are moved into their proper places in FP_SCR0.  If digit e4
# is non-zero, OPERR is signaled.  In all cases, all 4 digits are
# written as specified in the 881/882 manual for packed decimal.
#
# Register usage:
#	Input/Output
#	d0: x/LEN call to binstr - final is 0
#	d1: x/scratch (0);shift count for final exponent packing
#	d2: x/ms 32-bits of exp fraction/scratch
#	d3: x/ls 32-bits of exp fraction
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG
#	d7: k-factor/Unchanged
#	a0: ptr to result string/ptr to L_SCR1(a6)
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: abs(YINT) adjusted/float(ILOG)
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:Work area for final result/BCD result
#	F_SCR2:Y with original exponent/ILOG/10^4
#	L_SCR1:original USER_FPCR/Exponent digits on return from binstr
#	L_SCR2:first word of X packed/Unchanged

A15_st:
	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.b		not_denorm
	ftest.x		%fp0		# test for zero
	fbeq.w		den_zero	# if zero, use k-factor or 4933
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
	bra.b		convrt
den_zero:
	tst.l		%d7		# check sign of the k-factor
	blt.b		use_ilog	# if negative, use ILOG
	fmov.s		F4933(%pc),%fp0	# force exponent to 4933
	bra.b		convrt		# do it
use_ilog:
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
	bra.b		convrt
not_denorm:
	ftest.x		%fp0		# test for zero
	fbneq.w		not_zero	# if zero, force exponent
	fmov.s		FONE(%pc),%fp0	# force exponent to 1
	bra.b		convrt		# do it
not_zero:
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
convrt:
	fdiv.x		24(%a1),%fp0	# compute ILOG/10^4
	fmov.x		%fp0,FP_SCR1(%a6)	# store fp0 in memory
	mov.l		4(%a2),%d2	# move word 2 to d2
	mov.l		8(%a2),%d3	# move word 3 to d3
	mov.w		(%a2),%d0	# move exp to d0
	beq.b		x_loop_fin	# if zero, skip the shift
	sub.w		&0x3ffd,%d0	# subtract off bias
	neg.w		%d0		# make exp positive
x_loop:
	lsr.l		&1,%d2		# shift d2:d3 right
	roxr.l		&1,%d3		# the number of places
	dbf.w		%d0,x_loop	# given in d0
x_loop_fin:
	clr.l		%d1		# put zero in d1 for addx
	add.l		&0x00000080,%d3	# inc at bit 6
	addx.l		%d1,%d2		# continue inc
	and.l		&0xffffff80,%d3	# strip off lsb not used by 882
	mov.l		&4,%d0		# put 4 in d0 for binstr call
	lea.l		L_SCR1(%a6),%a0	# a0 is ptr to L_SCR1 for exp digits
	bsr		binstr		# call binstr to convert exp
	mov.l		L_SCR1(%a6),%d0	# load L_SCR1 lword to d0
	mov.l		&12,%d1		# use d1 for shift count
	lsr.l		%d1,%d0		# shift d0 right by 12
	bfins		%d0,FP_SCR0(%a6){&4:&12}	# put e3:e2:e1 in FP_SCR0
	lsr.l		%d1,%d0		# shift d0 right by 12
	bfins		%d0,FP_SCR0(%a6){&16:&4}	# put e4 in FP_SCR0
	tst.b		%d0		# check if e4 is zero
	beq.b		A16_st		# if zero, skip rest
	or.l		&opaop_mask,USER_FPSR(%a6)	# set OPERR & AIOP in USER_FPSR


# A16. Write sign bits to final string.
#	   Sigma is bit 31 of initial value; RHO is bit 31 of d6 (ILOG).
#
# Register usage:
#	Input/Output
#	d0: x/scratch - final is x
#	d2: x/x
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG/ILOG adjusted
#	d7: k-factor/Unchanged
#	a0: ptr to L_SCR1(a6)/Unchanged
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: float(ILOG)/Unchanged
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:BCD result with correct signs
#	F_SCR2:ILOG/10^4
#	L_SCR1:Exponent digits on return from binstr
#	L_SCR2:first word of X packed/Unchanged

A16_st:
	clr.l		%d0		# clr d0 for collection of signs
	and.b		&0x0f,FP_SCR0(%a6)	# clear first nibble of FP_SCR0
	tst.l		L_SCR2(%a6)	# check sign of original mantissa
	bge.b		mant_p		# if pos, don't set SM
	mov.l		&2,%d0		# move 2 in to d0 for SM
mant_p:
	tst.l		%d6		# check sign of ILOG
	bge.b		wr_sgn		# if pos, don't set SE
	addq.l		&1,%d0		# set bit 0 in d0 for SE
wr_sgn:
	bfins		%d0,FP_SCR0(%a6){&0:&2}	# insert SM and SE into FP_SCR0

# Clean up and restore all registers used.

	fmov.l		&0,%fpsr	# clear possible inex2/ainex bits
	fmovm.x		(%sp)+,&0xe0	#  {%fp0-%fp2}
	movm.l		(%sp)+,&0x4fc	#  {%d2-%d7/%a2}
	rts

	global		PTENRN
PTENRN:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59E	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D5	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CE0	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8E	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C7	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C17	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE5	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979B	# 10 ^ 4096

	global		PTENRP
PTENRP:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59E	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D6	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CE0	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8E	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C7	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C18	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE5	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979B	# 10 ^ 4096

	global		PTENRM
PTENRM:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59D	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D5	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CDF	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8D	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C6	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C17	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE4	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979A	# 10 ^ 4096

#########################################################################
# binstr(): Converts a 64-bit binary integer to bcd.			#
#									#
# INPUT *************************************************************** #
#	d2:d3 = 64-bit binary integer					#
#	d0    = desired length (LEN)					#
#	a0    = pointer to start in memory for bcd characters		#
#		(This pointer must point to byte 4 of the first		#
#		 lword of the packed decimal memory string.)		#
#									#
# OUTPUT ************************************************************** #
#	a0 = pointer to LEN bcd digits representing the 64-bit integer.	#
#									#
# ALGORITHM ***********************************************************	#
#	The 64-bit binary is assumed to have a decimal point before	#
#	bit 63.  The fraction is multiplied by 10 using a mul by 2	#
#	shift and a mul by 8 shift.  The bits shifted out of the	#
#	msb form a decimal digit.  This process is iterated until	#
#	LEN digits are formed.						#
#									#
# A1. Init d7 to 1.  D7 is the byte digit counter, and if 1, the	#
#     digit formed will be assumed the least significant.  This is	#
#     to force the first byte formed to have a 0 in the upper 4 bits.	#
#									#
# A2. Beginning of the loop:						#
#     Copy the fraction in d2:d3 to d4:d5.				#
#									#
# A3. Multiply the fraction in d2:d3 by 8 using bit-field		#
#     extracts and shifts.  The three msbs from d2 will go into d1.	#
#									#
# A4. Multiply the fraction in d4:d5 by 2 using shifts.  The msb	#
#     will be collected by the carry.					#
#									#
# A5. Add using the carry the 64-bit quantities in d2:d3 and d4:d5	#
#     into d2:d3.  D1 will contain the bcd digit formed.		#
#									#
# A6. Test d7.  If zero, the digit formed is the ms digit.  If non-	#
#     zero, it is the ls digit.  Put the digit in its place in the	#
#     upper word of d0.  If it is the ls digit, write the word		#
#     from d0 to memory.						#
#									#
# A7. Decrement d6 (LEN counter) and repeat the loop until zero.	#
#									#
#########################################################################

#	Implementation Notes:
#
#	The registers are used as follows:
#
#		d0: LEN counter
#		d1: temp used to form the digit
#		d2: upper 32-bits of fraction for mul by 8
#		d3: lower 32-bits of fraction for mul by 8
#		d4: upper 32-bits of fraction for mul by 2
#		d5: lower 32-bits of fraction for mul by 2
#		d6: temp for bit-field extracts
#		d7: byte digit formation word;digit count {0,1}
#		a0: pointer into memory for packed bcd string formation
#

	global		binstr
binstr:
	movm.l		&0xff00,-(%sp)	#  {%d0-%d7}

#
# A1: Init d7
#
	mov.l		&1,%d7		# init d7 for second digit
	subq.l		&1,%d0		# for dbf d0 would have LEN+1 passes
#
# A2. Copy d2:d3 to d4:d5.  Start loop.
#
loop:
	mov.l		%d2,%d4		# copy the fraction before muls
	mov.l		%d3,%d5		# to d4:d5
#
# A3. Multiply d2:d3 by 8; extract msbs into d1.
#
	bfextu		%d2{&0:&3},%d1	# copy 3 msbs of d2 into d1
	asl.l		&3,%d2		# shift d2 left by 3 places
	bfextu		%d3{&0:&3},%d6	# copy 3 msbs of d3 into d6
	asl.l		&3,%d3		# shift d3 left by 3 places
	or.l		%d6,%d2		# or in msbs from d3 into d2
#
# A4. Multiply d4:d5 by 2; add carry out to d1.
#
	asl.l		&1,%d5		# mul d5 by 2
	roxl.l		&1,%d4		# mul d4 by 2
	swap		%d6		# put 0 in d6 lower word
	addx.w		%d6,%d1		# add in extend from mul by 2
#
# A5. Add mul by 8 to mul by 2.  D1 contains the digit formed.
#
	add.l		%d5,%d3		# add lower 32 bits
	nop				# ERRATA FIX #13 (Rev. 1.2 6/6/90)
	addx.l		%d4,%d2		# add with extend upper 32 bits
	nop				# ERRATA FIX #13 (Rev. 1.2 6/6/90)
	addx.w		%d6,%d1		# add in extend from add to d1
	swap		%d6		# with d6 = 0; put 0 in upper word
#
# A6. Test d7 and branch.
#
	tst.w		%d7		# if zero, store digit & to loop
	beq.b		first_d		# if non-zero, form byte & write
sec_d:
	swap		%d7		# bring first digit to word d7b
	asl.w		&4,%d7		# first digit in upper 4 bits d7b
	add.w		%d1,%d7		# add in ls digit to d7b
	mov.b		%d7,(%a0)+	# store d7b byte in memory
	swap		%d7		# put LEN counter in word d7a
	clr.w		%d7		# set d7a to signal no digits done
	dbf.w		%d0,loop	# do loop some more!
	bra.b		end_bstr	# finished, so exit
first_d:
	swap		%d7		# put digit word in d7b
	mov.w		%d1,%d7		# put new digit in d7b
	swap		%d7		# put LEN counter in word d7a
	addq.w		&1,%d7		# set d7a to signal first digit done
	dbf.w		%d0,loop	# do loop some more!
	swap		%d7		# put last digit in string
	lsl.w		&4,%d7		# move it to upper 4 bits
	mov.b		%d7,(%a0)+	# store it in memory string
#
# Clean up and return with result in fp0.
#
end_bstr:
	movm.l		(%sp)+,&0xff	#  {%d0-%d7}
	rts

#########################################################################
# XDEF ****************************************************************	#
#	facc_in_b(): dmem_read_byte failed				#
#	facc_in_w(): dmem_read_word failed				#
#	facc_in_l(): dmem_read_long failed				#
#	facc_in_d(): dmem_read of dbl prec failed			#
#	facc_in_x(): dmem_read of ext prec failed			#
#									#
#	facc_out_b(): dmem_write_byte failed				#
#	facc_out_w(): dmem_write_word failed				#
#	facc_out_l(): dmem_write_long failed				#
#	facc_out_d(): dmem_write of dbl prec failed			#
#	facc_out_x(): dmem_write of ext prec failed			#
#									#
# XREF ****************************************************************	#
#	_real_access() - exit through access error handler		#
#									#
# INPUT ***************************************************************	#
#	None								#
#									#
# OUTPUT **************************************************************	#
#	None								#
#									#
# ALGORITHM ***********************************************************	#
#	Flow jumps here when an FP data fetch call gets an error	#
# result. This means the operating system wants an access error frame	#
# made out of the current exception stack frame.			#
#	So, we first call restore() which makes sure that any updated	#
# -(an)+ register gets returned to its pre-exception value and then	#
# we change the stack to an access error stack frame.			#
#									#
#########################################################################

facc_in_b:
	movq.l		&0x1,%d0			# one byte
	bsr.w		restore				# fix An

	mov.w		&0x0121,EXC_VOFF(%a6)		# set FSLW
	bra.w		facc_finish

facc_in_w:
	movq.l		&0x2,%d0			# two bytes
	bsr.w		restore				# fix An

	mov.w		&0x0141,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_l:
	movq.l		&0x4,%d0			# four bytes
	bsr.w		restore				# fix An

	mov.w		&0x0101,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_d:
	movq.l		&0x8,%d0			# eight bytes
	bsr.w		restore				# fix An

	mov.w		&0x0161,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_x:
	movq.l		&0xc,%d0			# twelve bytes
	bsr.w		restore				# fix An

	mov.w		&0x0161,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

################################################################

facc_out_b:
	movq.l		&0x1,%d0			# one byte
	bsr.w		restore				# restore An

	mov.w		&0x00a1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_w:
	movq.l		&0x2,%d0			# two bytes
	bsr.w		restore				# restore An

	mov.w		&0x00c1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_l:
	movq.l		&0x4,%d0			# four bytes
	bsr.w		restore				# restore An

	mov.w		&0x0081,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_d:
	movq.l		&0x8,%d0			# eight bytes
	bsr.w		restore				# restore An

	mov.w		&0x00e1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_x:
	mov.l		&0xc,%d0			# twelve bytes
	bsr.w		restore				# restore An

	mov.w		&0x00e1,EXC_VOFF(%a6)		# set FSLW

# here's where we actually create the access error frame from the
# current exception stack frame.
facc_finish:
	mov.l		USER_FPIAR(%a6),EXC_PC(%a6) # store current PC

	fmovm.x		EXC_FPREGS(%a6),&0xc0	# restore fp0-fp1
	fmovm.l		USER_FPCR(%a6),%fpcr,%fpsr,%fpiar # restore ctrl regs
	movm.l		EXC_DREGS(%a6),&0x0303	# restore d0-d1/a0-a1

	unlk		%a6

	mov.l		(%sp),-(%sp)		# store SR, hi(PC)
	mov.l		0x8(%sp),0x4(%sp)	# store lo(PC)
	mov.l		0xc(%sp),0x8(%sp)	# store EA
	mov.l		&0x00000001,0xc(%sp)	# store FSLW
	mov.w		0x6(%sp),0xc(%sp)	# fix FSLW (size)
	mov.w		&0x4008,0x6(%sp)	# store voff

	btst		&0x5,(%sp)		# supervisor or user mode?
	beq.b		facc_out2		# user
	bset		&0x2,0xd(%sp)		# set supervisor TM bit

facc_out2:
	bra.l		_real_access

##################################################################

# if the effective addressing mode was predecrement or postincrement,
# the emulation has already changed its value to the correct post-
# instruction value. but since we're exiting to the access error
# handler, then AN must be returned to its pre-instruction value.
# we do that here.
restore:
	mov.b		EXC_OPWORD+0x1(%a6),%d1
	andi.b		&0x38,%d1		# extract opmode
	cmpi.b		%d1,&0x18		# postinc?
	beq.w		rest_inc
	cmpi.b		%d1,&0x20		# predec?
	beq.w		rest_dec
	rts

rest_inc:
	mov.b		EXC_OPWORD+0x1(%a6),%d1
	andi.w		&0x0007,%d1		# fetch An

	mov.w		(tbl_rest_inc.b,%pc,%d1.w*2),%d1
	jmp		(tbl_rest_inc.b,%pc,%d1.w*1)

tbl_rest_inc:
	short		ri_a0 - tbl_rest_inc
	short		ri_a1 - tbl_rest_inc
	short		ri_a2 - tbl_rest_inc
	short		ri_a3 - tbl_rest_inc
	short		ri_a4 - tbl_rest_inc
	short		ri_a5 - tbl_rest_inc
	short		ri_a6 - tbl_rest_inc
	short		ri_a7 - tbl_rest_inc

ri_a0:
	sub.l		%d0,EXC_DREGS+0x8(%a6)	# fix stacked a0
	rts
ri_a1:
	sub.l		%d0,EXC_DREGS+0xc(%a6)	# fix stacked a1
	rts
ri_a2:
	sub.l		%d0,%a2			# fix a2
	rts
ri_a3:
	sub.l		%d0,%a3			# fix a3
	rts
ri_a4:
	sub.l		%d0,%a4			# fix a4
	rts
ri_a5:
	sub.l		%d0,%a5			# fix a5
	rts
ri_a6:
	sub.l		%d0,(%a6)		# fix stacked a6
	rts
# if it's a fmove out instruction, we don't have to fix a7
# because we hadn't changed it yet. if it's an opclass two
# instruction (data moved in) and the exception was in supervisor
# mode, then also also wasn't updated. if it was user mode, then
# restore the correct a7 which is in the USP currently.
ri_a7:
	cmpi.b		EXC_VOFF(%a6),&0x30	# move in or out?
	bne.b		ri_a7_done		# out

	btst		&0x5,EXC_SR(%a6)	# user or supervisor?
	bne.b		ri_a7_done		# supervisor
	movc		%usp,%a0		# restore USP
	sub.l		%d0,%a0
	movc		%a0,%usp
ri_a7_done:
	rts

# need to invert adjustment value if the <ea> was predec
rest_dec:
	neg.l		%d0
	bra.b		rest_inc
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



ifpsp060/src/pfpsp.S [12887:14745]:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#########################################################################
# XDEF ****************************************************************	#
#	get_packed(): fetch a packed operand from memory and then	#
#		      convert it to a floating-point binary number.	#
#									#
# XREF ****************************************************************	#
#	_dcalc_ea() - calculate the correct <ea>			#
#	_mem_read() - fetch the packed operand from memory		#
#	facc_in_x() - the fetch failed so jump to special exit code	#
#	decbin()    - convert packed to binary extended precision	#
#									#
# INPUT ***************************************************************	#
#	None								#
#									#
# OUTPUT **************************************************************	#
#	If no failure on _mem_read():					#
#	FP_SRC(a6) = packed operand now as a binary FP number		#
#									#
# ALGORITHM ***********************************************************	#
#	Get the correct <ea> which is the value on the exception stack	#
# frame w/ maybe a correction factor if the <ea> is -(an) or (an)+.	#
# Then, fetch the operand from memory. If the fetch fails, exit		#
# through facc_in_x().							#
#	If the packed operand is a ZERO,NAN, or INF, convert it to	#
# its binary representation here. Else, call decbin() which will	#
# convert the packed value to an extended precision binary value.	#
#									#
#########################################################################

# the stacked <ea> for packed is correct except for -(An).
# the base reg must be updated for both -(An) and (An)+.
	global		get_packed
get_packed:
	mov.l		&0xc,%d0		# packed is 12 bytes
	bsr.l		_dcalc_ea		# fetch <ea>; correct An

	lea		FP_SRC(%a6),%a1		# pass: ptr to super dst
	mov.l		&0xc,%d0		# pass: 12 bytes
	bsr.l		_dmem_read		# read packed operand

	tst.l		%d1			# did dfetch fail?
	bne.l		facc_in_x		# yes

# The packed operand is an INF or a NAN if the exponent field is all ones.
	bfextu		FP_SRC(%a6){&1:&15},%d0	# get exp
	cmpi.w		%d0,&0x7fff		# INF or NAN?
	bne.b		gp_try_zero		# no
	rts					# operand is an INF or NAN

# The packed operand is a zero if the mantissa is all zero, else it's
# a normal packed op.
gp_try_zero:
	mov.b		3+FP_SRC(%a6),%d0	# get byte 4
	andi.b		&0x0f,%d0		# clear all but last nybble
	bne.b		gp_not_spec		# not a zero
	tst.l		FP_SRC_HI(%a6)		# is lw 2 zero?
	bne.b		gp_not_spec		# not a zero
	tst.l		FP_SRC_LO(%a6)		# is lw 3 zero?
	bne.b		gp_not_spec		# not a zero
	rts					# operand is a ZERO
gp_not_spec:
	lea		FP_SRC(%a6),%a0		# pass: ptr to packed op
	bsr.l		decbin			# convert to extended
	fmovm.x		&0x80,FP_SRC(%a6)	# make this the srcop
	rts

#########################################################################
# decbin(): Converts normalized packed bcd value pointed to by register	#
#	    a0 to extended-precision value in fp0.			#
#									#
# INPUT ***************************************************************	#
#	a0 = pointer to normalized packed bcd value			#
#									#
# OUTPUT **************************************************************	#
#	fp0 = exact fp representation of the packed bcd value.		#
#									#
# ALGORITHM ***********************************************************	#
#	Expected is a normal bcd (i.e. non-exceptional; all inf, zero,	#
#	and NaN operands are dispatched without entering this routine)	#
#	value in 68881/882 format at location (a0).			#
#									#
#	A1. Convert the bcd exponent to binary by successive adds and	#
#	muls. Set the sign according to SE. Subtract 16 to compensate	#
#	for the mantissa which is to be interpreted as 17 integer	#
#	digits, rather than 1 integer and 16 fraction digits.		#
#	Note: this operation can never overflow.			#
#									#
#	A2. Convert the bcd mantissa to binary by successive		#
#	adds and muls in FP0. Set the sign according to SM.		#
#	The mantissa digits will be converted with the decimal point	#
#	assumed following the least-significant digit.			#
#	Note: this operation can never overflow.			#
#									#
#	A3. Count the number of leading/trailing zeros in the		#
#	bcd string.  If SE is positive, count the leading zeros;	#
#	if negative, count the trailing zeros.  Set the adjusted	#
#	exponent equal to the exponent from A1 and the zero count	#
#	added if SM = 1 and subtracted if SM = 0.  Scale the		#
#	mantissa the equivalent of forcing in the bcd value:		#
#									#
#	SM = 0	a non-zero digit in the integer position		#
#	SM = 1	a non-zero digit in Mant0, lsd of the fraction		#
#									#
#	this will insure that any value, regardless of its		#
#	representation (ex. 0.1E2, 1E1, 10E0, 100E-1), is converted	#
#	consistently.							#
#									#
#	A4. Calculate the factor 10^exp in FP1 using a table of		#
#	10^(2^n) values.  To reduce the error in forming factors	#
#	greater than 10^27, a directed rounding scheme is used with	#
#	tables rounded to RN, RM, and RP, according to the table	#
#	in the comments of the pwrten section.				#
#									#
#	A5. Form the final binary number by scaling the mantissa by	#
#	the exponent factor.  This is done by multiplying the		#
#	mantissa in FP0 by the factor in FP1 if the adjusted		#
#	exponent sign is positive, and dividing FP0 by FP1 if		#
#	it is negative.							#
#									#
#	Clean up and return. Check if the final mul or div was inexact.	#
#	If so, set INEX1 in USER_FPSR.					#
#									#
#########################################################################

#
#	PTENRN, PTENRM, and PTENRP are arrays of powers of 10 rounded
#	to nearest, minus, and plus, respectively.  The tables include
#	10**{1,2,4,8,16,32,64,128,256,512,1024,2048,4096}.  No rounding
#	is required until the power is greater than 27, however, all
#	tables include the first 5 for ease of indexing.
#
RTABLE:
	byte		0,0,0,0
	byte		2,3,2,3
	byte		2,3,3,2
	byte		3,2,2,3

	set		FNIBS,7
	set		FSTRT,0

	set		ESTRT,4
	set		EDIGITS,2

	global		decbin
decbin:
	mov.l		0x0(%a0),FP_SCR0_EX(%a6) # make a copy of input
	mov.l		0x4(%a0),FP_SCR0_HI(%a6) # so we don't alter it
	mov.l		0x8(%a0),FP_SCR0_LO(%a6)

	lea		FP_SCR0(%a6),%a0

	movm.l		&0x3c00,-(%sp)		# save d2-d5
	fmovm.x		&0x1,-(%sp)		# save fp1
#
# Calculate exponent:
#  1. Copy bcd value in memory for use as a working copy.
#  2. Calculate absolute value of exponent in d1 by mul and add.
#  3. Correct for exponent sign.
#  4. Subtract 16 to compensate for interpreting the mant as all integer digits.
#     (i.e., all digits assumed left of the decimal point.)
#
# Register usage:
#
#  calc_e:
#	(*)  d0: temp digit storage
#	(*)  d1: accumulator for binary exponent
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: first word of bcd
#	( )  a0: pointer to working bcd value
#	( )  a6: pointer to original bcd value
#	(*)  FP_SCR1: working copy of original bcd value
#	(*)  L_SCR1: copy of original exponent word
#
calc_e:
	mov.l		&EDIGITS,%d2		# # of nibbles (digits) in fraction part
	mov.l		&ESTRT,%d3		# counter to pick up digits
	mov.l		(%a0),%d4		# get first word of bcd
	clr.l		%d1			# zero d1 for accumulator
e_gd:
	mulu.l		&0xa,%d1		# mul partial product by one digit place
	bfextu		%d4{%d3:&4},%d0		# get the digit and zero extend into d0
	add.l		%d0,%d1			# d1 = d1 + d0
	addq.b		&4,%d3			# advance d3 to the next digit
	dbf.w		%d2,e_gd		# if we have used all 3 digits, exit loop
	btst		&30,%d4			# get SE
	beq.b		e_pos			# don't negate if pos
	neg.l		%d1			# negate before subtracting
e_pos:
	sub.l		&16,%d1			# sub to compensate for shift of mant
	bge.b		e_save			# if still pos, do not neg
	neg.l		%d1			# now negative, make pos and set SE
	or.l		&0x40000000,%d4		# set SE in d4,
	or.l		&0x40000000,(%a0)	# and in working bcd
e_save:
	mov.l		%d1,-(%sp)		# save exp on stack
#
#
# Calculate mantissa:
#  1. Calculate absolute value of mantissa in fp0 by mul and add.
#  2. Correct for mantissa sign.
#     (i.e., all digits assumed left of the decimal point.)
#
# Register usage:
#
#  calc_m:
#	(*)  d0: temp digit storage
#	(*)  d1: lword counter
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: words 2 and 3 of bcd
#	( )  a0: pointer to working bcd value
#	( )  a6: pointer to original bcd value
#	(*) fp0: mantissa accumulator
#	( )  FP_SCR1: working copy of original bcd value
#	( )  L_SCR1: copy of original exponent word
#
calc_m:
	mov.l		&1,%d1			# word counter, init to 1
	fmov.s		&0x00000000,%fp0	# accumulator
#
#
#  Since the packed number has a long word between the first & second parts,
#  get the integer digit then skip down & get the rest of the
#  mantissa.  We will unroll the loop once.
#
	bfextu		(%a0){&28:&4},%d0	# integer part is ls digit in long word
	fadd.b		%d0,%fp0		# add digit to sum in fp0
#
#
#  Get the rest of the mantissa.
#
loadlw:
	mov.l		(%a0,%d1.L*4),%d4	# load mantissa lonqword into d4
	mov.l		&FSTRT,%d3		# counter to pick up digits
	mov.l		&FNIBS,%d2		# reset number of digits per a0 ptr
md2b:
	fmul.s		&0x41200000,%fp0	# fp0 = fp0 * 10
	bfextu		%d4{%d3:&4},%d0		# get the digit and zero extend
	fadd.b		%d0,%fp0		# fp0 = fp0 + digit
#
#
#  If all the digits (8) in that long word have been converted (d2=0),
#  then inc d1 (=2) to point to the next long word and reset d3 to 0
#  to initialize the digit offset, and set d2 to 7 for the digit count;
#  else continue with this long word.
#
	addq.b		&4,%d3			# advance d3 to the next digit
	dbf.w		%d2,md2b		# check for last digit in this lw
nextlw:
	addq.l		&1,%d1			# inc lw pointer in mantissa
	cmp.l		%d1,&2			# test for last lw
	ble.b		loadlw			# if not, get last one
#
#  Check the sign of the mant and make the value in fp0 the same sign.
#
m_sign:
	btst		&31,(%a0)		# test sign of the mantissa
	beq.b		ap_st_z			# if clear, go to append/strip zeros
	fneg.x		%fp0			# if set, negate fp0
#
# Append/strip zeros:
#
#  For adjusted exponents which have an absolute value greater than 27*,
#  this routine calculates the amount needed to normalize the mantissa
#  for the adjusted exponent.  That number is subtracted from the exp
#  if the exp was positive, and added if it was negative.  The purpose
#  of this is to reduce the value of the exponent and the possibility
#  of error in calculation of pwrten.
#
#  1. Branch on the sign of the adjusted exponent.
#  2p.(positive exp)
#   2. Check M16 and the digits in lwords 2 and 3 in descending order.
#   3. Add one for each zero encountered until a non-zero digit.
#   4. Subtract the count from the exp.
#   5. Check if the exp has crossed zero in #3 above; make the exp abs
#	   and set SE.
#	6. Multiply the mantissa by 10**count.
#  2n.(negative exp)
#   2. Check the digits in lwords 3 and 2 in descending order.
#   3. Add one for each zero encountered until a non-zero digit.
#   4. Add the count to the exp.
#   5. Check if the exp has crossed zero in #3 above; clear SE.
#   6. Divide the mantissa by 10**count.
#
#  *Why 27?  If the adjusted exponent is within -28 < expA < 28, than
#   any adjustment due to append/strip zeros will drive the resultane
#   exponent towards zero.  Since all pwrten constants with a power
#   of 27 or less are exact, there is no need to use this routine to
#   attempt to lessen the resultant exponent.
#
# Register usage:
#
#  ap_st_z:
#	(*)  d0: temp digit storage
#	(*)  d1: zero count
#	(*)  d2: digit count
#	(*)  d3: offset pointer
#	( )  d4: first word of bcd
#	(*)  d5: lword counter
#	( )  a0: pointer to working bcd value
#	( )  FP_SCR1: working copy of original bcd value
#	( )  L_SCR1: copy of original exponent word
#
#
# First check the absolute value of the exponent to see if this
# routine is necessary.  If so, then check the sign of the exponent
# and do append (+) or strip (-) zeros accordingly.
# This section handles a positive adjusted exponent.
#
ap_st_z:
	mov.l		(%sp),%d1		# load expA for range test
	cmp.l		%d1,&27			# test is with 27
	ble.w		pwrten			# if abs(expA) <28, skip ap/st zeros
	btst		&30,(%a0)		# check sign of exp
	bne.b		ap_st_n			# if neg, go to neg side
	clr.l		%d1			# zero count reg
	mov.l		(%a0),%d4		# load lword 1 to d4
	bfextu		%d4{&28:&4},%d0		# get M16 in d0
	bne.b		ap_p_fx			# if M16 is non-zero, go fix exp
	addq.l		&1,%d1			# inc zero count
	mov.l		&1,%d5			# init lword counter
	mov.l		(%a0,%d5.L*4),%d4	# get lword 2 to d4
	bne.b		ap_p_cl			# if lw 2 is zero, skip it
	addq.l		&8,%d1			# and inc count by 8
	addq.l		&1,%d5			# inc lword counter
	mov.l		(%a0,%d5.L*4),%d4	# get lword 3 to d4
ap_p_cl:
	clr.l		%d3			# init offset reg
	mov.l		&7,%d2			# init digit counter
ap_p_gd:
	bfextu		%d4{%d3:&4},%d0		# get digit
	bne.b		ap_p_fx			# if non-zero, go to fix exp
	addq.l		&4,%d3			# point to next digit
	addq.l		&1,%d1			# inc digit counter
	dbf.w		%d2,ap_p_gd		# get next digit
ap_p_fx:
	mov.l		%d1,%d0			# copy counter to d2
	mov.l		(%sp),%d1		# get adjusted exp from memory
	sub.l		%d0,%d1			# subtract count from exp
	bge.b		ap_p_fm			# if still pos, go to pwrten
	neg.l		%d1			# now its neg; get abs
	mov.l		(%a0),%d4		# load lword 1 to d4
	or.l		&0x40000000,%d4		# and set SE in d4
	or.l		&0x40000000,(%a0)	# and in memory
#
# Calculate the mantissa multiplier to compensate for the striping of
# zeros from the mantissa.
#
ap_p_fm:
	lea.l		PTENRN(%pc),%a1		# get address of power-of-ten table
	clr.l		%d3			# init table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
	mov.l		&3,%d2			# init d2 to count bits in counter
ap_p_el:
	asr.l		&1,%d0			# shift lsb into carry
	bcc.b		ap_p_en			# if 1, mul fp1 by pwrten factor
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
ap_p_en:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		ap_p_el			# if not, get next bit
	fmul.x		%fp1,%fp0		# mul mantissa by 10**(no_bits_shifted)
	bra.b		pwrten			# go calc pwrten
#
# This section handles a negative adjusted exponent.
#
ap_st_n:
	clr.l		%d1			# clr counter
	mov.l		&2,%d5			# set up d5 to point to lword 3
	mov.l		(%a0,%d5.L*4),%d4	# get lword 3
	bne.b		ap_n_cl			# if not zero, check digits
	sub.l		&1,%d5			# dec d5 to point to lword 2
	addq.l		&8,%d1			# inc counter by 8
	mov.l		(%a0,%d5.L*4),%d4	# get lword 2
ap_n_cl:
	mov.l		&28,%d3			# point to last digit
	mov.l		&7,%d2			# init digit counter
ap_n_gd:
	bfextu		%d4{%d3:&4},%d0		# get digit
	bne.b		ap_n_fx			# if non-zero, go to exp fix
	subq.l		&4,%d3			# point to previous digit
	addq.l		&1,%d1			# inc digit counter
	dbf.w		%d2,ap_n_gd		# get next digit
ap_n_fx:
	mov.l		%d1,%d0			# copy counter to d0
	mov.l		(%sp),%d1		# get adjusted exp from memory
	sub.l		%d0,%d1			# subtract count from exp
	bgt.b		ap_n_fm			# if still pos, go fix mantissa
	neg.l		%d1			# take abs of exp and clr SE
	mov.l		(%a0),%d4		# load lword 1 to d4
	and.l		&0xbfffffff,%d4		# and clr SE in d4
	and.l		&0xbfffffff,(%a0)	# and in memory
#
# Calculate the mantissa multiplier to compensate for the appending of
# zeros to the mantissa.
#
ap_n_fm:
	lea.l		PTENRN(%pc),%a1		# get address of power-of-ten table
	clr.l		%d3			# init table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
	mov.l		&3,%d2			# init d2 to count bits in counter
ap_n_el:
	asr.l		&1,%d0			# shift lsb into carry
	bcc.b		ap_n_en			# if 1, mul fp1 by pwrten factor
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
ap_n_en:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		ap_n_el			# if not, get next bit
	fdiv.x		%fp1,%fp0		# div mantissa by 10**(no_bits_shifted)
#
#
# Calculate power-of-ten factor from adjusted and shifted exponent.
#
# Register usage:
#
#  pwrten:
#	(*)  d0: temp
#	( )  d1: exponent
#	(*)  d2: {FPCR[6:5],SM,SE} as index in RTABLE; temp
#	(*)  d3: FPCR work copy
#	( )  d4: first word of bcd
#	(*)  a1: RTABLE pointer
#  calc_p:
#	(*)  d0: temp
#	( )  d1: exponent
#	(*)  d3: PWRTxx table index
#	( )  a0: pointer to working copy of bcd
#	(*)  a1: PWRTxx pointer
#	(*) fp1: power-of-ten accumulator
#
# Pwrten calculates the exponent factor in the selected rounding mode
# according to the following table:
#
#	Sign of Mant  Sign of Exp  Rounding Mode  PWRTEN Rounding Mode
#
#	ANY	  ANY	RN	RN
#
#	 +	   +	RP	RP
#	 -	   +	RP	RM
#	 +	   -	RP	RM
#	 -	   -	RP	RP
#
#	 +	   +	RM	RM
#	 -	   +	RM	RP
#	 +	   -	RM	RP
#	 -	   -	RM	RM
#
#	 +	   +	RZ	RM
#	 -	   +	RZ	RM
#	 +	   -	RZ	RP
#	 -	   -	RZ	RP
#
#
pwrten:
	mov.l		USER_FPCR(%a6),%d3	# get user's FPCR
	bfextu		%d3{&26:&2},%d2		# isolate rounding mode bits
	mov.l		(%a0),%d4		# reload 1st bcd word to d4
	asl.l		&2,%d2			# format d2 to be
	bfextu		%d4{&0:&2},%d0		# {FPCR[6],FPCR[5],SM,SE}
	add.l		%d0,%d2			# in d2 as index into RTABLE
	lea.l		RTABLE(%pc),%a1		# load rtable base
	mov.b		(%a1,%d2),%d0		# load new rounding bits from table
	clr.l		%d3			# clear d3 to force no exc and extended
	bfins		%d0,%d3{&26:&2}		# stuff new rounding bits in FPCR
	fmov.l		%d3,%fpcr		# write new FPCR
	asr.l		&1,%d0			# write correct PTENxx table
	bcc.b		not_rp			# to a1
	lea.l		PTENRP(%pc),%a1		# it is RP
	bra.b		calc_p			# go to init section
not_rp:
	asr.l		&1,%d0			# keep checking
	bcc.b		not_rm
	lea.l		PTENRM(%pc),%a1		# it is RM
	bra.b		calc_p			# go to init section
not_rm:
	lea.l		PTENRN(%pc),%a1		# it is RN
calc_p:
	mov.l		%d1,%d0			# copy exp to d0;use d0
	bpl.b		no_neg			# if exp is negative,
	neg.l		%d0			# invert it
	or.l		&0x40000000,(%a0)	# and set SE bit
no_neg:
	clr.l		%d3			# table index
	fmov.s		&0x3f800000,%fp1	# init fp1 to 1
e_loop:
	asr.l		&1,%d0			# shift next bit into carry
	bcc.b		e_next			# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp1		# mul by 10**(d3_bit_no)
e_next:
	add.l		&12,%d3			# inc d3 to next rtable entry
	tst.l		%d0			# check if d0 is zero
	bne.b		e_loop			# not zero, continue shifting
#
#
#  Check the sign of the adjusted exp and make the value in fp0 the
#  same sign. If the exp was pos then multiply fp1*fp0;
#  else divide fp0/fp1.
#
# Register Usage:
#  norm:
#	( )  a0: pointer to working bcd value
#	(*) fp0: mantissa accumulator
#	( ) fp1: scaling factor - 10**(abs(exp))
#
pnorm:
	btst		&30,(%a0)		# test the sign of the exponent
	beq.b		mul			# if clear, go to multiply
div:
	fdiv.x		%fp1,%fp0		# exp is negative, so divide mant by exp
	bra.b		end_dec
mul:
	fmul.x		%fp1,%fp0		# exp is positive, so multiply by exp
#
#
# Clean up and return with result in fp0.
#
# If the final mul/div in decbin incurred an inex exception,
# it will be inex2, but will be reported as inex1 by get_op.
#
end_dec:
	fmov.l		%fpsr,%d0		# get status register
	bclr		&inex2_bit+8,%d0	# test for inex2 and clear it
	beq.b		no_exc			# skip this if no exc
	ori.w		&inx1a_mask,2+USER_FPSR(%a6) # set INEX1/AINEX
no_exc:
	add.l		&0x4,%sp		# clear 1 lw param
	fmovm.x		(%sp)+,&0x40		# restore fp1
	movm.l		(%sp)+,&0x3c		# restore d2-d5
	fmov.l		&0x0,%fpcr
	fmov.l		&0x0,%fpsr
	rts

#########################################################################
# bindec(): Converts an input in extended precision format to bcd format#
#									#
# INPUT ***************************************************************	#
#	a0 = pointer to the input extended precision value in memory.	#
#	     the input may be either normalized, unnormalized, or	#
#	     denormalized.						#
#	d0 = contains the k-factor sign-extended to 32-bits.		#
#									#
# OUTPUT **************************************************************	#
#	FP_SCR0(a6) = bcd format result on the stack.			#
#									#
# ALGORITHM ***********************************************************	#
#									#
#	A1.	Set RM and size ext;  Set SIGMA = sign of input.	#
#		The k-factor is saved for use in d7. Clear the		#
#		BINDEC_FLG for separating normalized/denormalized	#
#		input.  If input is unnormalized or denormalized,	#
#		normalize it.						#
#									#
#	A2.	Set X = abs(input).					#
#									#
#	A3.	Compute ILOG.						#
#		ILOG is the log base 10 of the input value.  It is	#
#		approximated by adding e + 0.f when the original	#
#		value is viewed as 2^^e * 1.f in extended precision.	#
#		This value is stored in d6.				#
#									#
#	A4.	Clr INEX bit.						#
#		The operation in A3 above may have set INEX2.		#
#									#
#	A5.	Set ICTR = 0;						#
#		ICTR is a flag used in A13.  It must be set before the	#
#		loop entry A6.						#
#									#
#	A6.	Calculate LEN.						#
#		LEN is the number of digits to be displayed.  The	#
#		k-factor can dictate either the total number of digits,	#
#		if it is a positive number, or the number of digits	#
#		after the decimal point which are to be included as	#
#		significant.  See the 68882 manual for examples.	#
#		If LEN is computed to be greater than 17, set OPERR in	#
#		USER_FPSR.  LEN is stored in d4.			#
#									#
#	A7.	Calculate SCALE.					#
#		SCALE is equal to 10^ISCALE, where ISCALE is the number	#
#		of decimal places needed to insure LEN integer digits	#
#		in the output before conversion to bcd. LAMBDA is the	#
#		sign of ISCALE, used in A9. Fp1 contains		#
#		10^^(abs(ISCALE)) using a rounding mode which is a	#
#		function of the original rounding mode and the signs	#
#		of ISCALE and X.  A table is given in the code.		#
#									#
#	A8.	Clr INEX; Force RZ.					#
#		The operation in A3 above may have set INEX2.		#
#		RZ mode is forced for the scaling operation to insure	#
#		only one rounding error.  The grs bits are collected in #
#		the INEX flag for use in A10.				#
#									#
#	A9.	Scale X -> Y.						#
#		The mantissa is scaled to the desired number of		#
#		significant digits.  The excess digits are collected	#
#		in INEX2.						#
#									#
#	A10.	Or in INEX.						#
#		If INEX is set, round error occurred.  This is		#
#		compensated for by 'or-ing' in the INEX2 flag to	#
#		the lsb of Y.						#
#									#
#	A11.	Restore original FPCR; set size ext.			#
#		Perform FINT operation in the user's rounding mode.	#
#		Keep the size to extended.				#
#									#
#	A12.	Calculate YINT = FINT(Y) according to user's rounding	#
#		mode.  The FPSP routine sintd0 is used.  The output	#
#		is in fp0.						#
#									#
#	A13.	Check for LEN digits.					#
#		If the int operation results in more than LEN digits,	#
#		or less than LEN -1 digits, adjust ILOG and repeat from	#
#		A6.  This test occurs only on the first pass.  If the	#
#		result is exactly 10^LEN, decrement ILOG and divide	#
#		the mantissa by 10.					#
#									#
#	A14.	Convert the mantissa to bcd.				#
#		The binstr routine is used to convert the LEN digit	#
#		mantissa to bcd in memory.  The input to binstr is	#
#		to be a fraction; i.e. (mantissa)/10^LEN and adjusted	#
#		such that the decimal point is to the left of bit 63.	#
#		The bcd digits are stored in the correct position in	#
#		the final string area in memory.			#
#									#
#	A15.	Convert the exponent to bcd.				#
#		As in A14 above, the exp is converted to bcd and the	#
#		digits are stored in the final string.			#
#		Test the length of the final exponent string.  If the	#
#		length is 4, set operr.					#
#									#
#	A16.	Write sign bits to final string.			#
#									#
#########################################################################

set	BINDEC_FLG,	EXC_TEMP	# DENORM flag

# Constants in extended precision
PLOG2:
	long		0x3FFD0000,0x9A209A84,0xFBCFF798,0x00000000
PLOG2UP1:
	long		0x3FFD0000,0x9A209A84,0xFBCFF799,0x00000000

# Constants in single precision
FONE:
	long		0x3F800000,0x00000000,0x00000000,0x00000000
FTWO:
	long		0x40000000,0x00000000,0x00000000,0x00000000
FTEN:
	long		0x41200000,0x00000000,0x00000000,0x00000000
F4933:
	long		0x459A2800,0x00000000,0x00000000,0x00000000

RBDTBL:
	byte		0,0,0,0
	byte		3,3,2,2
	byte		3,2,2,3
	byte		2,3,3,2

#	Implementation Notes:
#
#	The registers are used as follows:
#
#		d0: scratch; LEN input to binstr
#		d1: scratch
#		d2: upper 32-bits of mantissa for binstr
#		d3: scratch;lower 32-bits of mantissa for binstr
#		d4: LEN
#		d5: LAMBDA/ICTR
#		d6: ILOG
#		d7: k-factor
#		a0: ptr for original operand/final result
#		a1: scratch pointer
#		a2: pointer to FP_X; abs(original value) in ext
#		fp0: scratch
#		fp1: scratch
#		fp2: scratch
#		F_SCR1:
#		F_SCR2:
#		L_SCR1:
#		L_SCR2:

	global		bindec
bindec:
	movm.l		&0x3f20,-(%sp)	#  {%d2-%d7/%a2}
	fmovm.x		&0x7,-(%sp)	#  {%fp0-%fp2}

# A1. Set RM and size ext. Set SIGMA = sign input;
#     The k-factor is saved for use in d7.  Clear BINDEC_FLG for
#     separating  normalized/denormalized input.  If the input
#     is a denormalized number, set the BINDEC_FLG memory word
#     to signal denorm.  If the input is unnormalized, normalize
#     the input and test for denormalized result.
#
	fmov.l		&rm_mode*0x10,%fpcr	# set RM and ext
	mov.l		(%a0),L_SCR2(%a6)	# save exponent for sign check
	mov.l		%d0,%d7		# move k-factor to d7

	clr.b		BINDEC_FLG(%a6)	# clr norm/denorm flag
	cmpi.b		STAG(%a6),&DENORM # is input a DENORM?
	bne.w		A2_str		# no; input is a NORM

#
# Normalize the denorm
#
un_de_norm:
	mov.w		(%a0),%d0
	and.w		&0x7fff,%d0	# strip sign of normalized exp
	mov.l		4(%a0),%d1
	mov.l		8(%a0),%d2
norm_loop:
	sub.w		&1,%d0
	lsl.l		&1,%d2
	roxl.l		&1,%d1
	tst.l		%d1
	bge.b		norm_loop
#
# Test if the normalized input is denormalized
#
	tst.w		%d0
	bgt.b		pos_exp		# if greater than zero, it is a norm
	st		BINDEC_FLG(%a6)	# set flag for denorm
pos_exp:
	and.w		&0x7fff,%d0	# strip sign of normalized exp
	mov.w		%d0,(%a0)
	mov.l		%d1,4(%a0)
	mov.l		%d2,8(%a0)

# A2. Set X = abs(input).
#
A2_str:
	mov.l		(%a0),FP_SCR1(%a6)	# move input to work space
	mov.l		4(%a0),FP_SCR1+4(%a6)	# move input to work space
	mov.l		8(%a0),FP_SCR1+8(%a6)	# move input to work space
	and.l		&0x7fffffff,FP_SCR1(%a6)	# create abs(X)

# A3. Compute ILOG.
#     ILOG is the log base 10 of the input value.  It is approx-
#     imated by adding e + 0.f when the original value is viewed
#     as 2^^e * 1.f in extended precision.  This value is stored
#     in d6.
#
# Register usage:
#	Input/Output
#	d0: k-factor/exponent
#	d2: x/x
#	d3: x/x
#	d4: x/x
#	d5: x/x
#	d6: x/ILOG
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/x
#	a2: x/x
#	fp0: x/float(ILOG)
#	fp1: x/x
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X)/Abs(X) with $3fff exponent
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.b		A3_cont		# if clr, continue with norm
	mov.l		&-4933,%d6	# force ILOG = -4933
	bra.b		A4_str
A3_cont:
	mov.w		FP_SCR1(%a6),%d0	# move exp to d0
	mov.w		&0x3fff,FP_SCR1(%a6)	# replace exponent with 0x3fff
	fmov.x		FP_SCR1(%a6),%fp0	# now fp0 has 1.f
	sub.w		&0x3fff,%d0	# strip off bias
	fadd.w		%d0,%fp0	# add in exp
	fsub.s		FONE(%pc),%fp0	# subtract off 1.0
	fbge.w		pos_res		# if pos, branch
	fmul.x		PLOG2UP1(%pc),%fp0	# if neg, mul by LOG2UP1
	fmov.l		%fp0,%d6	# put ILOG in d6 as a lword
	bra.b		A4_str		# go move out ILOG
pos_res:
	fmul.x		PLOG2(%pc),%fp0	# if pos, mul by LOG2
	fmov.l		%fp0,%d6	# put ILOG in d6 as a lword


# A4. Clr INEX bit.
#     The operation in A3 above may have set INEX2.

A4_str:
	fmov.l		&0,%fpsr	# zero all of fpsr - nothing needed


# A5. Set ICTR = 0;
#     ICTR is a flag used in A13.  It must be set before the
#     loop entry A6. The lower word of d5 is used for ICTR.

	clr.w		%d5		# clear ICTR

# A6. Calculate LEN.
#     LEN is the number of digits to be displayed.  The k-factor
#     can dictate either the total number of digits, if it is
#     a positive number, or the number of digits after the
#     original decimal point which are to be included as
#     significant.  See the 68882 manual for examples.
#     If LEN is computed to be greater than 17, set OPERR in
#     USER_FPSR.  LEN is stored in d4.
#
# Register usage:
#	Input/Output
#	d0: exponent/Unchanged
#	d2: x/x/scratch
#	d3: x/x
#	d4: exc picture/LEN
#	d5: ICTR/Unchanged
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/x
#	a2: x/x
#	fp0: float(ILOG)/Unchanged
#	fp1: x/x
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A6_str:
	tst.l		%d7		# branch on sign of k
	ble.b		k_neg		# if k <= 0, LEN = ILOG + 1 - k
	mov.l		%d7,%d4		# if k > 0, LEN = k
	bra.b		len_ck		# skip to LEN check
k_neg:
	mov.l		%d6,%d4		# first load ILOG to d4
	sub.l		%d7,%d4		# subtract off k
	addq.l		&1,%d4		# add in the 1
len_ck:
	tst.l		%d4		# LEN check: branch on sign of LEN
	ble.b		LEN_ng		# if neg, set LEN = 1
	cmp.l		%d4,&17		# test if LEN > 17
	ble.b		A7_str		# if not, forget it
	mov.l		&17,%d4		# set max LEN = 17
	tst.l		%d7		# if negative, never set OPERR
	ble.b		A7_str		# if positive, continue
	or.l		&opaop_mask,USER_FPSR(%a6)	# set OPERR & AIOP in USER_FPSR
	bra.b		A7_str		# finished here
LEN_ng:
	mov.l		&1,%d4		# min LEN is 1


# A7. Calculate SCALE.
#     SCALE is equal to 10^ISCALE, where ISCALE is the number
#     of decimal places needed to insure LEN integer digits
#     in the output before conversion to bcd. LAMBDA is the sign
#     of ISCALE, used in A9.  Fp1 contains 10^^(abs(ISCALE)) using
#     the rounding mode as given in the following table (see
#     Coonen, p. 7.23 as ref.; however, the SCALE variable is
#     of opposite sign in bindec.sa from Coonen).
#
#	Initial					USE
#	FPCR[6:5]	LAMBDA	SIGN(X)		FPCR[6:5]
#	----------------------------------------------
#	 RN	00	   0	   0		00/0	RN
#	 RN	00	   0	   1		00/0	RN
#	 RN	00	   1	   0		00/0	RN
#	 RN	00	   1	   1		00/0	RN
#	 RZ	01	   0	   0		11/3	RP
#	 RZ	01	   0	   1		11/3	RP
#	 RZ	01	   1	   0		10/2	RM
#	 RZ	01	   1	   1		10/2	RM
#	 RM	10	   0	   0		11/3	RP
#	 RM	10	   0	   1		10/2	RM
#	 RM	10	   1	   0		10/2	RM
#	 RM	10	   1	   1		11/3	RP
#	 RP	11	   0	   0		10/2	RM
#	 RP	11	   0	   1		11/3	RP
#	 RP	11	   1	   0		11/3	RP
#	 RP	11	   1	   1		10/2	RM
#
# Register usage:
#	Input/Output
#	d0: exponent/scratch - final is 0
#	d2: x/0 or 24 for A9
#	d3: x/scratch - offset ptr into PTENRM array
#	d4: LEN/Unchanged
#	d5: 0/ICTR:LAMBDA
#	d6: ILOG/ILOG or k if ((k<=0)&(ILOG<k))
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: x/ptr to PTENRM array
#	a2: x/x
#	fp0: float(ILOG)/Unchanged
#	fp1: x/10^ISCALE
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A7_str:
	tst.l		%d7		# test sign of k
	bgt.b		k_pos		# if pos and > 0, skip this
	cmp.l		%d7,%d6		# test k - ILOG
	blt.b		k_pos		# if ILOG >= k, skip this
	mov.l		%d7,%d6		# if ((k<0) & (ILOG < k)) ILOG = k
k_pos:
	mov.l		%d6,%d0		# calc ILOG + 1 - LEN in d0
	addq.l		&1,%d0		# add the 1
	sub.l		%d4,%d0		# sub off LEN
	swap		%d5		# use upper word of d5 for LAMBDA
	clr.w		%d5		# set it zero initially
	clr.w		%d2		# set up d2 for very small case
	tst.l		%d0		# test sign of ISCALE
	bge.b		iscale		# if pos, skip next inst
	addq.w		&1,%d5		# if neg, set LAMBDA true
	cmp.l		%d0,&0xffffecd4	# test iscale <= -4908
	bgt.b		no_inf		# if false, skip rest
	add.l		&24,%d0		# add in 24 to iscale
	mov.l		&24,%d2		# put 24 in d2 for A9
no_inf:
	neg.l		%d0		# and take abs of ISCALE
iscale:
	fmov.s		FONE(%pc),%fp1	# init fp1 to 1
	bfextu		USER_FPCR(%a6){&26:&2},%d1	# get initial rmode bits
	lsl.w		&1,%d1		# put them in bits 2:1
	add.w		%d5,%d1		# add in LAMBDA
	lsl.w		&1,%d1		# put them in bits 3:1
	tst.l		L_SCR2(%a6)	# test sign of original x
	bge.b		x_pos		# if pos, don't set bit 0
	addq.l		&1,%d1		# if neg, set bit 0
x_pos:
	lea.l		RBDTBL(%pc),%a2	# load rbdtbl base
	mov.b		(%a2,%d1),%d3	# load d3 with new rmode
	lsl.l		&4,%d3		# put bits in proper position
	fmov.l		%d3,%fpcr	# load bits into fpu
	lsr.l		&4,%d3		# put bits in proper position
	tst.b		%d3		# decode new rmode for pten table
	bne.b		not_rn		# if zero, it is RN
	lea.l		PTENRN(%pc),%a1	# load a1 with RN table base
	bra.b		rmode		# exit decode
not_rn:
	lsr.b		&1,%d3		# get lsb in carry
	bcc.b		not_rp2		# if carry clear, it is RM
	lea.l		PTENRP(%pc),%a1	# load a1 with RP table base
	bra.b		rmode		# exit decode
not_rp2:
	lea.l		PTENRM(%pc),%a1	# load a1 with RM table base
rmode:
	clr.l		%d3		# clr table index
e_loop2:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		e_next2		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp1	# mul by 10**(d3_bit_no)
e_next2:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if ISCALE is zero
	bne.b		e_loop2		# if not, loop

# A8. Clr INEX; Force RZ.
#     The operation in A3 above may have set INEX2.
#     RZ mode is forced for the scaling operation to insure
#     only one rounding error.  The grs bits are collected in
#     the INEX flag for use in A10.
#
# Register usage:
#	Input/Output

	fmov.l		&0,%fpsr	# clr INEX
	fmov.l		&rz_mode*0x10,%fpcr	# set RZ rounding mode

# A9. Scale X -> Y.
#     The mantissa is scaled to the desired number of significant
#     digits.  The excess digits are collected in INEX2. If mul,
#     Check d2 for excess 10 exponential value.  If not zero,
#     the iscale value would have caused the pwrten calculation
#     to overflow.  Only a negative iscale can cause this, so
#     multiply by 10^(d2), which is now only allowed to be 24,
#     with a multiply by 10^8 and 10^16, which is exact since
#     10^24 is exact.  If the input was denormalized, we must
#     create a busy stack frame with the mul command and the
#     two operands, and allow the fpu to complete the multiply.
#
# Register usage:
#	Input/Output
#	d0: FPCR with RZ mode/Unchanged
#	d2: 0 or 24/unchanged
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: ptr to PTENRM array/Unchanged
#	a2: x/x
#	fp0: float(ILOG)/X adjusted for SCALE (Y)
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Abs(X) with $3fff exponent/Unchanged
#	L_SCR1:x/x
#	L_SCR2:first word of X packed/Unchanged

A9_str:
	fmov.x		(%a0),%fp0	# load X from memory
	fabs.x		%fp0		# use abs(X)
	tst.w		%d5		# LAMBDA is in lower word of d5
	bne.b		sc_mul		# if neg (LAMBDA = 1), scale by mul
	fdiv.x		%fp1,%fp0	# calculate X / SCALE -> Y to fp0
	bra.w		A10_st		# branch to A10

sc_mul:
	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.w		A9_norm		# if norm, continue with mul

# for DENORM, we must calculate:
#	fp0 = input_op * 10^ISCALE * 10^24
# since the input operand is a DENORM, we can't multiply it directly.
# so, we do the multiplication of the exponents and mantissas separately.
# in this way, we avoid underflow on intermediate stages of the
# multiplication and guarantee a result without exception.
	fmovm.x		&0x2,-(%sp)	# save 10^ISCALE to stack

	mov.w		(%sp),%d3	# grab exponent
	andi.w		&0x7fff,%d3	# clear sign
	ori.w		&0x8000,(%a0)	# make DENORM exp negative
	add.w		(%a0),%d3	# add DENORM exp to 10^ISCALE exp
	subi.w		&0x3fff,%d3	# subtract BIAS
	add.w		36(%a1),%d3
	subi.w		&0x3fff,%d3	# subtract BIAS
	add.w		48(%a1),%d3
	subi.w		&0x3fff,%d3	# subtract BIAS

	bmi.w		sc_mul_err	# is result is DENORM, punt!!!

	andi.w		&0x8000,(%sp)	# keep sign
	or.w		%d3,(%sp)	# insert new exponent
	andi.w		&0x7fff,(%a0)	# clear sign bit on DENORM again
	mov.l		0x8(%a0),-(%sp) # put input op mantissa on stk
	mov.l		0x4(%a0),-(%sp)
	mov.l		&0x3fff0000,-(%sp) # force exp to zero
	fmovm.x		(%sp)+,&0x80	# load normalized DENORM into fp0
	fmul.x		(%sp)+,%fp0

#	fmul.x	36(%a1),%fp0	# multiply fp0 by 10^8
#	fmul.x	48(%a1),%fp0	# multiply fp0 by 10^16
	mov.l		36+8(%a1),-(%sp) # get 10^8 mantissa
	mov.l		36+4(%a1),-(%sp)
	mov.l		&0x3fff0000,-(%sp) # force exp to zero
	mov.l		48+8(%a1),-(%sp) # get 10^16 mantissa
	mov.l		48+4(%a1),-(%sp)
	mov.l		&0x3fff0000,-(%sp)# force exp to zero
	fmul.x		(%sp)+,%fp0	# multiply fp0 by 10^8
	fmul.x		(%sp)+,%fp0	# multiply fp0 by 10^16
	bra.b		A10_st

sc_mul_err:
	bra.b		sc_mul_err

A9_norm:
	tst.w		%d2		# test for small exp case
	beq.b		A9_con		# if zero, continue as normal
	fmul.x		36(%a1),%fp0	# multiply fp0 by 10^8
	fmul.x		48(%a1),%fp0	# multiply fp0 by 10^16
A9_con:
	fmul.x		%fp1,%fp0	# calculate X * SCALE -> Y to fp0

# A10. Or in INEX.
#      If INEX is set, round error occurred.  This is compensated
#      for by 'or-ing' in the INEX2 flag to the lsb of Y.
#
# Register usage:
#	Input/Output
#	d0: FPCR with RZ mode/FPSR with INEX2 isolated
#	d2: x/x
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/final result
#	a1: ptr to PTENxx array/Unchanged
#	a2: x/ptr to FP_SCR1(a6)
#	fp0: Y/Y with lsb adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x

A10_st:
	fmov.l		%fpsr,%d0	# get FPSR
	fmov.x		%fp0,FP_SCR1(%a6)	# move Y to memory
	lea.l		FP_SCR1(%a6),%a2	# load a2 with ptr to FP_SCR1
	btst		&9,%d0		# check if INEX2 set
	beq.b		A11_st		# if clear, skip rest
	or.l		&1,8(%a2)	# or in 1 to lsb of mantissa
	fmov.x		FP_SCR1(%a6),%fp0	# write adjusted Y back to fpu


# A11. Restore original FPCR; set size ext.
#      Perform FINT operation in the user's rounding mode.  Keep
#      the size to extended.  The sintdo entry point in the sint
#      routine expects the FPCR value to be in USER_FPCR for
#      mode and precision.  The original FPCR is saved in L_SCR1.

A11_st:
	mov.l		USER_FPCR(%a6),L_SCR1(%a6)	# save it for later
	and.l		&0x00000030,USER_FPCR(%a6)	# set size to ext,
#					;block exceptions


# A12. Calculate YINT = FINT(Y) according to user's rounding mode.
#      The FPSP routine sintd0 is used.  The output is in fp0.
#
# Register usage:
#	Input/Output
#	d0: FPSR with AINEX cleared/FPCR with size set to ext
#	d2: x/x/scratch
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/Unchanged
#	d6: ILOG/Unchanged
#	d7: k-factor/Unchanged
#	a0: ptr for original operand/src ptr for sintdo
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	a6: temp pointer to FP_SCR1(a6) - orig value saved and restored
#	fp0: Y/YINT
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/x
#	F_SCR1:x/x
#	F_SCR2:Y adjusted for inex/Y with original exponent
#	L_SCR1:x/original USER_FPCR
#	L_SCR2:first word of X packed/Unchanged

A12_st:
	movm.l	&0xc0c0,-(%sp)	# save regs used by sintd0	 {%d0-%d1/%a0-%a1}
	mov.l	L_SCR1(%a6),-(%sp)
	mov.l	L_SCR2(%a6),-(%sp)

	lea.l		FP_SCR1(%a6),%a0	# a0 is ptr to FP_SCR1(a6)
	fmov.x		%fp0,(%a0)	# move Y to memory at FP_SCR1(a6)
	tst.l		L_SCR2(%a6)	# test sign of original operand
	bge.b		do_fint12		# if pos, use Y
	or.l		&0x80000000,(%a0)	# if neg, use -Y
do_fint12:
	mov.l	USER_FPSR(%a6),-(%sp)
#	bsr	sintdo		# sint routine returns int in fp0

	fmov.l	USER_FPCR(%a6),%fpcr
	fmov.l	&0x0,%fpsr			# clear the AEXC bits!!!
##	mov.l		USER_FPCR(%a6),%d0	# ext prec/keep rnd mode
##	andi.l		&0x00000030,%d0
##	fmov.l		%d0,%fpcr
	fint.x		FP_SCR1(%a6),%fp0	# do fint()
	fmov.l	%fpsr,%d0
	or.w	%d0,FPSR_EXCEPT(%a6)
##	fmov.l		&0x0,%fpcr
##	fmov.l		%fpsr,%d0		# don't keep ccodes
##	or.w		%d0,FPSR_EXCEPT(%a6)

	mov.b	(%sp),USER_FPSR(%a6)
	add.l	&4,%sp

	mov.l	(%sp)+,L_SCR2(%a6)
	mov.l	(%sp)+,L_SCR1(%a6)
	movm.l	(%sp)+,&0x303	# restore regs used by sint	 {%d0-%d1/%a0-%a1}

	mov.l	L_SCR2(%a6),FP_SCR1(%a6)	# restore original exponent
	mov.l	L_SCR1(%a6),USER_FPCR(%a6)	# restore user's FPCR

# A13. Check for LEN digits.
#      If the int operation results in more than LEN digits,
#      or less than LEN -1 digits, adjust ILOG and repeat from
#      A6.  This test occurs only on the first pass.  If the
#      result is exactly 10^LEN, decrement ILOG and divide
#      the mantissa by 10.  The calculation of 10^LEN cannot
#      be inexact, since all powers of ten up to 10^27 are exact
#      in extended precision, so the use of a previous power-of-ten
#      table will introduce no error.
#
#
# Register usage:
#	Input/Output
#	d0: FPCR with size set to ext/scratch final = 0
#	d2: x/x
#	d3: x/scratch final = x
#	d4: LEN/LEN adjusted
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG/ILOG adjusted
#	d7: k-factor/Unchanged
#	a0: pointer into memory for packed bcd string formation
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: int portion of Y/abs(YINT) adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: x/10^LEN
#	F_SCR1:x/x
#	F_SCR2:Y with original exponent/Unchanged
#	L_SCR1:original USER_FPCR/Unchanged
#	L_SCR2:first word of X packed/Unchanged

A13_st:
	swap		%d5		# put ICTR in lower word of d5
	tst.w		%d5		# check if ICTR = 0
	bne		not_zr		# if non-zero, go to second test
#
# Compute 10^(LEN-1)
#
	fmov.s		FONE(%pc),%fp2	# init fp2 to 1.0
	mov.l		%d4,%d0		# put LEN in d0
	subq.l		&1,%d0		# d0 = LEN -1
	clr.l		%d3		# clr table index
l_loop:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		l_next		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp2	# mul by 10**(d3_bit_no)
l_next:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if LEN is zero
	bne.b		l_loop		# if not, loop
#
# 10^LEN-1 is computed for this test and A14.  If the input was
# denormalized, check only the case in which YINT > 10^LEN.
#
	tst.b		BINDEC_FLG(%a6)	# check if input was norm
	beq.b		A13_con		# if norm, continue with checking
	fabs.x		%fp0		# take abs of YINT
	bra		test_2
#
# Compare abs(YINT) to 10^(LEN-1) and 10^LEN
#
A13_con:
	fabs.x		%fp0		# take abs of YINT
	fcmp.x		%fp0,%fp2	# compare abs(YINT) with 10^(LEN-1)
	fbge.w		test_2		# if greater, do next test
	subq.l		&1,%d6		# subtract 1 from ILOG
	mov.w		&1,%d5		# set ICTR
	fmov.l		&rm_mode*0x10,%fpcr	# set rmode to RM
	fmul.s		FTEN(%pc),%fp2	# compute 10^LEN
	bra.w		A6_str		# return to A6 and recompute YINT
test_2:
	fmul.s		FTEN(%pc),%fp2	# compute 10^LEN
	fcmp.x		%fp0,%fp2	# compare abs(YINT) with 10^LEN
	fblt.w		A14_st		# if less, all is ok, go to A14
	fbgt.w		fix_ex		# if greater, fix and redo
	fdiv.s		FTEN(%pc),%fp0	# if equal, divide by 10
	addq.l		&1,%d6		# and inc ILOG
	bra.b		A14_st		# and continue elsewhere
fix_ex:
	addq.l		&1,%d6		# increment ILOG by 1
	mov.w		&1,%d5		# set ICTR
	fmov.l		&rm_mode*0x10,%fpcr	# set rmode to RM
	bra.w		A6_str		# return to A6 and recompute YINT
#
# Since ICTR <> 0, we have already been through one adjustment,
# and shouldn't have another; this is to check if abs(YINT) = 10^LEN
# 10^LEN is again computed using whatever table is in a1 since the
# value calculated cannot be inexact.
#
not_zr:
	fmov.s		FONE(%pc),%fp2	# init fp2 to 1.0
	mov.l		%d4,%d0		# put LEN in d0
	clr.l		%d3		# clr table index
z_loop:
	lsr.l		&1,%d0		# shift next bit into carry
	bcc.b		z_next		# if zero, skip the mul
	fmul.x		(%a1,%d3),%fp2	# mul by 10**(d3_bit_no)
z_next:
	add.l		&12,%d3		# inc d3 to next pwrten table entry
	tst.l		%d0		# test if LEN is zero
	bne.b		z_loop		# if not, loop
	fabs.x		%fp0		# get abs(YINT)
	fcmp.x		%fp0,%fp2	# check if abs(YINT) = 10^LEN
	fbneq.w		A14_st		# if not, skip this
	fdiv.s		FTEN(%pc),%fp0	# divide abs(YINT) by 10
	addq.l		&1,%d6		# and inc ILOG by 1
	addq.l		&1,%d4		# and inc LEN
	fmul.s		FTEN(%pc),%fp2	# if LEN++, the get 10^^LEN

# A14. Convert the mantissa to bcd.
#      The binstr routine is used to convert the LEN digit
#      mantissa to bcd in memory.  The input to binstr is
#      to be a fraction; i.e. (mantissa)/10^LEN and adjusted
#      such that the decimal point is to the left of bit 63.
#      The bcd digits are stored in the correct position in
#      the final string area in memory.
#
#
# Register usage:
#	Input/Output
#	d0: x/LEN call to binstr - final is 0
#	d1: x/0
#	d2: x/ms 32-bits of mant of abs(YINT)
#	d3: x/ls 32-bits of mant of abs(YINT)
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG
#	d7: k-factor/Unchanged
#	a0: pointer into memory for packed bcd string formation
#	    /ptr to first mantissa byte in result string
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: int portion of Y/abs(YINT) adjusted
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:x/Work area for final result
#	F_SCR2:Y with original exponent/Unchanged
#	L_SCR1:original USER_FPCR/Unchanged
#	L_SCR2:first word of X packed/Unchanged

A14_st:
	fmov.l		&rz_mode*0x10,%fpcr	# force rz for conversion
	fdiv.x		%fp2,%fp0	# divide abs(YINT) by 10^LEN
	lea.l		FP_SCR0(%a6),%a0
	fmov.x		%fp0,(%a0)	# move abs(YINT)/10^LEN to memory
	mov.l		4(%a0),%d2	# move 2nd word of FP_RES to d2
	mov.l		8(%a0),%d3	# move 3rd word of FP_RES to d3
	clr.l		4(%a0)		# zero word 2 of FP_RES
	clr.l		8(%a0)		# zero word 3 of FP_RES
	mov.l		(%a0),%d0	# move exponent to d0
	swap		%d0		# put exponent in lower word
	beq.b		no_sft		# if zero, don't shift
	sub.l		&0x3ffd,%d0	# sub bias less 2 to make fract
	tst.l		%d0		# check if > 1
	bgt.b		no_sft		# if so, don't shift
	neg.l		%d0		# make exp positive
m_loop:
	lsr.l		&1,%d2		# shift d2:d3 right, add 0s
	roxr.l		&1,%d3		# the number of places
	dbf.w		%d0,m_loop	# given in d0
no_sft:
	tst.l		%d2		# check for mantissa of zero
	bne.b		no_zr		# if not, go on
	tst.l		%d3		# continue zero check
	beq.b		zer_m		# if zero, go directly to binstr
no_zr:
	clr.l		%d1		# put zero in d1 for addx
	add.l		&0x00000080,%d3	# inc at bit 7
	addx.l		%d1,%d2		# continue inc
	and.l		&0xffffff80,%d3	# strip off lsb not used by 882
zer_m:
	mov.l		%d4,%d0		# put LEN in d0 for binstr call
	addq.l		&3,%a0		# a0 points to M16 byte in result
	bsr		binstr		# call binstr to convert mant


# A15. Convert the exponent to bcd.
#      As in A14 above, the exp is converted to bcd and the
#      digits are stored in the final string.
#
#      Digits are stored in L_SCR1(a6) on return from BINDEC as:
#
#	 32               16 15                0
#	-----------------------------------------
#	|  0 | e3 | e2 | e1 | e4 |  X |  X |  X |
#	-----------------------------------------
#
# And are moved into their proper places in FP_SCR0.  If digit e4
# is non-zero, OPERR is signaled.  In all cases, all 4 digits are
# written as specified in the 881/882 manual for packed decimal.
#
# Register usage:
#	Input/Output
#	d0: x/LEN call to binstr - final is 0
#	d1: x/scratch (0);shift count for final exponent packing
#	d2: x/ms 32-bits of exp fraction/scratch
#	d3: x/ls 32-bits of exp fraction
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG
#	d7: k-factor/Unchanged
#	a0: ptr to result string/ptr to L_SCR1(a6)
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: abs(YINT) adjusted/float(ILOG)
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:Work area for final result/BCD result
#	F_SCR2:Y with original exponent/ILOG/10^4
#	L_SCR1:original USER_FPCR/Exponent digits on return from binstr
#	L_SCR2:first word of X packed/Unchanged

A15_st:
	tst.b		BINDEC_FLG(%a6)	# check for denorm
	beq.b		not_denorm
	ftest.x		%fp0		# test for zero
	fbeq.w		den_zero	# if zero, use k-factor or 4933
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
	bra.b		convrt
den_zero:
	tst.l		%d7		# check sign of the k-factor
	blt.b		use_ilog	# if negative, use ILOG
	fmov.s		F4933(%pc),%fp0	# force exponent to 4933
	bra.b		convrt		# do it
use_ilog:
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
	bra.b		convrt
not_denorm:
	ftest.x		%fp0		# test for zero
	fbneq.w		not_zero	# if zero, force exponent
	fmov.s		FONE(%pc),%fp0	# force exponent to 1
	bra.b		convrt		# do it
not_zero:
	fmov.l		%d6,%fp0	# float ILOG
	fabs.x		%fp0		# get abs of ILOG
convrt:
	fdiv.x		24(%a1),%fp0	# compute ILOG/10^4
	fmov.x		%fp0,FP_SCR1(%a6)	# store fp0 in memory
	mov.l		4(%a2),%d2	# move word 2 to d2
	mov.l		8(%a2),%d3	# move word 3 to d3
	mov.w		(%a2),%d0	# move exp to d0
	beq.b		x_loop_fin	# if zero, skip the shift
	sub.w		&0x3ffd,%d0	# subtract off bias
	neg.w		%d0		# make exp positive
x_loop:
	lsr.l		&1,%d2		# shift d2:d3 right
	roxr.l		&1,%d3		# the number of places
	dbf.w		%d0,x_loop	# given in d0
x_loop_fin:
	clr.l		%d1		# put zero in d1 for addx
	add.l		&0x00000080,%d3	# inc at bit 6
	addx.l		%d1,%d2		# continue inc
	and.l		&0xffffff80,%d3	# strip off lsb not used by 882
	mov.l		&4,%d0		# put 4 in d0 for binstr call
	lea.l		L_SCR1(%a6),%a0	# a0 is ptr to L_SCR1 for exp digits
	bsr		binstr		# call binstr to convert exp
	mov.l		L_SCR1(%a6),%d0	# load L_SCR1 lword to d0
	mov.l		&12,%d1		# use d1 for shift count
	lsr.l		%d1,%d0		# shift d0 right by 12
	bfins		%d0,FP_SCR0(%a6){&4:&12}	# put e3:e2:e1 in FP_SCR0
	lsr.l		%d1,%d0		# shift d0 right by 12
	bfins		%d0,FP_SCR0(%a6){&16:&4}	# put e4 in FP_SCR0
	tst.b		%d0		# check if e4 is zero
	beq.b		A16_st		# if zero, skip rest
	or.l		&opaop_mask,USER_FPSR(%a6)	# set OPERR & AIOP in USER_FPSR


# A16. Write sign bits to final string.
#	   Sigma is bit 31 of initial value; RHO is bit 31 of d6 (ILOG).
#
# Register usage:
#	Input/Output
#	d0: x/scratch - final is x
#	d2: x/x
#	d3: x/x
#	d4: LEN/Unchanged
#	d5: ICTR:LAMBDA/LAMBDA:ICTR
#	d6: ILOG/ILOG adjusted
#	d7: k-factor/Unchanged
#	a0: ptr to L_SCR1(a6)/Unchanged
#	a1: ptr to PTENxx array/Unchanged
#	a2: ptr to FP_SCR1(a6)/Unchanged
#	fp0: float(ILOG)/Unchanged
#	fp1: 10^ISCALE/Unchanged
#	fp2: 10^LEN/Unchanged
#	F_SCR1:BCD result with correct signs
#	F_SCR2:ILOG/10^4
#	L_SCR1:Exponent digits on return from binstr
#	L_SCR2:first word of X packed/Unchanged

A16_st:
	clr.l		%d0		# clr d0 for collection of signs
	and.b		&0x0f,FP_SCR0(%a6)	# clear first nibble of FP_SCR0
	tst.l		L_SCR2(%a6)	# check sign of original mantissa
	bge.b		mant_p		# if pos, don't set SM
	mov.l		&2,%d0		# move 2 in to d0 for SM
mant_p:
	tst.l		%d6		# check sign of ILOG
	bge.b		wr_sgn		# if pos, don't set SE
	addq.l		&1,%d0		# set bit 0 in d0 for SE
wr_sgn:
	bfins		%d0,FP_SCR0(%a6){&0:&2}	# insert SM and SE into FP_SCR0

# Clean up and restore all registers used.

	fmov.l		&0,%fpsr	# clear possible inex2/ainex bits
	fmovm.x		(%sp)+,&0xe0	#  {%fp0-%fp2}
	movm.l		(%sp)+,&0x4fc	#  {%d2-%d7/%a2}
	rts

	global		PTENRN
PTENRN:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59E	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D5	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CE0	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8E	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C7	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C17	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE5	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979B	# 10 ^ 4096

	global		PTENRP
PTENRP:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59E	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D6	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CE0	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8E	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C7	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C18	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE5	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979B	# 10 ^ 4096

	global		PTENRM
PTENRM:
	long		0x40020000,0xA0000000,0x00000000	# 10 ^ 1
	long		0x40050000,0xC8000000,0x00000000	# 10 ^ 2
	long		0x400C0000,0x9C400000,0x00000000	# 10 ^ 4
	long		0x40190000,0xBEBC2000,0x00000000	# 10 ^ 8
	long		0x40340000,0x8E1BC9BF,0x04000000	# 10 ^ 16
	long		0x40690000,0x9DC5ADA8,0x2B70B59D	# 10 ^ 32
	long		0x40D30000,0xC2781F49,0xFFCFA6D5	# 10 ^ 64
	long		0x41A80000,0x93BA47C9,0x80E98CDF	# 10 ^ 128
	long		0x43510000,0xAA7EEBFB,0x9DF9DE8D	# 10 ^ 256
	long		0x46A30000,0xE319A0AE,0xA60E91C6	# 10 ^ 512
	long		0x4D480000,0xC9767586,0x81750C17	# 10 ^ 1024
	long		0x5A920000,0x9E8B3B5D,0xC53D5DE4	# 10 ^ 2048
	long		0x75250000,0xC4605202,0x8A20979A	# 10 ^ 4096

#########################################################################
# binstr(): Converts a 64-bit binary integer to bcd.			#
#									#
# INPUT *************************************************************** #
#	d2:d3 = 64-bit binary integer					#
#	d0    = desired length (LEN)					#
#	a0    = pointer to start in memory for bcd characters		#
#		(This pointer must point to byte 4 of the first		#
#		 lword of the packed decimal memory string.)		#
#									#
# OUTPUT ************************************************************** #
#	a0 = pointer to LEN bcd digits representing the 64-bit integer.	#
#									#
# ALGORITHM ***********************************************************	#
#	The 64-bit binary is assumed to have a decimal point before	#
#	bit 63.  The fraction is multiplied by 10 using a mul by 2	#
#	shift and a mul by 8 shift.  The bits shifted out of the	#
#	msb form a decimal digit.  This process is iterated until	#
#	LEN digits are formed.						#
#									#
# A1. Init d7 to 1.  D7 is the byte digit counter, and if 1, the	#
#     digit formed will be assumed the least significant.  This is	#
#     to force the first byte formed to have a 0 in the upper 4 bits.	#
#									#
# A2. Beginning of the loop:						#
#     Copy the fraction in d2:d3 to d4:d5.				#
#									#
# A3. Multiply the fraction in d2:d3 by 8 using bit-field		#
#     extracts and shifts.  The three msbs from d2 will go into d1.	#
#									#
# A4. Multiply the fraction in d4:d5 by 2 using shifts.  The msb	#
#     will be collected by the carry.					#
#									#
# A5. Add using the carry the 64-bit quantities in d2:d3 and d4:d5	#
#     into d2:d3.  D1 will contain the bcd digit formed.		#
#									#
# A6. Test d7.  If zero, the digit formed is the ms digit.  If non-	#
#     zero, it is the ls digit.  Put the digit in its place in the	#
#     upper word of d0.  If it is the ls digit, write the word		#
#     from d0 to memory.						#
#									#
# A7. Decrement d6 (LEN counter) and repeat the loop until zero.	#
#									#
#########################################################################

#	Implementation Notes:
#
#	The registers are used as follows:
#
#		d0: LEN counter
#		d1: temp used to form the digit
#		d2: upper 32-bits of fraction for mul by 8
#		d3: lower 32-bits of fraction for mul by 8
#		d4: upper 32-bits of fraction for mul by 2
#		d5: lower 32-bits of fraction for mul by 2
#		d6: temp for bit-field extracts
#		d7: byte digit formation word;digit count {0,1}
#		a0: pointer into memory for packed bcd string formation
#

	global		binstr
binstr:
	movm.l		&0xff00,-(%sp)	#  {%d0-%d7}

#
# A1: Init d7
#
	mov.l		&1,%d7		# init d7 for second digit
	subq.l		&1,%d0		# for dbf d0 would have LEN+1 passes
#
# A2. Copy d2:d3 to d4:d5.  Start loop.
#
loop:
	mov.l		%d2,%d4		# copy the fraction before muls
	mov.l		%d3,%d5		# to d4:d5
#
# A3. Multiply d2:d3 by 8; extract msbs into d1.
#
	bfextu		%d2{&0:&3},%d1	# copy 3 msbs of d2 into d1
	asl.l		&3,%d2		# shift d2 left by 3 places
	bfextu		%d3{&0:&3},%d6	# copy 3 msbs of d3 into d6
	asl.l		&3,%d3		# shift d3 left by 3 places
	or.l		%d6,%d2		# or in msbs from d3 into d2
#
# A4. Multiply d4:d5 by 2; add carry out to d1.
#
	asl.l		&1,%d5		# mul d5 by 2
	roxl.l		&1,%d4		# mul d4 by 2
	swap		%d6		# put 0 in d6 lower word
	addx.w		%d6,%d1		# add in extend from mul by 2
#
# A5. Add mul by 8 to mul by 2.  D1 contains the digit formed.
#
	add.l		%d5,%d3		# add lower 32 bits
	nop				# ERRATA FIX #13 (Rev. 1.2 6/6/90)
	addx.l		%d4,%d2		# add with extend upper 32 bits
	nop				# ERRATA FIX #13 (Rev. 1.2 6/6/90)
	addx.w		%d6,%d1		# add in extend from add to d1
	swap		%d6		# with d6 = 0; put 0 in upper word
#
# A6. Test d7 and branch.
#
	tst.w		%d7		# if zero, store digit & to loop
	beq.b		first_d		# if non-zero, form byte & write
sec_d:
	swap		%d7		# bring first digit to word d7b
	asl.w		&4,%d7		# first digit in upper 4 bits d7b
	add.w		%d1,%d7		# add in ls digit to d7b
	mov.b		%d7,(%a0)+	# store d7b byte in memory
	swap		%d7		# put LEN counter in word d7a
	clr.w		%d7		# set d7a to signal no digits done
	dbf.w		%d0,loop	# do loop some more!
	bra.b		end_bstr	# finished, so exit
first_d:
	swap		%d7		# put digit word in d7b
	mov.w		%d1,%d7		# put new digit in d7b
	swap		%d7		# put LEN counter in word d7a
	addq.w		&1,%d7		# set d7a to signal first digit done
	dbf.w		%d0,loop	# do loop some more!
	swap		%d7		# put last digit in string
	lsl.w		&4,%d7		# move it to upper 4 bits
	mov.b		%d7,(%a0)+	# store it in memory string
#
# Clean up and return with result in fp0.
#
end_bstr:
	movm.l		(%sp)+,&0xff	#  {%d0-%d7}
	rts

#########################################################################
# XDEF ****************************************************************	#
#	facc_in_b(): dmem_read_byte failed				#
#	facc_in_w(): dmem_read_word failed				#
#	facc_in_l(): dmem_read_long failed				#
#	facc_in_d(): dmem_read of dbl prec failed			#
#	facc_in_x(): dmem_read of ext prec failed			#
#									#
#	facc_out_b(): dmem_write_byte failed				#
#	facc_out_w(): dmem_write_word failed				#
#	facc_out_l(): dmem_write_long failed				#
#	facc_out_d(): dmem_write of dbl prec failed			#
#	facc_out_x(): dmem_write of ext prec failed			#
#									#
# XREF ****************************************************************	#
#	_real_access() - exit through access error handler		#
#									#
# INPUT ***************************************************************	#
#	None								#
#									#
# OUTPUT **************************************************************	#
#	None								#
#									#
# ALGORITHM ***********************************************************	#
#	Flow jumps here when an FP data fetch call gets an error	#
# result. This means the operating system wants an access error frame	#
# made out of the current exception stack frame.			#
#	So, we first call restore() which makes sure that any updated	#
# -(an)+ register gets returned to its pre-exception value and then	#
# we change the stack to an access error stack frame.			#
#									#
#########################################################################

facc_in_b:
	movq.l		&0x1,%d0			# one byte
	bsr.w		restore				# fix An

	mov.w		&0x0121,EXC_VOFF(%a6)		# set FSLW
	bra.w		facc_finish

facc_in_w:
	movq.l		&0x2,%d0			# two bytes
	bsr.w		restore				# fix An

	mov.w		&0x0141,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_l:
	movq.l		&0x4,%d0			# four bytes
	bsr.w		restore				# fix An

	mov.w		&0x0101,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_d:
	movq.l		&0x8,%d0			# eight bytes
	bsr.w		restore				# fix An

	mov.w		&0x0161,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_in_x:
	movq.l		&0xc,%d0			# twelve bytes
	bsr.w		restore				# fix An

	mov.w		&0x0161,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

################################################################

facc_out_b:
	movq.l		&0x1,%d0			# one byte
	bsr.w		restore				# restore An

	mov.w		&0x00a1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_w:
	movq.l		&0x2,%d0			# two bytes
	bsr.w		restore				# restore An

	mov.w		&0x00c1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_l:
	movq.l		&0x4,%d0			# four bytes
	bsr.w		restore				# restore An

	mov.w		&0x0081,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_d:
	movq.l		&0x8,%d0			# eight bytes
	bsr.w		restore				# restore An

	mov.w		&0x00e1,EXC_VOFF(%a6)		# set FSLW
	bra.b		facc_finish

facc_out_x:
	mov.l		&0xc,%d0			# twelve bytes
	bsr.w		restore				# restore An

	mov.w		&0x00e1,EXC_VOFF(%a6)		# set FSLW

# here's where we actually create the access error frame from the
# current exception stack frame.
facc_finish:
	mov.l		USER_FPIAR(%a6),EXC_PC(%a6) # store current PC

	fmovm.x		EXC_FPREGS(%a6),&0xc0	# restore fp0-fp1
	fmovm.l		USER_FPCR(%a6),%fpcr,%fpsr,%fpiar # restore ctrl regs
	movm.l		EXC_DREGS(%a6),&0x0303	# restore d0-d1/a0-a1

	unlk		%a6

	mov.l		(%sp),-(%sp)		# store SR, hi(PC)
	mov.l		0x8(%sp),0x4(%sp)	# store lo(PC)
	mov.l		0xc(%sp),0x8(%sp)	# store EA
	mov.l		&0x00000001,0xc(%sp)	# store FSLW
	mov.w		0x6(%sp),0xc(%sp)	# fix FSLW (size)
	mov.w		&0x4008,0x6(%sp)	# store voff

	btst		&0x5,(%sp)		# supervisor or user mode?
	beq.b		facc_out2		# user
	bset		&0x2,0xd(%sp)		# set supervisor TM bit

facc_out2:
	bra.l		_real_access

##################################################################

# if the effective addressing mode was predecrement or postincrement,
# the emulation has already changed its value to the correct post-
# instruction value. but since we're exiting to the access error
# handler, then AN must be returned to its pre-instruction value.
# we do that here.
restore:
	mov.b		EXC_OPWORD+0x1(%a6),%d1
	andi.b		&0x38,%d1		# extract opmode
	cmpi.b		%d1,&0x18		# postinc?
	beq.w		rest_inc
	cmpi.b		%d1,&0x20		# predec?
	beq.w		rest_dec
	rts

rest_inc:
	mov.b		EXC_OPWORD+0x1(%a6),%d1
	andi.w		&0x0007,%d1		# fetch An

	mov.w		(tbl_rest_inc.b,%pc,%d1.w*2),%d1
	jmp		(tbl_rest_inc.b,%pc,%d1.w*1)

tbl_rest_inc:
	short		ri_a0 - tbl_rest_inc
	short		ri_a1 - tbl_rest_inc
	short		ri_a2 - tbl_rest_inc
	short		ri_a3 - tbl_rest_inc
	short		ri_a4 - tbl_rest_inc
	short		ri_a5 - tbl_rest_inc
	short		ri_a6 - tbl_rest_inc
	short		ri_a7 - tbl_rest_inc

ri_a0:
	sub.l		%d0,EXC_DREGS+0x8(%a6)	# fix stacked a0
	rts
ri_a1:
	sub.l		%d0,EXC_DREGS+0xc(%a6)	# fix stacked a1
	rts
ri_a2:
	sub.l		%d0,%a2			# fix a2
	rts
ri_a3:
	sub.l		%d0,%a3			# fix a3
	rts
ri_a4:
	sub.l		%d0,%a4			# fix a4
	rts
ri_a5:
	sub.l		%d0,%a5			# fix a5
	rts
ri_a6:
	sub.l		%d0,(%a6)		# fix stacked a6
	rts
# if it's a fmove out instruction, we don't have to fix a7
# because we hadn't changed it yet. if it's an opclass two
# instruction (data moved in) and the exception was in supervisor
# mode, then also also wasn't updated. if it was user mode, then
# restore the correct a7 which is in the USP currently.
ri_a7:
	cmpi.b		EXC_VOFF(%a6),&0x30	# move in or out?
	bne.b		ri_a7_done		# out

	btst		&0x5,EXC_SR(%a6)	# user or supervisor?
	bne.b		ri_a7_done		# supervisor
	movc		%usp,%a0		# restore USP
	sub.l		%d0,%a0
	movc		%a0,%usp
ri_a7_done:
	rts

# need to invert adjustment value if the <ea> was predec
rest_dec:
	neg.l		%d0
	bra.b		rest_inc
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



