mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
x86-64: make minor codegen/disaassembler changes
* Don't always need make-funcallable-instance-tramp
* Consequently there are no asm routines that referenced using
an LEA instruction. (effectively undoing git rev 8933292b1a
so there may be additional code that can be removed now)
* Allow pinning a funinstance with a pointer to word index 1
which will be needed for GC safety in a later change
This commit is contained in:
Douglas Katzman
parent
5a2e639a0d
commit
9e244505ab
|
|
@ -275,7 +275,8 @@ during backtrace.
|
|||
:lowtag fun-pointer-lowtag
|
||||
:widetag funcallable-instance-widetag
|
||||
:alloc-trans %make-funcallable-instance)
|
||||
(trampoline :init :funcallable-instance-tramp)
|
||||
(trampoline #-compact-instance-header :init
|
||||
#-compact-instance-header :funcallable-instance-tramp)
|
||||
#-compact-instance-header (layout :set-trans %set-fun-layout :ref-trans %fun-layout)
|
||||
#+compact-instance-header (instword1)
|
||||
#+compact-instance-header (instword2)
|
||||
|
|
@ -462,10 +463,10 @@ during backtrace.
|
|||
(defconstant-eqx +thread-header-slot-names+
|
||||
`#(#+x86-64
|
||||
,@'(t-nil-constants
|
||||
alien-linkage-table-base
|
||||
msan-xor-constant
|
||||
;; The following slot's existence must NOT be conditional on #+msan
|
||||
msan-param-tls) ; = &__msan_param_tls
|
||||
alien-linkage-table-base
|
||||
msan-xor-constant
|
||||
;; The following slot's existence must NOT be conditional on #+msan
|
||||
msan-param-tls) ; = &__msan_param_tls
|
||||
#+immobile-space
|
||||
,@'(function-layout
|
||||
text-space-addr
|
||||
|
|
|
|||
|
|
@ -886,16 +886,14 @@
|
|||
|
||||
;;;; automatic allocators for primitive objects
|
||||
|
||||
;;; FIXME: figure out how not to need this?
|
||||
(define-vop (make-funcallable-instance-tramp)
|
||||
(:args)
|
||||
(:results (result :scs (any-reg)))
|
||||
(:vop-var vop)
|
||||
(:generator 1
|
||||
(let ((tramp (make-fixup 'funcallable-instance-tramp :assembly-routine)))
|
||||
(if (sb-c::code-immobile-p vop)
|
||||
(inst lea result (ea tramp rip-tn))
|
||||
(inst mov result tramp)))))
|
||||
;; gets "... is not the name of a defined VOP." if not defined at all
|
||||
#+compact-instance-header (bug "Shouldn't get here")
|
||||
(inst mov result (make-fixup 'funcallable-instance-tramp :assembly-routine))))
|
||||
|
||||
(flet
|
||||
((alloc (name words type lowtag stack-allocate-p result
|
||||
|
|
|
|||
|
|
@ -465,9 +465,8 @@
|
|||
'alien-linkage)
|
||||
(not (machine-ea-index value))
|
||||
(integerp (machine-ea-disp value)))
|
||||
(let* ((index (sb-vm::alien-linkage-table-index-from-address
|
||||
(+ sb-vm:alien-linkage-table-space-start (machine-ea-disp value))))
|
||||
(name (sb-impl::alien-linkage-index-to-name index)))
|
||||
(let ((name (sb-impl::alien-linkage-index-to-name
|
||||
(floor (machine-ea-disp value) sb-vm:alien-linkage-table-entry-size))))
|
||||
(note (lambda (s) (format s "&~A" name)) dstate)))
|
||||
(setf (sb-disassem::dstate-known-register-contents dstate) nil)
|
||||
|
||||
|
|
@ -543,41 +542,42 @@
|
|||
;; Figure out whether LEA should print its EA with just the stuff in brackets,
|
||||
;; or additionally show the EA as either a label or a hex literal.
|
||||
(defun lea-print-ea (value stream dstate)
|
||||
(let* ((width (inst-operand-size dstate))
|
||||
(addr
|
||||
(etypecase value
|
||||
(machine-ea
|
||||
;; Indicate to PRINT-MEM-REF that this is not a memory access.
|
||||
(print-mem-ref :compute value width stream dstate)
|
||||
(when (eq (machine-ea-base value) :rip)
|
||||
(+ (dstate-next-addr dstate) (machine-ea-disp value))))
|
||||
(let*
|
||||
((width (inst-operand-size dstate))
|
||||
(addr
|
||||
(etypecase value
|
||||
(machine-ea
|
||||
;; Indicate to PRINT-MEM-REF that this is not a memory access.
|
||||
(print-mem-ref :compute value width stream dstate)
|
||||
(when (eq (machine-ea-base value) :rip)
|
||||
(+ (dstate-next-addr dstate) (machine-ea-disp value))))
|
||||
|
||||
((or string integer)
|
||||
;; A label for the EA should not print as itself, but as the decomposed
|
||||
;; addressing mode so that [ADDR] and [RIP+disp] are unmistakable.
|
||||
;; We can see an INTEGER here because LEA-COMPUTE-LABEL is always called
|
||||
;; on the operand to LEA, and it will compute an absolute address based
|
||||
;; off RIP when possible. If :use-labels NIL was specified, there is
|
||||
;; no hashtable of address to string, so we get the address.
|
||||
;; But ordinarily we get the string. Either way, the r/m arg reveals the
|
||||
;; EA calculation. DCHUNK-ZERO is a meaningless value - any would do -
|
||||
;; because the EA was computed in a prefilter.
|
||||
;; (the instruction format is known because LEA has exactly one format)
|
||||
(print-mem-ref :compute (regrm-inst-r/m dchunk-zero dstate)
|
||||
width stream dstate)
|
||||
value)
|
||||
((or string integer)
|
||||
;; A label for the EA should not print as itself, but as the decomposed
|
||||
;; addressing mode so that [ADDR] and [RIP+disp] are unmistakable.
|
||||
;; We can see an INTEGER here because LEA-COMPUTE-LABEL is always called
|
||||
;; on the operand to LEA, and it will compute an absolute address based
|
||||
;; off RIP when possible. If :use-labels NIL was specified, there is
|
||||
;; no hashtable of address to string, so we get the address.
|
||||
;; But ordinarily we get the string. Either way, the r/m arg reveals the
|
||||
;; EA calculation. DCHUNK-ZERO is a meaningless value - any would do -
|
||||
;; because the EA was computed in a prefilter.
|
||||
;; (the instruction format is known because LEA has exactly one format)
|
||||
(print-mem-ref :compute (regrm-inst-r/m dchunk-zero dstate)
|
||||
width stream dstate)
|
||||
value)
|
||||
|
||||
;; LEA Rx,Ry is an illegal encoding, but we'll show it as-is.
|
||||
;; When we used integers instead of REG to represent registers, this case
|
||||
;; overlapped with the preceding. It's nice that it no longer does.
|
||||
(reg
|
||||
(print-reg-with-width value width stream dstate)
|
||||
nil))))
|
||||
|
||||
(when (and addr stream) ; no end-of-line comments if storing into dstate
|
||||
(unless (maybe-note-assembler-routine addr nil dstate)
|
||||
(note (lambda (s) (format s (if (stringp addr) "= ~A" "= #x~x") addr))
|
||||
dstate)))))
|
||||
;; LEA Rx,Ry is an illegal encoding, but we'll show it as-is.
|
||||
;; When we used integers instead of REG to represent registers, this case
|
||||
;; overlapped with the preceding. It's nice that it no longer does.
|
||||
(reg
|
||||
(print-reg-with-width value width stream dstate)
|
||||
nil))))
|
||||
(when stream
|
||||
(cond ((stringp addr) ; label
|
||||
(note (lambda (s) (format s "= ~A" addr)) dstate))
|
||||
(addr
|
||||
(note (lambda (s) (format s "= #x~x" addr)) dstate))))))
|
||||
|
||||
;;;; interrupt instructions
|
||||
|
||||
|
|
|
|||
|
|
@ -2391,7 +2391,7 @@ scavenge_control_stack(struct thread *th)
|
|||
|
||||
static int boxed_registers[] = BOXED_REGISTERS;
|
||||
|
||||
// Nothing usees os_context_pc_addr any more, except ACCESS_INTERIOR_POINTER_pc.
|
||||
// Nothing uses os_context_pc_addr any more, except ACCESS_INTERIOR_POINTER_pc.
|
||||
// I didn't see a good way to remove that one.
|
||||
extern os_context_register_t* os_context_pc_addr(os_context_t*);
|
||||
|
||||
|
|
|
|||
|
|
@ -2043,7 +2043,12 @@ static lispobj conservative_root_p(lispobj addr, page_index_t addr_page_index)
|
|||
return 0;
|
||||
#ifdef LISP_FEATURE_X86_64
|
||||
case FUNCALLABLE_INSTANCE_WIDETAG:
|
||||
// Allow any of these to pin a funcallable instance:
|
||||
// - pointer to embedded machine instructions
|
||||
// - untagged pointer to trampoline word
|
||||
// - correctly tagged pointer
|
||||
if ((addr >= (uword_t)(object_start+2) && addr < (uword_t)(object_start+4))
|
||||
|| addr == (lispobj)(object_start+1)
|
||||
|| addr == make_lispobj(object_start, FUN_POINTER_LOWTAG))
|
||||
return make_lispobj(object_start, FUN_POINTER_LOWTAG);
|
||||
return 0;
|
||||
|
|
|
|||
|
|
@ -233,24 +233,6 @@
|
|||
(with-test (:name :disassemble-assembly-routine)
|
||||
(disassemble sb-fasl:*assembler-routines* :stream (make-broadcast-stream)))
|
||||
|
||||
;;; This tests that the x86-64 disasembler does not crash
|
||||
;;; on LEA with a rip-relative operand and no label.
|
||||
(with-test (:name (disassemble :no-labels)
|
||||
:skipped-on (not :x86-64))
|
||||
(let* ((lines
|
||||
(split-string
|
||||
(with-output-to-string (stream)
|
||||
;; A smallish function whose code happens to contain
|
||||
;; the thing under test.
|
||||
(disassemble 'sb-impl::inspector :stream stream))
|
||||
#\Newline))
|
||||
(line (find "; = L0" lines :test 'search)))
|
||||
(assert (search "LEA " line)) ; verify our test precondition
|
||||
;; Now just disassemble without labels and see that we don't crash
|
||||
(disassemble 'sb-impl::inspector
|
||||
:use-labels nil
|
||||
:stream (make-broadcast-stream))))
|
||||
|
||||
;;; Check that SLEEP called with ratios (with no common factors with
|
||||
;;; 1000000000, and smaller than 1/1000000000) works more or less as
|
||||
;;; expected.
|
||||
|
|
|
|||
|
|
@ -182,22 +182,6 @@
|
|||
(assert (search "; #<SB-KERNEL:WRAPPER " line))
|
||||
(assert (search " SB-ASSEM:LABEL" line)))))
|
||||
|
||||
#+immobile-code
|
||||
(with-test (:name :reference-assembly-tramp)
|
||||
(dolist (testcase '(("FUNCALLABLE-INSTANCE-TRAMP"
|
||||
sb-kernel:%make-funcallable-instance)))
|
||||
(let ((lines
|
||||
(split-string
|
||||
(with-output-to-string (stream)
|
||||
(let ((sb-disassem:*disassem-location-column-width* 0))
|
||||
(disassemble (cadr testcase) :stream stream)))
|
||||
#\newline)))
|
||||
(assert (loop for line in lines
|
||||
thereis (and (search "LEA" line)
|
||||
(search "RIP" line) ; require RIP-relative mode
|
||||
;; and verify disassembly
|
||||
(search (car testcase) line)))))))
|
||||
|
||||
#+immobile-code ; uses SB-C::*COMPILE-TO-MEMORY-SPACE*
|
||||
(with-test (:name :static-link-compile-to-memory)
|
||||
(let* ((string
|
||||
|
|
@ -224,7 +208,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 QWORD PTR [#x" c-call))))
|
||||
#-immobile-code (assert (search "CALL [#x" c-call))))
|
||||
|
||||
(with-test (:name :set-symbol-value-imm)
|
||||
(let (success)
|
||||
|
|
@ -1281,3 +1265,21 @@
|
|||
"&verify_gens"
|
||||
'(lambda ()
|
||||
(extern-alien "verify_gens" char)))))))
|
||||
|
||||
;;; This tests that the x86-64 disasembler does not crash
|
||||
;;; on LEA with a rip-relative operand and no label.
|
||||
(with-test (:name (disassemble :no-labels)
|
||||
:skipped-on (not :x86-64))
|
||||
(let* ((lines
|
||||
(split-string
|
||||
(with-output-to-string (stream)
|
||||
;; A smallish function whose code happens to contain
|
||||
;; the thing under test.
|
||||
(disassemble 'sb-impl::inspector :stream stream))
|
||||
#\Newline))
|
||||
(line (find "; = L0" lines :test 'search)))
|
||||
(assert (search "LEA " line)) ; verify our test precondition
|
||||
;; Now just disassemble without labels and see that we don't crash
|
||||
(disassemble 'sb-impl::inspector
|
||||
:use-labels nil
|
||||
:stream (make-broadcast-stream))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue