(IN-PACKAGE "RTL")

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

(SET-IGNORE-OK T)

(SET-IRRELEVANT-FORMALS-OK T)

(DEFUN RMODENEAR NIL (BITS 0 1 0))

(DEFUN RMODEUP NIL (BITS 1 1 0))

(DEFUN RMODEDN NIL (BITS 2 1 0))

(DEFUN RMODEZERO NIL (BITS 3 1 0))

(DEFUN IDC NIL 7)

(DEFUN IXC NIL 4)

(DEFUN UFC NIL 3)

(DEFUN OFC NIL 2)

(DEFUN DZC NIL 1)

(DEFUN IOC NIL 0)

(DEFUN
 ANALYZE (OP FMT FZ FLAGS)
 (LET
  ((SIGN 0)
   (EXP 0)
   (MAN 0)
   (MANMSB 0)
   (EXPISMAX 0))
  (MV-LET
     (SIGN EXP EXPISMAX MAN MANMSB)
     (CASE FMT
           (2 (LET ((SIGN (BITN OP 63))
                    (EXP (BITS OP 62 52)))
                   (MV SIGN EXP (LOG= (SI EXP 13) 2047)
                       (BITS OP 51 0)
                       (BITS 2251799813685248 51 0))))
           (1 (LET ((SIGN (BITN OP 31))
                    (EXP (BITS OP 30 23)))
                   (MV SIGN EXP (LOG= (SI EXP 13) 255)
                       (BITS OP 22 0)
                       (BITS 4194304 51 0))))
           (0 (LET ((SIGN (BITN OP 15))
                    (EXP (BITS OP 14 10)))
                   (MV SIGN EXP (LOG= (SI EXP 13) 31)
                       (BITS OP 9 0)
                       (BITS 512 51 0))))
           (T (MV SIGN EXP EXPISMAX MAN MANMSB)))
     (LET ((C 0))
          (MV-LET (FLAGS C)
                  (IF1 EXPISMAX
                       (MV FLAGS
                           (IF1 (LOG= MAN 0)
                                1 (IF1 (LOGAND MAN MANMSB) 3 2)))
                       (IF1 (LOG= (SI EXP 13) 0)
                            (IF1 (LOG= MAN 0)
                                 (MV FLAGS 0)
                                 (MV-LET (C FLAGS)
                                         (IF1 FZ
                                              (MV 0
                                                  (IF1 (LOG<> FMT 0)
                                                       (SETBITN FLAGS 8 (IDC) 1)
                                                       FLAGS))
                                              (MV 5 FLAGS))
                                         (MV FLAGS C)))
                            (MV FLAGS 4)))
                  (MV SIGN (BITS (SI EXP 13) 10 0)
                      MAN C FLAGS))))))

(DEFUN CLZ53-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))
                               5 0)
                         C))
                  (C (AS I
                         (SETBITN (AG I C)
                                  6 K (AG (+ (* 2 I) 1) Z))
                         C))
                  (Z (AS I
                         (LOGAND1 (AG (+ (* 2 I) 1) Z)
                                  (AG (* 2 I) Z))
                         Z)))
                 (CLZ53-LOOP-0 (+ I 1) N K C Z))
           (MV C Z)))

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

(DEFUN CLZ53-LOOP-2 (I X Z C)
       (DECLARE (XARGS :MEASURE (NFIX (- 64 I))))
       (IF (AND (INTEGERP I) (< I 64))
           (LET ((Z (AS I (LOGNOT1 (BITN X I)) Z))
                 (C (AS I (BITS 0 5 0) C)))
                (CLZ53-LOOP-2 (+ I 1) X Z C))
           (MV Z C)))

(DEFUN CLZ53 (S)
       (LET* ((X (BITS 0 63 0))
              (X (SETBITS X 64 63 11 S))
              (Z NIL)
              (C NIL))
             (MV-LET (Z C)
                     (CLZ53-LOOP-2 0 X Z C)
                     (LET ((N 64))
                          (MV-LET (N C Z)
                                  (CLZ53-LOOP-1 0 N C Z)
                                  (AG 0 C))))))

