Permute FDEFN slots for #+linkage-space

Function-related accessors for symbols and fdefns become one and the same.

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")))

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)))
 

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

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))

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)))

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'

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;

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) {