(IN-PACKAGE "RTL")

(INCLUDE-BOOK "rtl/rel11/lib/rac" :DIR :SYSTEM)

(SET-IGNORE-OK T)

(SET-IRRELEVANT-FORMALS-OK T)

(DEFUND FMUL32 (A B)
        (LET ((AZERO (LOG= (BITS A 30 0) 0))
              (BZERO (LOG= (BITS B 30 0) 0))
              (ANAN (LOGAND1 (LOG= (BITS A 30 23) 255)
                             (LOG<> (BITS A 22 0) 0)))
              (BNAN (LOGAND1 (LOG= (BITS B 30 23) 255)
                             (LOG<> (BITS B 22 0) 0)))
              (AINF (LOGAND1 (LOG= (BITS A 30 23) 255)
                             (LOG= (BITS A 22 0) 0)))
              (BINF (LOGAND1 (LOG= (BITS B 30 23) 255)
                             (LOG= (BITS B 22 0) 0)))
              (PSIGN (LOGXOR (BITN A 31) (BITN B 31)))
              (AEXP (BITS (IF1 (LOG= (BITS A 30 23) 0)
                               1 (BITS A 30 23))
                          7 0))
              (BEXP (BITS (IF1 (LOG= (BITS B 30 23) 0)
                               1 (BITS B 30 23))
                          7 0))
              (PEXP 0))
             (MV PSIGN
                 (IF1 (LOGIOR1 (LOGIOR1 (LOGIOR1 ANAN BNAN)
                                        (LOGAND1 AINF BZERO))
                               (LOGAND1 AZERO BINF))
                      (BITS 511 8 0)
                      (IF1 (LOGIOR1 AINF BINF)
                           (BITS 1 8 0)
                           (IF1 (LOGIOR1 AZERO BZERO)
                                (BITS 0 8 0)
                                (BITS (+ (+ AEXP BEXP) 2) 8 0))))
                 (BITS (* (SETBITN (BITS A 22 0)
                                   24 23 (LOG<> (BITS A 30 23) 0))
                          (SETBITN (BITS B 22 0)
                                   24 23 (LOG<> (BITS B 30 23) 0)))
                       47 0))))

(DEFUND CLZ77-LOOP-0 (I N K C Z)
        (DECLARE (XARGS :MEASURE (NFIX (- N I))))
        (IF (AND (INTEGERP I) (INTEGERP N) (< I N))
            (LET* ((C (AS I
                          (BITS (IF1 (AG (+ (* 2 I) 1) Z)
                                     (AG (* 2 I) C)
                                     (AG (+ (* 2 I) 1) C))
                                6 0)
                          C))
                   (C (AS I
                          (SETBITN (AG I C)
                                   7 K (AG (+ (* 2 I) 1) Z))
                          C))
                   (Z (AS I
                          (LOGAND1 (AG (+ (* 2 I) 1) Z)
                                   (AG (* 2 I) Z))
                          Z)))
                  (CLZ77-LOOP-0 (+ I 1) N K C Z))
            (MV C Z)))

(DEFUND CLZ77-LOOP-1 (K N C Z)
        (DECLARE (XARGS :MEASURE (NFIX (- 7 K))))
        (IF (AND (INTEGERP K) (< K 7))
            (LET ((N (FLOOR N 2)))
                 (MV-LET (C Z)
                         (CLZ77-LOOP-0 0 N K C Z)
                         (CLZ77-LOOP-1 (+ K 1) N C Z)))
            (MV N C Z)))

(DEFUND CLZ77-LOOP-2 (I X Z C)
        (DECLARE (XARGS :MEASURE (NFIX (- 128 I))))
        (IF (AND (INTEGERP I) (< I 128))
            (LET ((Z (AS I (LOGNOT1 (BITN X I)) Z))
                  (C (AS I (BITS 0 6 0) C)))
                 (CLZ77-LOOP-2 (+ I 1) X Z C))
            (MV Z C)))

(DEFUND CLZ77 (S)
        (LET* ((X (BITS 0 127 0))
               (X (SETBITS X 128 127 51 S))
               (Z NIL)
               (C NIL))
              (MV-LET (Z C)
                      (CLZ77-LOOP-2 0 X Z C)
                      (LET ((N 128))
                           (MV-LET (N C Z)
                                   (CLZ77-LOOP-1 0 N C Z)
                                   (AG 0 C))))))

(DEFUND CLZ24-LOOP-0 (I N K C Z)
        (DECLARE (XARGS :MEASURE (NFIX (- N I))))
        (IF (AND (INTEGERP I) (INTEGERP N) (< I N))
            (LET* ((C (AS I
                          (BITS (IF1 (AG (+ (* 2 I) 1) Z)
                                     (AG (* 2 I) C)
                                     (AG (+ (* 2 I) 1) C))
                                4 0)
                          C))
                   (C (AS I
                          (SETBITN (AG I C)
                                   5 K (AG (+ (* 2 I) 1) Z))
                          C))
                   (Z (AS I
                          (LOGAND1 (AG (+ (* 2 I) 1) Z)
                                   (AG (* 2 I) Z))
                          Z)))
                  (CLZ24-LOOP-0 (+ I 1) N K C Z))
            (MV C Z)))

(DEFUND CLZ24-LOOP-1 (K N C Z)
        (DECLARE (XARGS :MEASURE (NFIX (- 5 K))))
        (IF (AND (INTEGERP K) (< K 5))
            (LET ((N (FLOOR N 2)))
                 (MV-LET (C Z)
                         (CLZ24-LOOP-0 0 N K C Z)
                         (CLZ24-LOOP-1 (+ K 1) N C Z)))
            (MV N C Z)))

(DEFUND CLZ24-LOOP-2 (I X Z C)
        (DECLARE (XARGS :MEASURE (NFIX (- 32 I))))
        (IF (AND (INTEGERP I) (< I 32))
            (LET ((Z (AS I (LOGNOT1 (BITN X I)) Z))
                  (C (AS I (BITS 0 4 0) C)))
                 (CLZ24-LOOP-2 (+ I 1) X Z C))
            (MV Z C)))

(DEFUND CLZ24 (S)
        (LET* ((X (BITS 0 31 0))
               (X (SETBITS X 32 31 8 S))
               (Z NIL)
               (C NIL))
              (MV-LET (Z C)
                      (CLZ24-LOOP-2 0 X Z C)
                      (LET ((N 32))
                           (MV-LET (N C Z)
                                   (CLZ24-LOOP-1 0 N C Z)
                                   (AG 0 C))))))

(DEFUND LZA52 (ADD1 ADD2 SUMEXP)
        (LET* ((GEN (LOGAND ADD1 ADD2))
               (PROP (LOGXOR ADD1 ADD2))
               (KILL (BITS (LOGNOT (LOGIOR ADD1 ADD2)) 51 0))
               (PATSUB (BITS (LOGXOR (BITS PROP 52 1) GEN)
                             50 0))
               (PATADD (BITS (LOGXOR (BITS PROP 52 1) KILL)
                             50 0))
               (W (BITS (LOGNOT (LOGIOR (LOGAND (BITS PATSUB 49 0)
                                                (BITS PATSUB 50 1))
                                        (LOGAND (BITS PATADD 49 0)
                                                (BITS PATADD 50 1))))
                        49 0))
               (VEC W)
               (VEC (IF1 (LOG<= SUMEXP 971)
                         (SETBITN VEC 77 (- 972 SUMEXP) 1)
                         VEC)))
              (CLZ77 VEC)))

(DEFUND
 COMPUTEADDENDS
 (CEXP PEXP CMANT PMANT NOZERO SUB CLARGER)
 (LET
   ((CMPEXP (BITS (- CEXP PEXP) 8 0))
    (RSHFT 0)
    (PRESHFT (BITS 0 112 0)))
   (MV-LET
        (RSHFT PRESHFT)
        (IF1 CLARGER
             (MV CMPEXP
                 (SETBITS PRESHFT 113 112 65 PMANT))
             (MV (BITS (LOGNOT CMPEXP) 8 0)
                 (SETBITS PRESHFT 113 111 64 CMANT)))
        (LET ((ADD1 (BITS 2251799813685248 51 0))
              (ADD2 (BITS 2251799813685248 51 0))
              (INX 0))
             (MV-LET (ADD1 INX)
                     (IF1 (LOG>= RSHFT 64)
                          (MV ADD1 NOZERO)
                          (LET ((POSTSHFT (BITS (ASH PRESHFT (- RSHFT)) 112 0)))
                               (MV (SETBITS ADD1 52 49 0 (BITS POSTSHFT 112 63))
                                   (LOG<> (BITS POSTSHFT 62 0) 0))))
                     (LET ((ADD2 (SETBITS ADD2
                                          52 49 2 (IF1 CLARGER CMANT PMANT))))
                          (MV ADD1
                              (IF1 SUB (BITS (LOGNOT ADD2) 51 0) ADD2)
                              INX)))))))

