mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
x86-64: tweak #+mark-region-gc for presumptive static space relocation
The main problem presented by #+mark-region-gc (or #-immobile-space) is use of of hardwired addresses for linkage tables, both lisp and alien calling. This patch remedies that by referencing linkage entries off NULL-TN. Some immobile-space hacks are removed from the machine-independent pieces of coreparse and instead done in a *-arch.c file which has a new function named coreparse_alloc_space() that is intended to be customized as needed. The basic implementation remains in coreparse for other architectures. This change still does not actually allow relocating static space, and in fact takes a step backwards by disabling the elf-sans-immobile test until I finish relocatability. However in triaging the current state, I discovered a more urgent concern: as static space is of variable size based on dynamic-space and hence the GC card table size, and not made by allocate_hardwired_spaces(), is it _less_ likely that the OS will place it as requested. So that becomes the most important issue to resolve at the moment.
This commit is contained in:
Douglas Katzman
parent
2a2879e1ce
commit
b219fb32f5
|
|
@ -13,10 +13,7 @@
|
|||
|
||||
#-sb-assembling ; avoid redefinition warning
|
||||
(macrolet ((static-fun-addr (name)
|
||||
#-immobile-code
|
||||
`(progn
|
||||
(inst mov rax-tn (thread-slot-ea sb-vm::thread-linkage-table-slot))
|
||||
(ea (make-fixup ,name :linkage-cell) rax-tn))
|
||||
#-immobile-code `(ea (make-fixup ,name :linkage-cell) null-tn)
|
||||
;; Caution: this looks like it jumps to the linkage cell's address,
|
||||
;; and that is indeed what it would do if it were not for the fact that
|
||||
;; genesis recognizes that this isn't right, and instead does what you mean.
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@
|
|||
|
||||
(define-alien-variable ("TEXT_SPACE_START" sb-vm:text-space-start) sb-kernel::os-vm-size-t)
|
||||
|
||||
#+immobile-space
|
||||
#+(or x86-64 immobile-space)
|
||||
(define-symbol-macro sb-vm:alien-linkage-space-start
|
||||
(extern-alien "ALIEN_LINKAGE_SPACE_START" unsigned))
|
||||
|
||||
|
|
|
|||
|
|
@ -2380,12 +2380,15 @@ Legal values for OFFSET are -4, -8, -12, ..."
|
|||
(sb-vm:fixup-code-object code-object after-header value kind flavor)
|
||||
code-object)
|
||||
|
||||
(defun alien-linkage-table-note-symbol (symbol-name datap)
|
||||
"Register a symbol and return its address in proto-linkage-table."
|
||||
(sb-vm::alien-linkage-table-entry-address
|
||||
(ensure-gethash (if datap (list symbol-name) symbol-name)
|
||||
*cold-foreign-symbol-table*
|
||||
(hash-table-count *cold-foreign-symbol-table*))))
|
||||
(defun alien-linkage-table-note-symbol (symbol-name datap &optional (mode :address))
|
||||
"Register a symbol and return its address or index in proto-linkage-table."
|
||||
(let ((index
|
||||
(ensure-gethash (if datap (list symbol-name) symbol-name)
|
||||
*cold-foreign-symbol-table*
|
||||
(hash-table-count *cold-foreign-symbol-table*))))
|
||||
(case mode
|
||||
(:address (sb-vm::alien-linkage-table-entry-address index))
|
||||
(:index index))))
|
||||
|
||||
(defun foreign-symbols-to-core ()
|
||||
(flet ((to-core (list transducer target-symbol)
|
||||
|
|
@ -2993,6 +2996,10 @@ Legal values for OFFSET are -4, -8, -12, ..."
|
|||
(:assembly-routine (lookup-assembler-reference name))
|
||||
(:foreign (alien-linkage-table-note-symbol string nil))
|
||||
(:foreign-dataref (alien-linkage-table-note-symbol string t))
|
||||
(:alien-code-linkage-index
|
||||
(alien-linkage-table-note-symbol string nil :index))
|
||||
(:alien-data-linkage-index
|
||||
(alien-linkage-table-note-symbol string t :index))
|
||||
(:code-object (descriptor-bits code-obj))
|
||||
#+sb-thread ; ENSURE-SYMBOL-TLS-INDEX isn't defined otherwise
|
||||
(:symbol-tls-index (ensure-symbol-tls-index name))
|
||||
|
|
|
|||
|
|
@ -82,7 +82,9 @@
|
|||
((spaces (append `((read-only ,ro-space-size)
|
||||
#+(and win32 x86-64)
|
||||
(seh-data ,(symbol-value '+backend-page-bytes+) win64-seh-data-addr)
|
||||
#-immobile-space (alien-linkage ,alien-linkage-space-size)
|
||||
;; #+immobile-space implies a relocatable alien linkage space. And x86-64 always
|
||||
;; has relocatable linkage tables
|
||||
#-(or x86-64 immobile-space) (alien-linkage ,alien-linkage-space-size)
|
||||
;; safepoint on 64-bit uses a relocatable trap page just below the card mark
|
||||
;; table, which works nicely assuming a register is wired to the card table
|
||||
#+(and sb-safepoint (not x86-64))
|
||||
|
|
|
|||
|
|
@ -255,8 +255,8 @@
|
|||
(:result-types system-area-pointer)
|
||||
(:vop-var vop)
|
||||
(:generator 2
|
||||
#-immobile-space ; non-relocatable alien linkage table
|
||||
(inst mov res (ea (make-fixup foreign-symbol :foreign-dataref)))
|
||||
#-immobile-space
|
||||
(inst mov res (ea (make-fixup foreign-symbol :alien-data-linkage-index) null-tn))
|
||||
#+immobile-space ; relocatable alien linkage table
|
||||
(cond ((code-immobile-p vop)
|
||||
(inst mov res (rip-relative-ea (make-fixup foreign-symbol :foreign-dataref))))
|
||||
|
|
@ -326,11 +326,11 @@
|
|||
(:temporary (:sc unsigned-reg :offset r15-offset :from :eval :to :result) r15)
|
||||
#+win32
|
||||
(:ignore r15)
|
||||
#+win32
|
||||
(:temporary (:sc unsigned-reg :offset rbx-offset :from :eval :to :result) rbx)
|
||||
(:ignore results)
|
||||
(:vop-var vop)
|
||||
(:generator 0
|
||||
(progn rbx)
|
||||
(emit-c-call vop rax c-symbol args varargsp
|
||||
#+sb-safepoint pc-save
|
||||
#+win32 rbx))
|
||||
|
|
@ -392,7 +392,9 @@
|
|||
(pseudo-atomic (:elide-if (not (call-out-pseudo-atomic-p vop)))
|
||||
(inst call (if (tn-p fun)
|
||||
fun
|
||||
#-immobile-space (ea (make-fixup fun :foreign 8))
|
||||
#-immobile-space
|
||||
(progn (inst lea rbx-tn (ea (make-fixup fun :alien-code-linkage-index) null-tn))
|
||||
rbx-tn)
|
||||
#+immobile-space
|
||||
(cond ((code-immobile-p vop) (make-fixup fun :foreign))
|
||||
(t
|
||||
|
|
|
|||
|
|
@ -51,6 +51,8 @@
|
|||
:linkage-cell))))
|
||||
|
||||
(defun compute-linkage-cell (node name res)
|
||||
#-immobile-space (inst lea res (ea (linkage-cell-fixup name node) null-tn))
|
||||
#+immobile-space ; this is ironically worse than #-immobile-space
|
||||
(cond ((code-immobile-p node)
|
||||
(inst lea res (rip-relative-ea (linkage-cell-fixup name node))))
|
||||
(t
|
||||
|
|
@ -901,6 +903,9 @@
|
|||
(inst* instruction (ea rax-tn)))
|
||||
((code-immobile-p node)
|
||||
(inst* instruction (rip-relative-ea (linkage-cell-fixup name node))))
|
||||
#-immobile-space
|
||||
(t (inst* instruction (ea (linkage-cell-fixup name node) null-tn)))
|
||||
#+immobile-space ; again, this should not be worse than #-immobile-space, but it is
|
||||
(t
|
||||
;; get the linkage table base into RAX
|
||||
(inst mov rax-tn (thread-slot-ea sb-vm::thread-linkage-table-slot))
|
||||
|
|
|
|||
|
|
@ -3401,13 +3401,28 @@
|
|||
(1- (ash 1 value)))
|
||||
(:linkage-cell
|
||||
(let ((index (ash value word-shift)))
|
||||
#-immobile-space
|
||||
(ecase kind
|
||||
#+immobile-space (:rel32 (+ sb-vm::lisp-linkage-space-addr index))
|
||||
(:abs32 ; implicitly has a base reg of NULL-TN
|
||||
(let ((lt (+ (- sb-vm::alien-linkage-space-size)
|
||||
(- (ash 1 (+ sb-vm::n-linkage-index-bits sb-vm:word-shift)))
|
||||
(- sb-vm::nil-value-offset))))
|
||||
(setf (signed-sap-ref-32 sap offset) (+ lt index)))
|
||||
(return-from fixup-code-object)))
|
||||
#+immobile-space
|
||||
(ecase kind
|
||||
(:rel32 (+ sb-vm::lisp-linkage-space-addr index))
|
||||
(:abs32 index))))
|
||||
(:assembly-routine
|
||||
(if (eq kind :*abs32) (sb-vm::asm-routine-indirect-address value) value))
|
||||
((:alien-code-linkage-index :alien-data-linkage-index)
|
||||
(* value alien-linkage-table-entry-size))
|
||||
#-immobile-space ; implicitly has a base reg of NULL-TN
|
||||
(let ((lt (+ (- sb-vm::alien-linkage-space-size)
|
||||
(- sb-vm::nil-value-offset)))
|
||||
(index (* value alien-linkage-table-entry-size)))
|
||||
(setf (signed-sap-ref-32 sap offset) (+ lt index))
|
||||
(return-from fixup-code-object))
|
||||
#+immobile-space (* value alien-linkage-table-entry-size))
|
||||
(:layout-id ; layout IDs are signed quantities on x86-64
|
||||
(setf (signed-sap-ref-32 sap offset) value)
|
||||
(return-from fixup-code-object))
|
||||
|
|
|
|||
|
|
@ -75,16 +75,15 @@
|
|||
|
||||
;;;; description of the target address space
|
||||
|
||||
;;; Static space:
|
||||
;;;
|
||||
;;; start |<- 4k ->|
|
||||
;;; +----------------------|-------+---------+-----+--------+-
|
||||
;;; | | asm | other | | |
|
||||
;;; | other | code | popular | NIL | Safept | GC card
|
||||
;;; | static | jmp | consts | | Trap | table
|
||||
;;; | data | table | | | Page |
|
||||
;;; +----------------------*-------+---------+-----+--------+-
|
||||
;;; ^ freeptr end ^
|
||||
;;; Linkage |
|
||||
;;; Spaces | Static Space
|
||||
;;; +--------------+----------------------|-------+---------+-----+--------+-
|
||||
;;; | | | | asm | other | | |
|
||||
;;; | Lisp | Alien | other | code | popular | NIL | Safept | GC card
|
||||
;;; | | | static | jmp | consts | | Trap | table
|
||||
;;; | 4 MB | 1 MB | data | table | | | Page |
|
||||
;;; +--------------+----------------------*-------+---------+-----+--------+-
|
||||
;;; ^ freeptr end ^
|
||||
|
||||
;;; R12 (GC-card-table-reg) = NIL
|
||||
;;; R12 + 64 - lowtag_of(NIL) = GC cards
|
||||
|
|
@ -136,16 +135,11 @@
|
|||
(defconstant alien-linkage-table-growth-direction :up)
|
||||
(defconstant alien-linkage-table-entry-size 16)
|
||||
|
||||
#+(and sb-xc-host (not immobile-space))
|
||||
(defparameter lisp-linkage-space-addr #x1500000000) ; arbitrary
|
||||
#+(and sb-xc-host immobile-space)
|
||||
(progn
|
||||
(defparameter lisp-linkage-space-addr
|
||||
;; text space:
|
||||
;; | ALIEN LINKAGE | LISP LINKAGE | CODE OBJECTS ...
|
||||
;; |<------------->|<------------>| ....
|
||||
(- text-space-start (* (ash 1 n-linkage-index-bits) 8)))
|
||||
(defparameter alien-linkage-space-start (- lisp-linkage-space-addr alien-linkage-space-size)))
|
||||
#+sb-xc-host
|
||||
(progn (defparameter alien-linkage-space-start
|
||||
(- (or #+immobile-space text-space-start static-space-start) alien-linkage-space-size))
|
||||
(defparameter lisp-linkage-space-addr
|
||||
(- alien-linkage-space-start (* 8 (ash 1 n-linkage-index-bits)))))
|
||||
|
||||
(defenum (:start 8)
|
||||
halt-trap
|
||||
|
|
|
|||
|
|
@ -498,6 +498,26 @@
|
|||
(:qword (unboxed-constant-ref dstate addr disp))))
|
||||
dstate))))))
|
||||
|
||||
;; Recognize [R12-disp] as a linkage table use (lisp or alien)
|
||||
#-immobile-space
|
||||
(when (and (eq (machine-ea-base value) sb-vm::card-table-reg)
|
||||
(not (machine-ea-index value))
|
||||
(minusp (machine-ea-disp value)))
|
||||
(let* ((alien-end (- sb-vm::nil-value-offset))
|
||||
(alien-start (- alien-end sb-vm:alien-linkage-space-size))
|
||||
(lisp-start (- alien-start (ash 1 (+ sb-vm:n-linkage-index-bits 3))))
|
||||
(disp (machine-ea-disp value)))
|
||||
(cond ((<= lisp-start disp (1- alien-start))
|
||||
(let ((name (linkage-addr->name (- disp lisp-start) :rel)))
|
||||
(note (lambda (s) (format s "~S" name)) dstate))
|
||||
(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))))
|
||||
(note (lambda (s) (format s "&~A" name)) dstate))
|
||||
(return-from print-mem-ref)))))
|
||||
|
||||
;; Recognize "[Rbase+disp]" as an alien linkage table reference if Rbase was
|
||||
;; just loaded with the base address in the prior instruction.
|
||||
(when (and (eql (machine-ea-base value)
|
||||
|
|
|
|||
|
|
@ -327,3 +327,36 @@ void gcbarrier_patch_code(void* where, int nbits)
|
|||
unsigned int mask = ~0x0000FC00; // 6 bits at position 10
|
||||
*pc = (*pc & mask) | ((GENCGC_CARD_SHIFT + nbits - 1) << 10);
|
||||
}
|
||||
|
||||
os_vm_address_t coreparse_alloc_space(int space_id, int attr,
|
||||
os_vm_address_t addr, os_vm_size_t size)
|
||||
{
|
||||
__attribute__((unused)) int extra_request = 0;
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) {
|
||||
extra_request = ALIEN_LINKAGE_SPACE_SIZE;
|
||||
size += extra_request;
|
||||
addr -= extra_request; // try to put text space start where expected
|
||||
}
|
||||
#endif
|
||||
if (size == 0) return addr;
|
||||
|
||||
#ifdef LISP_FEATURE_SB_SAFEPOINT
|
||||
if (space_id == STATIC_CORE_SPACE_ID) {
|
||||
// Allocate space for the safepoint page.
|
||||
addr = os_alloc_gc_space(space_id, attr, addr - BACKEND_PAGE_BYTES, size + BACKEND_PAGE_BYTES) + BACKEND_PAGE_BYTES;
|
||||
}
|
||||
else
|
||||
#endif
|
||||
addr = os_alloc_gc_space(space_id, attr, addr, size);
|
||||
|
||||
if (!addr) lose("Can't allocate %#"OBJ_FMTX" bytes for space %d", size, space_id);
|
||||
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) {
|
||||
ALIEN_LINKAGE_SPACE_START = (uword_t)addr;
|
||||
addr += extra_request;
|
||||
}
|
||||
#endif
|
||||
return addr;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -678,36 +678,16 @@ void calc_immobile_space_bounds()
|
|||
}
|
||||
#endif
|
||||
|
||||
#ifdef LISP_FEATURE_LINKAGE_SPACE
|
||||
#define LISP_LINKAGE_SPACE_SIZE (1<<(N_LINKAGE_INDEX_BITS+WORD_SHIFT))
|
||||
#endif
|
||||
|
||||
#if defined LISP_FEATURE_IMMOBILE_SPACE && defined LISP_FEATURE_ARM64
|
||||
#define LISP_LINKAGE_SPACE_SIZE 0
|
||||
#endif
|
||||
static os_vm_address_t reserve_space(int space_id, int attr,
|
||||
os_vm_address_t addr, os_vm_size_t size)
|
||||
#if defined LISP_FEATURE_X86_64 || defined LISP_FEATURE_ARM64
|
||||
extern
|
||||
os_vm_address_t coreparse_alloc_space(int space_id, int attr,
|
||||
os_vm_address_t addr, os_vm_size_t size);
|
||||
#else
|
||||
static os_vm_address_t coreparse_alloc_space(int space_id, int attr,
|
||||
os_vm_address_t addr, os_vm_size_t size)
|
||||
{
|
||||
#ifndef LISP_FEATURE_RELOCATABLE_STATIC_SPACE
|
||||
/* temporary hack: spaces allocated by coreparse are assumed to be movable.
|
||||
* immovable static space ought to have been reserved by allocate_hardwired_spaces()
|
||||
* but it can't have been, because the allocation request must take into account the
|
||||
* size of the GC card table, which isn't known until parsing the core.
|
||||
* So this request has to be changed to not movable so that it fails if not
|
||||
* placed as required */
|
||||
if (space_id == STATIC_CORE_SPACE_ID) attr &= ~MOVABLE;
|
||||
#endif
|
||||
__attribute__((unused)) int extra_request = 0;
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) {
|
||||
extra_request = ALIEN_LINKAGE_SPACE_SIZE + LISP_LINKAGE_SPACE_SIZE;
|
||||
size += extra_request;
|
||||
addr -= extra_request; // compensate to try to put text space start where expected
|
||||
}
|
||||
#endif
|
||||
if (size == 0) return addr;
|
||||
// 64-bit already allocated a trap page when the GC card mark table was made
|
||||
#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_X86_64)
|
||||
#ifdef LISP_FEATURE_SB_SAFEPOINT // this is only for 32-bit x86, I think
|
||||
if (space_id == STATIC_CORE_SPACE_ID) {
|
||||
// Allocate space for the safepoint page.
|
||||
addr = os_alloc_gc_space(space_id, attr, addr - BACKEND_PAGE_BYTES, size + BACKEND_PAGE_BYTES) + BACKEND_PAGE_BYTES;
|
||||
|
|
@ -716,15 +696,9 @@ static os_vm_address_t reserve_space(int space_id, int attr,
|
|||
#endif
|
||||
addr = os_alloc_gc_space(space_id, attr, addr, size);
|
||||
if (!addr) lose("Can't allocate %#"OBJ_FMTX" bytes for space %d", size, space_id);
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) {
|
||||
ALIEN_LINKAGE_SPACE_START = (uword_t)addr;
|
||||
linkage_space = (void*)((char*)addr + ALIEN_LINKAGE_SPACE_SIZE);
|
||||
addr += extra_request;
|
||||
}
|
||||
#endif
|
||||
return addr;
|
||||
}
|
||||
#endif
|
||||
|
||||
static __attribute__((unused)) uword_t corespace_checksum(uword_t* base, int nwords)
|
||||
{
|
||||
|
|
@ -772,13 +746,6 @@ process_directory(int count, struct ndir_entry *entry,
|
|||
#endif
|
||||
// unprotect the pages
|
||||
os_protect((void*)TEXT_SPACE_START, text_space_size, OS_VM_PROT_ALL);
|
||||
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
// ELF core without immobile space has alien linkage space below static space.
|
||||
ALIEN_LINKAGE_SPACE_START =
|
||||
(uword_t)os_alloc_gc_space(ALIEN_LINKAGE_TABLE_CORE_SPACE_ID, 0, 0,
|
||||
ALIEN_LINKAGE_SPACE_SIZE);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
@ -833,8 +800,8 @@ process_directory(int count, struct ndir_entry *entry,
|
|||
#ifdef LISP_FEATURE_ASLR
|
||||
addr = 0;
|
||||
#endif
|
||||
addr = (uword_t)reserve_space(id, sub_2gb_flag ? MOVABLE_LOW : MOVABLE,
|
||||
(os_vm_address_t)addr, request);
|
||||
addr = (uword_t)coreparse_alloc_space(id, sub_2gb_flag ? MOVABLE_LOW : MOVABLE,
|
||||
(os_vm_address_t)addr, request);
|
||||
switch (id) {
|
||||
case PERMGEN_CORE_SPACE_ID:
|
||||
PERMGEN_SPACE_START = addr;
|
||||
|
|
@ -925,9 +892,6 @@ process_directory(int count, struct ndir_entry *entry,
|
|||
|
||||
#ifdef LISP_FEATURE_LINKAGE_SPACE
|
||||
if (linkage_table_count) {
|
||||
// Only #-immobile-space should allocate linkage space now,
|
||||
// because otherwise it must be contiguous with text space.
|
||||
if (linkage_space == 0) linkage_space = (void*)os_allocate(LISP_LINKAGE_SPACE_SIZE);
|
||||
off_t filepos = file_offset + (1 + linkage_table_data_page) * os_vm_page_size;
|
||||
gc_assert(os_reported_page_size);
|
||||
// Linkage space is only 8-byte-aligned in an ELF core. It doesn't need more than that.
|
||||
|
|
@ -1497,13 +1461,6 @@ load_core_file(char *file, os_vm_offset_t file_offset, int merge_core_pages)
|
|||
if (stringlen != (sizeof build_id-1) || memcmp(ptr, build_id, stringlen))
|
||||
lose("core was built for runtime \"%.*s\" but this is \"%s\"",
|
||||
(int)stringlen, (char*)ptr, build_id);
|
||||
#ifdef LISP_FEATURE_X86_64
|
||||
spaces[STATIC_CORE_SPACE_ID].desired_size +=
|
||||
# ifdef LISP_FEATURE_SB_SAFEPOINT
|
||||
BACKEND_PAGE_BYTES + /* ridiculously oversized */
|
||||
# endif
|
||||
ALIGN_UP((1+gc_card_table_mask), os_reported_page_size);
|
||||
#endif
|
||||
break;
|
||||
case STATIC_CONSTANTS_CORE_ENTRY_TYPE_CODE: {
|
||||
int nwords = remaining_len;
|
||||
|
|
|
|||
|
|
@ -58,9 +58,11 @@ lispobj *static_space_trailer_start;
|
|||
lispobj *static_code_space_free_pointer;
|
||||
#endif
|
||||
|
||||
#if defined LISP_FEATURE_X86_64 || defined LISP_FEATURE_IMMOBILE_SPACE
|
||||
lispobj ALIEN_LINKAGE_SPACE_START;
|
||||
#endif
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
lispobj *fixedobj_free_pointer;
|
||||
lispobj ALIEN_LINKAGE_SPACE_START;
|
||||
#endif
|
||||
os_vm_address_t anon_dynamic_space_start;
|
||||
// The end of immobile text mapped from disk, equivalently the starting address
|
||||
|
|
|
|||
|
|
@ -110,9 +110,11 @@ extern lispobj *static_code_space_free_pointer;
|
|||
#endif
|
||||
|
||||
extern lispobj *text_space_highwatermark;
|
||||
#if defined LISP_FEATURE_X86_64 || defined LISP_FEATURE_IMMOBILE_SPACE
|
||||
extern lispobj ALIEN_LINKAGE_SPACE_START;
|
||||
#endif
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
extern lispobj *fixedobj_free_pointer;
|
||||
extern lispobj ALIEN_LINKAGE_SPACE_START;
|
||||
#endif
|
||||
#define FIRST_USABLE_LINKAGE_ELT 1
|
||||
extern lispobj *linkage_space;
|
||||
|
|
|
|||
|
|
@ -92,11 +92,12 @@ bool allocate_hardwired_spaces(bool hard_failp)
|
|||
unsigned size;
|
||||
int id;
|
||||
} preinit_spaces[] = {
|
||||
#ifndef LISP_FEATURE_X86_64
|
||||
// For x86-64, static space allocation request depends on dynamic space size,
|
||||
// and linkage spaces (alien + lisp) are either placed at the start of
|
||||
// text space if it exists, or below static space otherwise.
|
||||
{ READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE, READ_ONLY_CORE_SPACE_ID },
|
||||
#ifndef LISP_FEATURE_IMMOBILE_SPACE
|
||||
{ ALIEN_LINKAGE_SPACE_START, ALIEN_LINKAGE_SPACE_SIZE, ALIEN_LINKAGE_TABLE_CORE_SPACE_ID },
|
||||
#endif
|
||||
#ifndef LISP_FEATURE_X86_64 // x86-64 static space allocation request depends on dynamic space size
|
||||
{ STATIC_SPACE_START, STATIC_SPACE_SIZE, STATIC_CORE_SPACE_ID },
|
||||
#endif
|
||||
#ifdef LISP_FEATURE_DARWIN_JIT
|
||||
|
|
|
|||
|
|
@ -37,6 +37,9 @@
|
|||
#endif
|
||||
|
||||
#define ALIEN_LINKAGE_SPACE_END (ALIEN_LINKAGE_SPACE_START + ALIEN_LINKAGE_SPACE_SIZE)
|
||||
#ifdef LISP_FEATURE_LINKAGE_SPACE
|
||||
#define LISP_LINKAGE_SPACE_SIZE (1<<(N_LINKAGE_INDEX_BITS+WORD_SHIFT))
|
||||
#endif
|
||||
|
||||
#if !defined(__ASSEMBLER__)
|
||||
#include <stdbool.h>
|
||||
|
|
|
|||
|
|
@ -784,4 +784,85 @@ lispobj call_into_lisp_first_time(lispobj fun, lispobj *args, int nargs) {
|
|||
return call_into_lisp_first_time_(fun, args, nargs, get_sb_vm_thread());
|
||||
}
|
||||
|
||||
/*
|
||||
* On x86-64 we try to place the alien and lisp linkage tables in such a way
|
||||
* that avoids extra load instructions when calling, but also allows those tables
|
||||
* to be fully relocatable. It is best achieved by using PC-relative addressng,
|
||||
* which works only for immobile text space. Failing that, we can place the
|
||||
* linkage tables below NIL and use NIL-relative addressing.
|
||||
* The core file makes no indication of the "effective size" of static space
|
||||
* or text space, so we have to oversize them.
|
||||
* It's a little confusing, so here are the possibilities:
|
||||
*
|
||||
* Supports | extra allocation amount
|
||||
* Immobile | elfcode | text | static
|
||||
* ---------|-----------------------------|-------------------------------------
|
||||
* Yes | No | +AL +LL below | none
|
||||
* Yes | Yes | n/a | +AL below, +GC cards above
|
||||
* No | No | none | +AL+LL below, +GC cards above
|
||||
* No | Yes | n/a | +AL below, +GC cards above
|
||||
*
|
||||
* AL = alien linkage
|
||||
* LL = lisp linkage
|
||||
* n/a means the call does not occur for that space
|
||||
*
|
||||
* For #+immobile-space we want to end up with text space having both linkage subspaces
|
||||
* (unless code-in-ELF)
|
||||
* | LISP LINKAGE | ALIEN LINKAGE | CODE OBJECTS ...
|
||||
* |<------------>|<------------->| ....
|
||||
* For code-in-ELF then the lisp linkage space was preallocated to a .bss section,
|
||||
* so we only oversize the static space by the alien linkage space size.
|
||||
* If there is no text space (i.e. for #-immobile-space) then the linkage tables
|
||||
* are below static space.
|
||||
*/
|
||||
os_vm_address_t coreparse_alloc_space(int space_id, int attr,
|
||||
os_vm_address_t addr, os_vm_size_t size)
|
||||
{
|
||||
if (size == 0) return addr;
|
||||
|
||||
/* temporary hack: spaces allocated by coreparse are assumed to be movable.
|
||||
* immovable static space ought to have been reserved by allocate_hardwired_spaces()
|
||||
* but it can't have been, because the allocation request must take into account the
|
||||
* size of the GC card table, which isn't known until parsing the core.
|
||||
* So this request has to be changed to not movable so that it fails if not
|
||||
* placed as required */
|
||||
if (space_id == STATIC_CORE_SPACE_ID) attr &= ~MOVABLE;
|
||||
|
||||
int extra_below = 0, extra_above = 0;
|
||||
extern int lisp_code_in_elf();
|
||||
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
# define LINKAGE_TABLE_CONTAINER IMMOBILE_TEXT_CORE_SPACE_ID
|
||||
#else
|
||||
# define LINKAGE_TABLE_CONTAINER STATIC_CORE_SPACE_ID
|
||||
#endif
|
||||
if (!lisp_code_in_elf()) { // a normal core
|
||||
if (space_id == LINKAGE_TABLE_CONTAINER)
|
||||
extra_below = LISP_LINKAGE_SPACE_SIZE + ALIEN_LINKAGE_SPACE_SIZE;
|
||||
} else { // code-in-ELF core
|
||||
if (space_id == STATIC_CORE_SPACE_ID)
|
||||
extra_below = ALIEN_LINKAGE_SPACE_SIZE;
|
||||
}
|
||||
if (space_id == STATIC_CORE_SPACE_ID) {
|
||||
extra_above =
|
||||
# ifdef LISP_FEATURE_SB_SAFEPOINT // should just add 1 OS page but instead
|
||||
BACKEND_PAGE_BYTES + // it's a ridiculously generous bump up
|
||||
# endif
|
||||
ALIGN_UP((1+gc_card_table_mask), os_reported_page_size);
|
||||
}
|
||||
|
||||
addr -= extra_below; // endeavor to return the requested address as it was
|
||||
size += extra_below + extra_above;
|
||||
//fprintf(stderr, "requesting space for space_id %d, below=%x above=%x\n", space_id, extra_below, extra_above);
|
||||
addr = os_alloc_gc_space(space_id, attr, addr, size);
|
||||
if (!addr) lose("Can't allocate %#"OBJ_FMTX" bytes for space %d", size, space_id);
|
||||
|
||||
if (extra_below) { // it contains at least alien linkage if not also lisp linkage
|
||||
if (extra_below > ALIEN_LINKAGE_SPACE_SIZE) linkage_space = (void*)addr;
|
||||
addr += extra_below;
|
||||
ALIEN_LINKAGE_SPACE_START = (uword_t)addr - ALIEN_LINKAGE_SPACE_SIZE;
|
||||
}
|
||||
return addr;
|
||||
}
|
||||
|
||||
#include "x86-arch-shared.inc"
|
||||
|
|
|
|||
|
|
@ -16,10 +16,10 @@
|
|||
. ./subr.sh
|
||||
|
||||
run_sbcl <<EOF
|
||||
#+(and linux x86-64 sb-thread)
|
||||
(unless (member :immobile-space sb-impl:+internal-features+)
|
||||
(exit :code 0)) ; proceed with test
|
||||
(exit :code 2) ; otherwise skip the test
|
||||
;#+(and linux x86-64 sb-thread)
|
||||
;(unless (member :immobile-space sb-impl:+internal-features+)
|
||||
; (exit :code 0)) ; proceed with test
|
||||
(exit :code 2) ; otherwise skip the test
|
||||
EOF
|
||||
status=$?
|
||||
if [ $status != 0 ]; then # test can't be executed
|
||||
|
|
|
|||
|
|
@ -175,7 +175,7 @@
|
|||
(c-call (find "os_deallocate" lines :test #'search)))
|
||||
;; Depending on #+immobile-code it's either direct or memory indirect.
|
||||
#+immobile-code (assert (search "CALL #x" c-call))
|
||||
#-immobile-code (assert (search "CALL [#x" c-call))))
|
||||
#-immobile-code (assert (search "LEA RBX, [R12-" c-call))))
|
||||
|
||||
(with-test (:name :set-symbol-value-imm)
|
||||
(let (success)
|
||||
|
|
|
|||
|
|
@ -145,10 +145,14 @@
|
|||
;;; At execution time the function will have virtual address LOAD-ADDR.
|
||||
#+x86-64
|
||||
(defun list-textual-instructions (sap length core load-addr emit-cfi)
|
||||
(let ((insts (simple-collect-inst-model sap length load-addr))
|
||||
(alien-linkage-end
|
||||
(+ (bounds-low (core-linkage-bounds core)) alien-linkage-space-size))
|
||||
(result))
|
||||
(let* ((insts (simple-collect-inst-model sap length load-addr))
|
||||
(alien-linkage-bounds
|
||||
(make-bounds (- (bounds-high (core-linkage-bounds core)) alien-linkage-space-size)
|
||||
(bounds-high (core-linkage-bounds core))))
|
||||
(lisp-linkage-bounds
|
||||
(make-bounds (bounds-low (core-linkage-bounds core))
|
||||
(bounds-low alien-linkage-bounds)))
|
||||
(result))
|
||||
(flet ((pc-relative-ea-p (x)
|
||||
(when (consp x) (setq x (car x)))
|
||||
(and (typep x 'machine-ea) (eq (machine-ea-base x) :rip)))
|
||||
|
|
@ -167,40 +171,41 @@
|
|||
(pc-relative-ea-p ea))
|
||||
(cond ((and (integerp ea) (in-bounds-p ea (core-linkage-bounds core)))
|
||||
(aver (eq (cadr inst) 'sb-x86-64-asm::call))
|
||||
(aver (< ea alien-linkage-end)) ; CALL via alien linkage
|
||||
(aver (in-bounds-p ea alien-linkage-bounds)) ; CALL via alien linkage
|
||||
(aver (= inst-len 5))
|
||||
(push (list* (car inst) 5 :call ea) result))
|
||||
((pc-relative-ea-p ea)
|
||||
(let* ((next-pc (+ load-addr (caadr insts)))
|
||||
(ea (+ next-pc (ea-disp-of ea)))
|
||||
(table-offset (- ea alien-linkage-end)))
|
||||
(when (in-bounds-p ea (core-linkage-bounds core))
|
||||
(cond ((< ea alien-linkage-end) ; alien linkage
|
||||
(aver (= inst-len 7))
|
||||
(let ((op (ecase (cadr inst)
|
||||
(sb-x86-64-asm::mov :mov-gotpcrel)
|
||||
(sb-x86-64-asm::lea :lea)))
|
||||
(args (list ea (string-downcase (princ-to-string (third inst))))))
|
||||
(push (list* (car inst) 7 op args) result)))
|
||||
((eq (cadr inst) 'sb-x86-64-asm::lea)
|
||||
(table-offset (- ea (bounds-low lisp-linkage-bounds))))
|
||||
(cond ((in-bounds-p ea alien-linkage-bounds)
|
||||
(aver (= inst-len 7))
|
||||
(let ((op (ecase (cadr inst)
|
||||
(sb-x86-64-asm::mov :mov-gotpcrel)
|
||||
(sb-x86-64-asm::lea :lea)))
|
||||
(args (list ea (string-downcase (princ-to-string (third inst))))))
|
||||
(push (list* (car inst) 7 op args) result)))
|
||||
((and (in-bounds-p ea lisp-linkage-bounds)
|
||||
(eq (cadr inst) 'sb-x86-64-asm::lea))
|
||||
;; Get ADDRESS of lisp linkage cell in stepping-enabled code
|
||||
(aver (eq (third inst) (get-gpr :qword 0))) ; %rax
|
||||
(aver (= inst-len 7))
|
||||
(push (list* (car inst) 7 :lea (format nil "(fntbl+~d)(%rip),%rax"
|
||||
table-offset))
|
||||
result))
|
||||
(t ; lisp CALL or JMP
|
||||
(aver (= inst-len 6))
|
||||
(let ((new-inst
|
||||
(format nil "~a *(fntbl+~d)(%rip)"
|
||||
(string-downcase (cadr inst))
|
||||
table-offset)))
|
||||
(push (list* (car inst) 6 :lispcall new-inst) result))))))))))))
|
||||
(aver (eq (third inst) (get-gpr :qword 0))) ; %rax
|
||||
(aver (= inst-len 7))
|
||||
(push (list* (car inst) 7 :lea (format nil "(fntbl+~d)(%rip),%rax"
|
||||
table-offset))
|
||||
result))
|
||||
((in-bounds-p ea lisp-linkage-bounds) ; lisp CALL or JMP
|
||||
(aver (= inst-len 6))
|
||||
(let ((new-inst
|
||||
(format nil "~a *(fntbl+~d)(%rip)"
|
||||
(string-downcase (cadr inst))
|
||||
table-offset)))
|
||||
(push (list* (car inst) 6 :lispcall new-inst) result)))))))))))
|
||||
(nreverse result)))
|
||||
|
||||
(defun c-linkage-sym-from-addr (addr core)
|
||||
(let ((entry-index (/ (- addr (bounds-low (core-linkage-bounds core)))
|
||||
(core-alien-linkage-entry-size 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))))
|
||||
(setf (bit (core-alien-linkage-symbol-usedp core) entry-index) 1)
|
||||
(let ((symbol (aref (core-alien-linkage-symbols core) entry-index)))
|
||||
(if (listp symbol)
|
||||
|
|
@ -1516,12 +1521,11 @@ lisp_fun_linkage_space: .zero ~:*~D
|
|||
(%make-lisp-obj (logior (sap-int (sap+ (space-physaddr text-space spacemap)
|
||||
code-offsets-vector-size))
|
||||
other-pointer-lowtag)))
|
||||
(alien-ls-start
|
||||
(symbol-global-value
|
||||
(find-target-symbol (package-id "SB-VM") "ALIEN-LINKAGE-SPACE-START"
|
||||
spacemap)))
|
||||
(alien-ls-start (- (space-addr (or text-space static-space))
|
||||
alien-linkage-space-size))
|
||||
(alien-ls-end (1- (+ alien-ls-start alien-linkage-space-size))))
|
||||
(aver (<= (length *c-linkage-redirects*) (length c-linkage-vector)))
|
||||
;; (format t "~&alien linkage range = ~x .. ~x~%" alien-ls-start alien-ls-end)
|
||||
(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)))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue