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