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