Annotation of sys/arch/m68k/fpsp/bindec.sa, Revision 1.1
1.1 ! nbrk 1: * $OpenBSD: bindec.sa,v 1.3 2001/09/20 17:02:30 mpech Exp $
! 2: * $NetBSD: bindec.sa,v 1.3 1994/10/26 07:48:51 cgd Exp $
! 3:
! 4: * MOTOROLA MICROPROCESSOR & MEMORY TECHNOLOGY GROUP
! 5: * M68000 Hi-Performance Microprocessor Division
! 6: * M68040 Software Package
! 7: *
! 8: * M68040 Software Package Copyright (c) 1993, 1994 Motorola Inc.
! 9: * All rights reserved.
! 10: *
! 11: * THE SOFTWARE is provided on an "AS IS" basis and without warranty.
! 12: * To the maximum extent permitted by applicable law,
! 13: * MOTOROLA DISCLAIMS ALL WARRANTIES WHETHER EXPRESS OR IMPLIED,
! 14: * INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A
! 15: * PARTICULAR PURPOSE and any warranty against infringement with
! 16: * regard to the SOFTWARE (INCLUDING ANY MODIFIED VERSIONS THEREOF)
! 17: * and any accompanying written materials.
! 18: *
! 19: * To the maximum extent permitted by applicable law,
! 20: * IN NO EVENT SHALL MOTOROLA BE LIABLE FOR ANY DAMAGES WHATSOEVER
! 21: * (INCLUDING WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS
! 22: * PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR
! 23: * OTHER PECUNIARY LOSS) ARISING OF THE USE OR INABILITY TO USE THE
! 24: * SOFTWARE. Motorola assumes no responsibility for the maintenance
! 25: * and support of the SOFTWARE.
! 26: *
! 27: * You are hereby granted a copyright license to use, modify, and
! 28: * distribute the SOFTWARE so long as this entire notice is retained
! 29: * without alteration in any modified and/or redistributed versions,
! 30: * and that such modified versions are clearly identified as such.
! 31: * No licenses are granted by implication, estoppel or otherwise
! 32: * under any patents or trademarks of Motorola, Inc.
! 33:
! 34: *
! 35: * bindec.sa 3.4 1/3/91
! 36: *
! 37: * bindec
! 38: *
! 39: * Description:
! 40: * Converts an input in extended precision format
! 41: * to bcd format.
! 42: *
! 43: * Input:
! 44: * a0 points to the input extended precision value
! 45: * value in memory; d0 contains the k-factor sign-extended
! 46: * to 32-bits. The input may be either normalized,
! 47: * unnormalized, or denormalized.
! 48: *
! 49: * Output: result in the FP_SCR1 space on the stack.
! 50: *
! 51: * Saves and Modifies: D2-D7,A2,FP2
! 52: *
! 53: * Algorithm:
! 54: *
! 55: * A1. Set RM and size ext; Set SIGMA = sign of input.
! 56: * The k-factor is saved for use in d7. Clear the
! 57: * BINDEC_FLG for separating normalized/denormalized
! 58: * input. If input is unnormalized or denormalized,
! 59: * normalize it.
! 60: *
! 61: * A2. Set X = abs(input).
! 62: *
! 63: * A3. Compute ILOG.
! 64: * ILOG is the log base 10 of the input value. It is
! 65: * approximated by adding e + 0.f when the original
! 66: * value is viewed as 2^^e * 1.f in extended precision.
! 67: * This value is stored in d6.
! 68: *
! 69: * A4. Clr INEX bit.
! 70: * The operation in A3 above may have set INEX2.
! 71: *
! 72: * A5. Set ICTR = 0;
! 73: * ICTR is a flag used in A13. It must be set before the
! 74: * loop entry A6.
! 75: *
! 76: * A6. Calculate LEN.
! 77: * LEN is the number of digits to be displayed. The
! 78: * k-factor can dictate either the total number of digits,
! 79: * if it is a positive number, or the number of digits
! 80: * after the decimal point which are to be included as
! 81: * significant. See the 68882 manual for examples.
! 82: * If LEN is computed to be greater than 17, set OPERR in
! 83: * USER_FPSR. LEN is stored in d4.
! 84: *
! 85: * A7. Calculate SCALE.
! 86: * SCALE is equal to 10^ISCALE, where ISCALE is the number
! 87: * of decimal places needed to insure LEN integer digits
! 88: * in the output before conversion to bcd. LAMBDA is the
! 89: * sign of ISCALE, used in A9. Fp1 contains
! 90: * 10^^(abs(ISCALE)) using a rounding mode which is a
! 91: * function of the original rounding mode and the signs
! 92: * of ISCALE and X. A table is given in the code.
! 93: *
! 94: * A8. Clr INEX; Force RZ.
! 95: * The operation in A3 above may have set INEX2.
! 96: * RZ mode is forced for the scaling operation to insure
! 97: * only one rounding error. The grs bits are collected in
! 98: * the INEX flag for use in A10.
! 99: *
! 100: * A9. Scale X -> Y.
! 101: * The mantissa is scaled to the desired number of
! 102: * significant digits. The excess digits are collected
! 103: * in INEX2.
! 104: *
! 105: * A10. Or in INEX.
! 106: * If INEX is set, round error occurred. This is
! 107: * compensated for by 'or-ing' in the INEX2 flag to
! 108: * the lsb of Y.
! 109: *
! 110: * A11. Restore original FPCR; set size ext.
! 111: * Perform FINT operation in the user's rounding mode.
! 112: * Keep the size to extended.
! 113: *
! 114: * A12. Calculate YINT = FINT(Y) according to user's rounding
! 115: * mode. The FPSP routine sintd0 is used. The output
! 116: * is in fp0.
! 117: *
! 118: * A13. Check for LEN digits.
! 119: * If the int operation results in more than LEN digits,
! 120: * or less than LEN -1 digits, adjust ILOG and repeat from
! 121: * A6. This test occurs only on the first pass. If the
! 122: * result is exactly 10^LEN, decrement ILOG and divide
! 123: * the mantissa by 10.
! 124: *
! 125: * A14. Convert the mantissa to bcd.
! 126: * The binstr routine is used to convert the LEN digit
! 127: * mantissa to bcd in memory. The input to binstr is
! 128: * to be a fraction; i.e. (mantissa)/10^LEN and adjusted
! 129: * such that the decimal point is to the left of bit 63.
! 130: * The bcd digits are stored in the correct position in
! 131: * the final string area in memory.
! 132: *
! 133: * A15. Convert the exponent to bcd.
! 134: * As in A14 above, the exp is converted to bcd and the
! 135: * digits are stored in the final string.
! 136: * Test the length of the final exponent string. If the
! 137: * length is 4, set operr.
! 138: *
! 139: * A16. Write sign bits to final string.
! 140: *
! 141: * Implementation Notes:
! 142: *
! 143: * The registers are used as follows:
! 144: *
! 145: * d0: scratch; LEN input to binstr
! 146: * d1: scratch
! 147: * d2: upper 32-bits of mantissa for binstr
! 148: * d3: scratch;lower 32-bits of mantissa for binstr
! 149: * d4: LEN
! 150: * d5: LAMBDA/ICTR
! 151: * d6: ILOG
! 152: * d7: k-factor
! 153: * a0: ptr for original operand/final result
! 154: * a1: scratch pointer
! 155: * a2: pointer to FP_X; abs(original value) in ext
! 156: * fp0: scratch
! 157: * fp1: scratch
! 158: * fp2: scratch
! 159: * F_SCR1:
! 160: * F_SCR2:
! 161: * L_SCR1:
! 162: * L_SCR2:
! 163: *
! 164:
! 165: BINDEC IDNT 2,1 Motorola 040 Floating Point Software Package
! 166:
! 167: include fpsp.h
! 168:
! 169: section 8
! 170:
! 171: * Constants in extended precision
! 172: LOG2 dc.l $3FFD0000,$9A209A84,$FBCFF798,$00000000
! 173: LOG2UP1 dc.l $3FFD0000,$9A209A84,$FBCFF799,$00000000
! 174:
! 175: * Constants in single precision
! 176: FONE dc.l $3F800000,$00000000,$00000000,$00000000
! 177: FTWO dc.l $40000000,$00000000,$00000000,$00000000
! 178: FTEN dc.l $41200000,$00000000,$00000000,$00000000
! 179: F4933 dc.l $459A2800,$00000000,$00000000,$00000000
! 180:
! 181: RBDTBL dc.b 0,0,0,0
! 182: dc.b 3,3,2,2
! 183: dc.b 3,2,2,3
! 184: dc.b 2,3,3,2
! 185:
! 186: xref binstr
! 187: xref sintdo
! 188: xref ptenrn,ptenrm,ptenrp
! 189:
! 190: xdef bindec
! 191: xdef sc_mul
! 192: bindec:
! 193: movem.l d2-d7/a2,-(a7)
! 194: fmovem.x fp0-fp2,-(a7)
! 195:
! 196: * A1. Set RM and size ext. Set SIGMA = sign input;
! 197: * The k-factor is saved for use in d7. Clear BINDEC_FLG for
! 198: * separating normalized/denormalized input. If the input
! 199: * is a denormalized number, set the BINDEC_FLG memory word
! 200: * to signal denorm. If the input is unnormalized, normalize
! 201: * the input and test for denormalized result.
! 202: *
! 203: fmove.l #rm_mode,FPCR ;set RM and ext
! 204: move.l (a0),L_SCR2(a6) ;save exponent for sign check
! 205: move.l d0,d7 ;move k-factor to d7
! 206: clr.b BINDEC_FLG(a6) ;clr norm/denorm flag
! 207: move.w STAG(a6),d0 ;get stag
! 208: andi.w #$e000,d0 ;isolate stag bits
! 209: beq A2_str ;if zero, input is norm
! 210: *
! 211: * Normalize the denorm
! 212: *
! 213: un_de_norm:
! 214: move.w (a0),d0
! 215: andi.w #$7fff,d0 ;strip sign of normalized exp
! 216: move.l 4(a0),d1
! 217: move.l 8(a0),d2
! 218: norm_loop:
! 219: sub.w #1,d0
! 220: add.l d2,d2
! 221: addx.l d1,d1
! 222: tst.l d1
! 223: bge.b norm_loop
! 224: *
! 225: * Test if the normalized input is denormalized
! 226: *
! 227: tst.w d0
! 228: bgt.b pos_exp ;if greater than zero, it is a norm
! 229: st BINDEC_FLG(a6) ;set flag for denorm
! 230: pos_exp:
! 231: andi.w #$7fff,d0 ;strip sign of normalized exp
! 232: move.w d0,(a0)
! 233: move.l d1,4(a0)
! 234: move.l d2,8(a0)
! 235:
! 236: * A2. Set X = abs(input).
! 237: *
! 238: A2_str:
! 239: move.l (a0),FP_SCR2(a6) ; move input to work space
! 240: move.l 4(a0),FP_SCR2+4(a6) ; move input to work space
! 241: move.l 8(a0),FP_SCR2+8(a6) ; move input to work space
! 242: andi.l #$7fffffff,FP_SCR2(a6) ;create abs(X)
! 243:
! 244: * A3. Compute ILOG.
! 245: * ILOG is the log base 10 of the input value. It is approx-
! 246: * imated by adding e + 0.f when the original value is viewed
! 247: * as 2^^e * 1.f in extended precision. This value is stored
! 248: * in d6.
! 249: *
! 250: * Register usage:
! 251: * Input/Output
! 252: * d0: k-factor/exponent
! 253: * d2: x/x
! 254: * d3: x/x
! 255: * d4: x/x
! 256: * d5: x/x
! 257: * d6: x/ILOG
! 258: * d7: k-factor/Unchanged
! 259: * a0: ptr for original operand/final result
! 260: * a1: x/x
! 261: * a2: x/x
! 262: * fp0: x/float(ILOG)
! 263: * fp1: x/x
! 264: * fp2: x/x
! 265: * F_SCR1:x/x
! 266: * F_SCR2:Abs(X)/Abs(X) with $3fff exponent
! 267: * L_SCR1:x/x
! 268: * L_SCR2:first word of X packed/Unchanged
! 269:
! 270: tst.b BINDEC_FLG(a6) ;check for denorm
! 271: beq.b A3_cont ;if clr, continue with norm
! 272: move.l #-4933,d6 ;force ILOG = -4933
! 273: bra.b A4_str
! 274: A3_cont:
! 275: move.w FP_SCR2(a6),d0 ;move exp to d0
! 276: move.w #$3fff,FP_SCR2(a6) ;replace exponent with 0x3fff
! 277: fmove.x FP_SCR2(a6),fp0 ;now fp0 has 1.f
! 278: sub.w #$3fff,d0 ;strip off bias
! 279: fadd.w d0,fp0 ;add in exp
! 280: fsub.s FONE,fp0 ;subtract off 1.0
! 281: fbge.w pos_res ;if pos, branch
! 282: fmul.x LOG2UP1,fp0 ;if neg, mul by LOG2UP1
! 283: fmove.l fp0,d6 ;put ILOG in d6 as a lword
! 284: bra.b A4_str ;go move out ILOG
! 285: pos_res:
! 286: fmul.x LOG2,fp0 ;if pos, mul by LOG2
! 287: fmove.l fp0,d6 ;put ILOG in d6 as a lword
! 288:
! 289:
! 290: * A4. Clr INEX bit.
! 291: * The operation in A3 above may have set INEX2.
! 292:
! 293: A4_str:
! 294: fmove.l #0,FPSR ;zero all of fpsr - nothing needed
! 295:
! 296:
! 297: * A5. Set ICTR = 0;
! 298: * ICTR is a flag used in A13. It must be set before the
! 299: * loop entry A6. The lower word of d5 is used for ICTR.
! 300:
! 301: clr.w d5 ;clear ICTR
! 302:
! 303:
! 304: * A6. Calculate LEN.
! 305: * LEN is the number of digits to be displayed. The k-factor
! 306: * can dictate either the total number of digits, if it is
! 307: * a positive number, or the number of digits after the
! 308: * original decimal point which are to be included as
! 309: * significant. See the 68882 manual for examples.
! 310: * If LEN is computed to be greater than 17, set OPERR in
! 311: * USER_FPSR. LEN is stored in d4.
! 312: *
! 313: * Register usage:
! 314: * Input/Output
! 315: * d0: exponent/Unchanged
! 316: * d2: x/x/scratch
! 317: * d3: x/x
! 318: * d4: exc picture/LEN
! 319: * d5: ICTR/Unchanged
! 320: * d6: ILOG/Unchanged
! 321: * d7: k-factor/Unchanged
! 322: * a0: ptr for original operand/final result
! 323: * a1: x/x
! 324: * a2: x/x
! 325: * fp0: float(ILOG)/Unchanged
! 326: * fp1: x/x
! 327: * fp2: x/x
! 328: * F_SCR1:x/x
! 329: * F_SCR2:Abs(X) with $3fff exponent/Unchanged
! 330: * L_SCR1:x/x
! 331: * L_SCR2:first word of X packed/Unchanged
! 332:
! 333: A6_str:
! 334: tst.l d7 ;branch on sign of k
! 335: ble.b k_neg ;if k <= 0, LEN = ILOG + 1 - k
! 336: move.l d7,d4 ;if k > 0, LEN = k
! 337: bra.b len_ck ;skip to LEN check
! 338: k_neg:
! 339: move.l d6,d4 ;first load ILOG to d4
! 340: sub.l d7,d4 ;subtract off k
! 341: addq.l #1,d4 ;add in the 1
! 342: len_ck:
! 343: tst.l d4 ;LEN check: branch on sign of LEN
! 344: ble.b LEN_ng ;if neg, set LEN = 1
! 345: cmp.l #17,d4 ;test if LEN > 17
! 346: ble.b A7_str ;if not, forget it
! 347: move.l #17,d4 ;set max LEN = 17
! 348: tst.l d7 ;if negative, never set OPERR
! 349: ble.b A7_str ;if positive, continue
! 350: or.l #opaop_mask,USER_FPSR(a6) ;set OPERR & AIOP in USER_FPSR
! 351: bra.b A7_str ;finished here
! 352: LEN_ng:
! 353: moveq.l #1,d4 ;min LEN is 1
! 354:
! 355:
! 356: * A7. Calculate SCALE.
! 357: * SCALE is equal to 10^ISCALE, where ISCALE is the number
! 358: * of decimal places needed to insure LEN integer digits
! 359: * in the output before conversion to bcd. LAMBDA is the sign
! 360: * of ISCALE, used in A9. Fp1 contains 10^^(abs(ISCALE)) using
! 361: * the rounding mode as given in the following table (see
! 362: * Coonen, p. 7.23 as ref.; however, the SCALE variable is
! 363: * of opposite sign in bindec.sa from Coonen).
! 364: *
! 365: * Initial USE
! 366: * FPCR[6:5] LAMBDA SIGN(X) FPCR[6:5]
! 367: * ----------------------------------------------
! 368: * RN 00 0 0 00/0 RN
! 369: * RN 00 0 1 00/0 RN
! 370: * RN 00 1 0 00/0 RN
! 371: * RN 00 1 1 00/0 RN
! 372: * RZ 01 0 0 11/3 RP
! 373: * RZ 01 0 1 11/3 RP
! 374: * RZ 01 1 0 10/2 RM
! 375: * RZ 01 1 1 10/2 RM
! 376: * RM 10 0 0 11/3 RP
! 377: * RM 10 0 1 10/2 RM
! 378: * RM 10 1 0 10/2 RM
! 379: * RM 10 1 1 11/3 RP
! 380: * RP 11 0 0 10/2 RM
! 381: * RP 11 0 1 11/3 RP
! 382: * RP 11 1 0 11/3 RP
! 383: * RP 11 1 1 10/2 RM
! 384: *
! 385: * Register usage:
! 386: * Input/Output
! 387: * d0: exponent/scratch - final is 0
! 388: * d2: x/0 or 24 for A9
! 389: * d3: x/scratch - offset ptr into PTENRM array
! 390: * d4: LEN/Unchanged
! 391: * d5: 0/ICTR:LAMBDA
! 392: * d6: ILOG/ILOG or k if ((k<=0)&(ILOG<k))
! 393: * d7: k-factor/Unchanged
! 394: * a0: ptr for original operand/final result
! 395: * a1: x/ptr to PTENRM array
! 396: * a2: x/x
! 397: * fp0: float(ILOG)/Unchanged
! 398: * fp1: x/10^ISCALE
! 399: * fp2: x/x
! 400: * F_SCR1:x/x
! 401: * F_SCR2:Abs(X) with $3fff exponent/Unchanged
! 402: * L_SCR1:x/x
! 403: * L_SCR2:first word of X packed/Unchanged
! 404:
! 405: A7_str:
! 406: tst.l d7 ;test sign of k
! 407: bgt.b k_pos ;if pos and > 0, skip this
! 408: cmp.l d6,d7 ;test k - ILOG
! 409: blt.b k_pos ;if ILOG >= k, skip this
! 410: move.l d7,d6 ;if ((k<0) & (ILOG < k)) ILOG = k
! 411: k_pos:
! 412: move.l d6,d0 ;calc ILOG + 1 - LEN in d0
! 413: addq.l #1,d0 ;add the 1
! 414: sub.l d4,d0 ;sub off LEN
! 415: swap d5 ;use upper word of d5 for LAMBDA
! 416: clr.w d5 ;set it zero initially
! 417: clr.w d2 ;set up d2 for very small case
! 418: tst.l d0 ;test sign of ISCALE
! 419: bge.b iscale ;if pos, skip next inst
! 420: addq.w #1,d5 ;if neg, set LAMBDA true
! 421: cmp.l #$ffffecd4,d0 ;test iscale <= -4908
! 422: bgt.b no_inf ;if false, skip rest
! 423: addi.l #24,d0 ;add in 24 to iscale
! 424: move.l #24,d2 ;put 24 in d2 for A9
! 425: no_inf:
! 426: neg.l d0 ;and take abs of ISCALE
! 427: iscale:
! 428: fmove.s FONE,fp1 ;init fp1 to 1
! 429: bfextu USER_FPCR(a6){26:2},d1 ;get initial rmode bits
! 430: add.w d1,d1 ;put them in bits 2:1
! 431: add.w d5,d1 ;add in LAMBDA
! 432: add.w d1,d1 ;put them in bits 3:1
! 433: tst.l L_SCR2(a6) ;test sign of original x
! 434: bge.b x_pos ;if pos, don't set bit 0
! 435: addq.l #1,d1 ;if neg, set bit 0
! 436: x_pos:
! 437: lea.l RBDTBL,a2 ;load rbdtbl base
! 438: move.b (a2,d1),d3 ;load d3 with new rmode
! 439: lsl.l #4,d3 ;put bits in proper position
! 440: fmove.l d3,fpcr ;load bits into fpu
! 441: lsr.l #4,d3 ;put bits in proper position
! 442: tst.b d3 ;decode new rmode for pten table
! 443: bne.b not_rn ;if zero, it is RN
! 444: lea.l PTENRN,a1 ;load a1 with RN table base
! 445: bra.b rmode ;exit decode
! 446: not_rn:
! 447: lsr.b #1,d3 ;get lsb in carry
! 448: bcc.b not_rp ;if carry clear, it is RM
! 449: lea.l PTENRP,a1 ;load a1 with RP table base
! 450: bra.b rmode ;exit decode
! 451: not_rp:
! 452: lea.l PTENRM,a1 ;load a1 with RM table base
! 453: rmode:
! 454: clr.l d3 ;clr table index
! 455: e_loop:
! 456: lsr.l #1,d0 ;shift next bit into carry
! 457: bcc.b e_next ;if zero, skip the mul
! 458: fmul.x (a1,d3),fp1 ;mul by 10**(d3_bit_no)
! 459: e_next:
! 460: add.l #12,d3 ;inc d3 to next pwrten table entry
! 461: tst.l d0 ;test if ISCALE is zero
! 462: bne.b e_loop ;if not, loop
! 463:
! 464:
! 465: * A8. Clr INEX; Force RZ.
! 466: * The operation in A3 above may have set INEX2.
! 467: * RZ mode is forced for the scaling operation to insure
! 468: * only one rounding error. The grs bits are collected in
! 469: * the INEX flag for use in A10.
! 470: *
! 471: * Register usage:
! 472: * Input/Output
! 473:
! 474: fmove.l #0,FPSR ;clr INEX
! 475: fmove.l #rz_mode,FPCR ;set RZ rounding mode
! 476:
! 477:
! 478: * A9. Scale X -> Y.
! 479: * The mantissa is scaled to the desired number of significant
! 480: * digits. The excess digits are collected in INEX2. If mul,
! 481: * Check d2 for excess 10 exponential value. If not zero,
! 482: * the iscale value would have caused the pwrten calculation
! 483: * to overflow. Only a negative iscale can cause this, so
! 484: * multiply by 10^(d2), which is now only allowed to be 24,
! 485: * with a multiply by 10^8 and 10^16, which is exact since
! 486: * 10^24 is exact. If the input was denormalized, we must
! 487: * create a busy stack frame with the mul command and the
! 488: * two operands, and allow the fpu to complete the multiply.
! 489: *
! 490: * Register usage:
! 491: * Input/Output
! 492: * d0: FPCR with RZ mode/Unchanged
! 493: * d2: 0 or 24/unchanged
! 494: * d3: x/x
! 495: * d4: LEN/Unchanged
! 496: * d5: ICTR:LAMBDA
! 497: * d6: ILOG/Unchanged
! 498: * d7: k-factor/Unchanged
! 499: * a0: ptr for original operand/final result
! 500: * a1: ptr to PTENRM array/Unchanged
! 501: * a2: x/x
! 502: * fp0: float(ILOG)/X adjusted for SCALE (Y)
! 503: * fp1: 10^ISCALE/Unchanged
! 504: * fp2: x/x
! 505: * F_SCR1:x/x
! 506: * F_SCR2:Abs(X) with $3fff exponent/Unchanged
! 507: * L_SCR1:x/x
! 508: * L_SCR2:first word of X packed/Unchanged
! 509:
! 510: A9_str:
! 511: fmove.x (a0),fp0 ;load X from memory
! 512: fabs.x fp0 ;use abs(X)
! 513: tst.w d5 ;LAMBDA is in lower word of d5
! 514: bne.b sc_mul ;if neg (LAMBDA = 1), scale by mul
! 515: fdiv.x fp1,fp0 ;calculate X / SCALE -> Y to fp0
! 516: bra.b A10_st ;branch to A10
! 517:
! 518: sc_mul:
! 519: tst.b BINDEC_FLG(a6) ;check for denorm
! 520: beq.b A9_norm ;if norm, continue with mul
! 521: fmovem.x fp1,-(a7) ;load ETEMP with 10^ISCALE
! 522: move.l 8(a0),-(a7) ;load FPTEMP with input arg
! 523: move.l 4(a0),-(a7)
! 524: move.l (a0),-(a7)
! 525: move.l #18,d3 ;load count for busy stack
! 526: A9_loop:
! 527: clr.l -(a7) ;clear lword on stack
! 528: dbf.w d3,A9_loop
! 529: move.b VER_TMP(a6),(a7) ;write current version number
! 530: move.b #BUSY_SIZE-4,1(a7) ;write current busy size
! 531: move.b #$10,$44(a7) ;set fcefpte[15] bit
! 532: move.w #$0023,$40(a7) ;load cmdreg1b with mul command
! 533: move.b #$fe,$8(a7) ;load all 1s to cu savepc
! 534: frestore (a7)+ ;restore frame to fpu for completion
! 535: fmul.x 36(a1),fp0 ;multiply fp0 by 10^8
! 536: fmul.x 48(a1),fp0 ;multiply fp0 by 10^16
! 537: bra.b A10_st
! 538: A9_norm:
! 539: tst.w d2 ;test for small exp case
! 540: beq.b A9_con ;if zero, continue as normal
! 541: fmul.x 36(a1),fp0 ;multiply fp0 by 10^8
! 542: fmul.x 48(a1),fp0 ;multiply fp0 by 10^16
! 543: A9_con:
! 544: fmul.x fp1,fp0 ;calculate X * SCALE -> Y to fp0
! 545:
! 546:
! 547: * A10. Or in INEX.
! 548: * If INEX is set, round error occurred. This is compensated
! 549: * for by 'or-ing' in the INEX2 flag to the lsb of Y.
! 550: *
! 551: * Register usage:
! 552: * Input/Output
! 553: * d0: FPCR with RZ mode/FPSR with INEX2 isolated
! 554: * d2: x/x
! 555: * d3: x/x
! 556: * d4: LEN/Unchanged
! 557: * d5: ICTR:LAMBDA
! 558: * d6: ILOG/Unchanged
! 559: * d7: k-factor/Unchanged
! 560: * a0: ptr for original operand/final result
! 561: * a1: ptr to PTENxx array/Unchanged
! 562: * a2: x/ptr to FP_SCR2(a6)
! 563: * fp0: Y/Y with lsb adjusted
! 564: * fp1: 10^ISCALE/Unchanged
! 565: * fp2: x/x
! 566:
! 567: A10_st:
! 568: fmove.l FPSR,d0 ;get FPSR
! 569: fmove.x fp0,FP_SCR2(a6) ;move Y to memory
! 570: lea.l FP_SCR2(a6),a2 ;load a2 with ptr to FP_SCR2
! 571: btst.l #9,d0 ;check if INEX2 set
! 572: beq.b A11_st ;if clear, skip rest
! 573: ori.l #1,8(a2) ;or in 1 to lsb of mantissa
! 574: fmove.x FP_SCR2(a6),fp0 ;write adjusted Y back to fpu
! 575:
! 576:
! 577: * A11. Restore original FPCR; set size ext.
! 578: * Perform FINT operation in the user's rounding mode. Keep
! 579: * the size to extended. The sintdo entry point in the sint
! 580: * routine expects the FPCR value to be in USER_FPCR for
! 581: * mode and precision. The original FPCR is saved in L_SCR1.
! 582:
! 583: A11_st:
! 584: move.l USER_FPCR(a6),L_SCR1(a6) ;save it for later
! 585: andi.l #$00000030,USER_FPCR(a6) ;set size to ext,
! 586: * ;block exceptions
! 587:
! 588:
! 589: * A12. Calculate YINT = FINT(Y) according to user's rounding mode.
! 590: * The FPSP routine sintd0 is used. The output is in fp0.
! 591: *
! 592: * Register usage:
! 593: * Input/Output
! 594: * d0: FPSR with AINEX cleared/FPCR with size set to ext
! 595: * d2: x/x/scratch
! 596: * d3: x/x
! 597: * d4: LEN/Unchanged
! 598: * d5: ICTR:LAMBDA/Unchanged
! 599: * d6: ILOG/Unchanged
! 600: * d7: k-factor/Unchanged
! 601: * a0: ptr for original operand/src ptr for sintdo
! 602: * a1: ptr to PTENxx array/Unchanged
! 603: * a2: ptr to FP_SCR2(a6)/Unchanged
! 604: * a6: temp pointer to FP_SCR2(a6) - orig value saved and restored
! 605: * fp0: Y/YINT
! 606: * fp1: 10^ISCALE/Unchanged
! 607: * fp2: x/x
! 608: * F_SCR1:x/x
! 609: * F_SCR2:Y adjusted for inex/Y with original exponent
! 610: * L_SCR1:x/original USER_FPCR
! 611: * L_SCR2:first word of X packed/Unchanged
! 612:
! 613: A12_st:
! 614: movem.l d0-d1/a0-a1,-(a7) ;save regs used by sintd0
! 615: move.l L_SCR1(a6),-(a7)
! 616: move.l L_SCR2(a6),-(a7)
! 617: lea.l FP_SCR2(a6),a0 ;a0 is ptr to F_SCR2(a6)
! 618: fmove.x fp0,(a0) ;move Y to memory at FP_SCR2(a6)
! 619: tst.l L_SCR2(a6) ;test sign of original operand
! 620: bge.b do_fint ;if pos, use Y
! 621: or.l #$80000000,(a0) ;if neg, use -Y
! 622: do_fint:
! 623: move.l USER_FPSR(a6),-(a7)
! 624: bsr sintdo ;sint routine returns int in fp0
! 625: move.b (a7),USER_FPSR(a6)
! 626: add.l #4,a7
! 627: move.l (a7)+,L_SCR2(a6)
! 628: move.l (a7)+,L_SCR1(a6)
! 629: movem.l (a7)+,d0-d1/a0-a1 ;restore regs used by sint
! 630: move.l L_SCR2(a6),FP_SCR2(a6) ;restore original exponent
! 631: move.l L_SCR1(a6),USER_FPCR(a6) ;restore user's FPCR
! 632:
! 633:
! 634: * A13. Check for LEN digits.
! 635: * If the int operation results in more than LEN digits,
! 636: * or less than LEN -1 digits, adjust ILOG and repeat from
! 637: * A6. This test occurs only on the first pass. If the
! 638: * result is exactly 10^LEN, decrement ILOG and divide
! 639: * the mantissa by 10. The calculation of 10^LEN cannot
! 640: * be inexact, since all powers of ten upto 10^27 are exact
! 641: * in extended precision, so the use of a previous power-of-ten
! 642: * table will introduce no error.
! 643: *
! 644: *
! 645: * Register usage:
! 646: * Input/Output
! 647: * d0: FPCR with size set to ext/scratch final = 0
! 648: * d2: x/x
! 649: * d3: x/scratch final = x
! 650: * d4: LEN/LEN adjusted
! 651: * d5: ICTR:LAMBDA/LAMBDA:ICTR
! 652: * d6: ILOG/ILOG adjusted
! 653: * d7: k-factor/Unchanged
! 654: * a0: pointer into memory for packed bcd string formation
! 655: * a1: ptr to PTENxx array/Unchanged
! 656: * a2: ptr to FP_SCR2(a6)/Unchanged
! 657: * fp0: int portion of Y/abs(YINT) adjusted
! 658: * fp1: 10^ISCALE/Unchanged
! 659: * fp2: x/10^LEN
! 660: * F_SCR1:x/x
! 661: * F_SCR2:Y with original exponent/Unchanged
! 662: * L_SCR1:original USER_FPCR/Unchanged
! 663: * L_SCR2:first word of X packed/Unchanged
! 664:
! 665: A13_st:
! 666: swap d5 ;put ICTR in lower word of d5
! 667: tst.w d5 ;check if ICTR = 0
! 668: bne not_zr ;if non-zero, go to second test
! 669: *
! 670: * Compute 10^(LEN-1)
! 671: *
! 672: fmove.s FONE,fp2 ;init fp2 to 1.0
! 673: move.l d4,d0 ;put LEN in d0
! 674: subq.l #1,d0 ;d0 = LEN -1
! 675: clr.l d3 ;clr table index
! 676: l_loop:
! 677: lsr.l #1,d0 ;shift next bit into carry
! 678: bcc.b l_next ;if zero, skip the mul
! 679: fmul.x (a1,d3),fp2 ;mul by 10**(d3_bit_no)
! 680: l_next:
! 681: add.l #12,d3 ;inc d3 to next pwrten table entry
! 682: tst.l d0 ;test if LEN is zero
! 683: bne.b l_loop ;if not, loop
! 684: *
! 685: * 10^LEN-1 is computed for this test and A14. If the input was
! 686: * denormalized, check only the case in which YINT > 10^LEN.
! 687: *
! 688: tst.b BINDEC_FLG(a6) ;check if input was norm
! 689: beq.b A13_con ;if norm, continue with checking
! 690: fabs.x fp0 ;take abs of YINT
! 691: bra test_2
! 692: *
! 693: * Compare abs(YINT) to 10^(LEN-1) and 10^LEN
! 694: *
! 695: A13_con:
! 696: fabs.x fp0 ;take abs of YINT
! 697: fcmp.x fp2,fp0 ;compare abs(YINT) with 10^(LEN-1)
! 698: fbge.w test_2 ;if greater, do next test
! 699: subq.l #1,d6 ;subtract 1 from ILOG
! 700: move.w #1,d5 ;set ICTR
! 701: fmove.l #rm_mode,FPCR ;set rmode to RM
! 702: fmul.s FTEN,fp2 ;compute 10^LEN
! 703: bra.w A6_str ;return to A6 and recompute YINT
! 704: test_2:
! 705: fmul.s FTEN,fp2 ;compute 10^LEN
! 706: fcmp.x fp2,fp0 ;compare abs(YINT) with 10^LEN
! 707: fblt.w A14_st ;if less, all is ok, go to A14
! 708: fbgt.w fix_ex ;if greater, fix and redo
! 709: fdiv.s FTEN,fp0 ;if equal, divide by 10
! 710: addq.l #1,d6 ; and inc ILOG
! 711: bra.b A14_st ; and continue elsewhere
! 712: fix_ex:
! 713: addq.l #1,d6 ;increment ILOG by 1
! 714: move.w #1,d5 ;set ICTR
! 715: fmove.l #rm_mode,FPCR ;set rmode to RM
! 716: bra.w A6_str ;return to A6 and recompute YINT
! 717: *
! 718: * Since ICTR <> 0, we have already been through one adjustment,
! 719: * and shouldn't have another; this is to check if abs(YINT) = 10^LEN
! 720: * 10^LEN is again computed using whatever table is in a1 since the
! 721: * value calculated cannot be inexact.
! 722: *
! 723: not_zr:
! 724: fmove.s FONE,fp2 ;init fp2 to 1.0
! 725: move.l d4,d0 ;put LEN in d0
! 726: clr.l d3 ;clr table index
! 727: z_loop:
! 728: lsr.l #1,d0 ;shift next bit into carry
! 729: bcc.b z_next ;if zero, skip the mul
! 730: fmul.x (a1,d3),fp2 ;mul by 10**(d3_bit_no)
! 731: z_next:
! 732: add.l #12,d3 ;inc d3 to next pwrten table entry
! 733: tst.l d0 ;test if LEN is zero
! 734: bne.b z_loop ;if not, loop
! 735: fabs.x fp0 ;get abs(YINT)
! 736: fcmp.x fp2,fp0 ;check if abs(YINT) = 10^LEN
! 737: fbne.w A14_st ;if not, skip this
! 738: fdiv.s FTEN,fp0 ;divide abs(YINT) by 10
! 739: addq.l #1,d6 ;and inc ILOG by 1
! 740: addq.l #1,d4 ; and inc LEN
! 741: fmul.s FTEN,fp2 ; if LEN++, the get 10^^LEN
! 742:
! 743:
! 744: * A14. Convert the mantissa to bcd.
! 745: * The binstr routine is used to convert the LEN digit
! 746: * mantissa to bcd in memory. The input to binstr is
! 747: * to be a fraction; i.e. (mantissa)/10^LEN and adjusted
! 748: * such that the decimal point is to the left of bit 63.
! 749: * The bcd digits are stored in the correct position in
! 750: * the final string area in memory.
! 751: *
! 752: *
! 753: * Register usage:
! 754: * Input/Output
! 755: * d0: x/LEN call to binstr - final is 0
! 756: * d1: x/0
! 757: * d2: x/ms 32-bits of mant of abs(YINT)
! 758: * d3: x/ls 32-bits of mant of abs(YINT)
! 759: * d4: LEN/Unchanged
! 760: * d5: ICTR:LAMBDA/LAMBDA:ICTR
! 761: * d6: ILOG
! 762: * d7: k-factor/Unchanged
! 763: * a0: pointer into memory for packed bcd string formation
! 764: * /ptr to first mantissa byte in result string
! 765: * a1: ptr to PTENxx array/Unchanged
! 766: * a2: ptr to FP_SCR2(a6)/Unchanged
! 767: * fp0: int portion of Y/abs(YINT) adjusted
! 768: * fp1: 10^ISCALE/Unchanged
! 769: * fp2: 10^LEN/Unchanged
! 770: * F_SCR1:x/Work area for final result
! 771: * F_SCR2:Y with original exponent/Unchanged
! 772: * L_SCR1:original USER_FPCR/Unchanged
! 773: * L_SCR2:first word of X packed/Unchanged
! 774:
! 775: A14_st:
! 776: fmove.l #rz_mode,FPCR ;force rz for conversion
! 777: fdiv.x fp2,fp0 ;divide abs(YINT) by 10^LEN
! 778: lea.l FP_SCR1(a6),a0
! 779: fmove.x fp0,(a0) ;move abs(YINT)/10^LEN to memory
! 780: move.l 4(a0),d2 ;move 2nd word of FP_RES to d2
! 781: move.l 8(a0),d3 ;move 3rd word of FP_RES to d3
! 782: clr.l 4(a0) ;zero word 2 of FP_RES
! 783: clr.l 8(a0) ;zero word 3 of FP_RES
! 784: move.l (a0),d0 ;move exponent to d0
! 785: swap d0 ;put exponent in lower word
! 786: beq.b no_sft ;if zero, don't shift
! 787: subi.l #$3ffd,d0 ;sub bias less 2 to make fract
! 788: tst.l d0 ;check if > 1
! 789: bgt.b no_sft ;if so, don't shift
! 790: neg.l d0 ;make exp positive
! 791: m_loop:
! 792: lsr.l #1,d2 ;shift d2:d3 right, add 0s
! 793: roxr.l #1,d3 ;the number of places
! 794: dbf.w d0,m_loop ;given in d0
! 795: no_sft:
! 796: tst.l d2 ;check for mantissa of zero
! 797: bne.b no_zr ;if not, go on
! 798: tst.l d3 ;continue zero check
! 799: beq.b zer_m ;if zero, go directly to binstr
! 800: no_zr:
! 801: clr.l d1 ;put zero in d1 for addx
! 802: addi.l #$00000080,d3 ;inc at bit 7
! 803: addx.l d1,d2 ;continue inc
! 804: andi.l #$ffffff80,d3 ;strip off lsb not used by 882
! 805: zer_m:
! 806: move.l d4,d0 ;put LEN in d0 for binstr call
! 807: addq.l #3,a0 ;a0 points to M16 byte in result
! 808: bsr binstr ;call binstr to convert mant
! 809:
! 810:
! 811: * A15. Convert the exponent to bcd.
! 812: * As in A14 above, the exp is converted to bcd and the
! 813: * digits are stored in the final string.
! 814: *
! 815: * Digits are stored in L_SCR1(a6) on return from BINDEC as:
! 816: *
! 817: * 32 16 15 0
! 818: * -----------------------------------------
! 819: * | 0 | e3 | e2 | e1 | e4 | X | X | X |
! 820: * -----------------------------------------
! 821: *
! 822: * And are moved into their proper places in FP_SCR1. If digit e4
! 823: * is non-zero, OPERR is signaled. In all cases, all 4 digits are
! 824: * written as specified in the 881/882 manual for packed decimal.
! 825: *
! 826: * Register usage:
! 827: * Input/Output
! 828: * d0: x/LEN call to binstr - final is 0
! 829: * d1: x/scratch (0);shift count for final exponent packing
! 830: * d2: x/ms 32-bits of exp fraction/scratch
! 831: * d3: x/ls 32-bits of exp fraction
! 832: * d4: LEN/Unchanged
! 833: * d5: ICTR:LAMBDA/LAMBDA:ICTR
! 834: * d6: ILOG
! 835: * d7: k-factor/Unchanged
! 836: * a0: ptr to result string/ptr to L_SCR1(a6)
! 837: * a1: ptr to PTENxx array/Unchanged
! 838: * a2: ptr to FP_SCR2(a6)/Unchanged
! 839: * fp0: abs(YINT) adjusted/float(ILOG)
! 840: * fp1: 10^ISCALE/Unchanged
! 841: * fp2: 10^LEN/Unchanged
! 842: * F_SCR1:Work area for final result/BCD result
! 843: * F_SCR2:Y with original exponent/ILOG/10^4
! 844: * L_SCR1:original USER_FPCR/Exponent digits on return from binstr
! 845: * L_SCR2:first word of X packed/Unchanged
! 846:
! 847: A15_st:
! 848: tst.b BINDEC_FLG(a6) ;check for denorm
! 849: beq.b not_denorm
! 850: ftst.x fp0 ;test for zero
! 851: fbeq.w den_zero ;if zero, use k-factor or 4933
! 852: fmove.l d6,fp0 ;float ILOG
! 853: fabs.x fp0 ;get abs of ILOG
! 854: bra.b convrt
! 855: den_zero:
! 856: tst.l d7 ;check sign of the k-factor
! 857: blt.b use_ilog ;if negative, use ILOG
! 858: fmove.s F4933,fp0 ;force exponent to 4933
! 859: bra.b convrt ;do it
! 860: use_ilog:
! 861: fmove.l d6,fp0 ;float ILOG
! 862: fabs.x fp0 ;get abs of ILOG
! 863: bra.b convrt
! 864: not_denorm:
! 865: ftst.x fp0 ;test for zero
! 866: fbne.w not_zero ;if zero, force exponent
! 867: fmove.s FONE,fp0 ;force exponent to 1
! 868: bra.b convrt ;do it
! 869: not_zero:
! 870: fmove.l d6,fp0 ;float ILOG
! 871: fabs.x fp0 ;get abs of ILOG
! 872: convrt:
! 873: fdiv.x 24(a1),fp0 ;compute ILOG/10^4
! 874: fmove.x fp0,FP_SCR2(a6) ;store fp0 in memory
! 875: move.l 4(a2),d2 ;move word 2 to d2
! 876: move.l 8(a2),d3 ;move word 3 to d3
! 877: move.w (a2),d0 ;move exp to d0
! 878: beq.b x_loop_fin ;if zero, skip the shift
! 879: subi.w #$3ffd,d0 ;subtract off bias
! 880: neg.w d0 ;make exp positive
! 881: x_loop:
! 882: lsr.l #1,d2 ;shift d2:d3 right
! 883: roxr.l #1,d3 ;the number of places
! 884: dbf.w d0,x_loop ;given in d0
! 885: x_loop_fin:
! 886: clr.l d1 ;put zero in d1 for addx
! 887: addi.l #$00000080,d3 ;inc at bit 6
! 888: addx.l d1,d2 ;continue inc
! 889: andi.l #$ffffff80,d3 ;strip off lsb not used by 882
! 890: move.l #4,d0 ;put 4 in d0 for binstr call
! 891: lea.l L_SCR1(a6),a0 ;a0 is ptr to L_SCR1 for exp digits
! 892: bsr binstr ;call binstr to convert exp
! 893: move.l L_SCR1(a6),d0 ;load L_SCR1 lword to d0
! 894: move.l #12,d1 ;use d1 for shift count
! 895: lsr.l d1,d0 ;shift d0 right by 12
! 896: bfins d0,FP_SCR1(a6){4:12} ;put e3:e2:e1 in FP_SCR1
! 897: lsr.l d1,d0 ;shift d0 right by 12
! 898: bfins d0,FP_SCR1(a6){16:4} ;put e4 in FP_SCR1
! 899: tst.b d0 ;check if e4 is zero
! 900: beq.b A16_st ;if zero, skip rest
! 901: or.l #opaop_mask,USER_FPSR(a6) ;set OPERR & AIOP in USER_FPSR
! 902:
! 903:
! 904: * A16. Write sign bits to final string.
! 905: * Sigma is bit 31 of initial value; RHO is bit 31 of d6 (ILOG).
! 906: *
! 907: * Register usage:
! 908: * Input/Output
! 909: * d0: x/scratch - final is x
! 910: * d2: x/x
! 911: * d3: x/x
! 912: * d4: LEN/Unchanged
! 913: * d5: ICTR:LAMBDA/LAMBDA:ICTR
! 914: * d6: ILOG/ILOG adjusted
! 915: * d7: k-factor/Unchanged
! 916: * a0: ptr to L_SCR1(a6)/Unchanged
! 917: * a1: ptr to PTENxx array/Unchanged
! 918: * a2: ptr to FP_SCR2(a6)/Unchanged
! 919: * fp0: float(ILOG)/Unchanged
! 920: * fp1: 10^ISCALE/Unchanged
! 921: * fp2: 10^LEN/Unchanged
! 922: * F_SCR1:BCD result with correct signs
! 923: * F_SCR2:ILOG/10^4
! 924: * L_SCR1:Exponent digits on return from binstr
! 925: * L_SCR2:first word of X packed/Unchanged
! 926:
! 927: A16_st:
! 928: clr.l d0 ;clr d0 for collection of signs
! 929: andi.b #$0f,FP_SCR1(a6) ;clear first nibble of FP_SCR1
! 930: tst.l L_SCR2(a6) ;check sign of original mantissa
! 931: bge.b mant_p ;if pos, don't set SM
! 932: moveq.l #2,d0 ;move 2 in to d0 for SM
! 933: mant_p:
! 934: tst.l d6 ;check sign of ILOG
! 935: bge.b wr_sgn ;if pos, don't set SE
! 936: addq.l #1,d0 ;set bit 0 in d0 for SE
! 937: wr_sgn:
! 938: bfins d0,FP_SCR1(a6){0:2} ;insert SM and SE into FP_SCR1
! 939:
! 940: * Clean up and restore all registers used.
! 941:
! 942: fmove.l #0,FPSR ;clear possible inex2/ainex bits
! 943: fmovem.x (a7)+,fp0-fp2
! 944: movem.l (a7)+,d2-d7/a2
! 945: rts
! 946:
! 947: end
CVSweb
![[BACK]](/icons/back.gif){kind=icon}
Return to bindec.sa CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [local] / sys / arch / m68k / fpsp