doprnt.s

<B>Digital的Unix操作系统VAX 4.2源码</B>

# define local_frame cry+16	
				# size of data area to allocate on stack


# define t_bexp 16	
				# the binary exponent is bytes 16-17 of each table entry

# define t_dexp 18	
				# the decimal exponent is bytes 18-19

/*
*	This is a jacket routine that is needed to interface
*	doprnt with the gfloat conversion routine
*/

g_text:		movab	4(sp),r5		# r5 -> addr to receive number
		movl	sp,r1			# r1 -> start of common_frame
		movad	(ap)+,r0		# r0 -> addr of number to convert
		movab	common_frame(sp),sp	# subract common_frame from stack
		movl	r5,string_addr(r1)	# store addr to common_frame
		movl	$17,sig_digits(r1)	# cheat and say that we need 17
		pushr	$1<8			# save reg 8
		jsb	ots$$cvt_g_t_r8		# call the convertion routine
		popr	$1<8			# restore reg 8
		movl	dec_exp(r1),exp		# get computed exponent
		movb	sig(r1),sign		# get computed sign
		movl	r1,sp			# restore stack
		rsb				# return

#
/*
* functional description:
*
*	this routine converts a g or h floating point value to a string
*	of ascii digits.  it is intended to form the base of a
*	language's floating point output conversion routine.
*
*
* calling sequence:
*
*	movab	common_frame, r1	; see common_frame definition above
*	movl	string_address, string_addr(r1)
*	movl	sig_digits, sig_digits(r1)
*	movl	user_flags, gflags(r1)
*	movl	rt_round, rt_rnd(r1)	;  optional
*	movab	value, r0
*	jsb	ots$$cvt_x_t_r8		; x is the datatype, g or h
*	; outputs are:
*	;	offset(r1) - offset
*	;	dec_exp(r1) - decimal exponent
*	;	sig(r1) - sign
*
* input parameters:
*
*	value				; floating value to be converted
*	sig_digits(r1)			; number of significant digits to
*					; generate.  if neither v_truncate
*					; or v_round_right is set, the
*					; value will be rounded to this
*					; many digits.
*	gflags(r1)			; caller supplied flags:
*	    v_truncate = 24		; truncate, don't round.
*	    v_round_right = 25		; round "rt_round" digits to
*					; right of decimal point.
*	rt_rnd(r1)			; number of places to the right
*					; of the decimal point to round
*					; after.  ignored if v_round_right
*					; is clear.
*
* implicit inputs:
*
*	none
*
* output parameters:
*
*	out_string			; string with result.  it will
*					; not have valid digits after the
*					; requested number of significant
*					; digits.
*					; the length must be at least:
*					; (9*int((sig_digits+8)/9))+2
*	offset				; the offset into out_string at
*					; which the first significant digit
*					; may be found.  it is guaranteed
*					; to be either 0 or 1.
*	exponent			; the signed decimal exponent of
*					; the value, assuming a radix point
*					; immediately to the left of the
*					; most significant digit.
*	sign				; -1 if the value is negative
*					; 0 if the value is zero
*					; 1 if the value is positive
*
* implicit outputs:
*
*	none
*
* side effects:
*
*	alters registers r0 through r8.
*
*			  this routine does not check the length, it
*			  is up to the caller to insure the correct
*			  length is present.
*
*/

/*
*	.sbttl	ots$$cvt_g_t_r8
*/

/*
* jsb entry point
*/
	.globl	ots$$cvt_g_t_r8

ots$$cvt_g_t_r8:
	movl	r1, r7			# use r7 as base
	clrl	dec_exp(r7)		# init decimal exponent
tstval_g:
	extv	$4, $12, (r0), r1	# test for zero and negative
	jneq	1f			# not zero
	jbr	zero			# is zero
1:	jlss	neg_val_g		# negative?
 #	movl	$1, sig(r7)		# no, set sign
	clrl	sig(r7)
	jbr	notres_g		# continue