(DEFUN
   COMPUTEQ (QP QN RP RN FMT ISSQRT)
   (LET* ((REM (BITS (+ (+ RP (LOGNOT RN)) 1) 58 0))
          (REMSIGN (BITN REM 58))
          (REMZERO (LOG= (LOGXOR RP RN) 0))
          (CIN (LOGNOT1 REMSIGN))
          (LSBIS2 (LOG= ISSQRT (LOG= FMT 1)))
          (INC (BITS (IF1 LSBIS2 4 2) 2 0))
          (Q0 (BITS (+ QP (LOGNOT QN)) 53 0))
          (QN1INC (BITS (LOGXOR (LOGXOR QP (BITS (LOGNOT QN) 53 0))
                                INC)
                        53 0))
          (QP1INC (BITS (ASH (LOGIOR (LOGAND QP (BITS (LOGNOT QN) 53 0))
                                     (LOGAND (LOGIOR QP (BITS (LOGNOT QN) 53 0))
                                             INC))
                             1)
                        53 0))
          (Q1INC (BITS (+ (+ QP1INC QN1INC) 1) 53 0))
          (Q1LOW (BITS (+ (+ (BITS QP 2 0) (LOGNOT (BITS QN 2 0)))
                          1)
                       2 0))
          (Q0INCLOW (BITS (+ (BITS QP1INC 2 0) (BITS QN1INC 2 0))
                          2 0))
          (Q1 Q1LOW)
          (Q0INC Q0INCLOW)
          (Q1 (IF1 (LOG= Q1 0)
                   (SETBITS Q1 54 53 3 (BITS Q1INC 53 3))
                   (SETBITS Q1 54 53 3 (BITS Q0 53 3))))
          (Q0INC (IF1 (LOGIOR1 (LOG<= Q0INC 1)
                               (LOGAND1 (LOG<= Q0INC 3) LSBIS2))
                      (SETBITS Q0INC 54 53 3 (BITS Q1INC 53 3))
                      (SETBITS Q0INC 54 53 3 (BITS Q0 53 3))))
          (Q01 (BITS (IF1 CIN Q1 Q0) 53 0))
          (Q01INC (BITS (IF1 CIN Q1INC Q0INC) 53 0)))
         (MV (BITS (IF1 LSBIS2 (ASH Q01 (- 1)) Q01)
                   52 0)
             (BITS (IF1 LSBIS2 (ASH Q01INC (- 1)) Q01INC)
                   52 0)
             (LOGNOT1 REMZERO))))

(DEFUN RSHFT64 (X S)
       (LET ((XS (BITS (ASH X (- S)) 63 0)))
            (MV XS (LOG<> X (ASH XS S)))))

