doprnt.s

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

/*	@(#)doprnt.s	4.3	ULTRIX	9/10/90	*/
	# C library -- conversions

/************************************************************************
 *		Modification history
 *
 *	Jon Reeves, 04-Dec-89
 * 011	Cleaned up error handling
 *
 *	Jon Reeves, 11-Oct-89
 * 010	G-float %E format tried to adjust the sign instead of the e.
 *
 *	Jon Reeves, 14-Jun-89
 * 009	Add ANSI-mandated %p (treated as %08x), %n, L size flag
 *
 *	Jon Reeves, 10-May-89
 * 008	Rounding was inconsistent.  D-float has 16-1/2 significant
 *	digits, G-float has 15-1/2, but they were being rounded at
 *	17 and 15, respectively.  They are now rounded at 17 and 16.
 *
 *	Andy Gadsby, 27-Nov-86
 * INTL	Added code to allow change of radix character.
 *
 *	David L Ballenger, 7-Jun-1985
 * 006	Fix rounding problem when printing gfloat numbers.
 *	Add handling of %i, %I, and %X for System V competibility.
 *
 *	Stephen Reilly, 14-May-84
 * 005- Changed the symbol MVAXI to GFLOAT to reflect the meaning of
 *	of the code.
 *
 *	Stephen Reilly, 02-May-84
 * 004- Rounding would sometimes cause overflow causing bogus results
 *
 *	Stephen Reilly, 04-Apr-84
 * 003- Change the symbol MicroVAX to MVAXI
 *
 *	Stephen Reilly, 05-Dec-83
 * 002- Have to change a line in skpc becuase it screws-up an awk
 *	script that translate things to use the Microvax library
 *
 *	Stephen Reilly, 04-Oct-83:
 * 001 - Added code to handle gfloat numbers for MicroVAX
 *
 *
 ***********************************************************************/

/************************************************************************
 *									*
 *			Copyright (c) 1984, 1988 by			*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/



.globl	__doprnt
.globl	__flsbuf
.globl  __lc_radix		# INTL - international radix character

#define vbit 1
#define flags r10
#define ndfnd 0
#define prec 1
#define zfill 2
#define minsgn 3
#define plssgn 4
#define numsgn 5
#define caps 6
#define blank 7
#define gflag 8
#define dpflag 9

/*
  The precision for gfloat is only 15 digits whereas for double it is 17.
	slr001
  Don't let these defines fool you, there's hand tuning needed, too.
*/

# ifdef	GFLOAT				

# define fltprec 16

#else

# define fltprec 17

# endif
#define width r9
#define ndigit r8
#define llafx r7
#define lrafx r6
#define fdesc -4(fp)
#define exp -8(fp)
#define sexp -12(fp)
#define nchar -16(fp)
#define sign -17(fp)
	.set ch.zer,'0			# cpp doesn't like single appostrophes

	.align 2
strtab:		# translate table for detecting null and percent
	.byte	0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15
	.byte	16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
	.byte	' ,'!,'",'#,'$, 0,'&,'','(,'),'*,'+,',,'-,'.,'/
	.byte	'0,'1,'2,'3,'4,'5,'6,'7,'8,'9,':,';,'<,'=,'>,'?
	.byte	'@,'A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M,'N,'O
	.byte	'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z,'[,'\,'],'^,'_
	.byte	'`,'a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m,'n,'o
	.byte	'p,'q,'r,'s,'t,'u,'v,'w,'x,'y,'z,'{,'|,'},'~,127
	.byte	128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143
	.byte	144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159
	.byte	160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175
	.byte	176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
	.byte	192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
	.byte	208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
	.byte	224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
	.byte	240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255

	.align	1
__doprnt:
	.word	0xfc0			# uses r11-r6
	jbr	doit

strfoo:
	clrl r4					# fix interrupt race
	jbr strok				# and try again
strmore:
	movzbl (r1)+,r2			# one char
	tstb strtab[r2]			# translate
	jeql stresc2			# bad guy in disguise (outbuf is full)
strout2:		# enter here to force out r2; r0,r1 must be set
	pushr $3				# save input descriptor
	pushl fdesc				# FILE
	pushl r2				# the char
	calls $2,__flsbuf		# please empty the buffer and handle 1 char
	tstl r0					# successful?
	jlss strouterr				# no
	incl nchar				# count the char
	popr $3					# get input descriptor back
strout:			# enter via bsb with (r0,r1)=input descriptor
	movab strtab,r3			# table address
	movq *fdesc,r4			# output descriptor
	jbs $31,r4,strfoo		# negative count is a no no
strok:
	addl2 r0,nchar			# we intend to move this many chars
/******* Start bogus movtuc workaround  *****/
	clrl r2
	tstl    r0
	bleq    movdon
movlp:
	tstl    r4
	bleq    movdon
	movzbl  (r1)+,r3
	tstb    strtab[r3]
	bneq    1f
	mnegl   $1,r2
	decl    r1
	brb     movdon
