From 711698b4eeee2d1f4e7cf99f30bf22965766560f Mon Sep 17 00:00:00 2001 From: Charles Zhang Date: Tue, 19 Oct 2021 10:40:17 -0700 Subject: [PATCH] x86-64: Allow static spaces in +4GB space. Still a bit buggy; GC invariant lost in some tests and I haven't tracked down a pointer truncation yet. Only builds without compact instance header, immobile code, and immobile space. --- src/assembly/x86-64/arith.lisp | 4 +- src/assembly/x86-64/assem-rtns.lisp | 6 +- src/assembly/x86-64/support.lisp | 4 +- src/compiler/dump.lisp | 4 +- src/compiler/generic/genesis.lisp | 2 + src/compiler/generic/target-core.lisp | 8 +- src/compiler/x86-64/alloc.lisp | 7 +- src/compiler/x86-64/c-call.lisp | 8 +- src/compiler/x86-64/call.lisp | 2 +- src/compiler/x86-64/cell.lisp | 5 +- src/compiler/x86-64/insts.lisp | 130 ++++++++++++++------------ src/compiler/x86-64/memory.lisp | 10 +- src/compiler/x86-64/parms.lisp | 2 +- src/runtime/x86-64-assem.S | 4 +- tests/call-into-lisp.impure.lisp | 3 +- 15 files changed, 113 insertions(+), 86 deletions(-) diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp index e77dbff57..c5a52b739 100644 --- a/src/assembly/x86-64/arith.lisp +++ b/src/assembly/x86-64/arith.lisp @@ -192,7 +192,7 @@ ,@(ecase test (:l `((inst mov y (1+ nil-value)) (inst cmp y x))) - (:g `((inst cmp x (1+ nil-value)))))))) + (:g `((inst cmp x (constantize (1+ nil-value))))))))) (define-cond-assem-rtn generic-< < two-arg-< :l) (define-cond-assem-rtn generic-> > two-arg-> :g)) @@ -215,7 +215,7 @@ DO-STATIC-FUN (call-static-fun 'two-arg-= 2) - (inst cmp x (+ nil-value (static-symbol-offset t)))) + (inst cmp x (constantize (+ nil-value (static-symbol-offset t))))) #+sb-assembling (define-assembly-routine (logcount) diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp index 42906031d..00c86f093 100644 --- a/src/assembly/x86-64/assem-rtns.lisp +++ b/src/assembly/x86-64/assem-rtns.lisp @@ -386,11 +386,13 @@ (defun ensure-thread-base-tn-loaded () #-sb-thread (progn - ;; Load THREAD-BASE-TN from the all_threads. Does not need to be spilled + ;; Load THREAD-TN from the all_threads. Does not need to be spilled ;; to stack, because we do do not give the register allocator access to it. ;; And call_into_lisp saves it as per convention, not that it matters, ;; because there's no way to get back into C code anyhow. - (inst mov thread-tn (ea (make-fixup "all_threads" :foreign-dataref))) + + (inst mov thread-tn (make-fixup "all_threads" :foreign-dataref)) + (inst mov thread-tn (ea thread-tn)) (inst mov thread-tn (ea thread-tn)))) ;;; Perform a store to code, updating the GC page (card) protection bits. diff --git a/src/assembly/x86-64/support.lisp b/src/assembly/x86-64/support.lisp index 61fc60f5d..b239ac91f 100644 --- a/src/assembly/x86-64/support.lisp +++ b/src/assembly/x86-64/support.lisp @@ -21,7 +21,7 @@ ;; emitting code into :ELSEWHERE when requesting a unique label. (assemble (:indirections) (emit-label label) - (inst jmp (ea (make-fixup name :assembly-routine*)))) + (inst jmp (ea (make-fixup name :asm-routine-nil-offset*) null-tn))) (push (cons name label) (sb-assem::asmstream-indirection-table asmstream)) label))) @@ -33,7 +33,7 @@ (uniquify (uniquify-fixup routine)) (t - (ea (make-fixup routine :assembly-routine*)))))) + (ea (make-fixup routine :asm-routine-nil-offset*) null-tn))))) (ecase inst (jmp (inst jmp fixup)) (call (inst call fixup))))) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index eb49e68d3..093d93122 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -1016,7 +1016,7 @@ (assert (<= (length +fixup-kinds+) 8))) ; fixup-kind fits in 3 bits (defconstant-eqx +fixup-flavors+ - #(:assembly-routine :assembly-routine* :asm-routine-nil-offset + #(:assembly-routine :assembly-routine* :asm-routine-nil-offset :asm-routine-nil-offset* :symbol-tls-index :foreign :foreign-dataref :code-object :layout :immobile-symbol :named-call :static-call @@ -1070,7 +1070,7 @@ (t name))))) (:layout-id (the wrapper name)) - ((:assembly-routine :assembly-routine* :asm-routine-nil-offset + ((:assembly-routine :assembly-routine* :asm-routine-nil-offset :asm-routine-nil-offset* :symbol-tls-index ;; Only #+immobile-space can use the following two flavors. ;; An :IMMOBILE-SYMBOL fixup references the symbol itself, diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 299c0841d..45bb249a8 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2747,6 +2747,8 @@ Legal values for OFFSET are -4, -8, -12, ..." (:assembly-routine* (lookup-assembler-reference sym :indirect)) (:asm-routine-nil-offset (- (lookup-assembler-reference sym) sb-vm:nil-value)) + (:asm-routine-nil-offset* + (- (lookup-assembler-reference sym :indirect) sb-vm:nil-value)) (:foreign (linkage-table-note-symbol (base-string-from-core sym) nil)) (:foreign-dataref diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index a71174a4e..45cb51fc3 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -82,10 +82,12 @@ (when (sb-vm:fixup-code-object code-obj offset (ecase flavor - ((:assembly-routine :assembly-routine* :asm-routine-nil-offset) - (- (or (get-asm-routine sym (eq flavor :assembly-routine*)) + ((:assembly-routine :assembly-routine* :asm-routine-nil-offset :asm-routine-nil-offset*) + (- (or (get-asm-routine sym (member flavor '(:assembly-routine* :asm-routine-nil-offset*))) (error "undefined assembler routine: ~S" sym)) - (if (eq flavor :asm-routine-nil-offset) sb-vm:nil-value 0))) + (if (member flavor '(:asm-routine-nil-offset :asm-routine-nil-offset*)) + sb-vm:nil-value + 0))) (:foreign (foreign-symbol-address sym)) (:foreign-dataref (foreign-symbol-address sym t)) (:code-object (get-lisp-obj-address code-obj)) diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp index d2bb8d7c6..ff916465f 100644 --- a/src/compiler/x86-64/alloc.lisp +++ b/src/compiler/x86-64/alloc.lisp @@ -168,7 +168,7 @@ ;; This jump is always encoded as 5 bytes (inst call (if (or (not node) ; assembly routine (sb-c::code-immobile-p node)) - (make-fixup helper :assembly-routine) + (ea (make-fixup helper :asm-routine-nil-offset*) null-tn) (uniquify-fixup helper)))) (inst nop) ;; Emit "TEST AL, imm" where the immediate value @@ -731,6 +731,7 @@ (:policy :fast-safe) (:translate make-fdefn) (:args (name :scs (descriptor-reg) :to :eval)) + (:temporary (:sc unsigned-reg) temp) (:results (result :scs (descriptor-reg) :from :argument)) #+gs-seg (:temporary (:sc unsigned-reg :offset 15) thread-tn) (:node-var node) @@ -738,8 +739,8 @@ (alloc-other fdefn-widetag fdefn-size result node nil thread-tn) (storew name result fdefn-name-slot other-pointer-lowtag) (storew null-tn result fdefn-fun-slot other-pointer-lowtag) - (storew (make-fixup 'undefined-tramp :assembly-routine) - result fdefn-raw-addr-slot other-pointer-lowtag))) + (inst mov temp (make-fixup 'undefined-tramp :assembly-routine)) + (storew temp result fdefn-raw-addr-slot other-pointer-lowtag))) (define-vop (make-closure) ; (:args (function :to :save :scs (descriptor-reg))) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index b7f84b49e..2b7e9f645 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -240,11 +240,13 @@ (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) + (:temporary (:sc unsigned-reg) temp) (:info foreign-symbol) (:results (res :scs (sap-reg))) (:result-types system-area-pointer) (:generator 2 - (inst mov res (ea (make-fixup foreign-symbol :foreign-dataref))))) + (inst mov temp (make-fixup foreign-symbol :foreign-dataref)) + (inst mov res (ea temp)))) #+sb-safepoint (defconstant thread-saved-csp-offset (- (1+ sb-vm::thread-header-slots))) @@ -369,7 +371,9 @@ #-win32 (inst call (cond ((tn-p fun) fun) ((sb-c::code-immobile-p vop) (make-fixup fun :foreign)) - (t (ea (make-fixup fun :foreign 8))))) + (t (inst mov null-tn (make-fixup fun :foreign 8)) + (ea null-tn)))) + (inst mov null-tn nil-value) ;; On win64, we don't support immobile space (yet) and calls go through one of ;; the thunks defined in set_up_win64_seh_data(). If the linkage table is ;; involved, RBX either points to a linkage table trampoline or to the linkage diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp index e25c2bc30..0112f2513 100644 --- a/src/compiler/x86-64/call.lisp +++ b/src/compiler/x86-64/call.lisp @@ -882,7 +882,7 @@ (%lea-for-lowtag-test rbx-tn fun fun-pointer-lowtag) (inst test :byte rbx-tn lowtag-mask) (inst jmp :nz (if relative-call - (make-fixup 'call-symbol :assembly-routine) + (ea (make-fixup 'call-symbol :asm-routine-nil-offset*) null-tn) not-fun)) (inst jmp fun-ea) not-fun diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index cf30f2b16..5f6d51b3a 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -491,6 +491,7 @@ (:policy :fast-safe) (:translate fdefn-makunbound) (:args (fdefn :scs (descriptor-reg))) + (:temporary (:sc unsigned-reg) temp) (:vop-var vop) (:generator 38 ;; Change the JMP instruction to INT3 so that a trap occurs in the fdefn @@ -506,8 +507,8 @@ ;; and resume at undefined-tramp. However, CALL-SYMBOL jumps via raw-addr if ;; its callable object was not a function. In that case RAX holds a symbol, ;; so we're OK because we can identify the undefined function. - (storew (make-fixup 'undefined-tramp :assembly-routine) - fdefn fdefn-raw-addr-slot other-pointer-lowtag))) + (inst mov temp (make-fixup 'undefined-tramp :assembly-routine)) + (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag))) ;;;; binding and unbinding diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index f88c4b4e8..4e96aaee4 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -1412,74 +1412,80 @@ (defun emit-mov (segment size dst src) (cond ((gpr-p dst) - (cond ((integerp src) - ;; We want to encode the immediate using the fewest bytes possible. - (let ((imm-size - ;; If it's a :qword constant that fits in an unsigned - ;; :dword, then use a zero-extended :dword immediate. - (if (and (eq size :qword) (typep src '(unsigned-byte 32))) - :dword - size))) - (emit-prefixes segment dst nil imm-size)) - (acond ((neq size :qword) ; :dword or smaller dst is straightforward - (emit-byte+reg segment (if (eq size :byte) #xB0 #xB8) dst) - (emit-imm-operand segment src size)) - ;; This must be move to a :qword register. - ((typep src '(unsigned-byte 32)) - ;; Encode as B8+dst using operand size of 32 bits - ;; and implicit zero-extension. - ;; Instruction size: 5 if no REX prefix, or 6 with. - (emit-byte+reg segment #xB8 dst) - (emit-dword segment src)) - ((plausible-signed-imm32-operand-p src) - ;; It's either a signed-byte-32, or a large unsigned - ;; value whose 33 high bits are all 1. - ;; Encode as C7 which sign-extends a 32-bit imm to 64 bits. - ;; Instruction size: 7 bytes. - (emit-byte segment #xC7) - (emit-mod-reg-r/m-byte segment #b11 #b000 - (reg-encoding dst segment)) - (emit-signed-dword segment it)) - (t - ;; 64-bit immediate. Instruction size: 10 bytes. - (emit-byte+reg segment #xB8 dst) - (emit-qword segment src)))) - ((fixup-p src) ; treat as a 32-bit unsigned integer - ;; But imm-to-reg could take a 64-bit operand if needed. - (emit-prefixes segment dst nil :dword) - (emit-byte+reg segment #xB8 dst) - (emit-absolute-fixup segment src)) - (t - (emit-prefixes segment src dst size) - (emit-byte segment (opcode+size-bit #x8A size)) - (emit-ea segment src dst)))) + (cond ((integerp src) + ;; We want to encode the immediate using the fewest bytes possible. + (let ((imm-size + ;; If it's a :qword constant that fits in an unsigned + ;; :dword, then use a zero-extended :dword immediate. + (if (and (eq size :qword) (typep src '(unsigned-byte 32))) + :dword + size))) + (emit-prefixes segment dst nil imm-size)) + (acond ((neq size :qword) ; :dword or smaller dst is straightforward + (emit-byte+reg segment (if (eq size :byte) #xB0 #xB8) dst) + (emit-imm-operand segment src size)) + ;; This must be move to a :qword register. + ((typep src '(unsigned-byte 32)) + ;; Encode as B8+dst using operand size of 32 bits + ;; and implicit zero-extension. + ;; Instruction size: 5 if no REX prefix, or 6 with. + (emit-byte+reg segment #xB8 dst) + (emit-dword segment src)) + ((plausible-signed-imm32-operand-p src) + ;; It's either a signed-byte-32, or a large unsigned + ;; value whose 33 high bits are all 1. + ;; Encode as C7 which sign-extends a 32-bit imm to 64 bits. + ;; Instruction size: 7 bytes. + (emit-byte segment #xC7) + (emit-mod-reg-r/m-byte segment #b11 #b000 + (reg-encoding dst segment)) + (emit-signed-dword segment it)) + (t + ;; 64-bit immediate. Instruction size: 10 bytes. + (emit-byte+reg segment #xB8 dst) + (emit-qword segment src)))) + ((fixup-p src) + ;; We emit the fixup as 32-bit or 64-bit, depending + ;; on where read only spaces are located. + (cond ((<= read-only-space-start #xffffffff) + (emit-prefixes segment dst nil :dword) + (emit-byte+reg segment #xB8 dst) + (emit-absolute-fixup segment src)) + (t + (emit-prefixes segment dst nil :qword) + (emit-byte+reg segment #xB8 dst) + (emit-absolute-fixup segment src t)))) + (t + (emit-prefixes segment src dst size) + (emit-byte segment (opcode+size-bit #x8A size)) + (emit-ea segment src dst)))) ((integerp src) ; imm to memory - ;; C7 only deals with 32 bit immediates even if the - ;; destination is a 64-bit location. The value is - ;; sign-extended in this case. - (let ((imm-size (if (eq size :qword) :dword size)) - ;; If IMMEDIATE32-P returns NIL, use the original value, - ;; which will signal an error in EMIT-IMMEDIATE - (imm-val (or (and (eq size :qword) - (plausible-signed-imm32-operand-p src)) - src))) - (emit-prefixes segment dst nil size) - (emit-byte segment (opcode+size-bit #xC6 size)) - ;; The EA could be RIP-relative, thus it is important - ;; to get :REMAINING-BYTES correct. - (emit-ea segment dst #b000 :remaining-bytes (size-nbyte imm-size)) - (emit-imm-operand segment imm-val imm-size))) + ;; C7 only deals with 32 bit immediates even if the + ;; destination is a 64-bit location. The value is + ;; sign-extended in this case. + (let ((imm-size (if (eq size :qword) :dword size)) + ;; If IMMEDIATE32-P returns NIL, use the original value, + ;; which will signal an error in EMIT-IMMEDIATE + (imm-val (or (and (eq size :qword) + (plausible-signed-imm32-operand-p src)) + src))) + (emit-prefixes segment dst nil size) + (emit-byte segment (opcode+size-bit #xC6 size)) + ;; The EA could be RIP-relative, thus it is important + ;; to get :REMAINING-BYTES correct. + (emit-ea segment dst #b000 :remaining-bytes (size-nbyte imm-size)) + (emit-imm-operand segment imm-val imm-size))) ((gpr-p src) ; reg to mem (emit-prefixes segment dst src size) (emit-byte segment (opcode+size-bit #x88 size)) (emit-ea segment dst src)) ((fixup-p src) ; equivalent to 32-bit unsigned integer - ;; imm-to-mem can not take a 64-bit operand, but could sign-extend - ;; to 8 bytes, which is probably not what you want. - (emit-prefixes segment dst nil size) - (emit-byte segment #xC7) - (emit-ea segment dst #b000) - (emit-absolute-fixup segment src)) + ;; imm-to-mem can not take a 64-bit operand, but could sign-extend + ;; to 8 bytes, which is probably not what you want. + (emit-prefixes segment dst nil size) + (emit-byte segment #xC7) + (emit-ea segment dst #b000) + (emit-absolute-fixup segment src)) (t (error "bogus arguments to MOV: ~S ~S" dst src)))) diff --git a/src/compiler/x86-64/memory.lisp b/src/compiler/x86-64/memory.lisp index c3de7fc52..d216aa208 100644 --- a/src/compiler/x86-64/memory.lisp +++ b/src/compiler/x86-64/memory.lisp @@ -178,6 +178,7 @@ (:policy :fast-safe) (:translate splat) (:args (vector :scs (descriptor-reg))) + (:temporary (:sc unsigned-reg) temp) ;fixme conditionalize (:info words value) (:arg-types * (:constant (eql 1)) (:constant t)) (:results (result :scs (descriptor-reg))) @@ -185,12 +186,18 @@ (progn words) ; don't put it in :ignore, which gets inherited (inst mov :qword (ea (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) vector) - (compute-splat-bits value)) + (let ((bits (compute-splat-bits value))) + (cond ((plausible-signed-imm32-operand-p bits) + bits) + (t + (inst mov temp bits) + temp)))) (move result vector))) (define-vop (splat-small splat-word) (:arg-types * (:constant (integer 2 10)) (:constant t)) (:temporary (:sc complex-double-reg) zero) + (:ignore temp) (:generator 5 (let ((bits (compute-splat-bits value))) (if (= bits 0) @@ -214,6 +221,7 @@ (:args (vector :scs (descriptor-reg) :to (:result 0)) (words :scs (unsigned-reg immediate) :target rcx)) (:info value) + (:ignore temp) (:arg-types * positive-fixnum (:constant t)) (:temporary (:sc any-reg :offset rdi-offset :from (:argument 0) :to (:result 0)) rdi) diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index 2950d322c..910712971 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -96,7 +96,7 @@ ;;; it would cause. -- JES, 2005-12-11 #+(or linux darwin) -(!gencgc-space-setup #x50000000 +(!gencgc-space-setup #x1dead0000 :read-only-space-size #+metaspace #.(* 2 1024 1024) #-metaspace 0 :fixedobj-space-size #.(* 40 1024 1024) diff --git a/src/runtime/x86-64-assem.S b/src/runtime/x86-64-assem.S index 1844ab03f..f0c15e2c3 100644 --- a/src/runtime/x86-64-assem.S +++ b/src/runtime/x86-64-assem.S @@ -289,10 +289,10 @@ GNAME(funcall_alien_callback): #ifdef LISP_FEATURE_IMMOBILE_CODE #include "genesis/vector.h" // An extra instruction is needed to load the fdefn. - mov (STATIC_FDEFNS+VECTOR_DATA_OFFSET+8*ENTER_ALIEN_CALLBACK_fdefn),%rax + movabsq (STATIC_FDEFNS+VECTOR_DATA_OFFSET+8*ENTER_ALIEN_CALLBACK_fdefn),%rax mov FDEFN_FUN_OFFSET(%rax),%rax #else - mov (ENTER_ALIEN_CALLBACK_FDEFN+FDEFN_FUN_OFFSET),%rax + movabsq (ENTER_ALIEN_CALLBACK_FDEFN+FDEFN_FUN_OFFSET),%rax #endif call *CLOSURE_FUN_OFFSET(%rax) diff --git a/tests/call-into-lisp.impure.lisp b/tests/call-into-lisp.impure.lisp index 2320dfc88..9bcf57a79 100644 --- a/tests/call-into-lisp.impure.lisp +++ b/tests/call-into-lisp.impure.lisp @@ -61,7 +61,8 @@ ;; Making room for 3 args aligns the stack to a 16-byte boundary ;; presuming it was at CALL to me. Darwin requires the alignment, others don't care. `((sub ,rsp-tn 24) - (mov :qword ,(ea 16 rsp-tn) ,(get-lisp-obj-address T)) + (mov ,rdi-tn ,(get-lisp-obj-address T)) + (mov ,(ea 16 rsp-tn) ,rdi-tn) (mov :qword ,(ea 8 rsp-tn) ,(fixnumize 311)) (mov :qword ,(ea 0 rsp-tn) ,(get-lisp-obj-address #\A)) (mov ,rdi-tn ,(get-lisp-obj-address #'monkeybiz)) ; C arg 0 = Lisp function