(DEFUN
 ROUNDER
 (QTRUNC QINC STK SIGN EXPQ RMODE FMT)
 (LET*
  ((LSB (BITN QTRUNC 1))
   (GRD (BITN QTRUNC 0))
   (QRND 0)
   (QRND (IF1 (LOGIOR1 (LOGIOR1 (LOGAND1 (LOGAND1 (LOG= RMODE (RMODENEAR)) GRD)
                                         (LOGIOR1 LSB STK))
                                (LOGAND1 (LOGAND1 (LOG= RMODE (RMODEUP))
                                                  (LOGNOT1 SIGN))
                                         (LOGIOR1 GRD STK)))
                       (LOGAND1 (LOGAND1 (LOG= RMODE (RMODEDN)) SIGN)
                                (LOGIOR1 GRD STK)))
              (BITS QINC 53 1)
              (BITS QTRUNC 53 1)))
   (INX (LOGIOR1 GRD STK))
   (QDEN (BITS 0 63 0))
   (QDEN (CASE FMT
               (2 (LET ((QDEN (SETBITN QDEN 64 53 1)))
                       (SETBITS QDEN 64 52 0 (BITS QTRUNC 52 0))))
               (1 (LET ((QDEN (SETBITN QDEN 64 24 1)))
                       (SETBITS QDEN 64 23 0 (BITS QTRUNC 23 0))))
               (0 (LET ((QDEN (SETBITN QDEN 64 11 1)))
                       (SETBITS QDEN 64 10 0 (BITS QTRUNC 10 0))))
               (T QDEN)))
   (SHFT12 (BITS (- 1 (SI EXPQ 13)) 11 0))
   (SHFT (BITS (IF1 (LOG>= SHFT12 64) 63 SHFT12)
               5 0))
   (LSBDEN 0)
   (GRDDEN 0)
   (STKDEN 0)
   (QSHFT 0))
  (MV-LET
   (QSHFT STKDEN)
   (RSHFT64 QDEN SHFT)
   (LET
     ((LSBDEN (BITN QSHFT 1))
      (GRDDEN (BITN QSHFT 0))
      (STKDEN (LOGIOR1 STKDEN STK))
      (QRNDDEN 0))
     (MV QRND INX
         (BITS (IF1 (LOGIOR1 (LOGIOR1 (LOGAND1 (LOGAND1 (LOG= RMODE (RMODENEAR))
                                                        GRDDEN)
                                               (LOGIOR1 LSBDEN STKDEN))
                                      (LOGAND1 (LOGAND1 (LOG= RMODE (RMODEUP))
                                                        (LOGNOT1 SIGN))
                                               (LOGIOR1 GRDDEN STKDEN)))
                             (LOGAND1 (LOGAND1 (LOG= RMODE (RMODEDN)) SIGN)
                                      (LOGIOR1 GRDDEN STKDEN)))
                    (BITS (+ (BITS QSHFT 53 1) 1) 53 0)
                    (BITS QSHFT 53 1))
               52 0)
         (LOGIOR1 GRDDEN STKDEN))))))

