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