(DEFUND HC64-LOOP-0 (I G0 GZ1 PZ1 P0 GZ0 PZ0)
        (DECLARE (XARGS :MEASURE (NFIX (- 32 I))))
        (IF (AND (INTEGERP I) (< I 32))
            (LET* ((GZ0 (SETBITN GZ0 65 (+ (* 2 I) 2)
                                 (BITN GZ1 (+ I 1))))
                   (PZ0 (SETBITN PZ0 65 (+ (* 2 I) 2)
                                 (BITN PZ1 (+ I 1))))
                   (GZ0 (SETBITN GZ0 65 (+ (* 2 I) 1)
                                 (LOGIOR1 (BITN G0 (* 2 I))
                                          (LOGAND1 (BITN P0 (* 2 I))
                                                   (BITN GZ1 I)))))
                   (PZ0 (SETBITN PZ0 65 (+ (* 2 I) 1)
                                 (LOGAND1 (BITN PZ1 I)
                                          (BITN P0 (* 2 I))))))
                  (HC64-LOOP-0 (+ I 1)
                               G0 GZ1 PZ1 P0 GZ0 PZ0))
            (MV GZ0 PZ0)))

(DEFUND HC64-LOOP-1 (I G1 GZ2 PZ2 P1 GZ1 PZ1)
        (DECLARE (XARGS :MEASURE (NFIX (- 16 I))))
        (IF (AND (INTEGERP I) (< I 16))
            (LET* ((GZ1 (SETBITN GZ1 33 (+ (* 2 I) 2)
                                 (BITN GZ2 (+ I 1))))
                   (PZ1 (SETBITN PZ1 33 (+ (* 2 I) 2)
                                 (BITN PZ2 (+ I 1))))
                   (GZ1 (SETBITN GZ1 33 (+ (* 2 I) 1)
                                 (LOGIOR1 (BITN G1 (* 2 I))
                                          (LOGAND1 (BITN P1 (* 2 I))
                                                   (BITN GZ2 I)))))
                   (PZ1 (SETBITN PZ1 33 (+ (* 2 I) 1)
                                 (LOGAND1 (BITN PZ2 I)
                                          (BITN P1 (* 2 I))))))
                  (HC64-LOOP-1 (+ I 1)
                               G1 GZ2 PZ2 P1 GZ1 PZ1))
            (MV GZ1 PZ1)))

(DEFUND HC64-LOOP-2 (I G2 GZ3 PZ3 P2 GZ2 PZ2)
        (DECLARE (XARGS :MEASURE (NFIX (- 8 I))))
        (IF (AND (INTEGERP I) (< I 8))
            (LET* ((GZ2 (SETBITN GZ2 17 (+ (* 2 I) 2)
                                 (BITN GZ3 (+ I 1))))
                   (PZ2 (SETBITN PZ2 17 (+ (* 2 I) 2)
                                 (BITN PZ3 (+ I 1))))
                   (GZ2 (SETBITN GZ2 17 (+ (* 2 I) 1)
                                 (LOGIOR1 (BITN G2 (* 2 I))
                                          (LOGAND1 (BITN P2 (* 2 I))
                                                   (BITN GZ3 I)))))
                   (PZ2 (SETBITN PZ2 17 (+ (* 2 I) 1)
                                 (LOGAND1 (BITN PZ3 I)
                                          (BITN P2 (* 2 I))))))
                  (HC64-LOOP-2 (+ I 1)
                               G2 GZ3 PZ3 P2 GZ2 PZ2))
            (MV GZ2 PZ2)))