(DEFUN
 FINAL
 (QRND INX QRNDDEN
       INXDEN SIGN EXPQ RMODE FZ FMT FLAGS)
 (LET
  ((SELMAXNORM (LOGIOR1 (LOGIOR1 (LOGAND1 (LOG= RMODE (RMODEDN))
                                          (LOGNOT1 SIGN))
                                 (LOGAND1 (LOG= RMODE (RMODEUP)) SIGN))
                        (LOG= RMODE (RMODEZERO))))
   (D (BITS 0 63 0)))
  (CASE
   FMT
   (2
    (LET
     ((D (SETBITN D 64 63 SIGN)))
     (IF1
         (LOG>= (SI EXPQ 13) 2047)
         (MV (IF1 SELMAXNORM
                  (LET ((D (SETBITS D 64 62 52 2046)))
                       (SETBITS D 64 51 0 4503599627370495))
                  (LET ((D (SETBITS D 64 62 52 2047)))
                       (SETBITS D 64 51 0 0)))
             (SETBITN (SETBITN FLAGS 8 (OFC) 1)
                      8 (IXC)
                      1))
         (IF1 (LOG<= (SI EXPQ 13) 0)
              (IF1 FZ (MV D (SETBITN FLAGS 8 (UFC) 1))
                   (LET* ((EXP (BITN QRNDDEN 52))
                          (D (SETBITS D 64 62 52 EXP))
                          (D (SETBITS D 64 51 0 (BITS QRNDDEN 51 0)))
                          (FLAGS (SETBITN FLAGS 8 (IXC)
                                          (LOGIOR1 (BITN FLAGS (IXC)) INXDEN))))
                         (MV D
                             (SETBITN FLAGS 8 (UFC)
                                      (LOGIOR1 (BITN FLAGS (UFC)) INXDEN)))))
              (MV (SETBITS (SETBITS D 64 62 52 (SI EXPQ 13))
                           64 51 0 (BITS QRND 51 0))
                  (SETBITN FLAGS 8 (IXC)
                           (LOGIOR1 (BITN FLAGS (IXC)) INX)))))))
   (1
    (LET
     ((D (SETBITN D 64 31 SIGN)))
     (IF1
         (LOG>= (SI EXPQ 13) 255)
         (MV (IF1 SELMAXNORM
                  (LET ((D (SETBITS D 64 30 23 254)))
                       (SETBITS D 64 22 0 8388607))
                  (LET ((D (SETBITS D 64 30 23 255)))
                       (SETBITS D 64 22 0 0)))
             (SETBITN (SETBITN FLAGS 8 (OFC) 1)
                      8 (IXC)
                      1))
         (IF1 (LOG<= (SI EXPQ 13) 0)
              (IF1 FZ (MV D (SETBITN FLAGS 8 (UFC) 1))
                   (LET* ((EXP (BITN QRNDDEN 23))
                          (D (SETBITS D 64 30 23 EXP))
                          (D (SETBITS D 64 22 0 (BITS QRNDDEN 22 0)))
                          (FLAGS (SETBITN FLAGS 8 (IXC)
                                          (LOGIOR1 (BITN FLAGS (IXC)) INXDEN))))
                         (MV D
                             (SETBITN FLAGS 8 (UFC)
                                      (LOGIOR1 (BITN FLAGS (UFC)) INXDEN)))))
              (MV (SETBITS (SETBITS D 64 30 23 (SI EXPQ 13))
                           64 22 0 (BITS QRND 22 0))
                  (SETBITN FLAGS 8 (IXC)
                           (LOGIOR1 (BITN FLAGS (IXC)) INX)))))))
   (0
    (LET
     ((D (SETBITN D 64 15 SIGN)))
     (IF1
         (LOG>= (SI EXPQ 13) 31)
         (MV (IF1 SELMAXNORM
                  (LET ((D (SETBITS D 64 14 10 30)))
                       (SETBITS D 64 9 0 1023))
                  (LET ((D (SETBITS D 64 14 10 31)))
                       (SETBITS D 64 9 0 0)))
             (SETBITN (SETBITN FLAGS 8 (OFC) 1)
                      8 (IXC)
                      1))
         (IF1 (LOG<= (SI EXPQ 13) 0)
              (IF1 FZ (MV D (SETBITN FLAGS 8 (UFC) 1))
                   (LET* ((EXP (BITN QRNDDEN 10))
                          (D (SETBITS D 64 14 10 EXP))
                          (D (SETBITS D 64 9 0 (BITS QRNDDEN 9 0)))
                          (FLAGS (SETBITN FLAGS 8 (IXC)
                                          (LOGIOR1 (BITN FLAGS (IXC)) INXDEN))))
                         (MV D
                             (SETBITN FLAGS 8 (UFC)
                                      (LOGIOR1 (BITN FLAGS (UFC)) INXDEN)))))
              (MV (SETBITS (SETBITS D 64 14 10 (SI EXPQ 13))
                           64 9 0 (BITS QRND 9 0))
                  (SETBITN FLAGS 8 (IXC)
                           (LOGIOR1 (BITN FLAGS (IXC)) INX)))))))
   (T (MV D FLAGS)))))

