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