doprnt.s

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

	jleq prstr			# none
	addl2 llafx,r1		# where current digits start
	pushl r1			# movcx gobbles registers
		# check bounds on users who say %.300d
	movab 32(r5)[ndigit],r2
	subl2 fp,r2
	jlss prn5
	subl2 r2,ndigit
prn5:
		#
	movc3 lrafx,(r1),(r1)[ndigit]	# make room in middle
	movc5 $0,(r1),$ch.zer,ndigit,*(sp)	# '0 fill
	subl3 llafx,(sp)+,r1	# first byte addr
	addl3 lrafx,r3,r5	# last byte addr +1

prstr:			# r1=addr first byte; r5=addr last byte +1
				# width=minimum width; llafx=len. left affix
				# ndigit=<avail>
	subl3 r1,r5,ndigit		# raw width
	subl3 ndigit,width,r0	# pad length
	jleq padlno				# in particular, no left padding
	jbs $minsgn,flags,padlno
			# extension for %0 flag causing left zero padding to field width
	jbs $zfill,flags,padlz
			# this bsbb needed even if %0 flag extension is removed
	bsbb padb				# blank pad on left
	jbr padnlz
padlz:
	movl llafx,r0
	jleq padnlx				# left zero pad requires left affix first
	subl2 r0,ndigit			# part of total length will be transferred
	subl2 r0,width			# and will account for part of minimum width
	bsbw strout				# left affix
padnlx:
	subl3 ndigit,width,r0	# pad length
	bsbb padz				# zero pad on left
padnlz:
	jbs $31,nchar,prdone		# bail out if I/O error
			# end of extension for left zero padding
padlno:			# remaining: root, possible right padding
	subl2 ndigit,width		# root reduces minimum width
	movl ndigit,r0			# root length
p1:	bsbw strout				# transfer to output buffer
p3:	jbc $vbit,r2,padnpct	# percent sign (or null byte via %c) ?
	jbs $31,nchar,prdone		# bail out if I/O error
	decl r0					# yes; adjust count
	movzbl (r1)+,r2			# fetch byte
	movq *fdesc,r4			# output buffer descriptor
	sobgeq r4,p2			# room at the out [inn] ?
	bsbw strout2			# no; force it, then try rest
	jbr p3					# here we go 'round the mullberry bush, ...
p2:	movb r2,(r5)+			# hand-deposit the percent or null
	incl nchar				# count it
	movq r4,*fdesc			# store output descriptor
	jbr p1					# what an expensive hiccup!
padnpct:
	movl width,r0	# size of pad
	jleq loop
	bsbb padb
	jbr loop

padz:
	movb $'0,r2
	jbr pad
padb:
	movb $' ,r2
pad:
	subl2 r0,width			# pad width decreases minimum width
	pushl r1				# save non-pad addr
	movl r0,llafx			# remember width of pad
	subl2 r0,sp				# allocate
	movc5 $0,(r0),r2,llafx,(sp)	# create pad string
	movl llafx,r0			# length
	movl sp,r1				# addr
	bsbw strout
	addl2 llafx,sp			# deallocate
	movl (sp)+,r1			# recover non-pad addr
	rsb

pone:	.byte	0x1C			# packed 1
	
charac:
	movl (ap)+,r0		# word containing the char
	movb r0,(r5)+		# one byte, that's all

prbuf:
	movl sp,r1			# addr first byte
	jbr prstr

space:	bisl2 $1<blank,flags		# constant width e fmt, no plus sign
	jbr L4a
sharp:	bisl2 $1<numsgn,flags		# 'self identifying', please
	jbr L4a
plus:	bisl2 $1<plssgn,flags		# always print sign for floats
	jbr L4a
minus:	bisl2 $1<minsgn,flags		# left justification, please
	jbr L4a
gnum0:	jbs $ndfnd,flags,gnum
	jbs $prec,flags,gnump		# ignore when reading precision
	bisl2 $1<zfill,flags		# leading zero fill, please