1:
	movb    r3,(r5)+
	decl    r4
	sobgtr  r0,movlp
  /******* End bogus movtuc workaround ***
	movtuc r0,(r1),$0,(r3),r4,(r5)
	movpsl r2                       /*  squirrel away condition codes */
  /******* End equally bogus movtuc ****/
movdon: movq r4,*fdesc                  /*  update output descriptor */
	subl2 r0,nchar			# some chars not moved
	jbs $vbit,r2,stresc		# terminated by escape?
	sobgeq r0,strmore		# no; but out buffer might be full
stresc:
	rsb

strouterr:
	popr $3					# put stack back in order
	mnegl $1,nchar				# set error return value
	movab strtab+1,r1			# point to nul char to exit
stresc2:
	incl r0					# fix the length
	decl r1					# and the addr
	movl $1<vbit,r2			# fake condition codes
	rsb

errdone:
	jbcs $31,nchar,prdone	# set error bit
prdone:
	movl nchar,r0
	ret

doit:
	movab -256(sp),sp		# work space
	movl 4(ap),r11			# addr of format string
	movl 12(ap),fdesc		# output FILE ptr
	movl 8(ap),ap			# addr of first arg
	clrl nchar				# number of chars transferred
loop:
	jbs $31,nchar,prdone		# bail out if I/O error
	movzwl $65535,r0		# pseudo length
	movl r11,r1				# fmt addr
		# comet sucks.
	movq *fdesc,r4
	subl3 r1,r5,r2
	jlss lp1
	cmpl r0,r2
	jleq lp1
	movl r2,r0
lp1:
		#
	bsbw strout				# copy to output, stop at null or percent
	movl r1,r11				# new fmt
	jbc $vbit,r2,loop		# if no escape, then very long fmt
	tstb (r11)+				# escape; null or percent?
	jeql prdone				# null means end of fmt

	movl sp,r5			# reset output buffer pointer
	clrq r9				# width; flags
	clrq r6				# lrafx,llafx
longorunsg:				# we can ignore both of these distinctions
short:
L4a:
	movzbl (r11)+,r0		# so capital letters can tail merge
L4:	caseb r0,$' ,$'x-' 		# format char
L5:
	.word space-L5			# space
	.word fmtbad-L5			# !
	.word fmtbad-L5			# "
	.word sharp-L5			# #
	.word fmtbad-L5			# $
	.word fmtbad-L5			# %
	.word fmtbad-L5			# &
	.word fmtbad-L5			# '
	.word fmtbad-L5			# (
	.word fmtbad-L5			# )
	.word indir-L5			# *
	.word plus-L5			# +
	.word fmtbad-L5			# ,
	.word minus-L5			# -
	.word dot-L5			# .
	.word fmtbad-L5			# /
	.word gnum0-L5			# 0
	.word gnum-L5			# 1
	.word gnum-L5			# 2
	.word gnum-L5			# 3
	.word gnum-L5			# 4
	.word gnum-L5			# 5
	.word gnum-L5			# 6
	.word gnum-L5			# 7
	.word gnum-L5			# 8
	.word gnum-L5			# 9
	.word fmtbad-L5			# :
	.word fmtbad-L5			# ;
	.word fmtbad-L5			# <
	.word fmtbad-L5			# =
	.word fmtbad-L5			# >
	.word fmtbad-L5			# ?
	.word fmtbad-L5			# @
	.word fmtbad-L5			# A
	.word fmtbad-L5			# B
	.word fmtbad-L5			# C
	.word decimal-L5		# D
	.word capital-L5		# E
	.word fmtbad-L5			# F
	.word capital-L5		# G
	.word fmtbad-L5			# H
	.word decimal-L5		# I
	.word fmtbad-L5			# J
	.word fmtbad-L5			# K
	.word longorunsg-L5		# L
	.word fmtbad-L5			# M
	.word fmtbad-L5			# N
	.word octal-L5			# O
	.word fmtbad-L5			# P
	.word fmtbad-L5			# Q
	.word fmtbad-L5			# R
	.word fmtbad-L5			# S
	.word fmtbad-L5			# T
	.word unsigned-L5		# U
	.word fmtbad-L5			# V
	.word fmtbad-L5			# W
	.word capital-L5		# X
	.word fmtbad-L5			# Y
	.word fmtbad-L5			# Z
	.word fmtbad-L5			# [
	.word fmtbad-L5			# \
	.word fmtbad-L5			# ]
	.word fmtbad-L5			# ^
	.word fmtbad-L5			# _
	.word fmtbad-L5			# `
	.word fmtbad-L5			# a
	.word fmtbad-L5			# b
	.word charac-L5			# c
	.word decimal-L5		# d
	.word scien-L5			# e
	.word float-L5			# f
	.word general-L5		# g
	.word short-L5			# h
	.word decimal-L5		# i
	.word fmtbad-L5			# j
	.word fmtbad-L5			# k
	.word longorunsg-L5		# l
	.word fmtbad-L5			# m
	.word count-L5			# n
	.word octal-L5			# o
	.word pointer-L5		# p
	.word fmtbad-L5			# q
	.word fmtbad-L5			# r
	.word string-L5			# s
	.word fmtbad-L5			# t
	.word unsigned-L5		# u
	.word fmtbad-L5			# v
	.word fmtbad-L5			# w
	.word hex-L5			# x
