Changeset 14229


Ignore:
Timestamp:
Aug 31, 2010, 3:15:56 AM (9 years ago)
Author:
rme
Message:

Re-enable some changes that try to do a better job on LOGAND
and LOGIOR (particularly as generated by DPB) in some simple
cases.

Location:
trunk/source/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx0.lisp

    r13966 r14229  
    27672767             (64 (subtypep *nx-form-type* '(unsigned-byte 64))))))))
    27682768
    2769 (defun nx-logand-2-op (arg-1 arg-2 env)
    2770   (let* ((form-1 (nx1-form arg-1))
    2771          (form-2 (nx1-form arg-2))
    2772          (fix-1 (nx-acode-fixnum-type-p form-1 env))
    2773          (fix-2 (nx-acode-fixnum-type-p form-2 env))
    2774          (nat-1 (nx-acode-natural-type-p form-1 env))
    2775          (nat-2 (nx-acode-natural-type-p form-2 env))
    2776          (natural-width (target-word-size-case (32 32) (64 64)))
    2777          (natural-mask (1- (ash 1 natural-width))))
    2778     (when (and nat-1
    2779                (not nat-2)
    2780                (acode-integer-constant-p form-2 natural-width))
    2781         (setq form-2 (nx1-form (logand natural-mask arg-2))
    2782               nat-2 t))
    2783     (when (and (not nat-1)
    2784                nat-2
    2785                (acode-integer-constant-p form-1 natural-width))
    2786         (setq form-1 (nx1-form (logand natural-mask arg-1))
    2787               nat-1 t))
    2788     (cond
    2789       ((and fix-1 fix-2)
    2790        (make-acode (%nx1-operator %ilogand2) form-1 form-2))
    2791       ((and nat-1 nat-2)
    2792        (make-acode (%nx1-operator typed-form)
    2793                    (target-word-size-case
    2794                     (32 '(unsigned-byte 32))
    2795                     (64 '(unsigned-byte 64)))
    2796                    (make-acode (%nx1-operator %natural-logand) form-1 form-2)))
    2797       ((and fix-1 nat-2)
    2798        (make-acode (%nx1-operator typed-form)
    2799                    (target-word-size-case
    2800                     (32 '(unsigned-byte 32))
    2801                     (64 '(unsigned-byte 64)))
    2802                    (make-acode (%nx1-operator %natural-logand)
    2803                                (make-acode (%nx1-operator %fixnum-mask-to-natural)
    2804                                            form-1)
    2805                                form-2)))
    2806       ((and nat-1 fix-2)
    2807        (make-acode (%nx1-operator typed-form)
    2808                    (target-word-size-case
    2809                     (32 '(unsigned-byte 32))
    2810                     (64 '(unsigned-byte 64)))
    2811                    (make-acode (%nx1-operator %natural-logand)
    2812                                form-1
    2813                                (make-acode (%nx1-operator %fixnum-mask-to-natural)
    2814                                                           form-2))))
    2815       (t
    2816        (make-acode (%nx1-operator logand2) form-1 form-2)))))
    2817 
    2818 (defun nx-logior-2-op (arg-1 arg-2 env)
    2819   (let* ((form-1 (nx1-form arg-1))
    2820          (form-2 (nx1-form arg-2))
    2821          (fix-1 (nx-acode-fixnum-type-p form-1 env))
    2822          (fix-2 (nx-acode-fixnum-type-p form-2 env))
    2823          (nat-1 (or (acode-natural-constant-p form-1)
    2824                     (nx-acode-natural-type-p form-1 env)))
    2825          (nat-2 (or (acode-natural-constant-p form-2)
    2826                     (nx-acode-natural-type-p form-2 env))))
    2827     (cond
    2828       ((and fix-1 fix-2)
    2829        (make-acode (%nx1-operator %ilogior2) form-1 form-2))
    2830       ((and nat-1 nat-2)
    2831        (make-acode (%nx1-operator typed-form)
    2832                    (target-word-size-case
    2833                     (32 '(unsigned-byte 32))
    2834                     (64 '(unsigned-byte 64)))
    2835                    (make-acode (%nx1-operator %natural-logior) form-1 form-2)))
    2836       (t
    2837        (make-acode (%nx1-operator logior2) form-1 form-2)))))
     2769(defun nx-logand-2-op (form1 form2 env)
     2770  (let* ((acode1 (nx1-form form1))
     2771         (acode2 (nx1-form form2))
     2772         (fix1 (nx-acode-fixnum-type-p acode1 env))
     2773         (fix2 (nx-acode-fixnum-type-p acode2 env)))
     2774    (if (and fix1 fix2)
     2775      (make-acode (%nx1-operator %ilogand2) acode1 acode2)
     2776      (let* ((natural-type (target-word-size-case
     2777                            (32 '(unsigned-byte 32))
     2778                            (64 '(unsigned-byte 64))))
     2779             (nat1 (or fix1 (nx-acode-form-typep acode1 natural-type env)))
     2780             (nat2 (or fix2 (nx-acode-form-typep acode2 natural-type env))))
     2781        (if (and nat1 nat2)
     2782          (make-acode (%nx1-operator typed-form) natural-type
     2783                      (make-acode (%nx1-operator %natural-logand)
     2784                                  acode1 acode2))
     2785          (make-acode (%nx1-operator logand2) acode1 acode2))))))
     2786
     2787(defun nx-logior-2-op (form1 form2 env)
     2788  (let* ((acode1 (nx1-form form1))
     2789         (acode2 (nx1-form form2))
     2790         (fix1 (nx-acode-fixnum-type-p acode1 env))
     2791         (fix2 (nx-acode-fixnum-type-p acode2 env)))
     2792    (if (and fix1 fix2)
     2793      (make-acode (%nx1-operator %ilogior2) acode1 acode2)
     2794      (let* ((natural-type (target-word-size-case
     2795                            (32 '(unsigned-byte 32))
     2796                            (64 '(unsigned-byte 64))))
     2797             (nat1 (or fix1 (nx-acode-form-typep acode1 natural-type env)))
     2798             (nat2 (or fix2 (nx-acode-form-typep acode2 natural-type env))))
     2799        (if (and nat1 nat2)
     2800          (make-acode (%nx1-operator typed-form) natural-type
     2801                      (make-acode (%nx1-operator %natural-logior)
     2802                                  acode1 acode2))
     2803          (make-acode (%nx1-operator logior2) acode1 acode2))))))
    28382804
    28392805(defun nx-binary-boole-op (whole env arg-1 arg-2 fixop intop naturalop)
  • trunk/source/compiler/nx1.lisp

    r14171 r14229  
    450450                (nx1-form newvalue)))
    451451
    452 (defnx1 nx1-logior-2 ((logior-2)) (&whole w &environment env arg-1 arg-2)
    453   (nx-binary-boole-op w
    454                       env
    455                       arg-1
    456                       arg-2
    457                       (%nx1-operator %ilogior2)
    458                       (%nx1-operator logior2)
    459                       (%nx1-operator %natural-logior)))
     452(defnx1 nx1-logior-2 ((logior-2)) (&environment env arg-1 arg-2)
     453  (nx-logior-2-op arg-1 arg-2 env))
    460454
    461455(defnx1 nx1-logxor-2 ((logxor-2)) (&whole w &environment env arg-1 arg-2)
     
    468462                      (%nx1-operator %natural-logxor)))
    469463
    470 (defnx1 nx1-logand-2 ((logand-2)) (&whole w &environment env arg-1 arg-2)
    471   (nx-binary-boole-op w
    472                       env
    473                       arg-1
    474                       arg-2
    475                       (%nx1-operator %ilogand2)
    476                       (%nx1-operator logand2)
    477                       (%nx1-operator %natural-logand)))
     464(defnx1 nx1-logand-2 ((logand-2)) (&environment env arg-1 arg-2)
     465  (nx-logand-2-op arg-1 arg-2 env))
    478466
    479467(defnx1 nx1-require ((require-simple-vector)
Note: See TracChangeset for help on using the changeset viewer.