|
|
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.