gnum:	jbs $prec,flags,gnump
	moval (width)[width],width	# width *= 5;
	movaw -ch.zer(r0)[width],width	# width = 2*witdh + r0 - '0';
	jbr gnumd
gnump:	moval (ndigit)[ndigit],ndigit	# ndigit *= 5;
	movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0';
gnumd:	bisl2 $1<ndfnd,flags		# digit seen
	jbr L4a
dot:	clrl ndigit			# start on the precision
	bisl2 $1<prec,flags
	bicl2 $1<ndfnd,flags
	jbr L4a
indir:
	jbs $prec,flags,in1
	movl (ap)+,width		# width specified by parameter
	jgeq gnumd
	xorl2 $1<minsgn,flags		# parameterized left adjustment
	mnegl width,width
	jbr gnumd
in1:
	movl (ap)+,ndigit		# precision specified by paratmeter
	jgeq gnumd
	mnegl ndigit,ndigit
	jbr gnumd

float:
	jbs $prec,flags,float1
	movl $6,ndigit			# default # digits to right of decpt.
float1:	bsbw fltcvt
	addl3 exp,ndigit,r7
	movl r7,r6			# for later "underflow" checking
	bgeq fxplrd
	clrl r7				# poor programmer planning
fxplrd:	cmpl r7,$31			# expressible in packed decimal?
	bleq fnarro			# yes
	movl $31,r7
fnarro:	subl3 $fltprec,r7,r0		# slr001 where to round
	ashp r0,$fltprec,(sp),$5,r7,16(sp)	# slr001 do it
	bvc fnovfl
		# band-aid for microcode error (spurious overflow)
	#	clrl r0				# assume even length result
	#	jlbc r7,fleven			# right
	#	movl $4,r0			# odd length result
	#fleven:	cmpv r0,$4,16(sp),$0		# top digit zero iff true overflow
	#	bneq fnovfl
		# end band-aid
	aobleq $0,r6,fnovfl		# if "underflow" then jump
	movl r7,r0
	incl exp
	incl r7
	ashp r0,$1,pone,$0,r7,16(sp)
	ashl $-1,r7,r0			# displ to last byte
	bisb2 sign,16(sp)[r0]		# insert sign
fnovfl:
	movab 16(sp),r1		# packed source
	movl r7,r6		# packed length
	pushab prnum	# goto prnum after fall-through call to fedit


	# enter via bsb
	#	r1=addr of packed source
	#	   16(r1) used to unpack source
	#	   48(r1) used to construct pattern to unpack source
	#	   48(r1) used to hold result
	#	r6=length of packed source (destroyed)
	#	exp=# digits to left of decimal point (destroyed)
	#	ndigit=# digits to right of decimal point (destroyed)
	#	sign=1 if negative, 0 otherwise
	# stack will be used for work space for pattern and unpacked source 
	# exits with
	#	r1=addr of punctuated result
	#	r5=addr of last byte +1
	#	llafx=1 if minus sign inserted, 0 otherwise
fedit:
	pushab 48(r1)			# save result addr
	movab 48(r1),r3			# pattern addr
	movb $0x03,(r3)+		# eo$set_signif
	movc5 $0,(r1),$0x91,r6,(r3)	# eo$move 1
	clrb (r3)				# eo$end
	editpc r6,(r1),48(r1),16(r1)	# unpack 'em all
	subl3 r6,r5,r1			# addr unpacked source
	movl (sp),r3			# punctuated output placed here
	clrl llafx
	jlbc sign,f1
	movb $'-,(r3)+		# negative
	incl llafx
f1:	movl exp,r0
	jgtr f2
	movb $'0,(r3)+		# must have digit before decimal point
	jbr f3
f2:	cmpl r0,r6			# limit on packed length
	jleq f4
	movl r6,r0
f4:	subl2 r0,r6			# eat some digits
	subl2 r0,exp		# from the exponent
	movc3 r0,(r1),(r3)	# (most of the) digits to left of decimal point
	movl exp,r0			# need any more?
	jleq f3
	movc5 $0,(r1),$'0,r0,(r3)	# '0 fill