(DEFUND HC64-LOOP-3 (I G2 P2 G3 P3)
        (DECLARE (XARGS :MEASURE (NFIX (- 8 I))))
        (IF (AND (INTEGERP I) (< I 8))
            (LET ((G3 (SETBITN G3 8 I
                               (LOGIOR1 (BITN G2 (+ (* 2 I) 1))
                                        (LOGAND1 (BITN G2 (* 2 I))
                                                 (BITN P2 (+ (* 2 I) 1))))))
                  (P3 (SETBITN P3 8 I
                               (LOGAND1 (BITN P2 (+ (* 2 I) 1))
                                        (BITN P2 (* 2 I))))))
                 (HC64-LOOP-3 (+ I 1) G2 P2 G3 P3))
            (MV G3 P3)))

(DEFUND HC64-LOOP-4 (I G1 P1 G2 P2)
        (DECLARE (XARGS :MEASURE (NFIX (- 16 I))))
        (IF (AND (INTEGERP I) (< I 16))
            (LET ((G2 (SETBITN G2 16 I
                               (LOGIOR1 (BITN G1 (+ (* 2 I) 1))
                                        (LOGAND1 (BITN G1 (* 2 I))
                                                 (BITN P1 (+ (* 2 I) 1))))))
                  (P2 (SETBITN P2 16 I
                               (LOGAND1 (BITN P1 (+ (* 2 I) 1))
                                        (BITN P1 (* 2 I))))))
                 (HC64-LOOP-4 (+ I 1) G1 P1 G2 P2))
            (MV G2 P2)))

(DEFUND HC64-LOOP-5 (I G0 P0 G1 P1)
        (DECLARE (XARGS :MEASURE (NFIX (- 32 I))))
        (IF (AND (INTEGERP I) (< I 32))
            (LET ((G1 (SETBITN G1 32 I
                               (LOGIOR1 (BITN G0 (+ (* 2 I) 1))
                                        (LOGAND1 (BITN G0 (* 2 I))
                                                 (BITN P0 (+ (* 2 I) 1))))))
                  (P1 (SETBITN P1 32 I
                               (LOGAND1 (BITN P0 (+ (* 2 I) 1))
                                        (BITN P0 (* 2 I))))))
                 (HC64-LOOP-5 (+ I 1) G0 P0 G1 P1))
            (MV G1 P1)))

(DEFUND
 HC64 (G0 P0)
 (LET
  ((G1 0) (P1 0))
  (MV-LET
   (G1 P1)
   (HC64-LOOP-5 0 G0 P0 G1 P1)
   (LET
    ((G2 0) (P2 0))
    (MV-LET
     (G2 P2)
     (HC64-LOOP-4 0 G1 P1 G2 P2)
     (LET
      ((G3 0) (P3 0))
      (MV-LET
       (G3 P3)
       (HC64-LOOP-3 0 G2 P2 G3 P3)
       (LET*
        ((GX0 G3)
         (NPX0 (BITS (LOGNOT P3) 7 0))
         (GX1 (BITS (LOGIOR GX0 (LOGAND (LOGNOT NPX0) (ASH GX0 1)))
                    7 0))
         (NPX1 (BITS (LOGIOR NPX0 (ASH NPX0 1)) 7 0))
         (GX2 (BITS (LOGIOR GX1 (LOGAND (LOGNOT NPX1) (ASH GX1 2)))
                    7 0))
         (NPX2 (BITS (LOGIOR NPX1 (ASH NPX1 2)) 7 0))
         (GX3 (BITS (LOGIOR GX2 (LOGAND (LOGNOT NPX2) (ASH GX2 4)))
                    7 0))
         (NPX3 (BITS (LOGIOR NPX2 (ASH NPX2 4)) 7 0))
         (PX3 (BITS (LOGNOT NPX3) 7 0))
         (GZ3 0)
         (PZ3 0)
         (GZ3 (SETBITN GZ3 9 0 0))
         (PZ3 (SETBITN PZ3 9 0 1))
         (GZ3 (SETBITS GZ3 9 8 1 GX3))
         (PZ3 (SETBITS PZ3 9 8 1 PX3))
         (GZ2 0)
         (PZ2 0)
         (GZ2 (SETBITN GZ2 17 0 0))
         (PZ2 (SETBITN PZ2 17 0 1)))
        (MV-LET (GZ2 PZ2)
                (HC64-LOOP-2 0 G2 GZ3 PZ3 P2 GZ2 PZ2)
                (LET* ((GZ1 0)
                       (PZ1 0)
                       (GZ1 (SETBITN GZ1 33 0 0))
                       (PZ1 (SETBITN PZ1 33 0 1)))
                      (MV-LET (GZ1 PZ1)
                              (HC64-LOOP-1 0 G1 GZ2 PZ2 P1 GZ1 PZ1)
                              (LET ((GZ0 0) (PZ0 0))
                                   (MV-LET (GZ0 PZ0)
                                           (HC64-LOOP-0 0 G0 GZ1 PZ1 P0 GZ0 PZ0)
                                           (MV (BITS GZ0 64 1)
                                               (BITS PZ0 64 1)))))))))))))))

