![[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] / 3BSD / libc / stdio|
Return to doprnt.s CVS log | Up to [CSRG BSD Unix] / 3BSD / libc / stdio |
1.1 root 1: # C library -- conversions
2:
3: .globl __doprnt
4: .globl __strout
5:
6: #define flags r10
7: #define literb 0
8: #define liter 1
9: #define ndfndb 0
10: #define ndfnd 1
11: #define ljustb 1
12: #define ljust 2
13: #define zfillb 2
14: #define zfill 4
15: #define precb 3
16: #define prec 8
17: #define psignb 4
18: #define psign 16
19: #define gflagb 5
20: #define gflag 32
21: #define width r9
22: #define ndigit r8
23: #define fdesc -4(fp)
24: #define exp -8(fp)
25: #define sign -9(fp)
26: .set one,010 # 1.0 in floating immediate
27: .set ch.zer,'0 # cpp doesn't like single appostrophes
28:
29: .align 1
30: __doprnt:
31: .word 0xfc0 # uses r11-r6
32: subl2 $128,sp
33: movl 4(ap),r11 # addr of format string
34: movl 12(ap),fdesc # output FILE ptr
35: movl 8(ap),ap # addr of first arg
36: loop:
37: movl r11,r0 # current point in format
38: bicl2 $liter,flags # no literal characters yet
39: L1: movb (r11)+,width # next character of format
40: beql L2 # end of format string
41: cmpb width,$'%
42: beql L2 # warning character
43: bisl2 $liter,flags # literal character
44: jbr L1
45: L2: blbc flags,L3 # bbc $literb,flags,L3 # no literals in format
46: pushl fdesc # file pointer
47: pushl $0 # no left/right adjust
48: pushl r0 # addr
49: subl3 r0,r11,r1 # length
50: subl3 $1,r1,-(sp) # % or null not part of literal
51: calls $4,__strout # dump the literal
52: L3:
53: blbs width,L4 # % is odd; end of format?
54: ret # yes
55:
56: # htab overlaps last 16 characters of ftab
57: ftab: .byte 0, 0, 0,'c,'d,'e,'f,'g, 0, 0, 0,'+,'l,'-,'.,'o
58: htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f
59:
60: L4: movl sp,r5 # reset output buffer pointer
61: clrq r9 # width; flags ljustb,ndfndb,zfillb
62: L4a: movzbl (r11)+,r0 # supposed format
63: extzv $0,$5,r0,r1 # bottom 5 bits
64: L4b: cmpb r0,ftab[r1] # good enough?
65: jneq L6 # no
66: L4c: casel r1,$3,$22 # yes
67: L5: .word charac-L5 # c
68: .word decimal-L5 # d
69: .word scien-L5 # e
70: .word float-L5 # f
71: .word general-L5 # g
72: .word L6-L5 # h
73: .word L6-L5 # i
74: .word L6-L5 # j
75: .word plus-L5 # +
76: .word longorunsg-L5 # l
77: .word minus-L5 # -
78: .word dot-L5 # .
79: .word octal-L5 # o
80: .word gnum0-L5 # 0
81: .word gnum-L5 # 1
82: .word gnum-L5 # 2
83: .word gnum-L5 # 3
84: .word gnum-L5 # 4
85: .word gnum-L5 # 5
86: .word gnum-L5 # 6
87: .word gnum-L5 # 7
88: .word gnum-L5 # 8
89: .word gnum-L5 # 9
90:
91: L6: jbcs $5,r0,L4b # capitals same as small
92: cmpb r0,$'s
93: jeql string
94: cmpb r0,$'x
95: jeql hex
96: cmpb r0,$'u
97: jeql unsigned
98: cmpb r0,$'r
99: jeql remote
100: movzbl -1(r11),r0 # orginal "format" character
101: cmpb r0,$'*
102: jeql indir
103: L9: movb r0,(r5)+ # print the unfound character
104: jbr prbuf
105:
106: nulstr:
107: .byte '(,'n,'u,'l,'l,'),0
108:
109: string:
110: movl ndigit,r0
111: jbs $precb,flags,L20 # max length was specified
112: mnegl $1,r0 # default max length
113: L20: movl (ap)+,r2 # addr first byte
114: bneq L21
115: movab nulstr,r2
116: L21: locc $0,r0,(r2) # find the zero at the end
117: movl r1,r5 # addr last byte +1
118: movl r2,r1 # addr first byte
119: jbr prstr
120:
121:
122: longorunsg:
123: movb (r11)+,r0
124: cmpb r0,$'o
125: jeql loct
126: cmpb r0,$'x
127: jeql lhex
128: cmpb r0,$'d
129: jeql long
130: cmpb r0,$'u
131: jeql lunsigned
132: decl r11
133: jbr unsigned
134:
135: loct:
136: octal:
137: movl $30,r2 # init position
138: movl $3,r3 # field width
139: movl $10,r4 # result length -1
140: jbr L10
141:
142: lhex:
143: hex:
144: movl $28,r2 # init position
145: movl $4,r3 # field width
146: movl $7,r4 # result length -1
147: L10: mnegl r3,r6 # increment
148: clrl r1
149: movl (ap)+,r0 # fetch arg
150: L11: extzv r2,r3,r0,r1 # pull out a digit
151: movb htab[r1],(r5)+ # convert to character
152: L12: acbl $0,r6,r2,L11 # continue until done
153: clrb (r5) # flag end
154: skpc $'0,r4,(sp) # skip over leading zeroes
155: jbr prstr
156:
157: patdec: # editpc pattern for decimal printing
158: .byte 0xA9 # eo$float 9
159: .byte 0x01 # eo$end_float
160: .byte 0x91 # eo$move 1
161: .byte 0 # eo$end
162:
163: long:
164: decimal:
165: cvtlp (ap)+,$10,(sp) # 10 digits max
166: L14: editpc $10,(sp),patdec,8(sp) # ascii at 8(sp); r5=end+1
167: skpc $' ,$10,8(sp) # skip leading blanks; r1=first
168:
169: prstr: # r1=addr first byte; r5=addr last byte +1
170: cvtbl $' ,-(sp) # blank fill
171: jbc $zfillb,flags,L15
172: cvtbl $'0,(sp) # zero fill
173: L15: pushl fdesc # FILE
174: subl2 r1,r5 # r5=actual length=end+1-first
175: subl3 r5,width,r0 # if >0, how much to fill
176: bgeq L24
177: clrl r0 # no fill
178: L24: jbs $ljustb,flags,L25
179: mnegl r0,r0
180: L25: pushl r0 # fill count
181: pushl r1 # addr first byte
182: pushl r5 # length
183: calls $5,__strout
184: jbr loop
185:
186: pone: .byte 0x1C # packed 1
187:
188: unsigned:
189: lunsigned:
190: extzv $1,$31,(ap),r0 # right shift logical 1 bit
191: cvtlp r0,$10,(sp) # convert [n/2] to packed
192: movp $10,(sp),8(sp) # copy packed
193: addp4 $10,8(sp),$10,(sp) # 2*[n/2] in packed, at (sp)
194: blbc (ap)+,L14 # n was even
195: addp4 $1,pone,$10,(sp) # n was odd
196: jbr L14
197:
198: charac:
199: movl $4,r0 # chars per word
200: L18: movb (ap)+,(r5)+ # transfer char
201: bneq L19
202: decl r5 # omit null characters
203: L19: sobgtr r0,L18
204:
205: prbuf:
206: movl sp,r1 # addr first byte
207: jbr prstr
208:
209: plus: bisl2 $psign,flags # always print sign for floats
210: jbr L4a
211: minus: bisl2 $ljust,flags # left justification, please
212: jbr L4a
213: gnum0: jbs $ndfndb,flags,gnum
214: jbs $precb,flags,gnump # ignore when reading precision
215: bisl2 $zfill,flags # leading zero fill, please
216: gnum: jbs $precb,flags,gnump
217: moval (width)[width],width # width *= 5;
218: movaw -ch.zer(r0)[width],width # width = 2*witdh + r0 - '0';
219: jbr gnumd
220: gnump: moval (ndigit)[ndigit],ndigit # ndigit *= 5;
221: movaw -ch.zer(r0)[ndigit],ndigit # ndigit = 2*ndigit + r0 - '0';
222: gnumd: bisl2 $ndfnd,flags # digit seen
223: jbr L4a
224: dot: clrl ndigit # start on the precision
225: bisl2 $prec,flags
226: bicl2 $ndfnd,flags
227: jbr L4a
228: indir: movl (ap)+,ndigit # width specified by parameter
229: jbr gnumd
230: remote: movl (ap)+,ap
231: movl (ap)+,r11
232: jbr loop
233:
234: float:
235: bsbw fltcvt
236: fltg: jbs $ndfndb,flags,float1
237: movl $6,ndigit # default # digits to right of decpt.
238: float1: addl3 exp,ndigit,r7
239: movl r7,r6 # for later "underflow" checking
240: bgeq fxplrd
241: clrl r7 # poor programmer planning
242: fxplrd: cmpl r7,$31 # expressible in packed decimal?
243: bleq fnarro # yes
244: movl $31,r7
245: fnarro: subl3 $17,r7,r0 # where to round
246: ashp r0,$17,(sp),$5,r7,16(sp) # do it
247: bvc fnovfl
248: # band-aid for microcode error (spurious overflow)
249: clrl r0 # assume even length result
250: jlbc r7,fleven # right
251: movl $4,r0 # odd length result
252: fleven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow
253: bneq fnovfl
254: # end band-aid
255: aobleq $0,r6,fnovfl # if "underflow" then jump
256: movl r7,r0
257: incl exp
258: incl r7
259: ashp r0,$1,pone,$0,r7,16(sp)
260: ashl $-1,r7,r0 # displ to last byte
261: bisb2 sign,16(sp)[r0] # insert sign
262: fnovfl:
263: movc3 $4,patsci,(sp)
264: clrl r6 # # digits moved so far
265: movl exp,r0
266: bleq fexpng
267: bsbb patmov # digits to left of decpt.
268: fexpng: tstl ndigit
269: jeql fnodp
270: movc3 $2,fpatdp,(r3)
271: tstl exp
272: bgeq fxppos
273: addl3 exp,ndigit,r6
274: bgeq flfakl
275: clrl r6 # it's all fill
276: flfakl: subl3 r6,$31,r6 # fake length for patmov
277: flfill: movc3 $2,fpatzf,(r3) # zero fill to right of dec.pt
278: fxppos: movl ndigit,r0
279: bsbb patmov
280: fnodp: sobgeq r6,fledit # must move at least 1 digit
281: movl $31,r6 # none moved; fake it
282: aobleq $1,ndigit,flfill # with a one-character zero fill
283: fledit: editpc r7,16(sp),(sp),32(sp)
284: jbr prflt
285:
286: patexp: .byte 0x03 # eo$set_signif
287: .byte 0x44,'e # eo$insert 'e
288: .byte 0x42,'+ # eo$load_plus '+
289: .byte 0x04 # eo$store_sign
290: .byte 0x92 # eo$move 2
291: .byte 0 # eo$end
292: patsci: .byte 0x42,'+ # eo$load_plus '+
293: .byte 0x03 # eo$set_signif
294: .byte 0x04 # eo$store_sign
295: .byte 0x91 # eo$move 1
296: fpatdp: .byte 0x44,'. # eo$insert '.
297: fpatzf: .byte 0x40,'0 # eo$load_fill '0
298:
299: # construct pattern at (r3) to move r0 digits in editpc;
300: # r6 digits already moved for this number
301: patmov:
302: movb $0x90,r2 # eo$move
303: subl3 r6,$31,r1 # # digits remaining in packed
304: addl2 r0,r6
305: cmpl r0,r1 # enough digits remaining?
306: bleq patsml # yes
307: tstl exp # zero 'fill'; before or after rest?
308: bgeq pataft # after
309: pushl r1 # # digits remaining
310: movb $0x80,r2 # eo$fill
311: subl3 $31,r6,r0 # number of fill bytes
312: bsbb patsml # recursion!
313: movl (sp)+,r0
314: movb $0x90,r2 # eo$move
315: jbr patsml
316: pataft: movl r1,r0 # last of the 31
317: bsbb patsml # recursion!
318: subl3 $31,r6,r0 # number of fill bytes
319: movb $0x80,r2 # eo$fill
320: patsml: tstl r0
321: bleq patzer # DEC doesn't like repetition counts of 0
322: mnegl $15,r1 # 15 digits at a time
323: subl2 r1,r0 # counteract acbl
324: jbr pattst
325: patmlp: bisb3 r2,$15,(r3)+ # 15
326: pattst: acbl $16,r1,r0,patmlp # until <= 15 left
327: bisb3 r2,r0,(r3)+ # rest
328: patzer: clrb (r3) # eo$end
329: rsb
330:
331: scien:
332: bsbw fltcvt # get packed digits
333: scig: incl ndigit
334: jbs $ndfndb,flags,L23
335: movl $7,ndigit
336: L23: subl3 $17,ndigit,r0 # rounding position
337: ashp r0,$17,(sp),$5,ndigit,16(sp) # shift and round
338: bvc snovfl
339: # band-aid for microcode error (spurious overflow)
340: clrl r0 # assume even length result
341: jlbc ndigit,sceven # right
342: movl $4,r0 # odd length result
343: sceven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow
344: bneq snovfl
345: # end band-aid
346: incl exp # rounding overflowed to 100...
347: subl3 $1,ndigit,r0
348: ashp r0,$1,pone,$0,ndigit,16(sp)
349: ashl $-1,ndigit,r0 # displ to last byte
350: bisb2 sign,16(sp)[r0] # insert sign
351: snovfl:
352: jbc $gflagb,flags,enotg # not %g format
353: # find trailing zeroes in packed number
354: ashl $-1,ndigit,r0
355: addl2 r3,r0 # addr of l.s.digit and sign
356: movl $4,r1 # bit position of digit
357: movl ndigit,r7 # current length of packed
358: jbr gtz
359: gtz1: xorl2 $4,r1 # position of next digit
360: bneq gtz # same byte
361: decl r0 # different byte
362: gtz: cmpv r1,$4,(r0),$0 # a trailing zero?
363: jneq gntz
364: sobgtr r7,gtz1
365: incl r7
366: gntz: # r7: minimum width of fraction
367: cmpl exp,$-4
368: jleq eg # small exponents use %e
369: subl3 r7,exp,r0
370: cmpl $5,r0
371: jleq eg # so do (w+5) <= exp
372: tstl r0 # rest use %f
373: jleq fg # did we trim too many trailing zeroes?
374: movl exp,r7 # yes
375: fg: subl3 ndigit,r7,r0
376: ashp r0,ndigit,16(sp),$0,r7,(sp)
377: movp r7,(sp),16(sp)
378: subl3 exp,r7,ndigit # correct ndigit for %f
379: jbr fnovfl
380: eg: subl3 ndigit,r7,r0
381: ashp r0,ndigit,16(sp),$0,r7,(sp)
382: movp r7,(sp),16(sp)
383: movl r7,ndigit # packed number has been trimmed
384: enotg:
385: movc3 $7,patsci,(sp)
386: movl $1,r6 # 1P
387: subl3 $1,ndigit,r0 # digits after dec.pt
388: bsbw patmov
389: editpc ndigit,16(sp),(sp),32(sp) # 32(sp)->result, r5->(end+1)
390: decl exp # compensate: 1 digit left of dec.pt
391: cvtlp exp,$2,(sp) # exponent
392: editpc $2,(sp),patexp,(r5)
393: prflt: movab 32(sp),r1
394: jbs $psignb,flags,prflt1
395: cmpb (r1)+,$'+
396: beql prflt1
397: decl r1
398: prflt1: skpc $' ,$63,(r1)
399: jbr prstr
400:
401: general:
402: jbcs $gflagb,flags,scien
403: jbr scien # safety net
404:
405: # convert double-floating at (ap) to 17-digit packed at (sp),
406: # set 'sign' and 'exp', advance ap.
407: fltcvt:
408: clrb sign
409: movd (ap)+,r5
410: jeql fzero
411: bgtr fpos
412: mnegd r5,r5
413: incb sign
414: fpos:
415: extzv $7,$8,r5,r2 # exponent of 2
416: movaw -0600(r2)[r2],r2 # unbias and mult by 3
417: bgeq epos
418: subl2 $9,r2
419: epos: divl2 $10,r2
420: bsbb expten
421: cmpd r0,r5
422: bgtr ceil
423: incl r2
424: ceil: movl r2,exp
425: mnegl r2,r2
426: cmpl r2,$29 # 10^(29+9) is all we can handle
427: bleq getman
428: muld2 ten16,r5
429: subl2 $16,r2
430: getman: addl2 $9,r2 # -ceil(log10(x)) + 9
431: bsbb expten
432: emodd r0,r4,r5,r0,r5 # (r0+r4)*r5; r0=int, r5=frac
433: fz1: cvtlp r0,$9,16(sp) # leading 9 digits
434: ashp $8,$9,16(sp),$0,$17,4(sp) # as top 9 of 17
435: emodd ten8,$0,r5,r0,r5
436: cvtlp r0,$8,16(sp) # trailing 8 digits
437: addp4 $8,16(sp),$17,4(sp) # combine leading and trailing
438: bisb2 sign,12(sp) # and insert sign
439: rsb
440: fzero: clrl r0
441: movl $1,exp # 0.000e+00 and 0.000 rather than 0.000e-01 and .000
442: jbr fz1
443:
444: # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4
445: # preserve r2, r5||r6
446: expten:
447: movd $one,r0 # begin computing 10^exp10
448: clrl r4 # bit counter
449: movad ten1,r3 # table address
450: tstl r2
451: bgeq e10lp
452: mnegl r2,r2 # get absolute value
453: jbss $6,r2,e10lp # flag as negative
454: e10lp: jbc r4,r2,el1 # want this power?
455: muld2 (r3),r0 # yes
456: el1: addl2 $8,r3 # advance to next power
457: aobleq $5,r4,e10lp # through 10^32
458: jbcc $6,r2,el2 # correct for negative exponent
459: divd3 r0,$one,r0 # by taking reciprocal
460: mnegl r2,r2
461: el2: clrl r4 # 8 extra bits of precision
462: rsb
463:
464: # powers of ten
465: .align 3
466: ten1: .word 0x4220,0,0,0
467: ten2: .word 0x43c8,0,0,0
468: ten4: .word 0x471c,0x4000,0,0
469: ten8: .word 0x4dbe,0xbc20,0,0
470: ten16: .word 0x5b0e,0x1bc9,0xbf04,0
471: ten32: .word 0x759d,0xc5ad,0xa82b,0x70b6
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.