(IN-PACKAGE "RTL")

; Note: Below, :DIR :SYSTEM has been manually moved onto the same line as
; INCLUDE-BOOK, in order to support the use of cert.pl.
(INCLUDE-BOOK "rtl/rel11/lib/rac" :DIR :SYSTEM)

(SET-IGNORE-OK T)

(SET-IRRELEVANT-FORMALS-OK T)

(DEFUN ENCODE (SLICE)
       (LET ((ENC 0))
            (CASE SLICE (4 (BITS 6 2 0))
                  ((5 6) (BITS 5 2 0))
                  ((7 0) (BITS 0 2 0))
                  ((1 2) (BITS 1 2 0))
                  (3 (BITS 2 2 0))
                  (T (LET ((ASSERT (IN-FUNCTION ENCODE (FALSE$))))
                          ENC)))))

(DEFUN BOOTH-LOOP-0 (K X35 A)
       (DECLARE (XARGS :MEASURE (NFIX (- 17 K))))
       (IF (AND (INTEGERP K) (< K 17))
           (LET ((A (AS K
                        (ENCODE (BITS X35 (+ (* 2 K) 2) (* 2 K)))
                        A)))
                (BOOTH-LOOP-0 (+ K 1) X35 A))
           A))

(DEFUN BOOTH (X)
       (LET ((X35 (BITS (ASH X 1) 34 0)) (A NIL))
            (BOOTH-LOOP-0 0 X35 A)))

(DEFUN PARTIALPRODUCTS-LOOP-0 (K Y M21 PP)
       (DECLARE (XARGS :MEASURE (NFIX (- 17 K))))
       (IF (AND (INTEGERP K) (< K 17))
           (LET* ((ROW 0)
                  (ROW (CASE (BITS (AG K M21) 1 0)
                             (2 (BITS (ASH Y 1) 32 0))
                             (1 Y)
                             (T (BITS 0 32 0))))
                  (PP (AS K
                          (BITS (IF1 (BITN (AG K M21) 2)
                                     (LOGNOT ROW)
                                     ROW)
                                32 0)
                          PP)))
                 (PARTIALPRODUCTS-LOOP-0 (+ K 1)
                                         Y M21 PP))
           PP))

(DEFUN PARTIALPRODUCTS (M21 Y)
       (LET ((PP NIL))
            (PARTIALPRODUCTS-LOOP-0 0 Y M21 PP)))

(DEFUN ALIGN-LOOP-0 (K PPS PSB SB TBLE)
       (DECLARE (XARGS :MEASURE (NFIX (- 17 K))))
       (IF (AND (INTEGERP K) (< K 17))
           (LET* ((TMP (BITS 0 66 0))
                  (TMP (SETBITS TMP 67 (+ (* 2 K) 32)
                                (* 2 K)
                                (AG K PPS)))
                  (TMP (IF1 (LOG= K 0)
                            (LET* ((TMP (SETBITN TMP 67 33 (AG K SB)))
                                   (TMP (SETBITN TMP 67 34 (AG K SB))))
                                  (SETBITN TMP 67 35 (LOGNOT1 (AG K SB))))
                            (LET* ((TMP (SETBITN TMP 67 (- (* 2 K) 2)
                                                 (AG K PSB)))
                                   (TMP (SETBITN TMP 67 (+ (* 2 K) 33)
                                                 (LOGNOT1 (AG K SB)))))
                                  (SETBITN TMP 67 (+ (* 2 K) 34) 1))))
                  (TBLE (AS K (BITS TMP 63 0) TBLE)))
                 (ALIGN-LOOP-0 (+ K 1) PPS PSB SB TBLE))
           TBLE))

(DEFUN ALIGN-LOOP-1 (K BDS SB PSB)
       (DECLARE (XARGS :MEASURE (NFIX (- 17 K))))
       (IF (AND (INTEGERP K) (< K 17))
           (LET ((SB (AS K (BITN (AG K BDS) 2) SB))
                 (PSB (AS (+ K 1) (BITN (AG K BDS) 2) PSB)))
                (ALIGN-LOOP-1 (+ K 1) BDS SB PSB))
           (MV SB PSB)))

(DEFUN ALIGN (BDS PPS)
       (LET ((SB NIL) (PSB NIL))
            (MV-LET (SB PSB)
                    (ALIGN-LOOP-1 0 BDS SB PSB)
                    (LET ((TBLE NIL))
                         (ALIGN-LOOP-0 0 PPS PSB SB TBLE)))))