(DEFUND HC52 (GIN PIN)
        (LET* ((G0 0)
               (P0 0)
               (G0 (SETBITS G0 64 63 12 GIN))
               (P0 (SETBITS P0 64 63 12 PIN))
               (G0 (SETBITS G0 64 11 0 0))
               (P0 (SETBITS P0 64 11 0 4095))
               (GZ0 0)
               (PZ0 0))
              (MV-LET (GZ0 PZ0)
                      (HC64 G0 P0)
                      (MV (BITS GZ0 63 12)
                          (BITS PZ0 63 12)))))

(DEFUND
     COMPUTESUM
     (ADD1 ADD2 SUB SIGNLARGER INX)
     (LET ((GIN (LOGAND ADD1 ADD2))
           (PIN (LOGXOR ADD1 ADD2))
           (GOUT 0)
           (POUT 0))
          (MV-LET (GOUT POUT)
                  (HC52 GIN PIN)
                  (LET* ((TOGGLESIGN (LOGNOT1 (BITN GOUT 51)))
                         (SEVERE (BITN POUT 51))
                         (GSHFT 0)
                         (PSHFT 0)
                         (GSHFT (SETBITS GSHFT 51 50 1 (BITS GOUT 49 0)))
                         (GSHFT (SETBITN GSHFT 51 0 0))
                         (PSHFT (SETBITS PSHFT 51 50 1 (BITS POUT 49 0)))
                         (PSHFT (SETBITN PSHFT 51 0 1))
                         (INC (LOGAND1 SUB (LOGIOR1 (BITN GOUT 51) INX)))
                         (CARRYIN (BITS (IF1 INC (LOGIOR GSHFT PSHFT) GSHFT)
                                        50 0)))
                        (MV (BITS (IF1 TOGGLESIGN
                                       (LOGNOT (LOGXOR (BITS PIN 50 0) CARRYIN))
                                       (LOGXOR (BITS PIN 50 0) CARRYIN))
                                  50 0)
                            (LOGXOR (LOGXOR SIGNLARGER
                                            (LOGAND1 SUB (LOGNOT1 TOGGLESIGN)))
                                    SEVERE)
                            SEVERE)))))

(DEFUND COMPUTEINC (RMODE SIGN MANT GRD STK)
        (LET ((INC 0))
             (CASE RMODE
                   (0 (BITS (LOGAND1 (LOGNOT1 SIGN)
                                     (LOGIOR1 STK GRD))
                            3 0))
                   (1 (BITS (LOGAND1 SIGN (LOGIOR1 STK GRD))
                            3 0))
                   (2 (BITS 0 3 0))
                   (3 (BITS (LOGAND1 GRD (LOGIOR1 STK (BITN MANT 0)))
                            3 0))
                   (4 (BITS GRD 3 0))
                   (5 (BITS (LOGAND1 (LOGNOT1 (BITN MANT 0))
                                     (LOGIOR1 GRD STK))
                            3 0))
                   (T (LET ((ASSERT (IN-FUNCTION COMPUTEINC (FALSE$))))
                           INC)))))

