master: Permute FDEFN slots for #+linkage-space
snuglas via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 976cf627663cea74fba0789689e36cfdbc3eef5a (commit)
from 2419acbc363d889e6bdedb3b380877e1b808edaf (commit)
- Log -----------------------------------------------------------------
commit 976cf627663cea74fba0789689e36cfdbc3eef5a
Author: Douglas Katzman <[email protected]>
Date: Wed Apr 15 16:48:46 2026 -0400
Permute FDEFN slots for #+linkage-space
Function-related accessors for symbols and fdefns become one and the same.
---
src/code/linkage-space.lisp | 20 +++++++++-----------
src/compiler/generic/genesis.lisp | 19 ++++++-------------
src/compiler/generic/objdef.lisp | 4 ++--
src/compiler/ppc64/cell.lisp | 8 --------
src/compiler/x86-64/cell.lisp | 15 +++++----------
src/runtime/gc-common.c | 2 +-
src/runtime/gencgc.c | 8 +-------
src/runtime/symbol-tls.inc | 8 ++------
8 files changed, 26 insertions(+), 58 deletions(-)
diff --git a/src/code/linkage-space.lisp b/src/code/linkage-space.lisp
index 8173f7b80..074fd7aa9 100644
--- a/src/code/linkage-space.lisp
+++ b/src/code/linkage-space.lisp
@@ -11,7 +11,9 @@
(in-package "SB-VM")
-(eval-when (:compile-toplevel) (aver (= symbol-fdefn-slot fdefn-fun-slot)))
+(eval-when (:compile-toplevel)
+ (aver (= symbol-hash-slot fdefn-bits-slot))
+ (aver (= symbol-fdefn-slot fdefn-fun-slot)))
(deftype linkage-index () `(unsigned-byte ,n-linkage-index-bits))
@@ -35,14 +37,12 @@
(declaim (ftype function unbypass-linkage))
(defun fname-linkage-index (fname)
- (etypecase fname
- ((and symbol (not null))
- (ldb (byte n-linkage-index-bits symbol-linkage-index-pos)
- (with-pinned-objects (fname)
- (#+big-endian sap-ref-word #+little-endian sap-ref-32
+ (declare (type (or (and symbol (not null)) fdefn) fname))
+ (ldb (byte n-linkage-index-bits symbol-linkage-index-pos)
+ (with-pinned-objects (fname)
+ (#+big-endian sap-ref-word #+little-endian sap-ref-32
(int-sap (get-lisp-obj-address fname))
(- (ash symbol-hash-slot word-shift) other-pointer-lowtag)))))
- (fdefn (ash (get-header-data fname) -24))))
(macrolet ((entry-addr (index f)
`(values #+ppc64 (truly-the word
@@ -107,10 +107,8 @@
(let ((simply-callable (ensure-simplistic (fdefn-fun fname) fname)))
(with-pinned-objects (simply-callable)
(multiple-value-bind (entrypoint cell) (entry-addr index simply-callable)
- ;; SYMBOL-LINKAGE-INDEX-POS is 3 so do the vop a favor and shift
- ;; the index into position. FDEFNs can do without a pre-shift.
- (let ((index
- (if (symbolp fname) (ash index symbol-linkage-index-pos) index)))
+ ;; Shift INDEX left so it doesn't require a vop temp
+ (let ((index (ash index symbol-linkage-index-pos)))
(%primitive set-fname-linkage-index fname index cell entrypoint)))))
index)))))
(bug "No more linkage table cells available. Rebuild SBCL with a larger table size")))
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index a3039f52d..443d2c692 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1261,12 +1261,7 @@ core and return a descriptor to it."
(if (zerop (descriptor-bits fun)) *nil-descriptor* fun)))
#+linkage-space
-(macrolet ((index-word-and-byte-posn (x)
- `(ecase (descriptor-widetag ,x)
- (,sb-vm:symbol-widetag
- (values sb-vm:symbol-hash-slot sb-vm::symbol-linkage-index-pos))
- (,sb-vm:fdefn-widetag
- (values 0 32)))))
+(progn
(defvar *fname-table*
(make-array 6000 :initial-element 0 :fill-pointer 1 :adjustable nil))
@@ -1281,19 +1276,17 @@ core and return a descriptor to it."
(defun fname-linkage-index (fname) ; modeled on the code in 'src/code/linkage-space'
(let ((des (coerce-to-cold-fname fname)))
(cond ((cold-null des) 0)
- (t (multiple-value-bind (wordindex byte-pos) (index-word-and-byte-posn des)
- (ldb (byte sb-vm:n-linkage-index-bits byte-pos)
- (read-bits-wordindexed des wordindex)))))))
+ (t (ldb (byte sb-vm:n-linkage-index-bits sb-vm::symbol-linkage-index-pos)
+ (read-bits-wordindexed des sb-vm:symbol-hash-slot))))))
(defun ensure-linkage-index (fname)
(let* ((des (coerce-to-cold-fname fname))
(index (fname-linkage-index des)))
(when (zerop index)
(setq index (vector-push-extend des *fname-table*))
- (multiple-value-bind (wordindex byte-pos) (index-word-and-byte-posn des)
- (let* ((oldbits (read-bits-wordindexed des wordindex))
- (newbits (logior oldbits (ash index byte-pos))))
- (write-wordindexed/raw des wordindex newbits)))
+ (let* ((oldbits (read-bits-wordindexed des sb-vm:symbol-hash-slot))
+ (newbits (logior oldbits (ash index sb-vm::symbol-linkage-index-pos))))
+ (write-wordindexed/raw des sb-vm:symbol-hash-slot newbits))
(assert (= (fname-linkage-index fname) index)))
index)))
diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index de4e77249..02150a7c4 100644
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -224,8 +224,8 @@ during backtrace.
;; or closure tramp.
(raw-addr :c-type "char *"))
#+linkage-space
- #((name :ref-trans fdefn-name)
- (unused)
+ #((bits)
+ (name :ref-trans fdefn-name)
(fun)))
;;; a simple function (as opposed to hairier things like closures
diff --git a/src/compiler/ppc64/cell.lisp b/src/compiler/ppc64/cell.lisp
index 835e82558..99fc1af26 100644
--- a/src/compiler/ppc64/cell.lisp
+++ b/src/compiler/ppc64/cell.lisp
@@ -314,17 +314,9 @@
(:vop-var vop)
(:generator 1
(gcbar)
- (load-type temp object (- other-pointer-lowtag))
- (inst cmpwi temp fdefn-widetag)
- (inst beq FDEFN)
- ;; SYMBOL
(loadw temp object symbol-hash-slot other-pointer-lowtag)
(inst or temp temp index)
(storew temp object symbol-hash-slot other-pointer-lowtag)
- (inst b CELL-SET)
- FDEFN
- (inst stw index object (- #+little-endian 4 other-pointer-lowtag))
- CELL-SET
(inst std linkage-val linkage-cell 0)))
(define-vop (set-fname-fun)
(:args (object :scs (descriptor-reg))
diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index 100b139c8..94335da60 100644
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -306,16 +306,11 @@
#-immobile-space (:temporary (:sc unsigned-reg) temp)
(:vop-var vop)
(:generator 1
- (pseudo-atomic (:elide-if (or #-immobile-space t))
+ (pseudo-atomic () ; assume software card marking
(gcbar)
- (inst cmp :byte (ea (- other-pointer-lowtag) object) fdefn-widetag)
- (inst jmp :ne SYMBOL)
- (inst mov :dword (ea (- 4 other-pointer-lowtag) object) index)
- (inst jmp CELL-SET)
- SYMBOL
- (inst or :dword :lock
- (object-slot-ea object symbol-hash-slot other-pointer-lowtag) index)
- CELL-SET
+ ;; I think this has :LOCK because I want the 3 lowest bits to be
+ ;; flags which might undergo concurrent modification.
+ (inst or :dword :lock (object-slot-ea object fdefn-bits-slot other-pointer-lowtag) index)
(inst mov (ea linkage-cell) linkage-val))))
(define-vop (set-fname-fun)
(:args (object :scs (descriptor-reg))
@@ -325,7 +320,7 @@
#-immobile-space (:temporary (:sc unsigned-reg) temp)
(:vop-var vop)
(:generator 1
- (pseudo-atomic (:elide-if (or #-immobile-space t))
+ (pseudo-atomic () ; assume software card marking
(gcbar)
(storew function object fdefn-fun-slot other-pointer-lowtag)
(unless (and (sc-is linkage-val immediate) (zerop (tn-value linkage-val)))
diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 365b10e4f..dbeba91b4 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -1041,7 +1041,7 @@ scav_fdefn(lispobj *where, lispobj __attribute__((unused)) object)
{
struct fdefn *fdefn = (struct fdefn *)where;
#ifdef LISP_FEATURE_LINKAGE_SPACE
- scavenge(where + 1, 3); // name, padding, function
+ scavenge(where + 2, 2); // 'name' and 'fun'
scav_linkage_cell(fdefn_linkage_index(fdefn));
#else
scavenge(where + 1, 2); // 'name' and 'fun'
diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 8b1658b85..5d2e5b80e 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2229,13 +2229,7 @@ static lispobj* range_dirty_p(lispobj* where, lispobj* limit, generation_index_t
}
#endif
#ifdef LISP_FEATURE_LINKAGE_SPACE
- else if (widetag == SYMBOL_WIDETAG) {
- struct symbol* s = (void*)where;
- if (!ptr_ok_to_writeprotect(linkage_cell_function(symbol_linkage_index(s)), gen))
- return where;
- // Process the value and info slots normally, and the bit-packed package ID + name
- // can't be younger, so that slot's contents are irrelevant
- } else if (widetag == FDEFN_WIDETAG) {
+ else if (widetag == SYMBOL_WIDETAG || widetag == FDEFN_WIDETAG) {
struct fdefn* f = (void*)where;
if (!ptr_ok_to_writeprotect(linkage_cell_function(fdefn_linkage_index(f)), gen))
return where;
diff --git a/src/runtime/symbol-tls.inc b/src/runtime/symbol-tls.inc
index b83d893d6..dc5c30baf 100644
--- a/src/runtime/symbol-tls.inc
+++ b/src/runtime/symbol-tls.inc
@@ -101,11 +101,7 @@ extern void unbind_to_here(lispobj *bsp,void *thread);
#ifdef LISP_FEATURE_LINKAGE_SPACE
static inline unsigned int fdefn_linkage_index(struct fdefn* f) {
-#ifdef LISP_FEATURE_BIG_ENDIAN
- return ((unsigned int*)f)[0]; // upper 4 bytes of header
-#else
- return ((unsigned int*)f)[1]; // same
-#endif
+ return (f->bits >> WORD_SHIFT) & ((1<<N_LINKAGE_INDEX_BITS)-1);
}
#ifdef LISP_FEATURE_RELOCATABLE_STATIC_SPACE
extern uword_t STATIC_SPACE_START; // for self-containedness of this header
@@ -113,7 +109,7 @@ extern uword_t STATIC_SPACE_START; // for self-containedness of this header
static inline unsigned int symbol_linkage_index(struct symbol* s) {
// never look at NIL's hash slot's low bits
if ((uword_t)s == (STATIC_SPACE_START + NIL_SYMBOL_SLOTS_OFFSET)) return 0;
- return (s->hash >> WORD_SHIFT) & ((1<<N_LINKAGE_INDEX_BITS)-1);
+ return fdefn_linkage_index((struct fdefn*)s);
}
static lispobj __attribute__((unused)) symbol_function(struct symbol* s) {
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL