libgcc/config/rl78/fpmath-sf.S

   1 ; SF format is:
   2 ;
   3 ; [sign] 1.[23bits] E[8bits(n-127)]
   4 ;
   5 ; SEEEEEEE Emmmmmmm mmmmmmmm mmmmmmmm
   6 ;
   7 ; [A+0] mmmmmmmm
   8 ; [A+1] mmmmmmmm
   9 ; [A+2] Emmmmmmm
  10 ; [A+3] SEEEEEEE
  11 ;
  12 ; Special values (xxx != 0):
  13 ;
  14 ;  r11      r10      r9       r8
  15 ;  [HL+3]   [HL+2]   [HL+1]   [HL+0]
  16 ;  s1111111 10000000 00000000 00000000  infinity
  17 ;  s1111111 1xxxxxxx xxxxxxxx xxxxxxxx  NaN
  18 ;  s0000000 00000000 00000000 00000000  zero
  19 ;  s0000000 0xxxxxxx xxxxxxxx xxxxxxxx  denormals
  20 ;
  21 ; Note that CMPtype is "signed char" for rl78
  22 ;
  23
  24 #include "vregs.h"
  25
  26 #define Z       PSW.6
  27
  28 ; External Functions:
  29 ;
  30 ;  __int_isnan  [HL] -> Z if NaN
  31 ;  __int_iszero  [HL] -> Z if zero
  32
  33 START_FUNC      __int_isinf
  34         ;; [HL] points to value, returns Z if it's #Inf
  35
  36         mov     a, [hl+2]
  37         and     a, #0x80
  38         mov     x, a
  39         mov     a, [hl+3]
  40         and     a, #0x7f
  41         cmpw    ax, #0x7f80
  42         skz
  43         ret                     ; return NZ if not NaN
  44         mov     a, [hl+2]
  45         and     a, #0x7f
  46         or      a, [hl+1]
  47         or      a, [hl]
  48         ret
  49
  50 END_FUNC        __int_isinf
  51
  52 #define A_SIGN          [hl+0]  /* byte */
  53 #define A_EXP           [hl+2]  /* word */
  54 #define A_FRAC_L        [hl+4]  /* word */
  55 #define A_FRAC_LH       [hl+5]  /* byte */
  56 #define A_FRAC_H        [hl+6]  /* word or byte */
  57 #define A_FRAC_HH       [hl+7]  /* byte */
  58
  59 #define B_SIGN          [hl+8]
  60 #define B_EXP           [hl+10]
  61 #define B_FRAC_L        [hl+12]
  62 #define B_FRAC_LH       [hl+13]
  63 #define B_FRAC_H        [hl+14]
  64 #define B_FRAC_HH       [hl+15]
  65
  66 START_FUNC      _int_unpack_sf
  67         ;; convert 32-bit SFmode [DE] to 6-byte struct [HL] ("A")
  68
  69         mov     a, [de+3]
  70         sar     a, 7
  71         mov     A_SIGN, a
  72
  73         movw    ax, [de+2]
  74         and     a, #0x7f
  75         shrw    ax, 7
  76         movw    bc, ax          ; remember if the exponent is all zeros
  77         subw    ax, #127        ; exponent is now non-biased
  78         movw    A_EXP, ax
  79
  80         movw    ax, [de]
  81         movw    A_FRAC_L, ax
  82
  83         mov     a, [de+2]
  84         and     a, #0x7f
  85         cmp0    c               ; if the exp is all zeros, it's denormal
  86         skz
  87         or      a, #0x80
  88         mov     A_FRAC_H, a
  89
  90         mov     a, #0
  91         mov     A_FRAC_HH, a
  92
  93         ;; rounding-bit-shift
  94         movw    ax, A_FRAC_L
  95         shlw    ax, 1
  96         movw    A_FRAC_L, ax
  97         mov     a, A_FRAC_H
  98         rolc    a, 1
  99         mov     A_FRAC_H, a
 100         mov     a, A_FRAC_HH
 101         rolc    a, 1
 102         mov     A_FRAC_HH, a
 103
 104         ret
 105
 106 END_FUNC        _int_unpack_sf
 107
 108 ;       func(SF a,SF b)
 109 ;       [SP+4..7]       a
 110 ;       [SP+8..11]      b
 111
 112 START_FUNC              ___subsf3
 113
 114         ;; a - b => a + (-b)
 115
 116         ;; Note - we cannot just change the sign of B on the stack and
 117         ;; then fall through into __addsf3.  The stack'ed value may be
 118         ;; used again (it was created by our caller after all).  Instead
 119         ;; we have to allocate some stack space of our own, copy A and B,
 120         ;; change the sign of B, call __addsf3, release the allocated stack
 121         ;; and then return.
 122
 123         subw    sp, #8
 124         movw    ax, [sp+4+8]
 125         movw    [sp], ax
 126         movw    ax, [sp+4+2+8]
 127         movw    [sp+2], ax
 128         movw    ax, [sp+4+4+8]
 129         movw    [sp+4], ax
 130         mov     a, [sp+4+6+8]
 131         mov     [sp+6], a
 132         mov     a, [sp+4+7+8]
 133         xor     a, #0x80
 134         mov     [sp+7], a
 135         call    $!___addsf3
 136         addw    sp, #8
 137         ret
 138 END_FUNC        ___subsf3
 139
 140 START_FUNC      ___addsf3
 141
 142         ;; if (isnan(a)) return a
 143         movw    ax, sp
 144         addw    ax, #4
 145         movw    hl, ax
 146         call    !!__int_isnan
 147         bnz     $1f
 148 ret_a:
 149         movw    ax, [sp+4]
 150         movw    r8, ax
 151         movw    ax, [sp+6]
 152         movw    r10, ax
 153         ret
 154
 155 1:      ;; if (isnan (b)) return b;
 156         movw    ax, sp
 157         addw    ax, #8
 158         movw    hl, ax
 159         call    !!__int_isnan
 160         bnz     $2f
 161 ret_b:
 162         movw    ax, [sp+8]
 163         movw    r8, ax
 164         movw    ax, [sp+10]
 165         movw    r10, ax
 166         ret
 167
 168 2:      ;; if (isinf (a))
 169         movw    ax, sp
 170         addw    ax, #4
 171         movw    hl, ax
 172         call    $!__int_isinf
 173         bnz     $3f
 174
 175         ;;   if (isinf (b) && a->sign != b->sign) return NaN
 176
 177         movw    ax, sp
 178         addw    ax, #8
 179         movw    hl, ax
 180         call    $!__int_isinf
 181         bnz     $ret_a
 182
 183         mov     a, [sp+7]
 184         mov     h, a
 185         mov     a, [sp+11]
 186         xor     a, h
 187         bf      a.7, $ret_a
 188
 189         movw    r8,  #0x0001
 190         movw    r10, #0x7f80
 191         ret
 192
 193 3:      ;; if (isinf (b)) return b;
 194         movw    ax, sp
 195         addw    ax, #8
 196         movw    hl, ax
 197         call    $!__int_isinf
 198         bz      $ret_b
 199
 200         ;; if (iszero (b))
 201         movw    ax, sp
 202         addw    ax, #8
 203         movw    hl, ax
 204         call    !!__int_iszero
 205         bnz     $4f
 206
 207         ;;   if (iszero (a))
 208         movw    ax, sp
 209         addw    ax, #4
 210         movw    hl, ax
 211         call    !!__int_iszero
 212         bnz     $ret_a
 213
 214         movw    ax, [sp+4]
 215         movw    r8, ax
 216         mov     a, [sp+7]
 217         mov     h, a
 218         movw    ax, [sp+10]
 219         and     a, h
 220         movw    r10, ax
 221         ret
 222
 223 4:      ;; if (iszero (a)) return b;
 224         movw    ax, sp
 225         addw    ax, #4
 226         movw    hl, ax
 227         call    !!__int_iszero
 228         bz      $ret_b
 229
 230 ; Normalize the two numbers relative to each other.  At this point,
 231 ; we need the numbers converted to their "unpacked" format.
 232
 233         subw    sp, #16         ; Save room for two unpacked values.
 234
 235         movw    ax, sp
 236         movw    hl, ax
 237         addw    ax, #16+4
 238         movw    de, ax
 239         call    $!_int_unpack_sf
 240
 241         movw    ax, sp
 242         addw    ax, #8
 243         movw    hl, ax
 244         addw    ax, #16+8-8
 245         movw    de, ax
 246         call    $!_int_unpack_sf
 247
 248         movw    ax, sp
 249         movw    hl, ax
 250
 251         ;; diff = a.exponent - b.exponent
 252         movw    ax, B_EXP       ; sign/exponent word
 253         movw    bc, ax
 254         movw    ax, A_EXP       ; sign/exponent word
 255
 256         subw    ax, bc          ; a = a.exp - b.exp
 257         movw    de, ax          ; d = sdiff
 258
 259         ;;  if (diff < 0) diff = -diff
 260         bf      a.7, $1f
 261         xor     a, #0xff
 262         xor     r_0, #0xff      ; x
 263         incw    ax              ; a = diff
 264 1:
 265         ;; if (diff >= 23) zero the smaller one
 266         cmpw    ax, #24
 267         bc      $.L661          ; if a < 23 goto 661
 268
 269         ;; zero out the smaller one
 270
 271         movw    ax, de
 272         bt      a.7, $1f        ; if sdiff < 0 (a_exp < b_exp) goto 1f
 273         ;; "zero out" b
 274         movw    ax, A_EXP
 275         movw    B_EXP, ax
 276         movw    ax, #0
 277         movw    B_FRAC_L, ax
 278         movw    B_FRAC_H, ax
 279         br      $5f
 280 1:
 281         ;; "zero out" a
 282         movw    ax, B_EXP
 283         movw    A_EXP, ax
 284         movw    ax, #0
 285         movw    A_FRAC_L, ax
 286         movw    A_FRAC_H, ax
 287
 288         br      $5f
 289 .L661:
 290         ;; shift the smaller one so they have the same exponents
 291 1:
 292         movw    ax, de
 293         bt      a.7, $1f
 294         cmpw    ax, #0          ; sdiff > 0
 295         bnh     $1f             ; if (sdiff <= 0) goto 1f
 296
 297         decw    de
 298         incw    B_EXP           ; because it's [HL+byte]
 299
 300         movw    ax, B_FRAC_H
 301         shrw    ax, 1
 302         movw    B_FRAC_H, ax
 303         mov     a, B_FRAC_LH
 304         rorc    a, 1
 305         mov     B_FRAC_LH, a
 306         mov     a, B_FRAC_L
 307         rorc    a, 1
 308         mov     B_FRAC_L, a
 309
 310         br      $1b
 311 1:
 312         movw    ax, de
 313         bf      a.7, $1f
 314
 315         incw    de
 316         incw    A_EXP           ; because it's [HL+byte]
 317
 318         movw    ax, A_FRAC_H
 319         shrw    ax, 1
 320         movw    A_FRAC_H, ax
 321         mov     a, A_FRAC_LH
 322         rorc    a, 1
 323         mov     A_FRAC_LH, a
 324         mov     a, A_FRAC_L
 325         rorc    a, 1
 326         mov     A_FRAC_L, a
 327
 328         br      $1b
 329 1:
 330
 331 5:      ;; At this point, A and B have the same exponent.
 332
 333         mov     a, A_SIGN
 334         cmp     a, B_SIGN
 335         bnz     $1f
 336
 337         ;; Same sign, just add.
 338         movw    ax, A_FRAC_L
 339         addw    ax, B_FRAC_L
 340         movw    A_FRAC_L, ax
 341         mov     a, A_FRAC_H
 342         addc    a, B_FRAC_H
 343         mov     A_FRAC_H, a
 344         mov     a, A_FRAC_HH
 345         addc    a, B_FRAC_HH
 346         mov     A_FRAC_HH, a
 347
 348         br      $.L728
 349
 350 1:      ;; Signs differ - A has A_SIGN still.
 351         bf      a.7, $.L696
 352
 353         ;; A is negative, do B-A
 354         movw    ax, B_FRAC_L
 355         subw    ax, A_FRAC_L
 356         movw    A_FRAC_L, ax
 357         mov     a, B_FRAC_H
 358         subc    a, A_FRAC_H
 359         mov     A_FRAC_H, a
 360         mov     a, B_FRAC_HH
 361         subc    a, A_FRAC_HH
 362         mov     A_FRAC_HH, a
 363
 364         br      $.L698
 365 .L696:
 366         ;; B is negative, do A-B
 367         movw    ax, A_FRAC_L
 368         subw    ax, B_FRAC_L
 369         movw    A_FRAC_L, ax
 370         mov     a, A_FRAC_H
 371         subc    a, B_FRAC_H
 372         mov     A_FRAC_H, a
 373         mov     a, A_FRAC_HH
 374         subc    a, B_FRAC_HH
 375         mov     A_FRAC_HH, a
 376
 377 .L698:
 378         ;; A is still A_FRAC_HH
 379         bt      a.7, $.L706
 380
 381         ;; subtraction was positive
 382         mov     a, #0
 383         mov     A_SIGN, a
 384         br      $.L712
 385
 386 .L706:
 387         ;; subtraction was negative
 388         mov     a, #0xff
 389         mov     A_SIGN, a
 390
 391         ;; This negates A_FRAC
 392         mov     a, A_FRAC_L
 393         xor     a, #0xff                ; XOR doesn't mess with carry
 394         add     a, #1                   ; INC doesn't set the carry
 395         mov     A_FRAC_L, a
 396         mov     a, A_FRAC_LH
 397         xor     a, #0xff
 398         addc    a, #0
 399         mov     A_FRAC_LH, a
 400         mov     a, A_FRAC_H
 401         xor     a, #0xff
 402         addc    a, #0
 403         mov     A_FRAC_H, a
 404         mov     a, A_FRAC_HH
 405         xor     a, #0xff
 406         addc    a, #0
 407         mov     A_FRAC_HH, a
 408
 409 .L712:
 410         ;; Renormalize the subtraction
 411
 412         mov     a, A_FRAC_L
 413         or      a, A_FRAC_LH
 414         or      a, A_FRAC_H
 415         or      a, A_FRAC_HH
 416         bz      $.L728
 417
 418         ;; Mantissa is not zero, left shift until the MSB is in the
 419         ;; right place
 420 1:
 421         movw    ax, A_FRAC_H
 422         cmpw    ax, #0x0200
 423         bnc     $.L728
 424
 425         decw    A_EXP
 426
 427         movw    ax, A_FRAC_L
 428         shlw    ax, 1
 429         movw    A_FRAC_L, ax
 430         movw    ax, A_FRAC_H
 431         rolwc   ax, 1
 432         movw    A_FRAC_H, ax
 433         br      $1b
 434
 435 .L728:
 436         ;; normalize A and pack it
 437
 438         movw    ax, A_FRAC_H
 439         cmpw    ax, #0x01ff
 440         bnh     $1f
 441         ;; overflow in the mantissa; adjust
 442         movw    ax, A_FRAC_H
 443         shrw    ax, 1
 444         movw    A_FRAC_H, ax
 445         mov     a, A_FRAC_LH
 446         rorc    a, 1
 447         mov     A_FRAC_LH, a
 448         mov     a, A_FRAC_L
 449         rorc    a, 1
 450         mov     A_FRAC_L, a
 451         incw    A_EXP
 452 1:
 453
 454         call    $!__rl78_int_pack_a_r8
 455         addw    sp, #16
 456         ret
 457
 458 END_FUNC        ___addsf3
 459
 460 START_FUNC      __rl78_int_pack_a_r8
 461         ;; pack A to R8
 462         movw    ax, A_EXP
 463         addw    ax, #126        ; not 127, we want the "bt/bf" test to check for denormals
 464
 465         bf      a.7, $1f
 466         ;; make a denormal
 467 2:
 468         movw    bc, ax
 469         movw    ax, A_FRAC_H
 470         shrw    ax, 1
 471         movw    A_FRAC_H, ax
 472         mov     a, A_FRAC_LH
 473         rorc    a, 1
 474         mov     A_FRAC_LH, a
 475         mov     a, A_FRAC_L
 476         rorc    a, 1
 477         mov     A_FRAC_L, a
 478         movw    ax, bc
 479         incw    ax
 480         bt      a.7, $2b
 481         decw    ax
 482 1:
 483         incw    ax              ; now it's as if we added 127
 484         movw    A_EXP, ax
 485
 486         cmpw    ax, #0xfe
 487         bnh     $1f
 488         ;; store #Inf instead
 489         mov     a, A_SIGN
 490         or      a, #0x7f
 491         mov     x, #0x80
 492         movw    r10, ax
 493         movw    r8, #0
 494         ret
 495
 496 1:
 497         bf      a.7, $1f        ; note AX has EXP at top of loop
 498         ;; underflow, denormal?
 499         movw    ax, A_FRAC_H
 500         shrw    ax, 1
 501         movw    A_FRAC_H, ax
 502         mov     a, A_FRAC_LH
 503         rorc    a, 1
 504         movw    A_FRAC_LH, ax
 505         mov     a, A_FRAC_L
 506         rorc    a, 1
 507         movw    A_FRAC_L, ax
 508         incw    A_EXP
 509         movw    ax, A_EXP
 510         br      $1b
 511
 512 1:
 513         ;; undo the rounding-bit-shift
 514         mov     a, A_FRAC_L
 515         bf      a.0, $1f
 516         ;; round up
 517         movw    ax, A_FRAC_L
 518         addw    ax, #1
 519         movw    A_FRAC_L, ax
 520         bnc     $1f
 521         incw    A_FRAC_H
 522
 523         ;; If the rounding set the bit beyond the end of the fraction, increment the exponent.
 524         mov     a, A_FRAC_HH
 525         bf      a.1, $1f
 526         incw    A_EXP
 527
 528 1:
 529         movw    ax, A_FRAC_H
 530         shrw    ax, 1
 531         movw    A_FRAC_H, ax
 532         mov     a, A_FRAC_LH
 533         rorc    a, 1
 534         mov     A_FRAC_LH, a
 535         mov     a, A_FRAC_L
 536         rorc    a, 1
 537         mov     A_FRAC_L, a
 538
 539         movw    ax, A_FRAC_L
 540         movw    r8, ax
 541
 542         or      a, x
 543         or      a, A_FRAC_H
 544         or      a, A_FRAC_HH
 545         bnz     $1f
 546         movw    ax, #0
 547         movw    A_EXP, ax
 548 1:
 549         mov     a, A_FRAC_H
 550         and     a, #0x7f
 551         mov     b, a
 552         mov     a, A_EXP
 553         shl     a, 7
 554         or      a, b
 555         mov     r10, a
 556
 557         mov     a, A_SIGN
 558         and     a, #0x80
 559         mov     b, a
 560         mov     a, A_EXP
 561         shr     a, 1
 562         or      a, b
 563         mov     r11, a
 564
 565         ret
 566 END_FUNC        __rl78_int_pack_a_r8
 567
 568 START_FUNC      ___mulsf3
 569
 570         ;; if (isnan(a)) return a
 571         movw    ax, sp
 572         addw    ax, #4
 573         movw    hl, ax
 574         call    !!__int_isnan
 575         bnz     $1f
 576 mret_a:
 577         movw    ax, [sp+4]
 578         movw    r8, ax
 579         mov     a, [sp+11]
 580         and     a, #0x80
 581         mov     b, a
 582         movw    ax, [sp+6]
 583         xor     a, b            ; sign is always a ^ b
 584         movw    r10, ax
 585         ret
 586 1:
 587         ;; if (isnan (b)) return b;
 588         movw    ax, sp
 589         addw    ax, #8
 590         movw    hl, ax
 591         call    !!__int_isnan
 592         bnz     $1f
 593 mret_b:
 594         movw    ax, [sp+8]
 595         movw    r8, ax
 596         mov     a, [sp+7]
 597         and     a, #0x80
 598         mov     b, a
 599         movw    ax, [sp+10]
 600         xor     a, b            ; sign is always a ^ b
 601         movw    r10, ax
 602         ret
 603 1:
 604         ;; if (isinf (a)) return (b==0) ? nan : a
 605         movw    ax, sp
 606         addw    ax, #4
 607         movw    hl, ax
 608         call    $!__int_isinf
 609         bnz     $.L805
 610
 611         movw    ax, sp
 612         addw    ax, #8
 613         movw    hl, ax
 614         call    !!__int_iszero
 615         bnz     $mret_a
 616
 617         movw    r8,  #0x0001    ; return NaN
 618         movw    r10, #0x7f80
 619         ret
 620
 621 .L805:
 622         ;; if (isinf (b)) return (a==0) ? nan : b
 623         movw    ax, sp
 624         addw    ax, #8
 625         movw    hl, ax
 626         call    $!__int_isinf
 627         bnz     $.L814
 628
 629         movw    ax, sp
 630         addw    ax, #4
 631         movw    hl, ax
 632         call    !!__int_iszero
 633         bnz     $mret_b
 634
 635         movw    r8,  #0x0001    ; return NaN
 636         movw    r10, #0x7f80
 637         ret
 638
 639 .L814:
 640         movw    ax, sp
 641         addw    ax, #4
 642         movw    hl, ax
 643         call    !!__int_iszero
 644         bz      $mret_a
 645
 646         movw    ax, sp
 647         addw    ax, #8
 648         movw    hl, ax
 649         call    !!__int_iszero
 650         bz      $mret_b
 651
 652         ;; at this point, we're doing the multiplication.
 653
 654         subw    sp, #16 ; save room for two unpacked values
 655
 656         movw    ax, sp
 657         movw    hl, ax
 658         addw    ax, #16+4
 659         movw    de, ax
 660         call    $!_int_unpack_sf
 661
 662         movw    ax, sp
 663         addw    ax, #8
 664         movw    hl, ax
 665         addw    ax, #16+8-8
 666         movw    de, ax
 667         call    $!_int_unpack_sf
 668
 669         movw    ax, sp
 670         movw    hl, ax
 671
 672         ;; multiply SI a.FRAC * SI b.FRAC to DI r8
 673
 674         subw    sp, #16
 675         movw    ax, A_FRAC_L
 676         movw    [sp+0], ax
 677         movw    ax, A_FRAC_H
 678         movw    [sp+2], ax
 679
 680         movw    ax, B_FRAC_L
 681         movw    [sp+8], ax
 682         movw    ax, B_FRAC_H
 683         movw    [sp+10], ax
 684
 685         movw    ax, #0
 686         movw    [sp+4], ax
 687         movw    [sp+6], ax
 688         movw    [sp+12], ax
 689         movw    [sp+14], ax
 690
 691         call    !!___muldi3     ; MTMPa * MTMPb -> R8..R15
 692         addw    sp, #16
 693
 694         movw    ax, sp
 695         movw    hl, ax
 696
 697         ;;  add the exponents together
 698         movw    ax, A_EXP
 699         addw    ax, B_EXP
 700         movw    bc, ax          ; exponent in BC
 701
 702         ;; now, re-normalize the DI value in R8..R15 to have the
 703         ;; MSB in the "right" place, adjusting BC as we shift it.
 704
 705         ;; The value will normally be in this range:
 706         ;; R15              R8
 707         ;; 0001_0000_0000_0000
 708         ;; 0003_ffff_fc00_0001
 709
 710         ;; so to speed it up, we normalize to:
 711         ;; 0001_xxxx_xxxx_xxxx
 712         ;; then extract the bytes we want (r11-r14)
 713
 714 1:
 715         mov     a, r15
 716         cmp0    a
 717         bnz     $2f
 718         mov     a, r14
 719         and     a, #0xfe
 720         bz      $1f
 721 2:
 722         ;; shift right, inc exponent
 723         movw    ax, r14
 724         shrw    ax, 1
 725         movw    r14, ax
 726         mov     a, r13
 727         rorc    a, 1
 728         mov     r13, a
 729         mov     a, r12
 730         rorc    a, 1
 731         mov     r12, a
 732         mov     a, r11
 733         rorc    a, 1
 734         mov     r11, a
 735         ;; we don't care about r8/r9/r10 if we're shifting this way
 736         incw    bc
 737         br      $1b
 738 1:
 739         mov     a, r15
 740         or      a, r14
 741         bnz     $1f
 742         ;; shift left, dec exponent
 743         movw    ax, r8
 744         shlw    ax, 1
 745         movw    r8, ax
 746         movw    ax, r10
 747         rolwc   ax, 1
 748         movw    r10, ax
 749         movw    ax, r12
 750         rolwc   ax, 1
 751         movw    r12, ax
 752         movw    ax, r14
 753         rolwc   ax, 1
 754         movw    r14, ax
 755         decw    bc
 756         br      $1b
 757 1:
 758         ;; at this point, FRAC is in R11..R14 and EXP is in BC
 759         movw    ax, bc
 760         movw    A_EXP, ax
 761
 762         mov     a, r11
 763         mov     A_FRAC_L, a
 764         mov     a, r12
 765         mov     A_FRAC_LH, a
 766         mov     a, r13
 767         mov     A_FRAC_H, a
 768         mov     a, r14
 769         mov     A_FRAC_HH, a
 770
 771         mov     a, A_SIGN
 772         xor     a, B_SIGN
 773         mov     A_SIGN, a
 774
 775         call    $!__rl78_int_pack_a_r8
 776
 777         addw    sp, #16
 778         ret
 779
 780 END_FUNC                ___mulsf3
 781
 782 START_FUNC              ___divsf3
 783
 784         ;; if (isnan(a)) return a
 785         movw    ax, sp
 786         addw    ax, #4
 787         movw    hl, ax
 788         call    !!__int_isnan
 789         bnz     $1f
 790 dret_a:
 791         movw    ax, [sp+4]
 792         movw    r8, ax
 793         mov     a, [sp+11]
 794         and     a, #0x80
 795         mov     b, a
 796         movw    ax, [sp+6]
 797         xor     a, b            ; sign is always a ^ b
 798         movw    r10, ax
 799         ret
 800 1:
 801         ;; if (isnan (b)) return b;
 802         movw    ax, sp
 803         addw    ax, #8
 804         movw    hl, ax
 805         call    !!__int_isnan
 806         bnz     $1f
 807 dret_b:
 808         movw    ax, [sp+8]
 809         movw    r8, ax
 810         mov     a, [sp+7]
 811         and     a, #0x80
 812         mov     b, a
 813         movw    ax, [sp+10]
 814         xor     a, b            ; sign is always a ^ b
 815         movw    r10, ax
 816         ret
 817 1:
 818
 819         ;; if (isinf (a)) return isinf(b) ? nan : a
 820
 821         movw    ax, sp
 822         addw    ax, #4
 823         movw    hl, ax
 824         call    $!__int_isinf
 825         bnz     $1f
 826
 827         movw    ax, sp
 828         addw    ax, #8
 829         movw    hl, ax
 830         call    $!__int_isinf
 831         bnz     $dret_a
 832 dret_nan:
 833         movw    r8,  #0x0001    ; return NaN
 834         movw    r10, #0x7f80
 835         ret
 836
 837 1:
 838
 839         ;; if (iszero (a)) return iszero(b) ? nan : a
 840
 841         movw    ax, sp
 842         addw    ax, #4
 843         movw    hl, ax
 844         call    !!__int_iszero
 845         bnz     $1f
 846
 847         movw    ax, sp
 848         addw    ax, #8
 849         movw    hl, ax
 850         call    !!__int_iszero
 851         bnz     $dret_a
 852         br      $dret_nan
 853
 854 1:
 855         ;; if (isinf (b)) return 0
 856
 857         movw    ax, sp
 858         addw    ax, #8
 859         movw    hl, ax
 860         call    $!__int_isinf
 861         bnz     $1f
 862
 863         mov     a, [sp+7]
 864         mov     b, a
 865         mov     a, [sp+11]
 866         xor     a, b
 867         and     a, #0x80
 868         mov     r11, a
 869         movw    r8, #0
 870         mov     r10, #0
 871         ret
 872
 873 1:
 874         ;; if (iszero (b)) return Inf
 875
 876         movw    ax, sp
 877         addw    ax, #8
 878         movw    hl, ax
 879         call    !!__int_iszero
 880         bnz     $1f
 881
 882         mov     a, [sp+7]
 883         mov     b, a
 884         mov     a, [sp+11]
 885         xor     a, b
 886         or      a, #0x7f
 887         mov     r11, a
 888         movw    r8, #0
 889         mov     r10, #0x80
 890         ret
 891 1:
 892
 893         ;; at this point, we're doing the division.  Normalized
 894         ;; mantissas look like:
 895         ;; 01.xx.xx.xx
 896         ;; so we divide:
 897         ;; 01.xx.xx.xx.00.00.00.00
 898         ;; by          01.xx.xx.xx
 899         ;; to get approx 00.80.00.00.00 to 01.ff.ff.ff.00
 900
 901
 902         subw    sp, #16 ; save room for two unpacked values
 903
 904         movw    ax, sp
 905         movw    hl, ax
 906         addw    ax, #16+4
 907         movw    de, ax
 908         call    $!_int_unpack_sf
 909
 910         movw    ax, sp
 911         addw    ax, #8
 912         movw    hl, ax
 913         addw    ax, #16+8-8
 914         movw    de, ax
 915         call    $!_int_unpack_sf
 916
 917         movw    ax, sp
 918         movw    hl, ax
 919
 920         ;; divide DI a.FRAC / SI b.FRAC to DI r8
 921
 922         subw    sp, #16
 923         movw    ax, A_FRAC_L
 924         movw    [sp+4], ax
 925         movw    ax, A_FRAC_H
 926         movw    [sp+6], ax
 927
 928         movw    ax, B_FRAC_L
 929         movw    [sp+8], ax
 930         movw    ax, B_FRAC_H
 931         movw    [sp+10], ax
 932
 933         movw    ax, #0
 934         movw    [sp+0], ax
 935         movw    [sp+2], ax
 936         movw    [sp+12], ax
 937         movw    [sp+14], ax
 938
 939         call    !!___divdi3     ; MTMPa / MTMPb -> R8..R15
 940         addw    sp, #16
 941
 942         movw    ax, sp
 943         movw    hl, ax
 944
 945         ;;  subtract the exponents A - B
 946         movw    ax, A_EXP
 947         subw    ax, B_EXP
 948         movw    bc, ax          ; exponent in BC
 949
 950         ;; now, re-normalize the DI value in R8..R15 to have the
 951         ;; MSB in the "right" place, adjusting BC as we shift it.
 952
 953         ;; The value will normally be in this range:
 954         ;; R15              R8
 955         ;; 0000_0000_8000_0000
 956         ;; 0000_0001_ffff_ff00
 957
 958         ;; so to speed it up, we normalize to:
 959         ;; 0000_0001_xxxx_xxxx
 960         ;; then extract the bytes we want (r9-r12)
 961
 962 1:
 963         movw    ax, r14
 964         cmpw    ax, #0
 965         bnz     $2f
 966         movw    ax, r12
 967         cmpw    ax, #1
 968         bnh     $1f
 969 2:
 970         ;; shift right, inc exponent
 971         movw    ax, r14
 972         shrw    ax, 1
 973         movw    r14, ax
 974         mov     a, r13
 975         rorc    a, 1
 976         mov     r13, a
 977         mov     a, r12
 978         rorc    a, 1
 979         mov     r12, a
 980         mov     a, r11
 981         rorc    a, 1
 982         mov     r11, a
 983         mov     a, r10
 984         rorc    a, 1
 985         mov     r10, a
 986         mov     a, r9
 987         rorc    a, 1
 988         mov     r9, a
 989         mov     a, r8
 990         rorc    a, 1
 991         mov     r8, a
 992
 993         incw    bc
 994         br      $1b
 995 1:
 996         ;; the previous loop leaves r15.r13 zero
 997         mov     a, r12
 998         cmp0    a
 999         bnz     $1f
1000         ;; shift left, dec exponent
1001         movw    ax, r8
1002         shlw    ax, 1
1003         movw    r8, ax
1004         movw    ax, r10
1005         rolwc   ax, 1
1006         movw    r10, ax
1007         movw    ax, r12
1008         rolwc   ax, 1
1009         movw    r12, ax
1010         ;; don't need to do r14
1011         decw    bc
1012         br      $1b
1013 1:
1014         ;; at this point, FRAC is in R8..R11 and EXP is in BC
1015         movw    ax, bc
1016         movw    A_EXP, ax
1017
1018         mov     a, r9
1019         mov     A_FRAC_L, a
1020         mov     a, r10
1021         mov     A_FRAC_LH, a
1022         mov     a, r11
1023         mov     A_FRAC_H, a
1024         mov     a, r12
1025         mov     A_FRAC_HH, a
1026
1027         mov     a, A_SIGN
1028         xor     a, B_SIGN
1029         mov     A_SIGN, a
1030
1031         call    $!__rl78_int_pack_a_r8
1032
1033         addw    sp, #16
1034         ret
1035
1036 END_FUNC        ___divsf3