(DEFUN COMPRESS32 (IN0 IN1 IN2)
       (MV (LOGXOR (LOGXOR IN0 IN1) IN2)
           (BITS (ASH (LOGIOR (LOGIOR (LOGAND IN0 IN1)
                                      (LOGAND IN0 IN2))
                              (LOGAND IN1 IN2))
                      1)
                 63 0)))

(DEFUN
 COMPRESS42 (IN0 IN1 IN2 IN3)
 (LET
  ((TEMP (BITS (ASH (LOGIOR (LOGIOR (LOGAND IN1 IN2)
                                    (LOGAND IN1 IN3))
                            (LOGAND IN2 IN3))
                    1)
               63 0)))
  (MV
   (LOGXOR (LOGXOR (LOGXOR (LOGXOR IN0 IN1) IN2)
                   IN3)
           TEMP)
   (BITS
        (ASH (LOGIOR (LOGAND IN0
                             (BITS (LOGNOT (LOGXOR (LOGXOR (LOGXOR IN0 IN1) IN2)
                                                   IN3))
                                   63 0))
                     (LOGAND TEMP
                             (LOGXOR (LOGXOR (LOGXOR IN0 IN1) IN2)
                                     IN3)))
             1)
        63 0))))

(DEFUN SUM-LOOP-0 (I A1 A2)
       (DECLARE (XARGS :MEASURE (NFIX (- 2 I))))
       (IF (AND (INTEGERP I) (< I 2))
           (LET ((A2 (LET ((TEMP-1 NIL) (TEMP-0 NIL))
                          (MV-LET (TEMP-0 TEMP-1)
                                  (COMPRESS42 (AG (* 4 I) A1)
                                              (AG (+ (* 4 I) 1) A1)
                                              (AG (+ (* 4 I) 2) A1)
                                              (AG (+ (* 4 I) 3) A1))
                                  (LET ((A2 (AS (+ (* 2 I) 0) TEMP-0 A2)))
                                       (AS (+ (* 2 I) 1) TEMP-1 A2))))))
                (SUM-LOOP-0 (+ I 1) A1 A2))
           A2))

(DEFUN SUM-LOOP-1 (I IN A1)
       (DECLARE (XARGS :MEASURE (NFIX (- 4 I))))
       (IF (AND (INTEGERP I) (< I 4))
           (LET ((A1 (LET ((TEMP-1 NIL) (TEMP-0 NIL))
                          (MV-LET (TEMP-0 TEMP-1)
                                  (COMPRESS42 (AG (* 4 I) IN)
                                              (AG (+ (* 4 I) 1) IN)
                                              (AG (+ (* 4 I) 2) IN)
                                              (AG (+ (* 4 I) 3) IN))
                                  (LET ((A1 (AS (+ (* 2 I) 0) TEMP-0 A1)))
                                       (AS (+ (* 2 I) 1) TEMP-1 A1))))))
                (SUM-LOOP-1 (+ I 1) IN A1))
           A1))

(DEFUN SUM (IN)
       (LET* ((A1 NIL)
              (A1 (SUM-LOOP-1 0 IN A1))
              (A2 NIL)
              (A2 (SUM-LOOP-0 0 A1 A2))
              (A3 NIL)
              (A3 (LET ((TEMP-1 NIL) (TEMP-0 NIL))
                       (MV-LET (TEMP-0 TEMP-1)
                               (COMPRESS42 (AG 0 A2)
                                           (AG 1 A2)
                                           (AG 2 A2)
                                           (AG 3 A2))
                               (LET ((A3 (AS 0 TEMP-0 A3)))
                                    (AS 1 TEMP-1 A3)))))
              (A4 NIL)
              (A4 (LET ((TEMP-1 NIL) (TEMP-0 NIL))
                       (MV-LET (TEMP-0 TEMP-1)
                               (COMPRESS32 (AG 0 A3)
                                           (AG 1 A3)
                                           (AG 16 IN))
                               (LET ((A4 (AS 0 TEMP-0 A4)))
                                    (AS 1 TEMP-1 A4))))))
             (BITS (+ (AG 0 A4) (AG 1 A4)) 63 0)))

(DEFUN IMUL (S1 S2)
       (LET* ((BD (BOOTH S1))
              (PP (PARTIALPRODUCTS BD S2))
              (TBLE (ALIGN BD PP)))
             (SUM TBLE)))

(DEFUN IMULTEST (S1 S2)
       (LET ((SPEC_RESULT (BITS (* S1 S2) 63 0))
             (IMUL_RESULT (IMUL S1 S2)))
            (MV (LOG= SPEC_RESULT IMUL_RESULT)
                SPEC_RESULT IMUL_RESULT)))

