projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
65535 is not ~= 65536 for text sizes >= 65536. (scale factor to profil)
[unix-history] / usr / src / lib / libc / vax / stdio.old / doprnt.c
CommitLineData
3fd6f19e 1/* @(#)doprnt.c 4.3 (Berkeley) %G% */
4e447cd1
BJ		 2 # C library -- conversions
3
4.globl __doprnt
5.globl __flsbuf
6
7#define vbit 1
8#define flags r10
9#define ndfnd 0
10#define prec 1
11#define zfill 2
12#define minsgn 3
13#define plssgn 4
14#define numsgn 5
15#define caps 6
16#define blank 7
17#define gflag 8
18#define dpflag 9
19#define width r9
20#define ndigit r8
21#define llafx r7
22#define lrafx r6
23#define fdesc -4(fp)
24#define exp -8(fp)
25#define sexp -12(fp)
26#define nchar -16(fp)
27#define sign -17(fp)
28 .set ch.zer,'0 # cpp doesn't like single appostrophes
29
30 .align 2
31strtab: # translate table for detecting null and percent
32 .byte 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15
33 .byte 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
34 .byte ' ,'!,'",'#,'$, 0,'&,'','(,'),'*,'+,',,'-,'.,'/
35 .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,':,';,'<,'=,'>,'?
36 .byte '@,'A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M,'N,'O
37 .byte 'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z,'[,'\,'],'^,'_
38 .byte '`,'a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m,'n,'o
39 .byte 'p,'q,'r,'s,'t,'u,'v,'w,'x,'y,'z,'{,'|,'},'~,127
40 .byte 128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143
41 .byte 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159
42 .byte 160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175
43 .byte 176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
44 .byte 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
45 .byte 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
46 .byte 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
47 .byte 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
48
49strfoo:
50 clrl r4 # fix interrupt race
51 jbr strok # and try again
52strmore:
53 movzbl (r1)+,r2 # one char
3fd6f19e 54 tstb strtab[r2] # translate
4e447cd1
BJ		 55 jeql stresc2 # bad guy in disguise (outbuf is full)
56strout2: # enter here to force out r2; r0,r1 must be set
57 pushr $3 # save input descriptor
58 pushl fdesc # FILE
59 pushl r2 # the char
60 calls $2,__flsbuf # please empty the buffer and handle 1 char
61 tstl r0 # successful?
62 jgeq strm1 # yes
63 jbcs $31,nchar,strm1 # turn on sign bit of nchar to signify error
64strm1:
65 incl nchar # count the char
66 popr $3 # get input descriptor back
67strout: # enter via bsb with (r0,r1)=input descriptor
68 movab strtab,r3 # table address
69 movq *fdesc,r4 # output descriptor
70 jbs $31,r4,strfoo # negative count is a no no
71strok:
72 addl2 r0,nchar # we intend to move this many chars
3fd6f19e
BJ		 73/******* Start bogus movtuc workaround *****/
74 clrl r2
75 tstl r0
76 bleq movdon
77movlp:
78 tstl r4
79 bleq movdon
80 movzbl (r1)+,r3
81 tstb strtab[r3]
82 bneq 1f
83 mnegl $1,r2
84 decl r1
85 brb movdon
861:
87 movb r3,(r5)+
88 decl r4
89 sobgtr r0,movlp
90 /******* End bogus movtuc workaround ***
4e447cd1 91 movtuc r0,(r1),$0,(r3),r4,(r5)
3fd6f19e
BJ		 92 movpsl r2 /* squirrel away condition codes */
93 /******* End equally bogus movtuc ****/
94movdon: movq r4,*fdesc /* update output descriptor */
4e447cd1
BJ		 95 subl2 r0,nchar # some chars not moved
96 jbs $vbit,r2,stresc # terminated by escape?
97 sobgeq r0,strmore # no; but out buffer might be full
98stresc:
99 rsb
100stresc2:
101 incl r0 # fix the length
102 decl r1 # and the addr
103 movl $1<vbit,r2 # fake condition codes
104 rsb
105
106errdone:
107 jbcs $31,nchar,prdone # set error bit
108prdone:
109 movl nchar,r0
110 ret
111
112 .align 1
113__doprnt:
114 .word 0xfc0 # uses r11-r6
115 movab -256(sp),sp # work space
116 movl 4(ap),r11 # addr of format string
117 movl 12(ap),fdesc # output FILE ptr
118 movl 8(ap),ap # addr of first arg
119 clrl nchar # number of chars transferred
120loop:
121 movzwl $65535,r0 # pseudo length
3fd6f19e 122 movl r11,r1 # fmt addr
861952dc
BJ		 123 # comet sucks.
124 movq *fdesc,r4
125 subl3 r1,r5,r2
126 jlss lp1
127 cmpl r0,r2
128 jleq lp1
129 movl r2,r0
130lp1:
131 #
4e447cd1
BJ		 132 bsbw strout # copy to output, stop at null or percent
133 movl r1,r11 # new fmt
134 jbc $vbit,r2,loop # if no escape, then very long fmt
135 tstb (r11)+ # escape; null or percent?
136 jeql prdone # null means end of fmt
137
138 movl sp,r5 # reset output buffer pointer
139 clrq r9 # width; flags
140 clrq r6 # lrafx,llafx
141longorunsg: # we can ignore both of these distinctions
142short:
143L4a:
144 movzbl (r11)+,r0 # so capital letters can tail merge
145L4: caseb r0,$' ,$'x-' # format char
146L5:
147 .word space-L5 # space
148 .word fmtbad-L5 # !
149 .word fmtbad-L5 # "
150 .word sharp-L5 # #
151 .word fmtbad-L5 # $
152 .word fmtbad-L5 # %
153 .word fmtbad-L5 # &
154 .word fmtbad-L5 # '
155 .word fmtbad-L5 # (
156 .word fmtbad-L5 # )
157 .word indir-L5 # *
158 .word plus-L5 # +
159 .word fmtbad-L5 # ,
160 .word minus-L5 # -
161 .word dot-L5 # .
162 .word fmtbad-L5 # /
163 .word gnum0-L5 # 0
164 .word gnum-L5 # 1
165 .word gnum-L5 # 2
166 .word gnum-L5 # 3
167 .word gnum-L5 # 4
168 .word gnum-L5 # 5
169 .word gnum-L5 # 6
170 .word gnum-L5 # 7
171 .word gnum-L5 # 8
172 .word gnum-L5 # 9
173 .word fmtbad-L5 # :
174 .word fmtbad-L5 # ;
175 .word fmtbad-L5 # <
176 .word fmtbad-L5 # =
177 .word fmtbad-L5 # >
178 .word fmtbad-L5 # ?
179 .word fmtbad-L5 # @
180 .word fmtbad-L5 # A
181 .word fmtbad-L5 # B
182 .word fmtbad-L5 # C
183 .word decimal-L5 # D
184 .word capital-L5 # E
185 .word fmtbad-L5 # F
186 .word capital-L5 # G
187 .word fmtbad-L5 # H
188 .word fmtbad-L5 # I
189 .word fmtbad-L5 # J
190 .word fmtbad-L5 # K
191 .word fmtbad-L5 # L
192 .word fmtbad-L5 # M
193 .word fmtbad-L5 # N
194 .word octal-L5 # O
195 .word fmtbad-L5 # P
196 .word fmtbad-L5 # Q
197 .word fmtbad-L5 # R
198 .word fmtbad-L5 # S
199 .word fmtbad-L5 # T
200 .word unsigned-L5 # U
201 .word fmtbad-L5 # V
202 .word fmtbad-L5 # W
203 .word hex-L5 # X
204 .word fmtbad-L5 # Y
205 .word fmtbad-L5 # Z
206 .word fmtbad-L5 # [
207 .word fmtbad-L5 # \
208 .word fmtbad-L5 # ]
209 .word fmtbad-L5 # ^
210 .word fmtbad-L5 # _
211 .word fmtbad-L5 # `
212 .word fmtbad-L5 # a
213 .word fmtbad-L5 # b
214 .word charac-L5 # c
215 .word decimal-L5 # d
216 .word scien-L5 # e
217 .word float-L5 # f
218 .word general-L5 # g
219 .word short-L5 # h
220 .word fmtbad-L5 # i
221 .word fmtbad-L5 # j
222 .word fmtbad-L5 # k
223 .word longorunsg-L5 # l
224 .word fmtbad-L5 # m
225 .word fmtbad-L5 # n
226 .word octal-L5 # o
227 .word fmtbad-L5 # p
228 .word fmtbad-L5 # q
229 .word fmtbad-L5 # r
230 .word string-L5 # s
231 .word fmtbad-L5 # t
232 .word unsigned-L5 # u
233 .word fmtbad-L5 # v
234 .word fmtbad-L5 # w
235 .word hex-L5 # x
236fmtbad:
237 movb r0,(r5)+ # print the unfound character
238 jeql errdone # dumb users who end the format with a %
239 jbr prbuf
240capital:
241 bisl2 $1<caps,flags # note that it was capitalized
242 xorb2 $'a^'A,r0 # make it small
243 jbr L4 # and try again
244
245string:
246 movl ndigit,r0
247 jbs $prec,flags,L20 # max length was specified
248 mnegl $1,r0 # default max length
249L20: movl (ap)+,r2 # addr first byte
250 locc $0,r0,(r2) # find the zero at the end
251 movl r1,r5 # addr last byte +1
252 movl r2,r1 # addr first byte
253 jbr prstr
254
255htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f
256Htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'A,'B,'C,'D,'E,'F
257
258octal:
259 movl $30,r2 # init position
260 movl $3,r3 # field width
261 movab htab,llafx # translate table
262 jbr L10
263
264hex:
265 movl $28,r2 # init position
266 movl $4,r3 # field width
267 movab htab,llafx # translate table
268 jbc $caps,flags,L10
269 movab Htab,llafx
270L10: mnegl r3,r6 # increment
271 clrl r1
272 addl2 $4,r5 # room for left affix (2) and slop [forced sign?]
273 movl (ap)+,r0 # fetch arg
274L11: extzv r2,r3,r0,r1 # pull out a digit
275 movb (llafx)[r1],(r5)+ # convert to character
276L12: acbl $0,r6,r2,L11 # continue until done
277 clrq r6 # lrafx, llafx
278 clrb (r5) # flag end
279 skpc $'0,$11,4(sp) # skip over leading zeroes
280 jbc $numsgn,flags,prn3 # easy if no left affix
281 tstl -4(ap) # original value
282 jeql prn3 # no affix on 0, for some reason
283 cmpl r3,$4 # were we doing hex or octal?
284 jneq L12a # octal
285 movb $'x,r0
286 jbc $caps,flags,L12b
287 movb $'X,r0
288L12b: movb r0,-(r1)
289 movl $2,llafx # leading 0x for hex is an affix
290L12a: movb $'0,-(r1) # leading zero for octal is a digit, not an affix
291 jbr prn3 # omit sign (plus, blank) massaging
292
293unsigned:
294lunsigned:
295 bicl2 $1<plssgn|1<blank,flags # omit sign (plus, blank) massaging
296 extzv $1,$31,(ap),r0 # right shift logical 1 bit
297 cvtlp r0,$10,(sp) # convert [n/2] to packed
298 movp $10,(sp),8(sp) # copy packed
299 addp4 $10,8(sp),$10,(sp) # 2*[n/2] in packed, at (sp)
300 blbc (ap)+,L14 # n was even
301 addp4 $1,pone,$10,(sp) # n was odd
302 jbr L14
303
304patdec: # editpc pattern for decimal printing
305 .byte 0xAA # eo$float 10
306 .byte 0x01 # eo$end_float
307 .byte 0 # eo$end
308
309decimal:
310 cvtlp (ap)+,$10,(sp) # 10 digits max
311 jgeq L14
312 incl llafx # minus sign is a left affix
313L14: editpc $10,(sp),patdec,8(sp) # ascii at 8(sp); r5=end+1
314 skpc $' ,$11,8(sp) # skip leading blanks; r1=first
315
316prnum: # r1=addr first byte, r5=addr last byte +1, llafx=size of signs
317 # -1(r1) vacant, for forced sign
318 tstl llafx
319 jneq prn3 # already some left affix, dont fuss
320 jbc $plssgn,flags,prn2
321 movb $'+,-(r1) # needs a plus sign
322 jbr prn4
323prn2: jbc $blank,flags,prn3
324 movb $' ,-(r1) # needs a blank sign
325prn4: incl llafx
326prn3: jbs $prec,flags,prn1
327 movl $1,ndigit # default precision is 1
328prn1: subl3 r1,r5,lrafx # raw width
329 subl2 llafx,lrafx # number of digits
330 subl2 lrafx,ndigit # number of leading zeroes needed
331 jleq prstr # none
332 addl2 llafx,r1 # where current digits start
333 pushl r1 # movcx gobbles registers
334 # check bounds on users who say %.300d
335 movab 32(r5)[ndigit],r2
336 subl2 fp,r2
337 jlss prn5
338 subl2 r2,ndigit
339prn5:
340 #
341 movc3 lrafx,(r1),(r1)[ndigit] # make room in middle
342 movc5 $0,(r1),$ch.zer,ndigit,*(sp) # '0 fill
343 subl3 llafx,(sp)+,r1 # first byte addr
344 addl3 lrafx,r3,r5 # last byte addr +1
345
346prstr: # r1=addr first byte; r5=addr last byte +1
347 # width=minimum width; llafx=len. left affix
348 # ndigit=<avail>
349 subl3 r1,r5,ndigit # raw width
350 subl3 ndigit,width,r0 # pad length
351 jleq padlno # in particular, no left padding
352 jbs $minsgn,flags,padlno
353 # extension for %0 flag causing left zero padding to field width
354 jbs $zfill,flags,padlz
355 # this bsbb needed even if %0 flag extension is removed
356 bsbb padb # blank pad on left
357 jbr padnlz
358padlz:
359 movl llafx,r0
360 jleq padnlx # left zero pad requires left affix first
361 subl2 r0,ndigit # part of total length will be transferred
362 subl2 r0,width # and will account for part of minimum width
363 bsbw strout # left affix
364padnlx:
365 subl3 ndigit,width,r0 # pad length
366 bsbb padz # zero pad on left
367padnlz:
368 # end of extension for left zero padding
369padlno: # remaining: root, possible right padding
370 subl2 ndigit,width # root reduces minimum width
371 movl ndigit,r0 # root length
372p1: bsbw strout # transfer to output buffer
373p3: jbc $vbit,r2,padnpct # percent sign (or null byte via %c) ?
374 decl r0 # yes; adjust count
375 movzbl (r1)+,r2 # fetch byte
376 movq *fdesc,r4 # output buffer descriptor
377 sobgeq r4,p2 # room at the out [inn] ?
378 bsbw strout2 # no; force it, then try rest
379 jbr p3 # here we go 'round the mullberry bush, ...
380p2: movb r2,(r5)+ # hand-deposit the percent or null
381 incl nchar # count it
382 movq r4,*fdesc # store output descriptor
383 jbr p1 # what an expensive hiccup!
384padnpct:
385 movl width,r0 # size of pad
386 jleq loop
387 bsbb padb
388 jbr loop
389
390padz:
391 movb $'0,r2
392 jbr pad
393padb:
394 movb $' ,r2
395pad:
396 subl2 r0,width # pad width decreases minimum width
397 pushl r1 # save non-pad addr
398 movl r0,llafx # remember width of pad
399 subl2 r0,sp # allocate
400 movc5 $0,(r0),r2,llafx,(sp) # create pad string
401 movl llafx,r0 # length
402 movl sp,r1 # addr
403 bsbw strout
404 addl2 llafx,sp # deallocate
405 movl (sp)+,r1 # recover non-pad addr
406 rsb
407
408pone: .byte 0x1C # packed 1
409
410charac:
411 movl (ap)+,r0 # word containing the char
412 movb r0,(r5)+ # one byte, that's all
413
414prbuf:
415 movl sp,r1 # addr first byte
416 jbr prstr
417
418space: bisl2 $1<blank,flags # constant width e fmt, no plus sign
419 jbr L4a
420sharp: bisl2 $1<numsgn,flags # 'self identifying', please
421 jbr L4a
422plus: bisl2 $1<plssgn,flags # always print sign for floats
423 jbr L4a
424minus: bisl2 $1<minsgn,flags # left justification, please
425 jbr L4a
426gnum0: jbs $ndfnd,flags,gnum
427 jbs $prec,flags,gnump # ignore when reading precision
428 bisl2 $1<zfill,flags # leading zero fill, please
429gnum: jbs $prec,flags,gnump
430 moval (width)[width],width # width *= 5;
431 movaw -ch.zer(r0)[width],width # width = 2*witdh + r0 - '0';
432 jbr gnumd
433gnump: moval (ndigit)[ndigit],ndigit # ndigit *= 5;
434 movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0';
435gnumd: bisl2 $1<ndfnd,flags # digit seen
436 jbr L4a
437dot: clrl ndigit # start on the precision
438 bisl2 $1<prec,flags
439 bicl2 $1<ndfnd,flags
440 jbr L4a
441indir:
442 jbs $prec,flags,in1
443 movl (ap)+,width # width specified by parameter
444 jgeq gnumd
445 xorl2 $1<minsgn,flags # parameterized left adjustment
446 mnegl width,width
447 jbr gnumd
448in1:
449 movl (ap)+,ndigit # precision specified by paratmeter
450 jgeq gnumd
451 mnegl ndigit,ndigit
452 jbr gnumd
453
454float:
455 jbs $prec,flags,float1
456 movl $6,ndigit # default # digits to right of decpt.
457float1: bsbw fltcvt
458 addl3 exp,ndigit,r7
459 movl r7,r6 # for later "underflow" checking
460 bgeq fxplrd
461 clrl r7 # poor programmer planning
462fxplrd: cmpl r7,$31 # expressible in packed decimal?
463 bleq fnarro # yes
464 movl $31,r7
465fnarro: subl3 $17,r7,r0 # where to round
466 ashp r0,$17,(sp),$5,r7,16(sp) # do it
467 bvc fnovfl
468 # band-aid for microcode error (spurious overflow)
469 # clrl r0 # assume even length result
470 # jlbc r7,fleven # right
471 # movl $4,r0 # odd length result
472 #fleven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow
473 # bneq fnovfl
474 # end band-aid
475 aobleq $0,r6,fnovfl # if "underflow" then jump
476 movl r7,r0
477 incl exp
478 incl r7
479 ashp r0,$1,pone,$0,r7,16(sp)
480 ashl $-1,r7,r0 # displ to last byte
481 bisb2 sign,16(sp)[r0] # insert sign
482fnovfl:
483 movab 16(sp),r1 # packed source
484 movl r7,r6 # packed length
485 pushab prnum # goto prnum after fall-through call to fedit
486
487
488 # enter via bsb
489 # r1=addr of packed source
490 # 16(r1) used to unpack source
491 # 48(r1) used to construct pattern to unpack source
492 # 48(r1) used to hold result
493 # r6=length of packed source (destroyed)
494 # exp=# digits to left of decimal point (destroyed)
495 # ndigit=# digits to right of decimal point (destroyed)
496 # sign=1 if negative, 0 otherwise
497 # stack will be used for work space for pattern and unpacked source
498 # exits with
499 # r1=addr of punctuated result
500 # r5=addr of last byte +1
501 # llafx=1 if minus sign inserted, 0 otherwise
502fedit:
503 pushab 48(r1) # save result addr
504 movab 48(r1),r3 # pattern addr
505 movb $0x03,(r3)+ # eo$set_signif
506 movc5 $0,(r1),$0x91,r6,(r3) # eo$move 1
507 clrb (r3) # eo$end
508 editpc r6,(r1),48(r1),16(r1) # unpack 'em all
509 subl3 r6,r5,r1 # addr unpacked source
510 movl (sp),r3 # punctuated output placed here
511 clrl llafx
512 jlbc sign,f1
513 movb $'-,(r3)+ # negative
514 incl llafx
515f1: movl exp,r0
516 jgtr f2
517 movb $'0,(r3)+ # must have digit before decimal point
518 jbr f3
519f2: cmpl r0,r6 # limit on packed length
520 jleq f4
521 movl r6,r0
522f4: subl2 r0,r6 # eat some digits
523 subl2 r0,exp # from the exponent
524 movc3 r0,(r1),(r3) # (most of the) digits to left of decimal point
525 movl exp,r0 # need any more?
526 jleq f3
527 movc5 $0,(r1),$'0,r0,(r3) # '0 fill
528f3: movl ndigit,r0 # # digits to right of decimal point
529 jgtr f5
530 jbs $numsgn,flags,f5 # no decimal point unless forced
531 jbcs $dpflag,flags,f6 # no decimal point
532f5: movb $'.,(r3)+ # the decimal point
533f6: mnegl exp,r0 # "leading" zeroes to right of decimal point
534 jleq f9
535 cmpl r0,ndigit # cant exceed this many
536 jleq fa
537 movl ndigit,r0
538fa: subl2 r0,ndigit
539 movc5 $0,(r1),$'0,r0,(r3)
540f9: movl ndigit,r0
541 cmpl r0,r6 # limit on packed length
542 jleq f7
543 movl r6,r0
544f7: subl2 r0,ndigit # eat some digits from the fraction
545 movc3 r0,(r1),(r3) # (most of the) digits to right of decimal point
546 movl ndigit,r0 # need any more?
547 jleq f8
548 # check bounds on users who say %.300f
549 movab 32(r3)[r0],r2
550 subl2 fp,r2
551 jlss fb
552 subl2 r2,r0 # truncate, willy-nilly
553 movl r0,ndigit # and no more digits later, either
554fb:
555 #
556 subl2 r0,ndigit # eat some digits from the fraction
557 movc5 $0,(r1),$'0,r0,(r3) # '0 fill
558f8: movl r3,r5 # addr last byte +1
559 popr $1<1 # [movl (sp)+,r1] addr first byte
560 rsb
561
562patexp: .byte 0x03 # eo$set_signif
563 .byte 0x44,'e # eo$insert 'e
564 .byte 0x42,'+ # eo$load_plus '+
565 .byte 0x04 # eo$store_sign
566 .byte 0x92 # eo$move 2
567 .byte 0 # eo$end
568
569scien:
570 incl ndigit
571 jbs $prec,flags,L23
572 movl $7,ndigit
573L23: bsbw fltcvt # get packed digits
574 movl ndigit,r7
575 cmpl r7,$31 # expressible in packed decimal?
576 jleq snarro # yes
577 movl $31,r7
578snarro: subl3 $17,r7,r0 # rounding position
579 ashp r0,$17,(sp),$5,r7,16(sp) # shift and round
580 bvc snovfl
581 # band-aid for microcode error (spurious overflow)
582 # clrl r0 # assume even length result
583 # jlbc ndigit,sceven # right
584 # movl $4,r0 # odd length result
585 #sceven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow
586 # bneq snovfl
587 # end band-aid
588 incl exp # rounding overflowed to 100...
589 subl3 $1,r7,r0
590 ashp r0,$1,pone,$0,r7,16(sp)
591 ashl $-1,r7,r0 # displ to last byte
592 bisb2 sign,16(sp)[r0] # insert sign
593snovfl:
594 jbs $gflag,flags,gfmt # %g format
595 movab 16(sp),r1
596 bsbb eedit
597eexp:
598 movl r1,r6 # save fwa from destruction by cvtlp
599 subl3 $1,sexp,r0 # 1P exponent
600 cvtlp r0,$2,(sp) # packed
601 editpc $2,(sp),patexp,(r5)
602 movl r6,r1 # fwa
603 jbc $caps,flags,prnum
604 xorb2 $'e^'E,-4(r5)
605 jbr prnum
606
607eedit:
608 movl r7,r6 # packed length
609 decl ndigit # 1 digit before decimal point
610 movl exp,sexp # save from destruction
611 movl $1,exp # and pretend
612 jbr fedit
613
614gfmt:
615 addl3 $3,exp,r0 # exp is 1 more than e
616 jlss gfmte # (e+1)+3<0, e+4<=-1, e<=-5
617 subl2 $3,r0 # exp [==(e+1)]
618 cmpl r0,ndigit
619 jgtr gfmte # e+1>n, e>=n
620gfmtf:
621 movl r7,r6
622 subl2 r0,ndigit # n-e-1
623 movab 16(sp),r1
624 bsbw fedit
625g1: jbs $numsgn,flags,g2
626 jbs $dpflag,flags,g2 # dont strip if no decimal point
627g3: cmpb -(r5),$'0 # strip trailing zeroes
628 jeql g3
629 cmpb (r5),$'. # and trailing decimal point
630 jeql g2
631 incl r5
632g2: jbc $gflag,flags,eexp
633 jbr prnum
634gfmte:
635 movab 16(sp),r1 # packed source
636 bsbw eedit
637 jbsc $gflag,flags,g1 # gflag now means "use %f" [hence no exponent]
638
639general:
640 jbs $prec,flags,gn1
641 movl $6,ndigit # default precision is 6 significant digits
642gn1: tstl ndigit # cannot allow precision of 0
643 jgtr gn2
644 movl $1,ndigit # change 0 to 1, willy-nilly
645gn2: jbcs $gflag,flags,L23
646 jbr L23 # safety net
647
648 # convert double-floating at (ap) to 17-digit packed at (sp),
649 # set 'sign' and 'exp', advance ap.
650fltcvt:
651 clrb sign
652 movd (ap)+,r5
653 jeql fzero
654 bgtr fpos
655 mnegd r5,r5
656 incb sign
657fpos:
658 extzv $7,$8,r5,r2 # exponent of 2
659 movab -0200(r2),r2 # unbias
660 mull2 $59,r2 # 59/196: 3rd convergent continued frac of log10(2)
661 jlss eneg
662 movab 196(r2),r2
663eneg:
664 movab -98(r2),r2
665 divl2 $196,r2
666 bsbw expten
667 cmpd r0,r5
668 bgtr ceil
669 incl r2
670ceil: movl r2,exp
671 mnegl r2,r2
672 cmpl r2,$29 # 10^(29+9) is all we can handle
673 bleq getman
674 muld2 ten16,r5
675 subl2 $16,r2
676getman: addl2 $9,r2 # -ceil(log10(x)) + 9
861952dc 677 jsb expten
4e447cd1
BJ		 678 emodd r0,r4,r5,r0,r5 # (r0+r4)*r5; r0=int, r5=frac
679fz1: cvtlp r0,$9,16(sp) # leading 9 digits
680 ashp $8,$9,16(sp),$0,$17,4(sp) # as top 9 of 17
681 emodd ten8,$0,r5,r0,r5
682 cvtlp r0,$8,16(sp) # trailing 8 digits
683 # if precision >= 17, must round here
684 movl ndigit,r7 # so figure out what precision is
685 pushab scien
686 cmpl (sp)+,(sp)
687 jleq gm1 # who called us?
688 addl2 exp,r7 # float; adjust for exponent
689gm1: cmpl r7,$17
690 jlss gm2
691 cmpd r5,$0d0.5 # must round here; check fraction
692 jlss gm2
693 bisb2 $0x10,8+4(sp) # increment l.s. digit
694gm2: # end of "round here" code
695 addp4 $8,16(sp),$17,4(sp) # combine leading and trailing
696 bisb2 sign,12(sp) # and insert sign
697 rsb
698fzero: clrl r0
699 movl $1,exp # 0.000e+00 and 0.000 rather than 0.000e-01 and .000
700 jbr fz1
701
702 .align 2
703lsb: .long 0x00010000 # lsb in the crazy floating-point format
704
705 # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4
706 # preserve r2, r5||r6
707expten:
708 movd $0d1.0,r0 # begin computing 10^exp10
709 clrl r4 # bit counter
710 movad ten1,r3 # table address
711 tstl r2
712 bgeq e10lp
713 mnegl r2,r2 # get absolute value
714 jbss $6,r2,e10lp # flag as negative
715e10lp: jbc r4,r2,el1 # want this power?
716 muld2 (r3),r0 # yes
717el1: addl2 $8,r3 # advance to next power
718 aobleq $5,r4,e10lp # through 10^32
719 jbcc $6,r2,el2 # correct for negative exponent
720 divd3 r0,$0d1.0,r0 # by taking reciprocal
721 cmpl $28,r2
722 jneq enm28
723 addl2 lsb,r1 # 10**-28 needs lsb incremented
724enm28: mnegl r2,r2 # original exponent of 10
725el2: addl3 $5*8,r2,r3 # negative bit positions are illegal?
726 jbc r3,xlsbh-5,eoklsb
727 subl2 lsb,r1 # lsb was too high
728eoklsb:
729 movzbl xprec[r2],r4 # 8 extra bits
730 rsb
731
732 # powers of ten
733 .align 2
734ten1: .word 0x4220,0,0,0
735ten2: .word 0x43c8,0,0,0
736ten4: .word 0x471c,0x4000,0,0
737ten8: .word 0x4dbe,0xbc20,0,0
738ten16: .word 0x5b0e,0x1bc9,0xbf04,0
739ten32: .word 0x759d,0xc5ad,0xa82b,0x70b6
740
741 # whether lsb is too high or not
742 .byte 1:0,1:0,1:0,1:0,1:1,1:0,1:1,1:0 # -40 thru -33
743 .byte 1:0,1:1,1:0,1:0,1:0,1:0,1:1,1:0 # -32 thru -25
744 .byte 1:0,1:0,1:1,1:1,1:1,1:1,1:0,1:0 # -24 thru -17
745 .byte 1:0,1:1,1:0,1:0,1:1,1:1,1:1,1:1 # -16 thru -9
746 .byte 1:1,1:1,1:1,1:0,1:0,1:0,1:0,1:1 # -8 thru -1
747xlsbh:
748 .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 0 thru 7
749 .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 8 thru 15
750 .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 16 thru 23
751 .byte 1:0,1:1,1:1,1:0,1:1,1:1,1:1,1:1 # 24 thru 31
752 .byte 1:1,1:1,1:1,1:1,1:1,1:1,1:1 # 32 thru 38
753
754 # bytes of extra precision
755 .byte 0x56,0x76,0xd3,0x88,0xb5,0x62 # -38 thru -33
756 .byte 0xba,0xf5,0x32,0x3e,0x0e,0x48,0xdb,0x51 # -32 thru -25
757 .byte 0x53,0x27,0xb1,0xef,0xeb,0xa5,0x07,0x49 # -24 thru -17
758 .byte 0x5b,0xd9,0x0f,0x13,0xcd,0xff,0xbf,0x97 # -16 thru -9
759 .byte 0xfd,0xbc,0xb6,0x23,0x2c,0x3b,0x0a,0xcd # -8 thru -1
760xprec:
761 .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 0 thru 7
762 .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 8 thru 15
763 .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 16 thru 23
764 .byte 0x00,0xa0,0xc8,0x3a,0x84,0xe4,0xdc,0x92 # 24 thru 31
765 .byte 0x9b,0x00,0xc0,0x58,0xae,0x18,0xef # 32 thru 38
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.