(DEFUN
 SPECIALCASE
 (SIGNA OPA CLASSA FMT DN FLAGS)
 (LET
  ((D (BITS 0 63 0))
   (ATRUNC 0)
   (MANMSB 0)
   (DEFNAN 0)
   (ZERO (BITS 0 63 0)))
  (MV-LET
       (ATRUNC ZERO DEFNAN MANMSB)
       (CASE FMT
             (2 (MV (BITS OPA 63 0)
                    (SETBITN ZERO 64 63 SIGNA)
                    (BITS 9221120237041090560 63 0)
                    (BITS 2251799813685248 63 0)))
             (1 (MV (BITS OPA 31 0)
                    (SETBITN ZERO 64 31 SIGNA)
                    (BITS 2143289344 63 0)
                    (BITS 4194304 63 0)))
             (0 (MV (BITS OPA 15 0)
                    (SETBITN ZERO 64 15 SIGNA)
                    (BITS 32256 63 0)
                    (BITS 512 63 0)))
             (T (MV ATRUNC ZERO DEFNAN MANMSB)))
       (IF1 (LOG= CLASSA 2)
            (MV (BITS (IF1 DN DEFNAN (LOGIOR ATRUNC MANMSB))
                      63 0)
                (SETBITN FLAGS 8 (IOC) 1))
            (MV-LET (FLAGS D)
                    (IF1 (LOG= CLASSA 3)
                         (MV FLAGS
                             (BITS (IF1 DN DEFNAN ATRUNC) 63 0))
                         (IF1 (LOG= CLASSA 0)
                              (MV FLAGS ZERO)
                              (MV-LET (D FLAGS)
                                      (IF1 SIGNA
                                           (MV DEFNAN (SETBITN FLAGS 8 (IOC) 1))
                                           (MV ATRUNC FLAGS))
                                      (MV FLAGS D))))
                    (MV D FLAGS))))))

(DEFUN NORMALIZE (EXPA MANA FMT)
       (LET ((SIGA (BITS 0 52 0)) (BIAS 0))
            (MV-LET (SIGA BIAS)
                    (CASE FMT (2 (MV MANA 1023))
                          (1 (MV (SETBITS SIGA 53 51 29 MANA) 127))
                          (0 (MV (SETBITS SIGA 53 51 42 MANA) 15))
                          (T (MV SIGA BIAS)))
                    (MV-LET (SIGA EXPA)
                            (IF1 (LOG= (SI EXPA 13) 0)
                                 (LET ((CLZ (BITS (CLZ53 SIGA) 5 0)))
                                      (MV (BITS (ASH SIGA CLZ) 52 0)
                                          (BITS (- 1 CLZ) 12 0)))
                                 (MV (SETBITN SIGA 53 52 1) EXPA))
                            (MV SIGA EXPA
                                (BITS (BITS (+ (SI EXPA 13) BIAS) 11 0)
                                      11 1))))))

(DEFUN SQRTPOW2 (EXPQ EXPODD RMODE FMT)
       (LET ((D (BITS 0 63 0))
             (FLAGS (BITS 0 7 0))
             (MANWIDTH 0)
             (MANSQRT2 0))
            (MV-LET (MANWIDTH MANSQRT2)
                    (CASE FMT
                          (2 (MV 52
                                 (BITS (IF1 (LOGIOR1 (LOG= RMODE (RMODENEAR))
                                                     (LOG= RMODE (RMODEUP)))
                                            1865452045155277 1865452045155276)
                                       51 0)))
                          (1 (MV 23
                                 (BITS (IF1 (LOG= RMODE (RMODEUP))
                                            3474676 3474675)
                                       51 0)))
                          (0 (MV 10
                                 (BITS (IF1 (LOG= RMODE (RMODEUP)) 1449 1448)
                                       51 0)))
                          (T (MV MANWIDTH MANSQRT2)))
                    (MV-LET (D FLAGS)
                            (IF1 (LOGNOT1 EXPODD)
                                 (MV MANSQRT2 (SETBITN FLAGS 8 (IXC) 1))
                                 (MV D FLAGS))
                            (MV (SETBITS D 64 (+ MANWIDTH 10)
                                         MANWIDTH EXPQ)
                                FLAGS)))))

