[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Optimize RATIONALP too.
From:       stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2023-06-29 20:54:16
Message-ID: 1688072056.814107.19913 () sfp-scm-5 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  eccba8a43e432d9197d1ac368eac0c35ca0a8e48 (commit)
      from  09cb73bb50d5289f37bd76bc9a250e0b3bb3f31a (commit)

- Log -----------------------------------------------------------------
commit eccba8a43e432d9197d1ac368eac0c35ca0a8e48
Author: Stas Boukarev <stassats@gmail.com>
Date:   Thu Jun 29 23:48:16 2023 +0300

    Optimize RATIONALP too.
---
 src/compiler/arm64/type-vops.lisp  |  4 +++-
 src/compiler/x86-64/type-vops.lisp | 15 +++++++++------
 2 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/src/compiler/arm64/type-vops.lisp b/src/compiler/arm64/type-vops.lisp
index 581eb373d..9db962b33 100644
--- a/src/compiler/arm64/type-vops.lisp
+++ b/src/compiler/arm64/type-vops.lisp
@@ -54,7 +54,9 @@
   (let ((drop-through (gen-label)))
     (assemble ()
       #.(assert (= fixnum-tag-mask 1))
-      (inst tbz* value 0 (if not-p drop-through target)))
+      (when (types-equal-or-intersect (tn-ref-type value-tn-ref)
+                                      (specifier-type 'fixnum))
+        (inst tbz* value 0 (if not-p drop-through target))))
     (%test-headers value temp target not-p nil headers
                    :drop-through drop-through
                    :value-tn-ref value-tn-ref
diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index dc8cda90b..7dee64801 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -46,13 +46,16 @@
                                  &key value-tn-ref immediate-tested)
   (let ((drop-through (gen-label)))
     (case n-fixnum-tag-bits
-     (1 (%lea-for-lowtag-test temp value other-pointer-lowtag :qword)
+     (1
+      (%lea-for-lowtag-test temp value other-pointer-lowtag :qword)
+      (when (types-equal-or-intersect (tn-ref-type value-tn-ref)
+                                      (specifier-type 'fixnum))
         (inst test :byte temp 1)
-        (inst jmp :nz (if not-p drop-through target)) ; inverted
-        (%test-headers value temp target not-p nil headers
-                       :drop-through drop-through :compute-temp nil
-                       :value-tn-ref value-tn-ref
-                       :immediate-tested immediate-tested))
+        (inst jmp :nz (if not-p drop-through target))) ; inverted
+      (%test-headers value temp target not-p nil headers
+                     :drop-through drop-through :compute-temp nil
+                     :value-tn-ref value-tn-ref
+                     :immediate-tested immediate-tested))
      (t
       (generate-fixnum-test value)
       (inst jmp :z (if not-p drop-through target))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]