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

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Define unbound-marker consistently across 64-bit platforms
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2020-06-30 1:15:48
Message-ID: 1593479748.970185.14423 () sfp-scm-3 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  38cb85c57c1d8dfe50f027b399c755faed4856b3 (commit)
      from  91f9193ce0d61fcfebde99956bd412884fb23828 (commit)

- Log -----------------------------------------------------------------
commit 38cb85c57c1d8dfe50f027b399c755faed4856b3
Author: Douglas Katzman <dougk@google.com>
Date:   Mon Jun 29 21:14:25 2020 -0400

    Define unbound-marker consistently across 64-bit platforms
    
    So that the optimization in %test-headers implemented for x86-64
    could be implemented for the other platforms if desired.
---
 src/compiler/generic/early-objdef.lisp    | 10 +++++-----
 src/compiler/generic/early-type-vops.lisp | 10 ++++++++--
 src/compiler/generic/genesis.lisp         |  2 +-
 src/compiler/generic/late-type-vops.lisp  |  4 ++--
 src/compiler/x86-64/type-vops.lisp        | 10 ----------
 5 files changed, 16 insertions(+), 20 deletions(-)

diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index 56d772ab2..7790cba82 100644
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -109,8 +109,8 @@
        ;; 8 is the number of words to reserve at the beginning of static space
        ;; prior to the words of NIL.
        ;; If you change this, then also change MAKE-NIL-DESCRIPTOR in genesis.
-       #+(and (not x86-64) gencgc (not sb-thread)) (ash 8 word-shift)
-       #+x86-64 #x100
+       #+(and gencgc (not sb-thread) (not 64-bit)) (ash 8 word-shift)
+       #+64-bit #x100
        (* 2 n-word-bytes)
        list-pointer-lowtag))
 
@@ -199,7 +199,7 @@
 ;; SIMPLE-VECTOR means the latter doesn't make it right for SBCL internals.
 
 (defconstant widetag-spacing 4)
-#+x86-64 (defconstant unbound-marker-widetag 9)
+#+64-bit (defconstant unbound-marker-widetag 9)
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defenum (;; The first widetag must be greater than SB-VM:LOWTAG-LIMIT
           ;; otherwise code in generic/early-type-vops will suffer
@@ -233,8 +233,8 @@
   value-cell-widetag                        ;  3E   45  3E   45
   character-widetag                         ;  42   49  42   49
   sap-widetag                               ;  46   4D  46   4D
-  #-x86-64 unbound-marker-widetag           ;  4A   51  4A   51
-  #+x86-64 unused00-widetag
+  #-64-bit unbound-marker-widetag           ;  4A   51  4A   51
+  #+64-bit unused00-widetag
   weak-pointer-widetag                      ;  4E   55  4E   55
   instance-widetag                          ;  52   59  52   59
   fdefn-widetag                             ;  56   5D  56   5D
diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp
index fcc4cb6b1..df5a49408 100644
--- a/src/compiler/generic/early-type-vops.lisp
+++ b/src/compiler/generic/early-type-vops.lisp
@@ -81,8 +81,14 @@
                                 (member lowtag type-codes))
                               '#.(mapcar #'symbol-value fixnum-lowtags))
                        t))
-         (lowtags (remove lowtag-limit type-codes :test #'<))
-         (extended (remove lowtag-limit type-codes :test #'>))
+         ;; On 64-bit, UNBOUND-MARKER-WIDETAG may be smaller than LOWTAG-LIMIT
+         ;; but it is not a lowtag.
+         (lowtags (remove unbound-marker-widetag
+                          (remove lowtag-limit type-codes :test #'<)))
+         (extended (remove-if (lambda (x)
+                                (and (< x lowtag-limit)
+                                     (/= x unbound-marker-widetag)))
+                              type-codes))
          (immediates (intersection extended +immediate-types+ :test #'eql))
          ;; To collapse the range of widetags comprising real numbers on 64-bit
          ;; machines, consider SHORT-FLOAT-WIDETAG both a header and immediate.
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index a87883ca1..a2e552f2c 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1546,7 +1546,7 @@ core and return a descriptor to it."
   (allocate-vector #-64-bit sb-vm:simple-array-signed-byte-32-widetag
                    #+64-bit sb-vm:simple-array-signed-byte-64-widetag
                    6 6 *static*)
-  #+x86-64 (setf (gspace-free-word-index *static*) (/ 256 sb-vm:n-word-bytes))
+  #+64-bit (setf (gspace-free-word-index *static*) (/ 256 sb-vm:n-word-bytes))
   (let* ((des (allocate-header+object *static* sb-vm:symbol-size 0))
          (nil-val (make-descriptor (+ (descriptor-bits des)
                                       (* 2 sb-vm:n-word-bytes)
diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp
index cb067c40d..43ba17014 100644
--- a/src/compiler/generic/late-type-vops.lisp
+++ b/src/compiler/generic/late-type-vops.lisp
@@ -257,8 +257,8 @@
 #+sb-simd-pack-256
 (define-type-vop simd-pack-256-p (simd-pack-256-widetag))
 
-#.(when (> unbound-marker-widetag lowtag-mask)
-    '(define-type-vop unbound-marker-p (unbound-marker-widetag)))
+(define-type-vop unbound-marker-p (unbound-marker-widetag)
+  #+x86-64 simple-type-predicate)
 
 ;;; Not type vops, but generic over all backends
 (macrolet ((def (name lowtag)
diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 8c36ec56d..b48f7280e 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -385,16 +385,6 @@
        (inst jmp (if not-p :a :be) target)
        (emit-label skip))))
 
-;;; The generic code (in src/compiler/generic/{early,late}-type-vops)
-;;; would do the wrong thing. UNBOUND-MARKER-WIDETAG looks like a lowtag
-;;; to that code and so it would mask off 4 bits before testing,
-;;; which matches too many values.
-(define-vop (unbound-marker-p simple-type-predicate)
-  (:translate unbound-marker-p)
-  (:generator 2
-   (inst cmp :byte value unbound-marker-widetag)
-   (inst jmp (if not-p :ne :e) target)))
-
 (define-vop (pointerp)
   (:args (value :scs (any-reg descriptor-reg) :target temp))
   (:temporary (:sc unsigned-reg :from (:argument 0)) temp)

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


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] 

Configure | About | News | Add a list | Sponsored by KoreLogic