Changeset 14235

Timestamp:

Sep 7, 2010, 11:03:11 AM (14 years ago)

Author:

R. Matthew Emerson

Message:

Abandon my attempts to do more low-level tricks with logand and logior
in the front end.

Location:

trunk/source/compiler

Files:

• X86/x862.lisp (modified) (1 diff)
• nx0.lisp (modified) (1 diff)
• nx1.lisp (modified) (3 diffs)
• nxenv.lisp (modified) (1 diff)

trunk/source/compiler/X86/x862.lisp

@@ -10292 +10292 @@
       (^))))
 
-(defx862 x862-%fixnum-mask-to-natural %fixnum-mask-to-natural (seg vreg xfer arg)
-  (with-imm-target () (target :natural)
-    (let ((r (x862-one-untargeted-reg-form seg arg *x862-arg-z*)))
-      (unless (or (acode-fixnum-form-p arg)
-                  *x862-reckless*)
-        (! trap-unless-fixnum r))
-      (! fixnum->signed-natural target r)
-      (<- target)
-      (^))))
-
 (defx862 x862-%double-float %double-float (seg vreg xfer arg)
   (let* ((real (or (acode-fixnum-form-p arg)

trunk/source/compiler/nx0.lisp

@@ -2767 +2767 @@
              (64 (subtypep *nx-form-type* '(unsigned-byte 64))))))))
 
-(defun nx-logand-2-op (form1 form2 env)
-  (let* ((acode1 (nx1-form form1))
-         (acode2 (nx1-form form2))
-         (fix1 (nx-acode-fixnum-type-p acode1 env))
-         (fix2 (nx-acode-fixnum-type-p acode2 env)))
-    (if (and fix1 fix2)
-      (make-acode (%nx1-operator %ilogand2) acode1 acode2)
-      (let* ((natural-type (target-word-size-case
-                            (32 '(unsigned-byte 32))
-                            (64 '(unsigned-byte 64))))
-             (nat1 (or fix1 (nx-acode-form-typep acode1 natural-type env)))
-             (nat2 (or fix2 (nx-acode-form-typep acode2 natural-type env))))
-        (if (and nat1 nat2)
-          (make-acode (%nx1-operator typed-form) natural-type
-                      (make-acode (%nx1-operator %natural-logand)
-                                  acode1 acode2))
-          (make-acode (%nx1-operator logand2) acode1 acode2))))))
-
-(defun nx-logior-2-op (form1 form2 env)
-  (let* ((acode1 (nx1-form form1))
-         (acode2 (nx1-form form2))
-         (fix1 (nx-acode-fixnum-type-p acode1 env))
-         (fix2 (nx-acode-fixnum-type-p acode2 env)))
-    (if (and fix1 fix2)
-      (make-acode (%nx1-operator %ilogior2) acode1 acode2)
-      (let* ((natural-type (target-word-size-case
-                            (32 '(unsigned-byte 32))
-                            (64 '(unsigned-byte 64))))
-             (nat1 (or fix1 (nx-acode-form-typep acode1 natural-type env)))
-             (nat2 (or fix2 (nx-acode-form-typep acode2 natural-type env))))
-        (if (and nat1 nat2)
-          (make-acode (%nx1-operator typed-form) natural-type
-                      (make-acode (%nx1-operator %natural-logior)
-                                  acode1 acode2))
-          (make-acode (%nx1-operator logior2) acode1 acode2))))))
-
 (defun nx-binary-boole-op (whole env arg-1 arg-2 fixop intop naturalop)
   (let* ((use-fixop (nx-binary-fixnum-op-p arg-1 arg-2 env t))

trunk/source/compiler/nx1.lisp

@@ -450 +450 @@
                 (nx1-form newvalue)))
 
-(defnx1 nx1-logior-2 ((logior-2)) (&environment env arg-1 arg-2)
-  (nx-logior-2-op arg-1 arg-2 env))
+(defnx1 nx1-logior-2 ((logior-2)) (&whole w &environment env arg-1 arg-2)
+  (nx-binary-boole-op w
+                      env
+                      arg-1
+                      arg-2
+                      (%nx1-operator %ilogior2)
+                      (%nx1-operator logior2)
+                      (%nx1-operator %natural-logior)))
 
 (defnx1 nx1-logxor-2 ((logxor-2)) (&whole w &environment env arg-1 arg-2)
@@ -462 +468 @@
                       (%nx1-operator %natural-logxor)))
 
-(defnx1 nx1-logand-2 ((logand-2)) (&environment env arg-1 arg-2)
-  (nx-logand-2-op arg-1 arg-2 env))
+(defnx1 nx1-logand-2 ((logand-2)) (&whole w &environment env arg-1 arg-2)
+  (nx-binary-boole-op w
+                      env
+                      arg-1
+                      arg-2
+                      (%nx1-operator %ilogand2)
+                      (%nx1-operator logand2)
+                      (%nx1-operator %natural-logand)))
 
 (defnx1 nx1-require ((require-simple-vector)
@@ -2195 +2207 @@
               (nx1-form arg)))
 
-(defnx1 nx1-%fixnum-mask-to-natural ((%fixnum-mask-to-natural)) (arg)
-  (make-acode (%nx1-operator %fixnum-mask-to-natural)
-              (nx1-form arg)))
-
 (defnx1 nx1-%double-float ((%double-float)) (&whole whole arg &optional (result nil result-p))
   (declare (ignore result))

trunk/source/compiler/nxenv.lisp

@@ -370 +370 @@
      (%double-float . #. #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
      (i386-ff-call . 0)
-     (i386-syscall . 0)
-     (%fixnum-mask-to-natural  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask)))))
+     (i386-syscall . 0))))
 
 (defmacro %nx1-operator (sym)