(DEFUND
 FADD32
 (C PSIGN PEXP PMANT RMODE SCALEOP SCALE)
 (LET*
  ((RESSIGN 0)
   (RESEXP 0)
   (RESMANT 0)
   (RNDINC 0)
   (CZERO (LOG= (BITS C 30 0) 0))
   (CINF (LOGAND1 (LOG= (BITS C 30 23) 255)
                  (LOG= (BITS C 22 0) 0)))
   (CNAN (LOGAND1 (LOG= (BITS C 30 23) 255)
                  (LOG<> (BITS C 22 0) 0)))
   (PZERO (LOG= PEXP 0))
   (PINF (LOG= PEXP 1))
   (PNAN (LOG= PEXP 511))
   (CSIGN (BITN C 31))
   (CEXP (BITS (+ (BITS C 30 23) 128) 8 0))
   (CMANT (BITS 0 47 0))
   (CMANT (IF1 (LOG= (BITS C 30 23) 0)
               (SETBITS CMANT 48 47 25 (BITS C 22 0))
               (LET ((CMANT (SETBITS CMANT 48 46 24 (BITS C 22 0))))
                    (SETBITN CMANT 48 47 1))))
   (SUB (LOGAND1 (LOGAND1 (LOGXOR CSIGN PSIGN)
                          (LOGNOT1 CZERO))
                 (LOGNOT1 PZERO)))
   (CLARGER (LOGAND1 (LOGNOT1 CZERO)
                     (LOG>= CEXP PEXP)))
   (ADD1 0)
   (ADD2 0)
   (INX 0))
  (MV-LET
   (ADD1 ADD2 INX)
   (COMPUTEADDENDS CEXP PEXP CMANT PMANT
                   (LOGAND1 (LOGNOT1 CZERO)
                            (LOGNOT1 PZERO))
                   SUB CLARGER)
   (LET
    ((SUM 0) (SEVERE 0))
    (MV-LET
     (SUM RESSIGN SEVERE)
     (COMPUTESUM ADD1 ADD2 SUB (IF1 CLARGER CSIGN PSIGN)
                 INX)
     (MV-LET
      (RNDINC RESSIGN RESEXP RESMANT)
      (IF1
       (LOGIOR1 (LOGIOR1 CNAN PNAN)
                (LOGAND1 (LOGAND1 CINF PINF)
                         (LOGXOR CSIGN PSIGN)))
       (MV RNDINC 0 (BITS 255 7 0)
           (BITS 4194304 22 0))
       (IF1
        (LOGIOR1 CINF PINF)
        (MV RNDINC (IF1 CINF CSIGN PSIGN)
            (BITS 255 7 0)
            (BITS 0 22 0))
        (IF1
         (LOGIOR1 (LOGAND1 CZERO PZERO)
                  (LOGAND1 SEVERE (LOGNOT1 INX)))
         (MV RNDINC
             (LOGIOR1 (LOGAND1 CSIGN PSIGN)
                      (LOGAND1 (LOG= RMODE 1)
                               (LOGIOR1 CSIGN PSIGN)))
             (BITS 0 7 0)
             (BITS 0 22 0))
         (LET*
          ((SUMEXP (BITS (+ (- (+ (IF1 CLARGER CEXP PEXP) 1023) 255)
                            26)
                         10 0))
           (SUMEXP (IF1 SCALEOP
                        (BITS (+ SUMEXP (SI SCALE 10)) 10 0)
                        SUMEXP)))
          (MV-LET
           (RESEXP RESMANT RNDINC)
           (IF1
            (LOGIOR1 SEVERE (LOG< SUMEXP 896))
            (MV (BITS 0 7 0)
                (BITS 0 22 0)
                (LOGIOR1 (LOG= RMODE 5)
                         (IF1 RESSIGN (LOG= RMODE 1)
                              (LOG= RMODE 0))))
            (LET*
             ((CLZ (LZA52 ADD1 ADD2 SUMEXP))
              (SUMSHFT (BITS (ASH SUM CLZ) 77 0))
              (OVERSHFT (BITN SUMSHFT 77))
              (CLZPRIME (BITS (IF1 OVERSHFT (- CLZ 1) CLZ)
                              6 0)))
             (IF1
              (LOG> (- SUMEXP CLZPRIME) 1149)
              (MV (BITS 254 7 0)
                  (BITS 8388607 22 0)
                  (LOGNOT1 (LOGIOR1 (LOGIOR1 (LOG= RMODE 2)
                                             (LOGAND1 RESSIGN (LOG= RMODE 0)))
                                    (LOGAND1 (LOGNOT1 RESSIGN)
                                             (LOG= RMODE 1)))))
              (LET
               ((GRD 0) (STK 0))
               (MV-LET
                 (RESMANT GRD STK)
                 (IF1 OVERSHFT
                      (MV (BITS SUMSHFT 76 54)
                          (BITN SUMSHFT 53)
                          (LOGIOR1 INX (LOG<> (BITS SUMSHFT 52 0) 0)))
                      (MV (BITS SUMSHFT 75 53)
                          (BITN SUMSHFT 52)
                          (LOGIOR1 INX (LOG<> (BITS SUMSHFT 51 0) 0))))
                 (LET* ((RESEXP (BITS (+ (- SUMEXP CLZPRIME) 1) 7 0))
                        (RESEXP (SETBITN RESEXP 8 7 (LOGNOT1 (BITN RESEXP 7)))))
                       (MV (IF1 (LOGAND1 (LOGAND1 (LOG= CLZ (- SUMEXP 896))
                                                  (LOGNOT1 OVERSHFT))
                                         (LOGNOT1 (BITN SUMSHFT 76)))
                                (SETBITN RESEXP 8 0 0)
                                RESEXP)
                           RESMANT
                           (COMPUTEINC RMODE RESSIGN RESMANT GRD STK))))))))
           (MV RNDINC RESSIGN RESEXP RESMANT))))))
      (LET* ((RES 0)
             (RES (SETBITN RES 32 31 RESSIGN))
             (RES (SETBITS RES 32 30 23 RESEXP))
             (RES (SETBITS RES 32 22 0 RESMANT)))
            (BITS (+ RES RNDINC) 31 0))))))))