f3:	movl ndigit,r0		# # digits to right of decimal point
	jgtr f5
	jbs $numsgn,flags,f5	# no decimal point unless forced
	jbcs $dpflag,flags,f6	# no decimal point
f5:	movb __lc_radix,(r3)+	# INTL the decimal point
f6:	mnegl exp,r0		# "leading" zeroes to right of decimal point
	jleq f9
	cmpl r0,ndigit		# cant exceed this many
	jleq fa
	movl ndigit,r0
fa:	subl2 r0,ndigit
	movc5 $0,(r1),$'0,r0,(r3)
f9:	movl ndigit,r0
	cmpl r0,r6			# limit on packed length
	jleq f7
	movl r6,r0
f7:	subl2 r0,ndigit		# eat some digits from the fraction
	movc3 r0,(r1),(r3)	# (most of the) digits to right of decimal point
	movl ndigit,r0			# need any more?
	jleq f8
		# check bounds on users who say %.300f
	movab 32(r3)[r0],r2
	subl2 fp,r2
	jlss fb
	subl2 r2,r0			# truncate, willy-nilly
	movl r0,ndigit		# and no more digits later, either
fb:
		#
	subl2 r0,ndigit		# eat some digits from the fraction
	movc5 $0,(r1),$'0,r0,(r3)	# '0 fill
f8:	movl r3,r5			# addr last byte +1
	popr $1<1			# [movl (sp)+,r1] addr first byte
	rsb

patexp:	.byte	0x03			# eo$set_signif
	.byte	0x44,'e			# eo$insert 'e
	.byte	0x42,'+			# eo$load_plus '+
	.byte	0x04			# eo$store_sign
# ifdef	GFLOAT
 # slr001 The exponent can be 3 characters long for gfloat numbers
	.byte	0x93			# eo$move slr001
# else
	.byte	0x92			# eo$move 2
#endif
	.byte	0			# eo$end

scien:
	incl ndigit
	jbs $prec,flags,L23
	movl $7,ndigit
L23:	bsbw fltcvt			# get packed digits
	movl ndigit,r7
	cmpl r7,$31				# expressible in packed decimal?
	jleq snarro				# yes
	movl $31,r7
snarro:	subl3 $fltprec,r7,r0		# slr001 rounding position
	ashp r0,$fltprec,(sp),$5,r7,16(sp) # slr001 shift and round
	bvc snovfl
		# band-aid for microcode error (spurious overflow)
	#	clrl r0				# assume even length result
	#	jlbc ndigit,sceven		# right
	#	movl $4,r0			# odd length result
	#sceven:	cmpv r0,$4,16(sp),$0		# top digit zero iff true overflow
	#	bneq snovfl
		# end band-aid
	incl exp			# rounding overflowed to 100...
	subl3 $1,r7,r0
	ashp r0,$1,pone,$0,r7,16(sp)
	ashl $-1,r7,r0		# displ to last byte
	bisb2 sign,16(sp)[r0]		# insert sign
snovfl:
	jbs $gflag,flags,gfmt		# %g format
	movab 16(sp),r1
	bsbb eedit
eexp:
	movl r1,r6		# save fwa from destruction by cvtlp
	subl3 $1,sexp,r0	# 1P exponent


# ifdef	GFLOAT
 # slr001	The exponent for gfloat numbers can be 3 characters long

	cvtlp r0,$3,(sp)	# slr001 need three positions for exponent
	editpc $3,(sp),patexp,(r5) # slr001
# else
	cvtlp r0,$2,(sp)	# packed
	editpc $2,(sp),patexp,(r5)
# endif
	movl r6,r1		# fwa
	jbc $caps,flags,prnum
# ifdef	GFLOAT
	xorb2 $'e^'E,-5(r5)	# extra digit for exponent -- adjust 'e'
# else
	xorb2 $'e^'E,-4(r5)
# endif
	jbr prnum

eedit:
	movl r7,r6		# packed length
	decl ndigit		# 1 digit before decimal point
	movl exp,sexp	# save from destruction
	movl $1,exp		# and pretend
	jbr fedit

