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