neg_val_g:
	extzv	$0, $11, r1, r1		# reserved operand?
	jneq	1f			# no
 #	calls	$0,5f 			# reserved operand
	cmpzv	$4, $12, (r0), $0x800	# still reserved?
	jneq	tstval_g		# no, try again
	jbr	zero			# still reserved, call it zero
 #5:	.word	^m<>
 #	movab	w'cvt_handler, (fp)	# enable condition handler
 #	tstg	(r0)			# force reserved operand fault
 #	ret				# continue

1:
 #	mnegl	$1, sig(r7)		# set negative sign
        	movl	$1, sig(r7)
notres_g:
	subl2	$local_frame, sp	# allocate local data on stack
	movl	sp, r8			# setup pointer to local data area
	subl3	$0x400, r1, binexp(r8)	# remove excess from exponent

		/* pick up g-floating fraction and store as a left
		* normalized unsigned 4-longword integer with the binary
		* point between bits 32 & 31 of "binnum+12"
		*/

	rotl	$16, (r0), r4		# get high fraction
	rotl	$16, 4(r0), r3		# get low fraction

		/* denormalize by 1 bit to insert
		* the hidden bit. 
		*/

	clrq	binnum+0(r8)		# clear low order bits
	clrl	r2
	extv	$21, $32, r2, binnum+8(r8)
	extzv	$21, $31, r3, r4
	bisl3	$0x80000000, r4, binnum+12(r8)	# and set hidden bit
	jbr	begsrc		# now convert the value


		/* now search the power-of-ten table to find
		* an entry close to the value stored
		* in binexp & binnum. then divide (or rather
		* multiply by the reciprocal) binexp & binnum
		* by that table entry to get the resultant
		* fraction into the range:
		*	 1.0 .gt. (fraction * 2** exponent) .ge. 0.1

		* the table search is broken into three pieces: the
		* big number exponential search (starting at bigexp), 
		* the small number exponential search (starting at
		* smlexp), and the middle number search of the linear
		* portion of the table (starting at srclin).
		*/

begsrc:	movaw	tm16, r2		# get 1st adr of linear table
	cmpw	t_bexp(r2), binexp(r8)	# compare with entry's bin exp
	jgtr	smlexp			# branch for small numbers
 #	cmpw	<t16-tm16>+t_bexp(r2), binexp(r8)
		cmpw	0x290(r2),binexp(r8)
					# compare with last linear entry
	jgtr	srclin			# branch for linear search

		/* the two searches which follow (bigexp & smlexp) find
		* the table entry closest to the number stored in
		* binexp(r8). this table entry is used to divide (or
		* multiply by the reciprocal) binexp & binnum.
		*/

bigexp:	movaw	t16, r2			# exponential search for big numbers
	jbr	bigex1

smlexp:	movaw	tsmall, r2		# exponential search for small numbers
bigex1:	cvtwl	t_bexp(r2), r0		# get power-of-2 from table
	ashl	$-1, r0, r1		# for large, calc: 1.5*entry
	jgeq	bigex2			# xfer for big nums (positive exponent)
	ashl	$-1, r1, r1		# for small, calc: .75*entry
	mnegl	r1, r1
bigex2:	addl2	r1, r0			# form .75*entry or 1.5*entry
					# r0 now contains value half way
					# between this and next entry.
	cmpw	r0, binexp(r8)		# is this closest table entry?
	jgeq	bigex3			# if yes, xfer
 #	addl2	$<t1-t0>, r2		# no, go look at next entry
		addl2	$0x14,r2
	jbr	bigex1

bigex3:	bsbw	rmul			# yes, go mul by reciprocal
	jbr	begsrc			#   and go try again

srclin:
		/* the conversion will take place from the linear (in
		* powers of ten) part of the table.
		* the decimal_exponent = 1 + log10(2) * (bin_exp - 1). use this
		* approximation to get the 1st probe into the table.
		* this approx may be 1 small, but no more than that.
		* the approx has been tested exhaustively over the
		* range -106 .le. bin_exp .le. +108 and always works
		* except for bin_exp=1 which has a special code hack.
		*/

	subl3	$1, binexp(r8), r1	# get (binexp - 1)
	jeql	srcl1			# if binexp=+1, return 0 (hack)
	mull2	$1233, r1		# 1233 = 4096 * log10(2)
	ashl	$-12, r1, r1		# remove the 4096 factor
	incl	r1			# final +1

