master: x86-64: Rearrange the alien linkage table

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  b89611cdd6142773ab814df391091c086c11a685 (commit)
      from  f4d064cdd009c586d6e7735376e8b8b6f47f281e (commit)

- Log -----------------------------------------------------------------
commit b89611cdd6142773ab814df391091c086c11a685
Author: Douglas Katzman <[email protected]>
Date:   Mon Apr 13 21:30:22 2026 -0400

    x86-64: Rearrange the alien linkage table
    
    Instructions are together, and data are together, in batches like so:
    ; 190:       FF257AFFFFFF     JMP [RIP-134]                   ; &memmove
    ; 196:       6690             NOP
    ; 198:       FF257AFFFFFF     JMP [RIP-134]                   ; &memcpy
    ; 19E:       6690             NOP
    ; 1A0:       FF257AFFFFFF     JMP [RIP-134]                   ; &os_get_errno
    ; 1A6:       6690             NOP
    ; 1A8:       FF257AFFFFFF     JMP [RIP-134]                   ; &os_set_errno
    ; 1AE:       6690             NOP
---
 src/code/foreign.lisp                 |  2 +-
 src/compiler/generic/utils.lisp       | 38 +++++++++++++++++++++++++++++++++++
 src/compiler/x86-64/c-call.lisp       | 18 -----------------
 src/compiler/x86-64/insts.lisp        | 37 ++++++++++++++++++++++------------
 src/compiler/x86-64/target-insts.lisp |  9 +++++----
 src/runtime/x86-64-arch.c             | 21 +++++++++++--------
 tools-for-build/elftool.lisp          | 10 +++++++--
 7 files changed, 89 insertions(+), 46 deletions(-)

diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index fc305eef2..191962122 100644
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -134,7 +134,7 @@ The returned address is always a linkage-table address.
 Symbols are entered into the linkage-table if they aren't there already."
   (declare (ignorable datap))
   (let ((index (ensure-alien-linkage-index name datap)))
-    (values (sb-vm::alien-linkage-index-to-addr index) t)))
+    (values (sb-vm::alien-linkage-index-to-addr index datap) t)))
 
 (defun foreign-symbol-sap (symbol &optional datap)
   "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index 919c23769..8a627e432 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -73,6 +73,44 @@
       (not (static-symbol-p symbol))
       (not (null (info :variable :wired-tls symbol)))))
 
+#+x86-64
+;;; Alien linkage entries are bundled into groups of 16. Within a group, all pointer words
+;;; are adjacent, followed by the jump instructions corresponding to them (if relevant).
+;;; To see why this is more favorable to the CPU, consider trying to bring 8 consecutive
+;;; alien linkage entries into the CPU's L1 cache, and suppose cache lines are 64 bytes.
+;;; With I & D interleaved, 4 entries x 16 bytes per entry = 64 bytes. Those 64 bytes consume
+;;; both an L1 icache line _and_ an L1 dcache line. i.e identical bytes are in two caches.
+;;; Therefore 8 entries consume 4 lines.  However the same 8 entries using separated I & D
+;;; consume only 1 icache line and 1 dcache line, so 8 entries consume 2 lines.
+;;; Conclusion: non-interleaving improves theoretical density in L1 cache.
+;;; Though this is conditioned for x86-64, any of the architectures could (and probably
+;;; should) use a piecewise linear map from alien linkage index to table element, because
+;;; spacing data away from instructions by >1 cache line is generally the right thing.
+(symbol-macrolet ((entries-per-group 16))
+(defun alien-linkage-element-offset (i datap)
+  (multiple-value-bind (group-number index-in-group) (floor i entries-per-group)
+    (+ (* group-number entries-per-group alien-linkage-table-entry-size)
+       (if datap
+           ;; return the address of the indirection word
+           (* index-in-group sb-vm:n-word-bytes)
+           ;; return the address of the JMP instruction
+           (+ (* entries-per-group sb-vm:n-word-bytes) ; skip over N indirection words
+              (* index-in-group 8)))))) ; coincidentally it's 8 bytes for the JMP+padding
+
+(defun alien-linkage-index-from-addr (addr)
+  (let* ((offset (- addr alien-linkage-space-start))
+         (group-number (floor offset (* entries-per-group alien-linkage-table-entry-size)))
+         (index (* group-number entries-per-group)))
+    (dotimes (i entries-per-group) ; This is a very silly but simple technique
+      (when (or (= offset (alien-linkage-element-offset index nil))
+                (= offset (alien-linkage-element-offset index t)))
+        (return index))
+      (incf index))))
+
+(defun alien-linkage-index-to-addr (i &optional datap)
+  (+ (alien-linkage-element-offset i datap) alien-linkage-space-start)))
+
+#-x86-64 ; alien linkage index -> address mapping is strictly linear
 (symbol-macrolet ((space-end (+ alien-linkage-space-start alien-linkage-space-size)))
 ;;; the address of the linkage table entry for table index I.
 (defun alien-linkage-index-to-addr (i &optional datap)
diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index 5d3c17a81..4ef45a199 100644
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -583,24 +583,6 @@ Floats are passed in integer registers."
     (16 (sign-extend x size))
     (32 (sign-extend x size))))
 
