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
|
Last modified: 1985-06-06
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1108 |
|