![[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 [Research Unix] / researchv10no / libc / stdio / ostdio|
Return to doprnt.s CVS log | Up to [Research Unix] / researchv10no / libc / stdio / ostdio |
1.1 ! root 1: # 1 "doprnt.nS" ! 2: ! 3: # C library -- conversions ! 4: ! 5: .globl __doprnt ! 6: .globl __flsbuf ! 7: ! 8: ! 9: ! 10: ! 11: ! 12: ! 13: ! 14: ! 15: ! 16: ! 17: ! 18: ! 19: ! 20: ! 21: ! 22: ! 23: ! 24: ! 25: ! 26: ! 27: ! 28: ! 29: .set ch.zer,'0 # cpp doesn't like single appostrophes ! 30: .set ch.per,'% # I'm convinced BE ! 31: ! 32: .align 2 ! 33: ! 34: ! 35: ! 36: ! 37: ! 38: ! 39: ! 40: ! 41: ! 42: ! 43: ! 44: ! 45: ! 46: ! 47: ! 48: ! 49: ! 50: ! 51: strfoo: ! 52: clrl r4 # fix interrupt race ! 53: jbr strok # and try again ! 54: strmore: ! 55: movzbl (r1)+,r2 # one char ! 56: ! 57: jeql stresc2 # BE ! 58: cmpl r2,$ch.per # BE ! 59: jeql stresc2 # bad guy in disguise (outbuf is full) ! 60: strout2: # enter here to force out r2; r0,r1 must be set ! 61: ! 62: movq r0,-(sp) # BE ! 63: pushl -4(fp) # FILE ! 64: pushl r2 # the char ! 65: calls $2,__flsbuf # please empty the buffer and handle 1 char ! 66: tstl r0 # successful? ! 67: jgeq strm1 # yes ! 68: jbcs $31,-16(fp),strm1 # turn on -17(fp) bit of -16(fp) to signify error ! 69: strm1: ! 70: incl -16(fp) # count the char ! 71: ! 72: movq r0,(sp)+ # BE ! 73: strout: # enter via bsb with (r0,r1)=input descriptor ! 74: ! 75: movq *-4(fp),r4 # output descriptor ! 76: jbs $31,r4,strfoo # negative count is a no no ! 77: strok: ! 78: addl2 r0,-16(fp) # we intend to move this many chars ! 79: ! 80: clrl r2 ! 81: tstl r0 ! 82: bleq movdon ! 83: movlp: ! 84: tstl r4 ! 85: bleq movdon ! 86: movzbl (r1)+,r3 ! 87: ! 88: beql 2f # BE ! 89: cmpl r3,$ch.per # BE ! 90: bneq 1f ! 91: 2: # BE ! 92: mnegl $1,r2 ! 93: decl r1 ! 94: brb movdon ! 95: 1: ! 96: movb r3,(r5)+ ! 97: decl r4 ! 98: sobgtr r0,movlp ! 99: ! 100: ! 101: ! 102: ! 103: movdon: movq r4,*-4(fp) ! 104: subl2 r0,-16(fp) # some chars not moved ! 105: jbs $1,r2,stresc # terminated by escape? ! 106: sobgeq r0,strmore # no; but out buffer might be full ! 107: stresc: ! 108: rsb ! 109: stresc2: ! 110: incl r0 # fix the length ! 111: decl r1 # and the addr ! 112: movl $1<1,r2 # fake condition codes ! 113: rsb ! 114: ! 115: errdone: ! 116: jbcs $31,-16(fp),prdone # set error bit ! 117: prdone: ! 118: movl -16(fp),r0 ! 119: ret ! 120: ! 121: .align 1 ! 122: __doprnt: ! 123: .word 0xfc0 # uses r11-r6 ! 124: movab -256(sp),sp # work space ! 125: movl 4(ap),r11 # addr of format string ! 126: movl 12(ap),-4(fp) # output FILE ptr ! 127: movl 8(ap),ap # addr of first arg ! 128: clrl -16(fp) # number of chars transferred ! 129: loop: ! 130: movzwl $65535,r0 # pseudo length ! 131: movl r11,r1 # fmt addr ! 132: # comet sucks. ! 133: movq *-4(fp),r4 ! 134: subl3 r1,r5,r2 ! 135: jlss lp1 ! 136: cmpl r0,r2 ! 137: jleq lp1 ! 138: movl r2,r0 ! 139: lp1: ! 140: # ! 141: bsbw strout # copy to output, stop at null or percent ! 142: movl r1,r11 # new fmt ! 143: jbc $1,r2,loop # if no escape, then very long fmt ! 144: tstb (r11)+ # escape; null or percent? ! 145: jeql prdone # null means end of fmt ! 146: ! 147: movl sp,r5 # reset output buffer pointer ! 148: clrq r9 # r9; r10 ! 149: clrq r6 # r6,r7 ! 150: longorunsg: # we can ignore both of these distinctions ! 151: short: ! 152: L4a: ! 153: movzbl (r11)+,r0 # so capital letters can tail merge ! 154: L4: caseb r0,$' ,$'x-' # format char ! 155: L5: ! 156: .word space-L5 # space ! 157: .word fmtbad-L5 # ! ! 158: .word fmtbad-L5 # " ! 159: .word sharp-L5 # # ! 160: .word fmtbad-L5 # $ ! 161: .word fmtbad-L5 # % ! 162: .word fmtbad-L5 # & ! 163: .word fmtbad-L5 # ' ! 164: .word fmtbad-L5 # ( ! 165: .word fmtbad-L5 # ) ! 166: .word indir-L5 # * ! 167: .word plus-L5 # + ! 168: .word fmtbad-L5 # , ! 169: .word minus-L5 # - ! 170: .word dot-L5 # . ! 171: .word fmtbad-L5 # / ! 172: .word gnum0-L5 # 0 ! 173: .word gnum-L5 # 1 ! 174: .word gnum-L5 # 2 ! 175: .word gnum-L5 # 3 ! 176: .word gnum-L5 # 4 ! 177: .word gnum-L5 # 5 ! 178: .word gnum-L5 # 6 ! 179: .word gnum-L5 # 7 ! 180: .word gnum-L5 # 8 ! 181: .word gnum-L5 # 9 ! 182: .word fmtbad-L5 # : ! 183: .word fmtbad-L5 # ; ! 184: .word fmtbad-L5 # < ! 185: .word fmtbad-L5 # = ! 186: .word fmtbad-L5 # > ! 187: .word fmtbad-L5 # ? ! 188: .word fmtbad-L5 # @ ! 189: .word fmtbad-L5 # A ! 190: .word fmtbad-L5 # B ! 191: .word fmtbad-L5 # C ! 192: .word decimal-L5 # D ! 193: .word capital-L5 # E ! 194: .word fmtbad-L5 # F ! 195: .word capital-L5 # G ! 196: .word fmtbad-L5 # H ! 197: .word fmtbad-L5 # I ! 198: .word fmtbad-L5 # J ! 199: .word fmtbad-L5 # K ! 200: .word fmtbad-L5 # L ! 201: .word fmtbad-L5 # M ! 202: .word fmtbad-L5 # N ! 203: .word octal-L5 # O ! 204: .word fmtbad-L5 # P ! 205: .word fmtbad-L5 # Q ! 206: .word fmtbad-L5 # R ! 207: .word fmtbad-L5 # S ! 208: .word fmtbad-L5 # T ! 209: .word unsigned-L5 # U ! 210: .word fmtbad-L5 # V ! 211: .word fmtbad-L5 # W ! 212: .word capital-L5 # X ! 213: .word fmtbad-L5 # Y ! 214: .word fmtbad-L5 # Z ! 215: .word fmtbad-L5 # [ ! 216: .word fmtbad-L5 # \ ! 217: .word fmtbad-L5 # ] ! 218: .word fmtbad-L5 # ^ ! 219: .word fmtbad-L5 # _ ! 220: .word fmtbad-L5 # ` ! 221: .word fmtbad-L5 # a ! 222: .word fmtbad-L5 # b ! 223: .word charac-L5 # c ! 224: .word decimal-L5 # d ! 225: .word scien-L5 # e ! 226: .word float-L5 # f ! 227: .word general-L5 # g ! 228: .word short-L5 # h ! 229: .word fmtbad-L5 # i ! 230: .word fmtbad-L5 # j ! 231: .word fmtbad-L5 # k ! 232: .word longorunsg-L5 # l ! 233: .word fmtbad-L5 # m ! 234: .word fmtbad-L5 # n ! 235: .word octal-L5 # o ! 236: .word fmtbad-L5 # p ! 237: .word fmtbad-L5 # q ! 238: .word fmtbad-L5 # r ! 239: .word string-L5 # s ! 240: .word fmtbad-L5 # t ! 241: .word unsigned-L5 # u ! 242: .word fmtbad-L5 # v ! 243: .word fmtbad-L5 # w ! 244: .word hex-L5 # x ! 245: fmtbad: ! 246: movb r0,(r5)+ # print the unfound character ! 247: jeql errdone # dumb users who end the format with a % ! 248: jbr prbuf ! 249: capital: ! 250: bisl2 $1<6,r10 # note that it was capitalized ! 251: xorb2 $'a^'A,r0 # make it small ! 252: jbr L4 # and try again ! 253: ! 254: string: ! 255: movl r8,r0 ! 256: jbs $1,r10,L20 # max length was specified ! 257: mnegl $1,r0 # default max length ! 258: L20: movl (ap)+,r2 # addr first byte ! 259: locc $0,r0,(r2) # find the zero at the end ! 260: movl r1,r5 # addr last byte +1 ! 261: movl r2,r1 # addr first byte ! 262: jbr prstr ! 263: ! 264: htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'a,'b,'c,'d,'e,'f ! 265: Htab: .byte '0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'A,'B,'C,'D,'E,'F ! 266: ! 267: octal: ! 268: movl $30,r2 # init position ! 269: movl $3,r3 # field r9 ! 270: movab htab,r7 # translate table ! 271: jbr L10 ! 272: ! 273: hex: ! 274: movl $28,r2 # init position ! 275: movl $4,r3 # field r9 ! 276: movab htab,r7 # translate table ! 277: jbc $6,r10,L10 ! 278: movab Htab,r7 ! 279: L10: mnegl r3,r6 # increment ! 280: clrl r1 ! 281: addl2 $4,r5 # room for left affix (2) and slop [forced -17(fp)?] ! 282: movl (ap)+,r0 # fetch arg ! 283: L11: extzv r2,r3,r0,r1 # pull out a digit ! 284: movb (r7)[r1],(r5)+ # convert to character ! 285: L12: acbl $0,r6,r2,L11 # continue until done ! 286: clrq r6 # r6, r7 ! 287: clrb (r5) # flag end ! 288: skpc $'0,$11,4(sp) # skip over leading zeroes ! 289: jbc $5,r10,prn3 # easy if no left affix ! 290: tstl -4(ap) # original value ! 291: jeql prn3 # no affix on 0, for some reason ! 292: cmpl r3,$4 # were we doing hex or octal? ! 293: jneq L12a # octal ! 294: movb $'x,r0 ! 295: jbc $6,r10,L12b ! 296: movb $'X,r0 ! 297: L12b: movb r0,-(r1) ! 298: movl $2,r7 # leading 0x for hex is an affix ! 299: L12a: movb $'0,-(r1) # leading zero for octal is a digit, not an affix ! 300: jbr prn3 # omit -17(fp) (plus, 7) massaging ! 301: ! 302: unsigned: ! 303: lunsigned: ! 304: bicl2 $1<4|1<7,r10 # omit -17(fp) (plus, 7) massaging ! 305: extzv $1,$31,(ap),r0 # right shift logical 1 bit ! 306: cvtlp r0,$10,(sp) # convert [n/2] to packed ! 307: movp $10,(sp),8(sp) # copy packed ! 308: addp4 $10,8(sp),$10,(sp) # 2*[n/2] in packed, at (sp) ! 309: blbc (ap)+,L14 # n was even ! 310: addp4 $1,pone,$10,(sp) # n was odd ! 311: jbr L14 ! 312: ! 313: patdec: # editpc pattern for decimal printing ! 314: .byte 0xAA # eo$float 10 ! 315: .byte 0x01 # eo$end_float ! 316: .byte 0 # eo$end ! 317: ! 318: decimal: ! 319: cvtlp (ap)+,$10,(sp) # 10 digits max ! 320: jgeq L14 ! 321: incl r7 # minus -17(fp) is a left affix ! 322: L14: editpc $10,(sp),patdec,8(sp) # ascii at 8(sp); r5=end+1 ! 323: skpc $' ,$11,8(sp) # skip leading blanks; r1=first ! 324: ! 325: prnum: # r1=addr first byte, r5=addr last byte +1, r7=size of signs ! 326: # -1(r1) vacant, for forced -17(fp) ! 327: tstl r7 ! 328: jneq prn3 # already some left affix, dont fuss ! 329: jbc $4,r10,prn2 ! 330: movb $'+,-(r1) # needs a plus sign ! 331: jbr prn4 ! 332: prn2: jbc $7,r10,prn3 ! 333: movb $' ,-(r1) # needs a blank sign ! 334: prn4: incl r7 ! 335: prn3: jbs $1,r10,prn1 ! 336: movl $1,r8 # default precision is 1 ! 337: prn1: subl3 r1,r5,r6 # raw r9 ! 338: subl2 r7,r6 # number of digits ! 339: subl2 r6,r8 # number of leading zeroes needed ! 340: jleq prstr # none ! 341: addl2 r7,r1 # where current digits start ! 342: pushl r1 # movcx gobbles registers ! 343: # check bounds on users who say %.300d ! 344: movab 32(r5)[r8],r2 ! 345: subl2 fp,r2 ! 346: jlss prn5 ! 347: subl2 r2,r8 ! 348: prn5: ! 349: # ! 350: movc3 r6,(r1),(r1)[r8] # make room in middle ! 351: movc5 $0,(r1),$ch.zer,r8,*(sp) # '0 fill ! 352: subl3 r7,(sp)+,r1 # first byte addr ! 353: addl3 r6,r3,r5 # last byte addr +1 ! 354: ! 355: prstr: # r1=addr first byte; r5=addr last byte +1 ! 356: # r9=minimum r9; r7=len. left affix ! 357: # r8=<avail> ! 358: subl3 r1,r5,r8 # raw r9 ! 359: subl3 r8,r9,r0 # pad length ! 360: jleq padlno # in particular, no left padding ! 361: jbs $3,r10,padlno ! 362: # extension for %0 flag causing left zero padding to field r9 ! 363: jbs $2,r10,padlz ! 364: # this bsbb needed even if %0 flag extension is removed ! 365: bsbb padb # 7 pad on left ! 366: jbr padnlz ! 367: padlz: ! 368: movl r7,r0 ! 369: jleq padnlx # left zero pad requires left affix first ! 370: subl2 r0,r8 # part of total length will be transferred ! 371: subl2 r0,r9 # and will account for part of minimum r9 ! 372: bsbw strout # left affix ! 373: padnlx: ! 374: subl3 r8,r9,r0 # pad length ! 375: bsbb padz # zero pad on left ! 376: padnlz: ! 377: # end of extension for left zero padding ! 378: padlno: # remaining: root, possible right padding ! 379: subl2 r8,r9 # root reduces minimum r9 ! 380: movl r8,r0 # root length ! 381: p1: bsbw strout # transfer to output buffer ! 382: p3: jbc $1,r2,padnpct # percent -17(fp) (or null byte via %c) ? ! 383: decl r0 # yes; adjust count ! 384: movzbl (r1)+,r2 # fetch byte ! 385: movq *-4(fp),r4 # output buffer descriptor ! 386: sobgeq r4,p2 # room at the out [inn] ? ! 387: bsbw strout2 # no; force it, then try rest ! 388: jbr p3 # here we go 'round the mullberry bush, ... ! 389: p2: movb r2,(r5)+ # hand-deposit the percent or null ! 390: incl -16(fp) # count it ! 391: movq r4,*-4(fp) # store output descriptor ! 392: jbr p1 # what an expensive hiccup! ! 393: padnpct: ! 394: movl r9,r0 # size of pad ! 395: jleq loop ! 396: bsbb padb ! 397: jbr loop ! 398: ! 399: padz: ! 400: movb $'0,r2 ! 401: jbr pad ! 402: padb: ! 403: movb $' ,r2 ! 404: pad: ! 405: subl2 r0,r9 # pad r9 decreases minimum r9 ! 406: pushl r1 # save non-pad addr ! 407: movl r0,r7 # remember r9 of pad ! 408: subl2 r0,sp # allocate ! 409: movc5 $0,(r0),r2,r7,(sp) # create pad string ! 410: movl r7,r0 # length ! 411: movl sp,r1 # addr ! 412: bsbw strout ! 413: addl2 r7,sp # deallocate ! 414: movl (sp)+,r1 # recover non-pad addr ! 415: rsb ! 416: ! 417: pone: .byte 0x1C # packed 1 ! 418: ! 419: charac: ! 420: movl (ap)+,r0 # word containing the char ! 421: movb r0,(r5)+ # one byte, that's all ! 422: ! 423: prbuf: ! 424: movl sp,r1 # addr first byte ! 425: jbr prstr ! 426: ! 427: space: bisl2 $1<7,r10 # constant r9 e fmt, no plus -17(fp) ! 428: jbr L4a ! 429: sharp: bisl2 $1<5,r10 # 'self identifying', please ! 430: jbr L4a ! 431: plus: bisl2 $1<4,r10 # always print -17(fp) for floats ! 432: jbr L4a ! 433: minus: bisl2 $1<3,r10 # left justification, please ! 434: jbr L4a ! 435: gnum0: jbs $0,r10,gnum ! 436: jbs $1,r10,gnump # ignore when reading precision ! 437: bisl2 $1<2,r10 # leading zero fill, please ! 438: gnum: jbs $1,r10,gnump ! 439: moval (r9)[r9],r9 # r9 *= 5; ! 440: movaw -ch.zer(r0)[r9],r9 # r9 = 2*witdh + r0 - '0'; ! 441: jbr gnumd ! 442: gnump: moval (r8)[r8],r8 # r8 *= 5; ! 443: movaw -ch.zer(r0)[r8],r8 # r8 = 2*r8 + r0 - '0'; ! 444: gnumd: bisl2 $1<0,r10 # digit seen ! 445: jbr L4a ! 446: dot: clrl r8 # start on the precision ! 447: bisl2 $1<1,r10 ! 448: bicl2 $1<0,r10 ! 449: jbr L4a ! 450: indir: ! 451: jbs $1,r10,in1 ! 452: movl (ap)+,r9 # r9 specified by parameter ! 453: jgeq gnumd ! 454: xorl2 $1<3,r10 # parameterized left adjustment ! 455: mnegl r9,r9 ! 456: jbr gnumd ! 457: in1: ! 458: movl (ap)+,r8 # precision specified by paratmeter ! 459: jgeq gnumd ! 460: mnegl r8,r8 ! 461: jbr gnumd ! 462: ! 463: float: ! 464: jbs $1,r10,float1 ! 465: movl $6,r8 # default # digits to right of decpt. ! 466: float1: bsbw fltcvt ! 467: addl3 -8(fp),r8,r7 ! 468: movl r7,r6 # for later "underflow" checking ! 469: bgeq fxplrd ! 470: clrl r7 # poor programmer planning ! 471: fxplrd: cmpl r7,$31 # expressible in packed decimal? ! 472: bleq fnarro # yes ! 473: movl $31,r7 ! 474: fnarro: subl3 $17,r7,r0 # where to round ! 475: ashp r0,$17,(sp),$5,r7,16(sp) # do it ! 476: bvc fnovfl ! 477: # band-aid for microcode error (spurious overflow) ! 478: # clrl r0 # assume even length result ! 479: # jlbc r7,fleven # right ! 480: # movl $4,r0 # odd length result ! 481: #fleven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow ! 482: # bneq fnovfl ! 483: # end band-aid ! 484: aobleq $0,r6,fnovfl # if "underflow" then jump ! 485: movl r7,r0 ! 486: incl -8(fp) ! 487: incl r7 ! 488: ashp r0,$1,pone,$0,r7,16(sp) ! 489: ashl $-1,r7,r0 # displ to last byte ! 490: bisb2 -17(fp),16(sp)[r0] # insert -17(fp) ! 491: fnovfl: ! 492: movab 16(sp),r1 # packed source ! 493: movl r7,r6 # packed length ! 494: pushab prnum # goto prnum after fall-through call to fedit ! 495: ! 496: ! 497: # enter via bsb ! 498: # r1=addr of packed source ! 499: # 16(r1) used to unpack source ! 500: # 48(r1) used to construct pattern to unpack source ! 501: # 48(r1) used to hold result ! 502: # r6=length of packed source (destroyed) ! 503: # -8(fp)=# digits to left of decimal point (destroyed) ! 504: # r8=# digits to right of decimal point (destroyed) ! 505: # -17(fp)=1 if negative, 0 otherwise ! 506: # stack will be used for work space for pattern and unpacked source ! 507: # exits with ! 508: # r1=addr of punctuated result ! 509: # r5=addr of last byte +1 ! 510: # r7=1 if minus -17(fp) inserted, 0 otherwise ! 511: fedit: ! 512: pushab 48(r1) # save result addr ! 513: movab 48(r1),r3 # pattern addr ! 514: movb $0x03,(r3)+ # eo$set_signif ! 515: movc5 $0,(r1),$0x91,r6,(r3) # eo$move 1 ! 516: clrb (r3) # eo$end ! 517: editpc r6,(r1),48(r1),16(r1) # unpack 'em all ! 518: subl3 r6,r5,r1 # addr unpacked source ! 519: movl (sp),r3 # punctuated output placed here ! 520: clrl r7 ! 521: jlbc -17(fp),f1 ! 522: movb $'-,(r3)+ # negative ! 523: incl r7 ! 524: f1: movl -8(fp),r0 ! 525: jgtr f2 ! 526: movb $'0,(r3)+ # must have digit before decimal point ! 527: jbr f3 ! 528: f2: cmpl r0,r6 # limit on packed length ! 529: jleq f4 ! 530: movl r6,r0 ! 531: f4: subl2 r0,r6 # eat some digits ! 532: subl2 r0,-8(fp) # from the exponent ! 533: movc3 r0,(r1),(r3) # (most of the) digits to left of decimal point ! 534: movl -8(fp),r0 # need any more? ! 535: jleq f3 ! 536: movc5 $0,(r1),$'0,r0,(r3) # '0 fill ! 537: f3: movl r8,r0 # # digits to right of decimal point ! 538: jgtr f5 ! 539: jbs $5,r10,f5 # no decimal point unless forced ! 540: jbcs $9,r10,f6 # no decimal point ! 541: f5: movb $'.,(r3)+ # the decimal point ! 542: f6: mnegl -8(fp),r0 # "leading" zeroes to right of decimal point ! 543: jleq f9 ! 544: cmpl r0,r8 # cant exceed this many ! 545: jleq fa ! 546: movl r8,r0 ! 547: fa: subl2 r0,r8 ! 548: movc5 $0,(r1),$'0,r0,(r3) ! 549: f9: movl r8,r0 ! 550: cmpl r0,r6 # limit on packed length ! 551: jleq f7 ! 552: movl r6,r0 ! 553: f7: subl2 r0,r8 # eat some digits from the fraction ! 554: movc3 r0,(r1),(r3) # (most of the) digits to right of decimal point ! 555: movl r8,r0 # need any more? ! 556: jleq f8 ! 557: # check bounds on users who say %.300f ! 558: movab 32(r3)[r0],r2 ! 559: subl2 fp,r2 ! 560: jlss fb ! 561: subl2 r2,r0 # truncate, willy-nilly ! 562: movl r0,r8 # and no more digits later, either ! 563: fb: ! 564: # ! 565: subl2 r0,r8 # eat some digits from the fraction ! 566: movc5 $0,(r1),$'0,r0,(r3) # '0 fill ! 567: f8: movl r3,r5 # addr last byte +1 ! 568: popr $1<1 # [movl (sp)+,r1] addr first byte ! 569: rsb ! 570: ! 571: patexp: .byte 0x03 # eo$set_signif ! 572: .byte 0x44,'e # eo$insert 'e ! 573: .byte 0x42,'+ # eo$load_plus '+ ! 574: .byte 0x04 # eo$store_sign ! 575: .byte 0x92 # eo$move 2 ! 576: .byte 0 # eo$end ! 577: ! 578: scien: ! 579: incl r8 ! 580: jbs $1,r10,L23 ! 581: movl $7,r8 ! 582: L23: bsbw fltcvt # get packed digits ! 583: movl r8,r7 ! 584: cmpl r7,$31 # expressible in packed decimal? ! 585: jleq snarro # yes ! 586: movl $31,r7 ! 587: snarro: subl3 $17,r7,r0 # rounding position ! 588: ashp r0,$17,(sp),$5,r7,16(sp) # shift and round ! 589: bvc snovfl ! 590: # band-aid for microcode error (spurious overflow) ! 591: # clrl r0 # assume even length result ! 592: # jlbc r8,sceven # right ! 593: # movl $4,r0 # odd length result ! 594: #sceven: cmpv r0,$4,16(sp),$0 # top digit zero iff true overflow ! 595: # bneq snovfl ! 596: # end band-aid ! 597: incl -8(fp) # rounding overflowed to 100... ! 598: subl3 $1,r7,r0 ! 599: ashp r0,$1,pone,$0,r7,16(sp) ! 600: ashl $-1,r7,r0 # displ to last byte ! 601: bisb2 -17(fp),16(sp)[r0] # insert -17(fp) ! 602: snovfl: ! 603: jbs $8,r10,gfmt # %g format ! 604: movab 16(sp),r1 ! 605: bsbb eedit ! 606: eexp: ! 607: movl r1,r6 # save fwa from destruction by cvtlp ! 608: subl3 $1,-12(fp),r0 # 1P exponent ! 609: cvtlp r0,$2,(sp) # packed ! 610: editpc $2,(sp),patexp,(r5) ! 611: movl r6,r1 # fwa ! 612: jbc $6,r10,prnum ! 613: xorb2 $'e^'E,-4(r5) ! 614: jbr prnum ! 615: ! 616: eedit: ! 617: movl r7,r6 # packed length ! 618: decl r8 # 1 digit before decimal point ! 619: movl -8(fp),-12(fp) # save from destruction ! 620: movl $1,-8(fp) # and pretend ! 621: jbr fedit ! 622: ! 623: gfmt: ! 624: addl3 $3,-8(fp),r0 # -8(fp) is 1 more than e ! 625: jlss gfmte # (e+1)+3<0, e+4<=-1, e<=-5 ! 626: subl2 $3,r0 # -8(fp) [==(e+1)] ! 627: cmpl r0,r8 ! 628: jgtr gfmte # e+1>n, e>=n ! 629: gfmtf: ! 630: movl r7,r6 ! 631: subl2 r0,r8 # n-e-1 ! 632: movab 16(sp),r1 ! 633: bsbw fedit ! 634: g1: jbs $5,r10,g2 ! 635: jbs $9,r10,g2 # dont strip if no decimal point ! 636: g3: cmpb -(r5),$'0 # strip trailing zeroes ! 637: jeql g3 ! 638: cmpb (r5),$'. # and trailing decimal point ! 639: jeql g2 ! 640: incl r5 ! 641: g2: jbc $8,r10,eexp ! 642: jbr prnum ! 643: gfmte: ! 644: movab 16(sp),r1 # packed source ! 645: bsbw eedit ! 646: jbsc $8,r10,g1 # 8 now means "use %f" [hence no exponent] ! 647: ! 648: general: ! 649: jbs $1,r10,gn1 ! 650: movl $6,r8 # default precision is 6 significant digits ! 651: gn1: tstl r8 # cannot allow precision of 0 ! 652: jgtr gn2 ! 653: movl $1,r8 # change 0 to 1, willy-nilly ! 654: gn2: jbcs $8,r10,L23 ! 655: jbr L23 # safety net ! 656: ! 657: # convert double-floating at (ap) to 17-digit packed at (sp), ! 658: # set 'sign' and 'exp', advance ap. ! 659: fltcvt: ! 660: clrb -17(fp) ! 661: movd (ap)+,r5 ! 662: jeql fzero ! 663: bgtr fpos ! 664: mnegd r5,r5 ! 665: incb -17(fp) ! 666: fpos: ! 667: extzv $7,$8,r5,r2 # exponent of 2 ! 668: movab -0200(r2),r2 # unbias ! 669: mull2 $59,r2 # 59/196: 3rd convergent continued frac of log10(2) ! 670: jlss eneg ! 671: movab 196(r2),r2 ! 672: eneg: ! 673: movab -98(r2),r2 ! 674: divl2 $196,r2 ! 675: bsbw expten ! 676: cmpd r0,r5 ! 677: bgtr ceil ! 678: incl r2 ! 679: ceil: movl r2,-8(fp) ! 680: mnegl r2,r2 ! 681: cmpl r2,$29 # 10^(29+9) is all we can handle ! 682: bleq getman ! 683: muld2 ten16,r5 ! 684: subl2 $16,r2 ! 685: getman: addl2 $9,r2 # -ceil(log10(x)) + 9 ! 686: jsb expten ! 687: emodd r0,r4,r5,r0,r5 # (r0+r4)*r5; r0=int, r5=frac ! 688: fz1: cvtlp r0,$9,16(sp) # leading 9 digits ! 689: ashp $8,$9,16(sp),$0,$17,4(sp) # as top 9 of 17 ! 690: emodd ten8,$0,r5,r0,r5 ! 691: cvtlp r0,$8,16(sp) # trailing 8 digits ! 692: # if precision >= 17, must round here ! 693: movl r8,r7 # so figure out what precision is ! 694: pushab scien ! 695: cmpl (sp)+,(sp) ! 696: jleq gm1 # who called us? ! 697: addl2 -8(fp),r7 # float; adjust for exponent ! 698: gm1: cmpl r7,$17 ! 699: jlss gm2 ! 700: cmpd r5,$0d0.5 # must round here; check fraction ! 701: jlss gm2 ! 702: bisb2 $0x10,8+4(sp) # increment l.s. digit ! 703: gm2: # end of "round here" code ! 704: addp4 $8,16(sp),$17,4(sp) # combine leading and trailing ! 705: bisb2 -17(fp),12(sp) # and insert -17(fp) ! 706: rsb ! 707: fzero: clrl r0 ! 708: movl $1,-8(fp) # 0.000e+00 and 0.000 rather than 0.000e-01 and .000 ! 709: jbr fz1 ! 710: ! 711: .align 2 ! 712: lsb: .long 0x00010000 # lsb in the crazy floating-point format ! 713: ! 714: # return 10^r2 as a double float in r0||r1 and 8 extra bits of precision in r4 ! 715: # preserve r2, r5||r6 ! 716: expten: ! 717: movd $0d1.0,r0 # begin computing 10^exp10 ! 718: clrl r4 # bit counter ! 719: movad ten1,r3 # table address ! 720: tstl r2 ! 721: bgeq e10lp ! 722: mnegl r2,r2 # get absolute value ! 723: jbss $6,r2,e10lp # flag as negative ! 724: e10lp: jbc r4,r2,el1 # want this power? ! 725: muld2 (r3),r0 # yes ! 726: el1: addl2 $8,r3 # advance to next power ! 727: aobleq $5,r4,e10lp # through 10^32 ! 728: jbcc $6,r2,el2 # correct for negative exponent ! 729: divd3 r0,$0d1.0,r0 # by taking reciprocal ! 730: cmpl $28,r2 ! 731: jneq enm28 ! 732: addl2 lsb,r1 # 10**-28 needs lsb incremented ! 733: enm28: mnegl r2,r2 # original exponent of 10 ! 734: el2: addl3 $5*8,r2,r3 # negative bit positions are illegal? ! 735: jbc r3,xlsbh-5,eoklsb ! 736: subl2 lsb,r1 # lsb was too high ! 737: eoklsb: ! 738: movzbl xprec[r2],r4 # 8 extra bits ! 739: rsb ! 740: ! 741: # powers of ten ! 742: .align 2 ! 743: ten1: .word 0x4220,0,0,0 ! 744: ten2: .word 0x43c8,0,0,0 ! 745: ten4: .word 0x471c,0x4000,0,0 ! 746: ten8: .word 0x4dbe,0xbc20,0,0 ! 747: ten16: .word 0x5b0e,0x1bc9,0xbf04,0 ! 748: ten32: .word 0x759d,0xc5ad,0xa82b,0x70b6 ! 749: ! 750: # whether lsb is too high or not ! 751: .byte 1:0,1:0,1:0,1:0,1:1,1:0,1:1,1:0 # -40 thru -33 ! 752: .byte 1:0,1:1,1:0,1:0,1:0,1:0,1:1,1:0 # -32 thru -25 ! 753: .byte 1:0,1:0,1:1,1:1,1:1,1:1,1:0,1:0 # -24 thru -17 ! 754: .byte 1:0,1:1,1:0,1:0,1:1,1:1,1:1,1:1 # -16 thru -9 ! 755: .byte 1:1,1:1,1:1,1:0,1:0,1:0,1:0,1:1 # -8 thru -1 ! 756: xlsbh: ! 757: .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 0 thru 7 ! 758: .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 8 thru 15 ! 759: .byte 1:0,1:0,1:0,1:0,1:0,1:0,1:0,1:0 # 16 thru 23 ! 760: .byte 1:0,1:1,1:1,1:0,1:1,1:1,1:1,1:1 # 24 thru 31 ! 761: .byte 1:1,1:1,1:1,1:1,1:1,1:1,1:1 # 32 thru 38 ! 762: ! 763: # bytes of extra precision ! 764: .byte 0x56,0x76,0xd3,0x88,0xb5,0x62 # -38 thru -33 ! 765: .byte 0xba,0xf5,0x32,0x3e,0x0e,0x48,0xdb,0x51 # -32 thru -25 ! 766: .byte 0x53,0x27,0xb1,0xef,0xeb,0xa5,0x07,0x49 # -24 thru -17 ! 767: .byte 0x5b,0xd9,0x0f,0x13,0xcd,0xff,0xbf,0x97 # -16 thru -9 ! 768: .byte 0xfd,0xbc,0xb6,0x23,0x2c,0x3b,0x0a,0xcd # -8 thru -1 ! 769: xprec: ! 770: .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 0 thru 7 ! 771: .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 8 thru 15 ! 772: .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 # 16 thru 23 ! 773: .byte 0x00,0xa0,0xc8,0x3a,0x84,0xe4,0xdc,0x92 # 24 thru 31 ! 774: .byte 0x9b,0x00,0xc0,0x58,0xae,0x18,0xef # 32 thru 38
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.