(DEFUN FIRSTITER (SIGA EXPODD)
       (LET ((RP (BITS 0 58 0))
             (RN (BITS 0 58 0))
             (QN (BITS 0 53 0))
             (Q 0)
             (I 0))
            (MV-LET (RP Q QN RN I)
                    (IF1 EXPODD
                         (LET* ((RP (SETBITS RP 59 58 56 6))
                                (RP (SETBITS RP 59 55 3 SIGA)))
                               (MV-LET (Q QN RN I)
                                       (IF1 (BITN SIGA 51)
                                            (MV -1 (SETBITS QN 54 53 52 1)
                                                (SETBITS RN 59 58 53 57)
                                                4)
                                            (MV -2 (SETBITS QN 54 53 52 2)
                                                (SETBITS RN 59 58 55 13)
                                                0))
                                       (MV RP Q QN RN I)))
                         (LET* ((RP (SETBITS RP 59 58 57 3))
                                (RP (SETBITS RP 59 56 4 SIGA)))
                               (MV-LET (QN RN Q I)
                                       (IF1 (BITN SIGA 51)
                                            (MV QN RN 0 8)
                                            (MV (SETBITS QN 54 53 52 1)
                                                (SETBITS RN 59 58 53 57)
                                                -1 4))
                                       (MV RP Q QN RN I))))
                    (MV RP RN QN Q I))))

(DEFUN NEXTDIGIT (RP RN I J)
       (LET* ((RP4 (BITS (ASH RP 2) 58 0))
              (RN4 (BITS (ASH RN 2) 58 0))
              (RS8 (BITS (+ (+ (BITS RP4 58 51)
                               (LOGNOT (BITS RN4 58 51)))
                            (LOGIOR1 (BITN RP4 50)
                                     (LOGNOT1 (BITN RN4 50))))
                         7 0))
              (RS7 (BITS RS8 7 1))
              (MP2 0)
              (MP1 0)
              (MZ0 0)
              (MN1 0))
             (MV-LET (MP2 MP1 MZ0 MN1)
                     (CASE I
                           (0 (MV (BITS 12 6 0)
                                  (BITS 4 6 0)
                                  (BITS -4 6 0)
                                  (BITS (IF1 (LOG= J 1) -11 -12) 6 0)))
                           (1 (MV (BITS (IF1 (LOG= J 2) 15 13) 6 0)
                                  (BITS 4 6 0)
                                  (BITS -4 6 0)
                                  (BITS -13 6 0)))
                           (2 (MV (BITS 15 6 0)
                                  (BITS 4 6 0)
                                  (BITS -4 6 0)
                                  (BITS -15 6 0)))
                           (3 (MV (BITS 16 6 0)
                                  (BITS 6 6 0)
                                  (BITS -6 6 0)
                                  (BITS -16 6 0)))
                           (4 (MV (BITS 18 6 0)
                                  (BITS 6 6 0)
                                  (BITS -6 6 0)
                                  (BITS -18 6 0)))
                           (5 (MV (BITS 20 6 0)
                                  (BITS 8 6 0)
                                  (BITS -6 6 0)
                                  (BITS -20 6 0)))
                           (6 (MV (BITS 20 6 0)
                                  (BITS 8 6 0)
                                  (BITS -8 6 0)
                                  (BITS -20 6 0)))
                           (7 (MV (BITS 22 6 0)
                                  (BITS 8 6 0)
                                  (BITS -8 6 0)
                                  (BITS -22 6 0)))
                           (8 (MV (BITS 24 6 0)
                                  (BITS 8 6 0)
                                  (BITS -8 6 0)
                                  (BITS -24 6 0)))
                           (T (MV MP2 MP1 MZ0 MN1)))
                     (LET ((Q 0))
                          (IF1 (LOG>= (SI RS7 7) (SI MP2 7))
                               2
                               (IF1 (LOG>= (SI RS7 7) (SI MP1 7))
                                    1
                                    (IF1 (LOG>= (SI RS7 7) (SI MZ0 7))
                                         0
                                         (IF1 (LOG>= (SI RS7 7) (SI MN1 7))
                                              -1 -2))))))))

