# sccsid = "@(#)doprnt.c 1.1 (Berkeley) 3/2/81";
# C library -- conversions
.set one
,010 # 1.0 in floating immediate
.set ch
.zer
,'0 # cpp doesn't like single appostrophes
.word
0xfc0 # uses r11-r6
movl
4(ap
),r11
# addr of format string
movl
12(ap
),fdesc
# output FILE ptr
movl
8(ap
),ap
# addr of first arg
movl r11
,r0
# current point in format
bicl2 $liter
,flags
# no literal characters yet
L1
: movb (r11
)+,width
# next character of format
beql L2
# end of format string
beql L2 # warning character
bisl2 $liter,flags # literal character
L2: blbc flags,L3 # bbc $literb,flags,L3 # no literals in format
pushl fdesc # file pointer
pushl $0 # no left/right adjust
subl3 $1,r1,-(sp) # % or null not part of literal
calls $4,__strout # dump the literal
blbs width,L4 # % is odd; end of format?
# htab overlaps last 16 characters of ftab
ftab: .byte 0, 0, 0,'c
,'d,'e
,'f,'g
, 0, 0, 0,'+,'l
,'-,'.,'o
htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a
,'b,'c
,'d,'e
,'f
L4: movl sp,r5 # reset output buffer pointer
clrq r9 # width; flags ljustb,ndfndb,zfillb
L4a: movzbl (r11)+,r0 # supposed format
extzv $0,$5,r0,r1 # bottom 5 bits
L4b: cmpb r0,ftab[r1] # good enough?
L4c: casel r1,$3,$22 # yes
L6: jbcs $5,r0,L4b # capitals same as small
movzbl -1(r11),r0 # orginal "format" character
L9
: movb r0
,(r5
)+ # print the unfound character
.byte
'(,'n
,'u,'l
,'l,'),0
jbs $precb
,flags
,L20
# max length was specified
mnegl $
1,r0
# default max length
L20
: movl (ap
)+,r2
# addr first byte
L21
: locc $
0,r0
,(r2
) # find the zero at the end
movl r1
,r5
# addr last byte +1
movl r2
,r1
# addr first byte
movl $
30,r2
# init position
movl $
10,r4
# result length -1
movl $
28,r2
# init position
movl $
7,r4
# result length -1
L10
: mnegl r3
,r6
# increment
movl (ap
)+,r0
# fetch arg
L11
: extzv r2
,r3
,r0
,r1
# pull out a digit
movb htab
[r1
],(r5
)+ # convert to character
L12
: acbl $
0,r6
,r2
,L11
# continue until done
skpc $
'0,r4,(sp) # skip over leading zeroes
patdec: # editpc pattern for decimal printing
.byte 0x01 # eo$end_float
cvtlp (ap)+,$10,(sp) # 10 digits max
L14: editpc $10,(sp),patdec,8(sp) # ascii at 8(sp); r5=end+1
skpc $' ,$
10,8(sp
) # skip leading blanks; r1=first
prstr
: # r1=addr first byte; r5=addr last byte +1
cvtbl $
' ,-(sp) # blank fill
cvtbl $'0,(sp
) # zero fill
subl2 r1
,r5
# r5=actual length=end+1-first
subl3 r5
,width
,r0
# if >0, how much to fill
L24
: jbs $ljustb
,flags
,L25
L25
: pushl r0
# fill count
pushl r1
# addr first byte
pone
: .byte
0x1C # packed 1
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
movl $
4,r0
# chars per word
L18
: movb (ap
)+,(r5
)+ # transfer char
decl r5
# omit null characters
movl sp
,r1
# addr first byte
plus
: bisl2 $psign
,flags
# always print sign for floats
minus
: bisl2 $ljust
,flags
# left justification, please
gnum0
: jbs $ndfndb
,flags
,gnum
jbs $precb
,flags
,gnump
# ignore when reading precision
bisl2 $zfill
,flags
# leading zero fill, please
gnum
: jbs $precb
,flags
,gnump
moval (width
)[width
],width
# width *= 5;
movaw
-ch
.zer(r0
)[width
],width
# width = 2*witdh + r0 - '0';
gnump
: moval (ndigit
)[ndigit
],ndigit
# ndigit *= 5;
movaw
-ch
.zer(r0
)[ndigit
],ndigit
# ndigit = 2*ndigit + r0 - '0';
gnumd
: bisl2 $ndfnd
,flags
# digit seen
dot
: clrl ndigit
# start on the precision
indir
: movl (ap
)+,ndigit
# width specified by parameter
fltg
: jbs $ndfndb
,flags
,float1
movl $
6,ndigit
# default # digits to right of decpt.
float1
: addl3 exp
,ndigit
,r7
movl r7
,r6
# for later "underflow" checking
clrl r7
# poor programmer planning
fxplrd
: cmpl r7
,$
31 # expressible in packed decimal?
fnarro
: subl3 $
17,r7
,r0
# where to round
ashp r0
,$
17,(sp
),$
5,r7
,16(sp
) # do it
# band-aid for microcode error (spurious overflow)
clrl r0
# assume even length result
movl $
4,r0
# odd length result
fleven
: cmpv r0
,$
4,16(sp
),$
0 # top digit zero iff true overflow
aobleq $
0,r6
,fnovfl
# if "underflow" then jump
ashp r0
,$
1,pone
,$
0,r7
,16(sp
)
ashl $
-1,r7
,r0
# displ to last byte
bisb2 sign
,16(sp
)[r0
] # insert sign
clrl r6
# # digits moved so far
bsbb patmov
# digits to left of decpt.
flfakl: subl3 r6,$31,r6 # fake length for patmov
flfill: movc3 $2,fpatzf,(r3) # zero fill to right of dec.pt
fnodp: sobgeq r6,fledit # must move at least 1 digit
movl $31,r6 # none moved; fake it
aobleq $1,ndigit,flfill # with a one-character zero fill
fledit: editpc r7,16(sp),(sp),32(sp)
patexp: .byte 0x03 # eo$set_signif
.byte 0x44,'e # eo$insert 'e
.byte 0x42,'+ # eo$load_plus '+
.byte 0x04 # eo$store_sign
patsci: .byte 0x42,'+ # eo$load_plus '+
.byte 0x03 # eo$set_signif
.byte 0x04 # eo$store_sign
fpatdp: .byte 0x44,'. # eo$insert '.
fpatzf: .byte 0x40,'0 # eo$load_fill '0
# construct pattern at (r3) to move r0 digits in editpc;
# r6 digits already moved for this number
subl3 r6,$31,r1 # # digits remaining in packed
cmpl r0,r1 # enough digits remaining?
tstl exp # zero 'fill'; before or after rest?
pushl r1 # # digits remaining
subl3 $31,r6,r0 # number of fill bytes
pataft: movl r1,r0 # last of the 31
subl3 $31,r6,r0 # number of fill bytes
bleq patzer # DEC doesn't like repetition counts of 0
mnegl $
15,r1
# 15 digits at a time
subl2 r1
,r0
# counteract acbl
patmlp
: bisb3 r2
,$
15,(r3
)+ # 15
pattst
: acbl $
16,r1
,r0
,patmlp
# until <= 15 left
patzer
: clrb (r3
) # eo$end
bsbw fltcvt
# get packed digits
L23
: subl3 $
17,ndigit
,r0
# rounding position
ashp r0
,$
17,(sp
),$
5,ndigit
,16(sp
) # shift and round
# 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
incl exp
# rounding overflowed to 100...
ashp r0
,$
1,pone
,$
0,ndigit
,16(sp
)
ashl $
-1,ndigit
,r0
# displ to last byte
bisb2 sign
,16(sp
)[r0
] # insert sign
jbc $gflagb
,flags
,enotg
# not %g format
# find trailing zeroes in packed number
addl2 r3
,r0
# addr of l.s.digit and sign
movl $
4,r1
# bit position of digit
movl ndigit
,r7
# current length of packed
gtz1
: xorl2 $
4,r1
# position of next digit
gtz
: cmpv r1
,$
4,(r0
),$
0 # a trailing zero?
gntz
: # r7: minimum width of fraction
jleq eg
# small exponents use %e
jleq eg
# so do (w+5) <= exp
jleq fg
# did we trim too many trailing zeroes?
ashp r0
,ndigit
,16(sp
),$
0,r7
,(sp
)
subl3 exp
,r7
,ndigit
# correct ndigit for %f
ashp r0
,ndigit
,16(sp
),$
0,r7
,(sp
)
movl r7
,ndigit
# packed number has been trimmed
subl3 $
1,ndigit
,r0
# digits after dec.pt
editpc ndigit
,16(sp
),(sp
),32(sp
) # 32(sp)->result, r5->(end+1)
decl exp
# compensate: 1 digit left of dec.pt
cvtlp exp
,$
2,(sp
) # exponent
editpc $
2,(sp
),patexp
,(r5
)
prflt1: skpc $' ,$
63,(r1
)
# convert double-floating at (ap) to 17-digit packed at (sp),
# set 'sign' and 'exp', advance ap.
extzv $
7,$
8,r5
,r2
# exponent of 2
movaw
-0600(r2
)[r2
],r2
# unbias and mult by 3
cmpl r2
,$
29 # 10^(29+9) is all we can handle
getman
: addl2 $
9,r2
# -ceil(log10(x)) + 9
emodd r0
,r4
,r5
,r0
,r5
# (r0+r4)*r5; r0=int, r5=frac
fz1
: cvtlp r0
,$
9,16(sp
) # leading 9 digits
ashp $
8,$
9,16(sp
),$
0,$
17,4(sp
) # as top 9 of 17
cvtlp r0
,$
8,16(sp
) # trailing 8 digits
addp4 $
8,16(sp
),$
17,4(sp
) # combine leading and trailing
bisb2 sign
,12(sp
) # and insert sign
movl $
1,exp
# 0.000e+00 and 0.000 rather than 0.000e-01 and .000
# return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4
movd $one
,r0
# begin computing 10^exp10
movad ten1
,r3
# table address
mnegl r2
,r2
# get absolute value
jbss $
6,r2
,e10lp
# flag as negative
e10lp
: jbc r4
,r2
,el1
# want this power?
el1
: addl2 $
8,r3
# advance to next power
aobleq $
5,r4
,e10lp
# through 10^32
jbcc $
6,r2
,el2
# correct for negative exponent
divd3 r0
,$one
,r0
# by taking reciprocal
el2
: clrl r4
# 8 extra bits of precision
ten4
: .word
0x471c,0x4000,0,0
ten8
: .word
0x4dbe,0xbc20,0,0
ten16
: .word
0x5b0e,0x1bc9,0xbf04,0
ten32
: .word
0x759d,0xc5ad,0xa82b,0x70b6