gfmt:
	addl3 $3,exp,r0		# exp is 1 more than e
	jlss gfmte		# (e+1)+3<0, e+4<=-1, e<=-5
	subl2 $3,r0		# exp [==(e+1)]
	cmpl r0,ndigit
	jgtr gfmte		# e+1>n, e>=n
gfmtf:
	movl r7,r6
	subl2 r0,ndigit		# n-e-1
	movab 16(sp),r1
	bsbw fedit
g1:	jbs $numsgn,flags,g2
	jbs $dpflag,flags,g2	# dont strip if no decimal point
g3:	cmpb -(r5),$'0		# strip trailing zeroes
	jeql g3
	cmpb (r5), __lc_radix	# INTL. and trailing decimal point
	jeql g2
	incl r5
g2:	jbc $gflag,flags,eexp
	jbr prnum
gfmte:
	movab 16(sp),r1		# packed source
	bsbw eedit
	jbsc $gflag,flags,g1	# gflag now means "use %f" [hence no exponent]

general:
	jbs $prec,flags,gn1
	movl $6,ndigit		# default precision is 6 significant digits
gn1:	tstl ndigit		# cannot allow precision of 0
	jgtr gn2
	movl $1,ndigit		# change 0 to 1, willy-nilly
gn2:	jbcs $gflag,flags,L23
	jbr L23			# safety net

	# convert double-floating at (ap) to 17-digit packed at (sp),
	# set 'sign' and 'exp', advance ap.
fltcvt:
# ifdef	GFLOAT

/*
*	The following code is edit SLR001 upto the # else
*
*	The following code was taken from the OTSCVTRT.MAR routine 
*	which is part of the RTL sources. Most of the comments and
*	code are not changed except where needed.  The routine g_text
*	is a jacket routine to the ots$$cvt_g_t_r8 and is not part
*	of the actual OTSCVTRT.MAR routine. 
*
*	I have tried to keep
*	the code as close as possible to the orginal so if any
*	bugs occur in the RTL routine, those bugs can be easily added to
*	this routine.
*
* facility: language-independent support library
*
* abstract:
*
*	a routine to convert g and h floating values to a string of
*	ascii digits and an exponent.  it is meant to be used as
*	a base for floating point output conversion routines.
*
* environment: user mode, ast reentrant
*
*
*/


/*
* equated symbols:
*

* stack frame offsets from r7
* common frame for kernel convert routines
*/
# define packed -8
					# temp for packed representation
# define gflags packed-4
					# flags for outer and inner routines
# define sig_digits gflags-4
					# significant digits
# define string_addr sig_digits-4
					# address of temp string
# define sig string_addr-4
					# sign
# define dec_exp sig-4
					# decimal exponent
# define offset dec_exp-4

					# offset
# define rt_rnd offset-4
					# right round point
# define common_frame rt_rnd
					# common frame size


				# binnum holds the 4 long-words of
				# the binary fraction. it is initialized
				# with the "straightened out" fraction
				# bits from the h-floating number.
				# binnum+0<0> is the least significant bit
				# binnum+12<31> is the most sig bit
# define binnum 0
# define int binnum+16
				# int must be 1st word after the 4
				# longwords of binnum. it is used to catch
				# the binary for the 9 decimal digits
				# when binnum is multiplied by 10**9.

# define binexp int+4
				# the binary exponent. it is initialized
				# from the h-floating exponent.
# define prodf_4 binexp+4
				# a temporary for helping with the
				# 4x4 multiple precision multiply.
				# this word never gets all
				# the appropriate cross-products added in
				# and is not really part of the result.
				# it's here because "emul" always gives
				# double l-word products even when the low
				# word isn't needed (wanted).

/*
*	WARNING:
*		Because of some preprocessor problem the variable 
*		was hard coded in the RMUL routine. So if prodf 
*		changes you must also change the hard coded version
*/
# define prodf prodf_4+4
				# the 4 long-words of prodf must start
				# just after prodf_4 (which is always
				# used as prodf-4).

# define cry prodf+16
				# used for a "carry save" multiply.