(DEFUN
 NEXTREM (RP RN QP QN Q J FMT)
 (LET*
  ((DCAR (BITS 0 58 0))
   (DSUM (BITS 0 58 0))
   (DCAR (SETBITN DCAR 59 56 1))
   (DCAR (SETBITS DCAR 59 55 2 QP))
   (DSUM (SETBITS DSUM 59 55 2 QN)))
  (MV-LET
   (DSUM DCAR)
   (IF1 (LOG> Q 0)
        (MV DSUM
            (SETBITS DCAR 59 (+ (- 53 (* 2 J)) 1)
                     (- 53 (* 2 J))
                     Q))
        (MV (IF1 (LOG< Q 0)
                 (SETBITS DSUM 59 (+ (- 53 (* 2 J)) 1)
                          (- 53 (* 2 J))
                          (- Q))
                 DSUM)
            DCAR))
   (LET
    ((DQCAR 0) (DQSUM 0))
    (MV-LET
     (DQCAR DQSUM)
     (CASE Q (1 (MV DSUM DCAR))
           (2 (MV (BITS (ASH DSUM 1) 58 0)
                  (BITS (ASH DCAR 1) 58 0)))
           (-1 (MV DCAR DSUM))
           (-2 (MV (BITS (ASH DCAR 1) 58 0)
                   (BITS (ASH DSUM 1) 58 0)))
           (T (MV DQCAR DQSUM)))
     (LET*
       ((RP4 (BITS (ASH RP 2) 58 0))
        (RN4 (BITS (ASH RN 2) 58 0))
        (SUM1 (LOGXOR (LOGXOR RN4 RP4) DQCAR))
        (CAR1 (BITS (ASH (LOGIOR (LOGAND (BITS (LOGNOT RN4) 58 0) RP4)
                                 (LOGAND (LOGIOR (BITS (LOGNOT RN4) 58 0) RP4)
                                         DQCAR))
                         1)
                    58 0))
        (CAR1 (IF1 (LOG= FMT 0)
                   (SETBITN CAR1 59 42 0)
                   (IF1 (LOG= FMT 1)
                        (SETBITN CAR1 59 29 0)
                        CAR1)))
        (SUM2 (LOGXOR (LOGXOR SUM1 CAR1)
                      (BITS (LOGNOT DQSUM) 58 0)))
        (CAR2 (BITS (ASH (LOGIOR (LOGAND (BITS (LOGNOT SUM1) 58 0) CAR1)
                                 (LOGAND (LOGIOR (BITS (LOGNOT SUM1) 58 0) CAR1)
                                         (BITS (LOGNOT DQSUM) 58 0)))
                         1)
                    58 0)))
       (IF1 (LOG= Q 0)
            (MV RP4 RN4)
            (MV-LET (CAR2 RP RN)
                    (CASE FMT
                          (2 (LET ((CAR2 (SETBITN CAR2 59 0 1)))
                                  (MV CAR2 CAR2 SUM2)))
                          (1 (LET ((CAR2 (SETBITN CAR2 59 29 1)))
                                  (MV CAR2
                                      (SETBITS RP 59 58 29 (BITS CAR2 58 29))
                                      (SETBITS RN 59 58 29 (BITS SUM2 58 29)))))
                          (0 (LET ((CAR2 (SETBITN CAR2 59 42 1)))
                                  (MV CAR2
                                      (SETBITS RP 59 58 42 (BITS CAR2 58 42))
                                      (SETBITS RN 59 58 42 (BITS SUM2 58 42)))))
                          (T (MV CAR2 RP RN)))
                    (MV RP RN)))))))))

(DEFUN NEXTROOT (QP QN Q J)
       (MV-LET (QN QP)
               (IF1 (LOG> Q 0)
                    (MV QN
                        (SETBITS QP 54 (+ (- 52 (* 2 J)) 1)
                                 (- 52 (* 2 J))
                                 Q))
                    (MV (IF1 (LOG< Q 0)
                             (SETBITS QN 54 (+ (- 52 (* 2 J)) 1)
                                      (- 52 (* 2 J))
                                      (- Q))
                             QN)
                        QP))
               (MV QP QN)))

(DEFUN
 FSQRT64-LOOP-0
 (J N FMT Q I RP RN QP QN EXPINC)
 (DECLARE (XARGS :MEASURE (NFIX (- N J))))
 (IF
    (AND (INTEGERP J) (INTEGERP N) (< J N))
    (LET* ((Q (NEXTDIGIT RP RN I J))
           (I (IF1 (LOG= J 1) (+ I Q) I)))
          (MV-LET (RP RN)
                  (NEXTREM RP RN QP QN Q J FMT)
                  (MV-LET (QP QN)
                          (NEXTROOT QP QN Q J)
                          (LET ((EXPINC (LOGAND EXPINC
                                                (IF1 (LOG< J (- N 1))
                                                     (LOG= Q 0)
                                                     (IF1 (LOG= FMT 1)
                                                          (LOG= Q -2)
                                                          (LOG= Q -1))))))
                               (FSQRT64-LOOP-0 (+ J 1)
                                               N FMT Q I RP RN QP QN EXPINC)))))
    (MV Q I RP RN QP QN EXPINC)))

(DEFUN
 FSQRT64 (OPA FMT FZ DN RMODE)
 (LET
  ((SIGNA 0)
   (EXPA 0)
   (MANA 0)
   (CLASSA 0)
   (FLAGS (BITS 0 7 0)))
  (MV-LET
   (SIGNA EXPA MANA CLASSA FLAGS)
   (ANALYZE OPA FMT FZ FLAGS)
   (IF1
    (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOG= CLASSA 0)
                                        (LOG= CLASSA 1))
                               (LOG= CLASSA 2))
                      (LOG= CLASSA 3))
             SIGNA)
    (SPECIALCASE SIGNA OPA CLASSA FMT DN FLAGS)
    (LET
     ((EXPINC (LOGAND1 (LOG= CLASSA 4)
                       (LOG= RMODE (RMODEUP))))
      (SIGA 0)
      (EXPSHFT 0)
      (EXPQ 0))
     (MV-LET
      (SIGA EXPSHFT EXPQ)
      (NORMALIZE EXPA MANA FMT)
      (LET
       ((EXPODD (BITN EXPSHFT 0)))
       (IF1
        (LOGAND1 (LOG= CLASSA 4) (LOG= MANA 0))
        (SQRTPOW2 EXPQ EXPODD RMODE FMT)
        (LET
         ((RP 0)
          (RN 0)
          (QP 0)
          (QN 0)
          (Q 0)
          (I 0))
         (MV-LET
          (RP RN QN Q I)
          (FIRSTITER SIGA EXPODD)
          (LET*
           ((QP (BITS 0 53 0))
            (EXPINC (LOGAND EXPINC (LOG= QN 0)))
            (N 0)
            (N (CASE FMT (2 (BITS 27 4 0))
                     (1 (BITS 13 4 0))
                     (0 (BITS 6 4 0))
                     (T N))))
           (MV-LET
            (Q I RP RN QP QN EXPINC)
            (FSQRT64-LOOP-0 1 N FMT Q I RP RN QP QN EXPINC)
            (LET
             ((EXPRND (BITS (IF1 EXPINC (+ EXPQ 1) EXPQ)
                            10 0)))
             (MV-LET
              (QP QN)
              (CASE FMT
                    (0 (MV (BITS QP 53 42) (BITS QN 53 42)))
                    (1 (MV (BITS QP 53 28) (BITS QN 53 28)))
                    (T (MV QP QN)))
              (LET
               ((QTRUNC 0) (QINC 0) (STK 0))
               (MV-LET (QTRUNC QINC STK)
                       (COMPUTEQ QP QN RP RN FMT (TRUE$))
                       (LET ((QRND 0)
                             (QRNDDEN 0)
                             (INX 0)
                             (INXDEN 0))
                            (MV-LET (QRND INX QRNDDEN INXDEN)
                                    (ROUNDER QTRUNC QINC STK 0 EXPRND RMODE FMT)
                                    (FINAL QRND INX QRNDDEN INXDEN 0 EXPRND
                                           RMODE FZ FMT FLAGS)))))))))))))))))))