srcl1:	
 #	mull2	$<t1-t0>, r1		# mul by size of table entry
		mull2	$0x14,r1
	addl2	r1, r2			# get index*size+tm16
 #	addl2	$<t0-tm16>, r2		# get index*size+t0
		addl2	$0x140,r2

	cmpw	t_bexp(r2), binexp(r8)	# compare exponents
	jgtr	found			# xfer if entry .gt. binnum

		# the next instruction is commented out. it can not xfer.
/*	jlss	small			; xfer if entry too small */
	cmpl	12(r2), binnum+12(r8)	# compare high-order fraction
	jgtru	found
	jlssu	small
	cmpl	8(r2), binnum+8(r8)
	jgtru	found
	jlssu	small
	cmpl	4(r2), binnum+4(r8)
	jgtru	found
	jlssu	small
	cmpl	0(r2), binnum+0(r8)	# compare low-order fraction
	jgtru	found
small:	
 #	addl2	$<t1-t0>, r2		# advance to next table item
		addl2	$0x14,r2

		/* final check for debugging. remove these next three
		* instructions after all the testing is done. (or
		* leave them in-- they don't really hurt.)
		*/

/*	cmpw	t_bexp(r2), binexp(r8)	; final size check
*	jgtr	found
*	halt				; bad index formula
*/

found:	movaw	t0, r0			# get table base adr
	cmpl	r2, r0
	jeql	muldun			# if 0, don't mul by 1.0
	bsbw	rmul			# and multiply by reciprocal

muldun:		/* binexp should now contain 0, -1, -2, or -3.
		* shift binnum right by that number of places
		* in order to reduce binexp to zero, thus
		* finally finishing with the binary exponent
		* round using the bits shifted off to the right
		*/

	mnegl	binexp(r8), r0			# find bit $ from binexp
	jeql	getdig				# if 0, skip right shift

	subl3	$1, r0, r1			# get pos of 1st discarded bit
	extzv	r1, $1, binnum+0(r8), r1	# get 1st discarde bit

	extv	r0, $32, binnum+0(r8), binnum+0(r8)
	extv	r0, $32, binnum+4(r8), binnum+4(r8)
	extv	r0, $32, binnum+8(r8), binnum+8(r8)
	clrl	binnum+16(r8)			# next extv will get 0's here
	extv	r0, $32, binnum+12(r8), binnum+12(r8)
/*	clrl	binexp(r8)			; binexp now reduced to zero */

	addl2	r1, binnum+0(r8)		# round with 1st discarded bit
	adwc	$0, binnum+4(r8)
	adwc	$0, binnum+8(r8)
	adwc	$0, binnum+12(r8)

getdig:	movl	string_addr(r7), r5		# get adr for digit string
	addl3	$1, sig_digits(r7), r6		# number of digits wanted
	movl	$1, offset(r7)			# initial offset
 #	movb	$^a/0/, (r5)+			# start out with a zero
 #		movb	$0x30,(r5)+

		/* now mul the binnum fraction by 10**9 in order to
		* force 9 digits to the left of the decimal point.
		* then convert that 9 digit binary integer to a
		* string for output in the final answer. repeat
		* the process until enough digits are output.
		*/

/* .macro imul2 i, r, ?l
*	emul	i, r, $0, r0
*	tstl	r
*	jgeq	l
*	addl2	i, r1
*l:	movl	r0, r
*	addl2	r1, 4+r
*.endm imul2
*/

diglup:	clrl	int(r8)			# clear for digits left of bin point

		/* multiply 4-long-words by 10**9, propogating carries
		* across the long-word boundaries.
		*/

	movl	$1000000000, r2			# setup 10**9