-;;; There is a troublesome assumption about alien code linkage entries, namely that you
-;;; can reference entry + 8 to extract the actual address of the C function.
-;;; This is not ideal, for two distinct reasons:
-;;;
-;;; (1) The linkage entry should contain instructions for GC yieldpoint cooperation,
-;;; removing such instructions from call out sites. (You have to inform the GC that
-;;; a thread is leaving managed code and entering code that won't execute yieldpoints.)
-;;; Clearly this won't work if jumping into the middle of the linkage entry is allowed.
-;;;
-;;; (2) The CPU has separate I+D caches, and there is a cost to shuttling data between
-;;; them. Jumping to an alien linkage entries as they are puts the whole entry into the I
-;;; cache (presumably) when the second word should instead be in the D cache.
-;;; To optimally structure the entries, all JMPs should precede all data words, like so:
-;;;   jmp [RIP+disp]
-;;;   jmp [RIP+disp]
-;;;   ...
-;;;   data ...
-;;; And were such change made, it would cease to be valid to jump to an entry + 8.
 (define-vop (foreign-symbol-sap)
   (:translate foreign-symbol-sap)
   (:policy :fast-safe)
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 65c846090..faf7b0904 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -3415,19 +3415,30 @@
   (case flavor
     (:linkage-cell (setf addend 0))
     ((:foreign :foreign-dataref)
-     (let ((disp (* value alien-linkage-table-entry-size)))
-       (setf value
-            (ecase kind
-              (:abs32
-               #+immobile-space disp
-               #-immobile-space
-               (let ((nil-based-disp
-                      (- disp (+ sb-vm::nil-value-offset sb-vm:alien-linkage-space-size))))
-                 (if (eql addend sb-vm::+nil-indirect+) (+ nil-based-disp 8) nil-based-disp)))
-              (:rel32 ; subkind is meaningless - this is a PC-relative fixup.
-               ;; must be ASM codeblob if #-immobile-space
-               (sb-vm::alien-linkage-index-to-addr value)))
-            addend 0))))
+     ;; VALUE is an _index_ into the linkage table (unlike for other achitectures where it
+     ;; is an address) and ADDEND is a boolean flag. This unique convention in contrast
+     ;; to the other architectures supports relocatable alien linkage space.
+     (setf value
+           (let ((datap (eq flavor :foreign-dataref)))
+             (ecase kind
+               (:abs32
+                ;; If immobile-space exists, :ABS32 foreign fixups occur only from dynamic-space
+                ;; because otherwise a PC-relative fixup is better. In movable code, the table's
+                ;; base address is loaded into RBX so that fixup amount is only the displacement.
+                #+immobile-space (sb-vm::alien-linkage-element-offset value datap)
+                ;; Without immobile space the alien linkage table is acessed based off NIL. The
+                ;; usual call is "LEA RBX, [NIL-disp] ; CALL RBX" where the value in RBX conveys
+                ;; the alien name if undefined.  "CALL [NIL-disp]" also works, skipping an extra
+                ;; JMP, however it can only be used for calls to the C runtime which are always
+                ;; defined. This mode is indicated with ADDEND = +NIL-INDIRECT+.
+                #-immobile-space
+                (let ((datap (or datap (= addend sb-vm::+nil-indirect+))))
+                  (- (sb-vm::alien-linkage-index-to-addr value datap) sb-vm:nil-value)))
+             (:rel32 ; PC-relative
+              ;; Without #+immobile-space, the :REL32 kind is rare- it occurs only when
+              ;; calling from Lisp asm routines to the C runtime.
+              (sb-vm::alien-linkage-index-to-addr value datap))))
+           addend 0)))
   ;; Preprocess the value based on FLAVOR and the implicit addend at the
   ;; fixup location.  The addend will be zero for most <KIND,FLAVOR> pairs.
   (setq value
diff --git a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp
index 84b522236..89f6e2cb6 100644
--- a/src/compiler/x86-64/target-insts.lisp
+++ b/src/compiler/x86-64/target-insts.lisp
@@ -517,8 +517,7 @@
                (return-from print-mem-ref))
               ((<= alien-start disp (1- alien-end))
                (let ((name (sb-impl::alien-linkage-index-to-name
-                            (floor (- disp alien-start)
-                                   sb-vm:alien-linkage-table-entry-size))))
+                            (sb-vm::alien-linkage-index-from-addr (+ disp sb-vm:nil-value)))))
                  (note (lambda (s) (format s "&~A" name)) dstate))
                (return-from print-mem-ref)))))
 
@@ -531,7 +530,8 @@
                (not (machine-ea-index value))
                (integerp (machine-ea-disp value)))
       (let ((name (sb-impl::alien-linkage-index-to-name
-                   (floor (machine-ea-disp value) sb-vm:alien-linkage-table-entry-size))))
+                   (sb-vm::alien-linkage-index-from-addr
+                    (+ (machine-ea-disp value) sb-vm:alien-linkage-space-start)))))
         (note (lambda (s) (format s "&~A" name)) dstate)))
     (setf (sb-disassem::dstate-known-register-contents dstate) nil)
 