fmtbad:
	movb r0,(r5)+			# print the unfound character
	jeql errdone			# dumb users who end the format with a %
	jbr prbuf
capital:
	bisl2 $1<caps,flags		# note that it was capitalized
	xorb2 $'a^'A,r0			# make it small
	jbr L4					# and try again

count:
	movl (ap)+,r2			# fetch arg
	movl nchar,(r2)			# store count so far
	jbr loop			# look for more work

string:
	movl ndigit,r0
	jbs $prec,flags,L20		# max length was specified
	mnegl $1,r0			# default max length
L20:	movl (ap)+,r2			# addr first byte
	locc $0,r0,(r2)			# find the zero at the end
	movl r1,r5			# addr last byte +1
	movl r2,r1			# addr first byte
	jbr prstr

htab:	.byte	'0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f
Htab:	.byte	'0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'A,'B,'C,'D,'E,'F

octal:
	movl $30,r2			# init position
	movl $3,r3			# field width
	movab htab,llafx	# translate table
	jbr L10

pointer:
	movl $1<zfill|1<prec,flags	# leading 0 fill, length given
	movl $8,ndigit			# 8 digits
/*	Fall through to normal hex handling	*/
hex:
	movl $28,r2			# init position
	movl $4,r3			# field width
	movab htab,llafx	# translate table
	jbc $caps,flags,L10
	movab Htab,llafx
L10:	mnegl r3,r6			# increment
	clrl r1
	addl2 $4,r5			# room for left affix (2) and slop [forced sign?]
	movl (ap)+,r0			# fetch arg
L11:	extzv r2,r3,r0,r1		# pull out a digit
	movb (llafx)[r1],(r5)+		# convert to character
L12:	acbl $0,r6,r2,L11		# continue until done
	clrq r6				# lrafx, llafx
	clrb (r5)			# flag end
	skpc $'0,$11,4(sp)		# skip over leading zeroes
	jbc $numsgn,flags,prn3	# easy if no left affix
	tstl -4(ap)				# original value
	jeql prn3			# no affix on 0, for some reason
	cmpl r3,$4			# were we doing hex or octal?
	jneq L12a			# octal
	movb $'x,r0
	jbc $caps,flags,L12b
	movb $'X,r0
L12b:	movb r0,-(r1)
	movl $2,llafx		# leading 0x for hex is an affix
L12a:	movb $'0,-(r1)	# leading zero for octal is a digit, not an affix
	jbr prn3			# omit sign (plus, blank) massaging

unsigned:
lunsigned:
	bicl2 $1<plssgn|1<blank,flags	# omit sign (plus, blank) massaging
	extzv $1,$31,(ap),r0		# right shift logical 1 bit
	cvtlp r0,$10,(sp)		# convert [n/2] to packed
	movp $10,(sp),8(sp)		# copy packed
	addp4 $10,8(sp),$10,(sp)	# 2*[n/2] in packed, at (sp)
	blbc (ap)+,L14			# n was even
	addp4 $1,pone,$10,(sp)		# n was odd
	jbr L14

patdec:					# editpc pattern for decimal printing
	.byte 0xAA			# eo$float 10
	.byte 0x01			# eo$end_float
	.byte 0				# eo$end

decimal:
	cvtlp (ap)+,$10,(sp)		# 10 digits max
	jgeq L14
	incl llafx			# minus sign is a left affix
L14:	editpc $10,(sp),patdec,8(sp)	# ascii at 8(sp); r5=end+1
 #	skpc $' ,$11,8(sp)		# skip leading blanks; r1=first
	skpc $0x20,$11,8(sp)		# slr002 

prnum:			# r1=addr first byte, r5=addr last byte +1, llafx=size of signs
				# -1(r1) vacant, for forced sign
	tstl llafx
	jneq prn3			# already some left affix, dont fuss
	jbc $plssgn,flags,prn2
	movb $'+,-(r1)		# needs a plus sign
	jbr prn4
prn2:	jbc $blank,flags,prn3
	movb $' ,-(r1)		# needs a blank sign
prn4:	incl llafx
prn3:	jbs $prec,flags,prn1
	movl $1,ndigit		# default precision is 1
prn1:	subl3 r1,r5,lrafx	# raw width
	subl2 llafx,lrafx	# number of digits
	subl2 lrafx,ndigit	# number of leading zeroes needed