/*	imul2	r2, binnum+12(r8)	*/

		emul	r2, binnum+12(r8), $0, r0
		tstl	binnum+12(r8)
		jgeq	1f
		addl2	r2, r1
1:		movl	r0, binnum+12(r8)
		addl2	r1, 4+binnum+12(r8)

/*	imul2	r2, binnum+8(r8)		*/

		emul	r2, binnum+8(r8), $0, r0
		tstl	binnum+8(r8)
		jgeq	2f
		addl2	r2, r1
2:		movl	r0, binnum+8(r8)
		addl2	r1, 4+binnum+8(r8)

	adwc	$0, int(r8)

/*	imul2	r2, binnum+4(r8)		*/

		emul	r2, binnum+4(r8), $0, r0
		tstl	binnum+4(r8)
		jgeq	3f
		addl2	r2, r1
3:		movl	r0, binnum+4(r8)
		addl2	r1, 4+binnum+4(r8)

	adwc	$0, binnum+12(r8)
	adwc	$0, int(r8)
 #	imul2	r2, binnum+0(r8)


		emul	r2, binnum+0(r8), $0, r0
		tstl	binnum+0(r8)
		jgeq	4f
		addl2	r2, r1
4:		movl	r0, binnum+0(r8)
		addl2	r1, 4+binnum+0(r8)

	adwc	$0, binnum+8(r8)
	adwc	$0, binnum+12(r8)
	adwc	$0, int(r8)

		# convert binary num now left of decimal point into
		# 9 packed digits.

 #	cvtlp	int(r8),$9,packed(r7)	# store 9 packed digits
 #	movb	-(r5), r4			# save byte
 #	cvtps	$9,packed(r7),$9,(r5)	# convert to separate
 #	movb	r4, (r5)+			# restore byte
 # 	addl2	$9, r5				# advance output string adr
 	subl2	$9, r6				# 9 more digits
 #	jleq	round				# loop for more?
		jleq	finis1
		cvtlp	int(r8),$9,packed(r7)	# Get the first nine digits
		ashp	$9,$9,packed(r7),$0,$19,(r5)
						# At the end we will have 18
						# digits but we need space for 19
 #	movb	-(r5), r4			# save byte
	jbr	diglup				# yes


/*
* this routine rounds the value to the given number of significant
* digits, unless flag v_truncate is on.  if so, the value is truncated
* at the next digit.

round:
	decl	r6
	addl2	r6, r5			# find least significant + 1
	jbs	$v_truncate, gflags(r7), finis	# truncate if desired
	jbc	$v_round_right, gflags(r7), 5f	# round to right of dec pt?
	addl3	dec_exp(r7), rt_rnd(r7), r1	# yes, find it
	jlss	finis			# exit if round to zero
	cmpl	r1, sig_digits(r7)	# round to right of $ sig digits?
	jgeq	5f			# yes, use number of significant
					# digits instead.
	incl	r1			# finish calculation
	addl3	r1, string_addr(r7), r5	# get rounding character address
5:
 #	cmpb	(r5), $^a/5/		# round?
		cmpb	(r5), $0x35
	jlss	finis			# no, just finish
	movl	r5, r0			# save position
1:
 #	cmpb	-(r0), $^a/9/		# if this is a 9...
		cmpb	-(r0),$0x39
	jlss	2f
 #	movb	$^a/0/, (r0)		# then it becomes a zero
		movb	$30,(r0)
	jbr	1b			# and we continue
2:	incb	(r0)			# else this is last carry
	subl2	string_addr(r7), r0	# do we need to change offset
	jgtr	finis			# no
	clrl	offset(r7)		# yes, set new offset
	incl	dec_exp(r7)		# set new exponent
*/

/*	
* all done.
*/
finis1:	cvtlp	int(r8),$9,packed(r7)	# Get the trailing nine digits
	addp4	$9,packed(r7),$19,(r5)	# Add the front nine with the back nine
	ashp	$-1,$fltprec+3,(r5),$0,$fltprec+2,12(r5)	# Get the 17 significant digits