@@ -559,7 +559,8 @@
               (aver (= (reg-num (regrm-inst-reg dchunk-zero dstate)) sb-vm::rbx-offset))
               (let* ((disp (ldb (byte 32 8) (sb-disassem::dstate-previous-chunk dstate)))
                      (name (sb-impl::alien-linkage-index-to-name
-                            (floor disp sb-vm:alien-linkage-table-entry-size))))
+                            (sb-vm::alien-linkage-index-from-addr
+                             (+ disp sb-vm:alien-linkage-space-start)))))
                 (setf (sb-disassem::dstate-known-register-contents dstate) (cons 'alien name))))
             (return-from print-mem-ref
               (note (lambda (s) (princ sym s)) dstate))))))
diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c
index 28fd6a723..9aac5f1bd 100644
--- a/src/runtime/x86-64-arch.c
+++ b/src/runtime/x86-64-arch.c
@@ -552,16 +552,21 @@ arch_install_interrupt_handlers()
 void
 arch_write_linkage_table_entry(int index, void *target_addr, int datap)
 {
-    char *reloc_addr = (char*)ALIEN_LINKAGE_SPACE_START + index * ALIEN_LINKAGE_TABLE_ENTRY_SIZE;
+    const unsigned int entries_per_group = 16;
+    unsigned int major_index = (unsigned int)index / entries_per_group;
+    unsigned int minor_index = (unsigned int)index % entries_per_group;
+    char* group_base = (major_index * entries_per_group * ALIEN_LINKAGE_TABLE_ENTRY_SIZE)
+                       + (char*)ALIEN_LINKAGE_SPACE_START;
+    char* data = group_base + minor_index*8;
+    *(uword_t*)data = (uword_t)target_addr;
+    int inst_offset = entries_per_group*N_WORD_BYTES + minor_index*8;
+    char *inst = inst_offset + group_base;
     if (datap) {
-        *(uword_t *)reloc_addr = (uword_t)target_addr;
-        return;
+        *(uword_t*)inst = (uword_t)0x0000000000841F0F; // 8-byte NOP
+    } else {
+        *(uword_t*)inst = (uword_t)0x90660000000025FF; // JMP [RIP+disp] + 2-byte NOP
+        UNALIGNED_STORE32((inst+2), (char*)data - (inst+6)); // inst length is 6
     }
-    reloc_addr[0] = 0xFF; /* Opcode for near jump to absolute reg/mem64. */
-    reloc_addr[1] = 0x25; /* ModRM #b00 100 101, i.e. RIP-relative. */
-    UNALIGNED_STORE32((reloc_addr+2), 2); /* 32-bit displacement field = 2 */
-    reloc_addr[6] = 0x66; reloc_addr[7] = 0x90; /* 2-byte NOP */
-    *(void**)(reloc_addr+8) = target_addr;
 }
 
 /* These setup and check *both* the sse2 and x87 FPUs. While lisp code
diff --git a/tools-for-build/elftool.lisp b/tools-for-build/elftool.lisp
index 2110ce4f8..c0a564e4d 100644
--- a/tools-for-build/elftool.lisp
+++ b/tools-for-build/elftool.lisp
@@ -205,7 +205,11 @@
 (defun c-linkage-sym-from-addr (addr core)
   ;; assumption: alien-linkage-table-growth-direction is :UP for the platform
   (let* ((alien-ls-start (- (bounds-high (core-linkage-bounds core)) alien-linkage-space-size))
-         (entry-index (/ (- addr alien-ls-start) (core-alien-linkage-entry-size core))))
+         (entry-index
+          (sb-vm::alien-linkage-index-from-addr
+           ;; The host's LINKAGE-SPACE-START is allowed to differ from the address
+           ;; implied by the core, but the index-from-addr logic can be reused.
+           (+ sb-vm:alien-linkage-space-start (- addr alien-ls-start)))))
     (setf (bit (core-alien-linkage-symbol-usedp core) entry-index) 1)
     (let ((symbol (aref (core-alien-linkage-symbols core) entry-index)))
       (if (listp symbol)
@@ -1518,7 +1522,9 @@ lisp_fun_linkage_space: .zero ~:*~D
     (dolist (x *c-linkage-redirects*)
       (let* ((index (position (cdr x) (core-alien-linkage-symbols core)
                               :test (lambda (a b) (and (stringp b) (string= a b)))))
-             (addr (+ alien-ls-start (* (core-alien-linkage-entry-size core) index))))
+             (addr (+ alien-ls-start
+                      (sb-vm::alien-linkage-index-to-addr index)
+                      (- sb-vm:alien-linkage-space-start))))
         (rplaca x addr)))
     (with-pinned-objects (inst-buffer)
       (do ((sap (vector-sap inst-buffer))

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


hooks/post-receive
-- 
SBCL
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.