(DEFUND
 SCALE128 (A B C D PEXP)
 (LET
   ((SCALE D)
    (AZEROINFNAN (LOGIOR1 (LOG= (BITS A 30 0) 0)
                          (LOG= (BITS A 30 23) 255)))
    (BZEROINFNAN (LOGIOR1 (LOG= (BITS B 30 0) 0)
                          (LOG= (BITS B 30 23) 255)))
    (CDENORM (LOGAND1 (LOG= (BITS C 30 23) 0)
                      (LOG<> (BITS C 22 0) 0)))
    (ABEXP (BITS (+ (BITS A 30 23) (BITS B 30 23))
                 8 0)))
   (MV-LET
        (C PEXP SCALE)
        (IF1 (LOGAND1 (LOGAND1 (LOGAND1 (LOGAND1 (LOGAND1 (LOGNOT1 AZEROINFNAN)
                                                          (LOGNOT1 BZEROINFNAN))
                                                 CDENORM)
                                        (LOG>= ABEXP 64))
                               (LOG< ABEXP 256))
                      (LOG>= (SI SCALE 32) 16))
             (LET* ((CLZ (BITS (CLZ24 (BITS C 22 0)) 4 0))
                    (C (SETBITS C 32 30 23 (- 129 CLZ))))
                   (MV (SETBITS C 32 22 0 (ASH (BITS C 22 0) CLZ))
                       (BITS (+ PEXP 128) 8 0)
                       (BITS (IF1 (LOG>= (SI SCALE 32) 512)
                                  511 (- (SI SCALE 32) 128))
                             31 0)))
             (MV C PEXP
                 (BITS (IF1 (LOG>= (SI SCALE 32) 512)
                            511
                            (IF1 (LOG< (SI SCALE 32) -512)
                                 -512 (SI SCALE 32)))
                       31 0)))
        (MV C PEXP (BITS (SI SCALE 32) 9 0)))))

(DEFUND FMA32 (A B C D RMODE SCALEOP)
        (LET ((PSIGN 0) (PEXP 0) (PMANT 0))
             (MV-LET (PSIGN PEXP PMANT)
                     (FMUL32 A B)
                     (LET ((SCALE (BITS 0 9 0)))
                          (MV-LET (C PEXP SCALE)
                                  (IF1 SCALEOP (SCALE128 A B C D PEXP)
                                       (MV C PEXP SCALE))
                                  (FADD32 C PSIGN
                                          PEXP PMANT RMODE SCALEOP SCALE))))))

