1 ;;;; target-only stuff from CMU CL's src/compiler/x86/insts.lisp
3 ;;;; i.e. stuff which was in CMU CL's insts.lisp file, but which in
4 ;;;; the SBCL build process can't be compiled into code for the
5 ;;;; cross-compilation host
7 ;;;; This software is part of the SBCL system. See the README file for
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
16 (in-package "SB!X86-64-ASM")
18 (defstruct (machine-ea (:include sb
!disassem
::filtered-arg
)
21 (:constructor %make-machine-ea
))
22 base disp index scale
)
24 ;;; Print to STREAM the name of the general-purpose register encoded by
25 ;;; VALUE and of size WIDTH. For robustness, the high byte registers
26 ;;; (AH, BH, CH, DH) are correctly detected, too, although the compiler
27 ;;; does not use them.
28 (defun print-reg-with-width (value width stream dstate
)
29 (declare (type full-reg value
)
31 (type disassem-state dstate
))
32 (princ (if (and (eq width
:byte
)
34 (not (dstate-get-inst-prop dstate
+rex
+)))
35 (aref #("AH" "CH" "DH" "BH") (- value
4))
37 (:byte sb
!vm
::+byte-register-names
+)
38 (:word sb
!vm
::+word-register-names
+)
39 (:dword sb
!vm
::+dword-register-names
+)
40 (:qword sb
!vm
::+qword-register-names
+))
43 ;; XXX plus should do some source-var notes
46 (defun print-reg (value stream dstate
)
47 (print-reg-with-width value
48 (inst-operand-size dstate
)
52 (defun print-reg-default-qword (value stream dstate
)
53 (print-reg-with-width value
54 (inst-operand-size-default-qword dstate
)
58 ;; Print a reg that can only be a :DWORD or :QWORD.
59 ;; Avoid use of INST-OPERAND-SIZE because it's wrong for this type of operand.
60 (defun print-d/q-word-reg
(value stream dstate
)
61 (print-reg-with-width value
62 (if (dstate-get-inst-prop dstate
+rex-w
+) :qword
:dword
)
66 (defun print-byte-reg (value stream dstate
)
67 (print-reg-with-width value
:byte stream dstate
))
69 (defun print-addr-reg (value stream dstate
)
70 (print-reg-with-width value
+default-address-size
+ stream dstate
))
72 ;;; Print a register or a memory reference of the given WIDTH.
73 ;;; If SIZED-P is true, add an explicit size indicator for memory
75 (defun print-reg/mem-with-width
(value width sized-p stream dstate
)
76 (declare (type (or machine-ea full-reg
) value
)
77 (type (member :byte
:word
:dword
:qword
) width
)
78 (type boolean sized-p
))
79 (if (typep value
'full-reg
)
80 (print-reg-with-width value width stream dstate
)
81 (print-mem-ref (if sized-p
:sized-ref
:ref
) value width stream dstate
)))
83 ;;; Print a register or a memory reference. The width is determined by
84 ;;; calling INST-OPERAND-SIZE.
85 (defun print-reg/mem
(value stream dstate
)
86 (print-reg/mem-with-width
87 value
(inst-operand-size dstate
) nil stream dstate
))
89 ;; Same as print-reg/mem, but prints an explicit size indicator for
91 (defun print-sized-reg/mem
(value stream dstate
)
92 (print-reg/mem-with-width
93 value
(inst-operand-size dstate
) t stream dstate
))
95 ;;; Same as print-sized-reg/mem, but with a default operand size of
97 (defun print-sized-reg/mem-default-qword
(value stream dstate
)
98 (print-reg/mem-with-width
99 value
(inst-operand-size-default-qword dstate
) t stream dstate
))
101 (defun print-sized-byte-reg/mem
(value stream dstate
)
102 (print-reg/mem-with-width value
:byte t stream dstate
))
104 (defun print-sized-word-reg/mem
(value stream dstate
)
105 (print-reg/mem-with-width value
:word t stream dstate
))
107 (defun print-sized-dword-reg/mem
(value stream dstate
)
108 (print-reg/mem-with-width value
:dword t stream dstate
))
110 (defun print-label (value stream dstate
)
111 (declare (ignore dstate
))
112 (princ16 value stream
))
114 (defun print-xmmreg (value stream dstate
)
115 (declare (type xmmreg value
) (type stream stream
) (ignore dstate
))
116 (format stream
"XMM~d" value
))
118 (defun print-xmmreg/mem
(value stream dstate
)
119 (if (typep value
'xmmreg
)
120 (print-xmmreg value stream dstate
)
121 (print-mem-ref :ref value nil stream dstate
)))
123 (defun print-imm/asm-routine
(value stream dstate
)
124 (if (or #!+immobile-space
(maybe-note-lisp-callee value dstate
)
125 (maybe-note-assembler-routine value nil dstate
)
126 (maybe-note-static-symbol value dstate
))
127 (write value
:stream stream
:base
16 :radix t
)
128 (princ value stream
)))
130 ;;; Return either a MACHINE-EA or a register (a fixnum).
131 ;;; MOD and R/M are the extracted bits from the instruction's ModRM byte.
132 ;;; Depending on MOD and R/M, a SIB byte and/or displacement may be read.
133 ;;; The REX.B and REX.X from dstate are appropriately consumed.
134 (defun prefilter-reg/mem
(dstate mod r
/m
)
135 (declare (type disassem-state dstate
)
136 (type (unsigned-byte 2) mod
)
137 (type (unsigned-byte 3) r
/m
))
138 (flet ((make-machine-ea (base &optional disp index scale
)
139 (let ((ea (the machine-ea
140 (sb!disassem
::new-filtered-arg dstate
#'%make-machine-ea
))))
141 (setf (machine-ea-base ea
) base
142 (machine-ea-disp ea
) disp
143 (machine-ea-index ea
) index
144 (machine-ea-scale ea
) scale
)
148 (#b01
(read-signed-suffix 8 dstate
))
149 (#b10
(read-signed-suffix 32 dstate
))))
150 (extend (bit-name reg
)
151 (logior (if (dstate-get-inst-prop dstate bit-name
) 8 0)
153 (declare (inline extend
))
154 (let ((full-reg (extend +rex-b
+ r
/m
)))
155 (cond ((= mod
#b11
) full-reg
) ; register direct mode
156 ((= r
/m
#b100
) ; SIB byte - rex.b is "don't care"
157 (let* ((sib (the (unsigned-byte 8) (read-suffix 8 dstate
)))
158 (index-reg (extend +rex-x
+ (ldb (byte 3 3) sib
)))
159 (base-reg (ldb (byte 3 0) sib
)))
160 ;; mod=0 and base=RBP means no base reg
161 (make-machine-ea (unless (and (= mod
#b00
) (= base-reg
#b101
))
162 (extend +rex-b
+ base-reg
))
163 (cond ((/= mod
#b00
) (displacement))
164 ((= base-reg
#b101
) (read-signed-suffix 32 dstate
)))
165 (unless (= index-reg
#b100
) index-reg
) ; index can't be RSP
166 (ash 1 (ldb (byte 2 6) sib
)))))
167 ((/= mod
#b00
) (make-machine-ea full-reg
(displacement)))
168 ;; rex.b is not decoded in determining RIP-relative mode
169 ((= r
/m
#b101
) (make-machine-ea :rip
(read-signed-suffix 32 dstate
)))
170 (t (make-machine-ea full-reg
))))))
173 (defun static-symbol-from-tls-index (index)
174 (dovector (sym +static-symbols
+)
175 (when (= (symbol-tls-index sym
) index
)
178 ;;; Prints a memory reference to STREAM. VALUE is a list of
179 ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component may be
180 ;;; missing or nil to indicate that it's not used or has the obvious
181 ;;; default value (e.g., 1 for the index-scale). BASE-REG can be the
182 ;;; symbol RIP or a full register, INDEX-REG a full register. If WIDTH
183 ;;; is non-nil it should be one of the symbols :BYTE, :WORD, :DWORD or
184 ;;; :QWORD; a corresponding size indicator is printed if MODE is :SIZED-REF.
185 ;;; The rationale for supplying WIDTH while eliding a pointer-size qualifier
186 ;;; is that proper dereferencing of RIP-relative constants requires a size,
187 ;;; but in other cases would only add clutter, since a source/destination
188 ;;; register implies a size.
190 (defun print-mem-ref (mode value width stream dstate
)
191 ;; :COMPUTE is used for the LEA instruction - it informs this function
192 ;; that we're not loading from the address and that the contents should not
193 ;; be printed. It'll usually be a reference to code within the disasembly
194 ;; segment, as LEA is employed to compute the entry point for local call.
195 (declare (type (member :ref
:sized-ref
:compute
) mode
)
196 (type machine-ea value
)
197 (type (member nil
:byte
:word
:dword
:qword
) width
)
199 (type disassem-state dstate
))
200 (let ((base-reg (machine-ea-base value
))
201 (disp (machine-ea-disp value
))
202 (index-reg (machine-ea-index value
))
204 (when (and width
(eq mode
:sized-ref
))
206 (princ '| PTR | stream
))
207 (write-char #\
[ stream
)
209 (if (eql :rip base-reg
)
210 (princ base-reg stream
)
211 (print-addr-reg base-reg stream dstate
))
214 (unless firstp
(write-char #\
+ stream
))
215 (print-addr-reg index-reg stream dstate
)
216 (let ((scale (machine-ea-scale value
)))
218 (write-char #\
* stream
)
219 (princ scale stream
)))
221 (when (and disp
(or firstp
(not (zerop disp
))))
222 (unless (or firstp
(minusp disp
))
223 (write-char #\
+ stream
))
224 (cond ((eq (machine-ea-base value
) :rip
)
226 (unless (eq mode
:compute
)
227 (let ((addr (+ disp
(dstate-next-addr dstate
))))
228 ;; The origin is zero when disassembling into a trace-file.
229 ;; Don't crash on account of it.
232 1 (note-code-constant-absolute addr dstate width
))
233 (maybe-note-assembler-routine addr nil dstate
)
234 ;; Show the absolute address and maybe the contents.
235 (note (format nil
"[#x~x]~@[ = ~x~]"
239 (unboxed-constant-ref
241 (+ (dstate-next-offs dstate
) disp
)))))
244 (princ16 disp stream
)
246 (nth-value 1 (note-code-constant-absolute disp dstate
))
247 (maybe-note-assembler-routine disp nil dstate
)
248 ;; Static symbols coming frorm CELL-REF
249 (maybe-note-static-symbol (+ disp
(- other-pointer-lowtag
253 (princ disp stream
))))
254 (write-char #\
] stream
)
256 (when (and (eql base-reg
#.
(ash (tn-offset sb
!vm
::thread-base-tn
) -
1))
257 (not index-reg
) ; no index
258 (typep disp
'(integer 0 *)) ; positive displacement
259 (seg-code (dstate-segment dstate
)))
260 ;; Try to reverse-engineer which thread-local binding this is
261 (let* ((code (seg-code (dstate-segment dstate
)))
262 (header-n-words (code-header-words code
))
263 (tls-index (ash disp
(- n-fixnum-tag-bits
)))
265 (or (loop for word-num from code-constants-offset below header-n-words
266 for obj
= (code-header-ref code word-num
)
267 when
(and (symbolp obj
) (= (symbol-tls-index obj
) tls-index
))
269 ;; static symbols with known TLS index don't go in the code header,
270 ;; but it'd be nice to guess at the symbol.
271 (static-symbol-from-tls-index tls-index
))))
273 (return-from print-mem-ref
274 (note (lambda (stream) (format stream
"tls: ~S" symbol
))
276 ;; Or maybe we're looking at the 'struct thread' itself
277 (when (< disp max-interrupts
)
280 (primitive-object-slots
281 (find 'sb
!vm
::thread
*primitive-objects
*
282 :key
#'primitive-object-name
)) t
))
283 (slot (find (ash disp
(- word-shift
)) thread-slots
284 :key
#'slot-offset
)))
286 (return-from print-mem-ref
287 (note (lambda (stream)
288 (format stream
"thread.~(~A~)" (slot-name slot
)))
291 (defun lea-compute-label (value dstate
)
292 ;; If VALUE should be regarded as a label, return the address.
293 ;; If not, just return VALUE.
294 (if (and (typep value
'machine-ea
) (eq (machine-ea-base value
) :rip
))
295 (+ (dstate-next-addr dstate
) (machine-ea-disp value
))
298 ;; Figure out whether LEA should print its EA with just the stuff in brackets,
299 ;; or additionally show the EA as either a label or a hex literal.
300 (defun lea-print-ea (value stream dstate
)
301 (let ((width (inst-operand-size dstate
))
306 ;; Indicate to PRINT-MEM-REF that this is not a memory access.
307 (print-mem-ref :compute value width stream dstate
)
308 (when (eq (machine-ea-base value
) :rip
)
309 (setq addr
(+ (dstate-next-addr dstate
) (machine-ea-disp value
)))))
311 ;; We're robust in allowing VALUE to be an integer (a register),
312 ;; though LEA Rx,Ry is an illegal instruction.
313 ;; Test this before INTEGER since the types overlap.
315 (print-reg-with-width value width stream dstate
))
318 ;; A label for the EA should not print as itself, but as the decomposed
319 ;; addressing mode so that [ADDR] and [RIP+disp] are unmistakable.
320 ;; We can see an INTEGER here because LEA-COMPUTE-LABEL is always called
321 ;; on the operand to LEA, and it will compute an absolute address based
322 ;; off RIP when possible. If :use-labels NIL was specified, there is
323 ;; no hashtable of address to string, so we get the address.
324 ;; But ordinarily we get the string. Either way, the r/m arg reveals the
325 ;; EA calculation. DCHUNK-ZERO is a meaningless value - any would do -
326 ;; because the EA was computed in a prefilter.
327 (print-mem-ref :compute
(reg-r/m-inst-r
/m-arg dchunk-zero dstate
)
330 (when (stringp value
) (setq fmt
"= ~A"))))
332 (note (lambda (s) (format s fmt addr
)) dstate
))))
334 (defun unboxed-constant-ref (dstate segment-offset
)
335 (let* ((seg (dstate-segment dstate
))
337 (sb!disassem
::segment-offs-to-code-offs segment-offset seg
))
338 (unboxed-range (sb!disassem
::seg-unboxed-data-range seg
)))
340 (<= (car unboxed-range
) code-offset
(cdr unboxed-range
))
341 (sap-ref-int (dstate-segment-sap dstate
)
342 segment-offset n-word-bytes
343 (dstate-byte-order dstate
)))))
345 ;;;; interrupt instructions
347 (defun break-control (chunk inst stream dstate
)
348 (declare (ignore inst
))
349 (flet ((nt (x) (if stream
(note x dstate
))))
350 (case #!-ud2-breakpoints
(byte-imm-code chunk dstate
)
351 #!+ud2-breakpoints
(word-imm-code chunk dstate
)
354 (handle-break-args #'snarf-error-junk stream dstate
))
357 (handle-break-args #'snarf-error-junk stream dstate
))
359 (nt "breakpoint trap"))
360 (#.pending-interrupt-trap
361 (nt "pending interrupt trap"))
364 (#.fun-end-breakpoint-trap
365 (nt "function end breakpoint trap"))
366 (#.single-step-around-trap
367 (nt "single-step trap (around)"))
368 (#.single-step-before-trap
369 (nt "single-step trap (before)"))
370 (#.invalid-arg-count-trap
371 (nt "Invalid argument count trap")))))
377 (defun sb!vm
::collect-immobile-code-relocs
()
378 (let ((code-components
379 (make-array 20000 :element-type
'(unsigned-byte 32)
380 :fill-pointer
0 :adjustable t
))
382 (make-array 100000 :element-type
'(unsigned-byte 32)
383 :fill-pointer
0 :adjustable t
))
384 ;; Look for these two instruction formats.
385 (jmp-inst (find-inst #b11101001
(get-inst-space)))
386 (call-inst (find-inst #b11101000
(get-inst-space)))
387 (seg (sb!disassem
::%make-segment
388 :sap-maker
#'error
:virtual-location
0))
389 (dstate (make-dstate)))
390 (flet ((scan-function (fun-entry-addr fun-end-addr predicate
)
391 (setf (seg-virtual-location seg
) fun-entry-addr
392 (seg-length seg
) (- fun-end-addr fun-entry-addr
)
394 (let ((sap (int-sap fun-entry-addr
))) (lambda () sap
)))
395 (map-segment-instructions
396 (lambda (dchunk inst
)
397 (when (and (or (eq inst jmp-inst
)
400 (+ (near-jump-displacement dchunk dstate
)
401 (dstate-next-addr dstate
))))
402 (vector-push-extend (dstate-cur-addr dstate
) relocs
)))
404 (finish-component (code start-relocs-index
)
405 (when (> (fill-pointer relocs
) start-relocs-index
)
406 (vector-push-extend (get-lisp-obj-address code
) code-components
)
407 (vector-push-extend start-relocs-index code-components
))))
409 ;; Assembler routines contain jumps to immobile code.
410 ;; Since these code components do not contain simple-funs,
411 ;; we have to group the routines by looking at addresses.
413 (loop for addr being each hash-value of sb
!fasl
:*assembler-routines
*
415 (dovector (code sb
!fasl
::*assembler-objects
*)
416 (let* ((text-origin (sap-int (code-instructions code
)))
417 (text-end (+ text-origin
(%code-code-size code
)))
418 (relocs-index (fill-pointer relocs
)))
420 (scan-function (car list
)
421 (if (cdr list
) (cadr list
) text-end
)
422 ;; Look for transfers into immobile code
423 (lambda (jmp-targ-addr)
424 (<= sb
!vm
:immobile-space-start
425 jmp-targ-addr sb
!vm
:immobile-space-end
))))
426 (sort (remove-if-not (lambda (address)
427 (<= text-origin address text-end
))
429 (finish-component code relocs-index
))))
431 ;; Immobile space - code components can jump to immobile space,
432 ;; read-only space, and C runtime routines.
433 (sb!vm
::map-allocated-objects
434 (lambda (code type size
)
435 (declare (ignore size
))
436 (when (= type code-header-widetag
)
437 (let* ((text-origin (sap-int (code-instructions code
)))
438 (text-end (+ text-origin
(%code-code-size code
)))
439 (relocs-index (fill-pointer relocs
)))
440 (dotimes (i (code-n-entries code
) (finish-component code relocs-index
))
441 (let ((fun (%code-entry-point code i
)))
443 (+ (get-lisp-obj-address fun
) (- fun-pointer-lowtag
)
444 (ash simple-fun-code-offset word-shift
))
445 (if (< (1+ i
) (code-n-entries code
))
446 (- (get-lisp-obj-address (%code-entry-point code
(1+ i
)))
449 ;; Exclude transfers within this code component
450 (lambda (jmp-targ-addr)
451 (not (<= text-origin jmp-targ-addr text-end
)))))))))
454 ;; Write a delimiter into the array passed to C
455 (vector-push-extend 0 code-components
)
456 (vector-push-extend (fill-pointer relocs
) code-components
)
457 (values code-components relocs
)))
459 (defmacro do-immobile-functions
((code-var fun-var addr-var
&key
(if t
)) &body body
)
460 ;; Loop over all code objects
461 `(let* ((call (find-inst #xE8
(get-inst-space)))
462 (jmp (find-inst #xE9
(get-inst-space)))
463 (dstate (make-dstate))
465 (seg (sb!disassem
::%make-segment
:sap-maker
(lambda () sap
))))
466 (sb!vm
::map-objects-in-range
467 (lambda (,code-var obj-type obj-size
)
468 (declare (ignore obj-size
))
469 (when (and (= obj-type code-header-widetag
) ,if
)
470 ;; Loop over all embedded functions
471 (dotimes (fun-index (code-n-entries ,code-var
))
472 (let* ((,fun-var
(%code-entry-point
,code-var fun-index
))
473 (,addr-var
(+ (get-lisp-obj-address ,fun-var
)
474 (- fun-pointer-lowtag
)
475 (ash simple-fun-code-offset word-shift
))))
476 (with-pinned-objects (sap) ; Mutate SAP to point to fun
477 (setf (sap-ref-word (int-sap (get-lisp-obj-address sap
))
478 (- n-word-bytes other-pointer-lowtag
))
480 (setf (seg-virtual-location seg
) ,addr-var
482 (- (let ((next (%code-entry-point
,code-var
(1+ fun-index
))))
484 (- (get-lisp-obj-address next
) fun-pointer-lowtag
)
485 (+ (sap-int (code-instructions ,code-var
))
486 (%code-code-size
,code-var
))))
489 ;; Slowness here is bothersome, especially for SB!VM::REMOVE-STATIC-LINKS,
490 ;; so skip right over all fixedobj pages.
491 (ash (+ immobile-space-start immobile-fixedobj-subspace-size
)
492 (- n-fixnum-tag-bits
))
493 (%make-lisp-obj
(sap-int *immobile-space-free-pointer
*)))))
495 (defun sb!vm
::statically-link-core
(&key callers exclude-callers
496 callees exclude-callees
498 (flet ((match-p (name include exclude
)
499 (and (not (member name exclude
:test
'equal
))
500 (or (not include
) (member name include
:test
'equal
)))))
501 (do-immobile-functions (code fun addr
)
502 (when (match-p (%simple-fun-name fun
) callers exclude-callers
)
503 (let ((printed-fun-name nil
))
504 ;; Loop over function's assembly code
505 (map-segment-instructions
507 (when (or (eq inst jmp
) (eq inst call
))
508 (let ((fdefn (sb!vm
::find-called-object
509 (+ (near-jump-displacement chunk dstate
)
510 (dstate-next-addr dstate
)))))
511 (when (and (fdefn-p fdefn
)
512 (let ((callee (fdefn-fun fdefn
)))
513 (and (sb!kernel
::immobile-space-obj-p callee
)
514 (not (sb!vm
::fun-requires-simplifying-trampoline-p callee
))
515 (match-p (%fun-name callee
)
516 callees exclude-callees
))))
517 (let ((entry (sb!vm
::fdefn-call-target fdefn
)))
519 (let ((*print-pretty
* nil
))
520 (unless printed-fun-name
521 (format t
"#x~X ~S~%" (get-lisp-obj-address fun
) fun
)
522 (setq printed-fun-name t
))
523 (format t
" @~x -> ~s [~x]~%"
524 (dstate-cur-addr dstate
) (fdefn-name fdefn
) entry
)))
525 ;; Set the statically-linked flag
526 (setf (sb!vm
::fdefn-has-static-callers fdefn
) 1)
527 ;; Change the machine instruction
528 (setf (signed-sap-ref-32 (int-sap (dstate-cur-addr dstate
)) 1)
529 (- entry
(dstate-next-addr dstate
))))))))
532 ;;; While concurrent use of un-statically-link is unlikely, misuse could easily
533 ;;; cause heap corruption. It's preventable by ensuring that this is atomic
534 ;;; with respect to GC and other code attempting to change the same fdefn.
535 ;;; The issue is that if the fdefn loses the pointer to the underlying code
536 ;;; via (setf fdefn-fun) before we were done removing the static links,
537 ;;; then there could be no remaining pointers visible to GC.
538 ;;; The only way to detect the current set of references is to find uses of the
539 ;;; current jump address, which means we need to fix them *all* before anyone
540 ;;; else gets an opportunity to change the fdefn-fun of this same fdefn again.
541 (defglobal *static-linker-lock
* (sb!thread
:make-mutex
:name
"static linker"))
542 (defun sb!vm
::remove-static-links
(fdefn)
543 ; (warn "undoing static linkage of ~S" (fdefn-name fdefn))
544 (sb!thread
::with-system-mutex
(*static-linker-lock
* :without-gcing t
)
545 ;; If the jump is to FUN-ENTRY, change it back to FDEFN-ENTRY
546 (let ((fun-entry (sb!vm
::fdefn-call-target fdefn
))
547 (fdefn-entry (+ (get-lisp-obj-address fdefn
)
548 (ash fdefn-raw-addr-slot word-shift
)
549 (- other-pointer-lowtag
))))
550 ;; Examine only those code components which potentially use FDEFN.
551 (do-immobile-functions
552 (code fun addr
:if
(loop for i downfrom
(1- (sb!kernel
:code-header-words code
))
553 to sb
!vm
:code-constants-offset
554 thereis
(eq (sb!kernel
:code-header-ref code i
)
556 (map-segment-instructions
558 (when (or (eq inst jmp
) (eq inst call
))
559 ;; TRULY-THE because near-jump-displacement isn't a known fun.
560 (let ((disp (truly-the (signed-byte 32)
561 (near-jump-displacement chunk dstate
))))
562 (when (= fun-entry
(+ disp
(dstate-next-addr dstate
)))
564 (the (signed-byte 32)
565 (- fdefn-entry
(dstate-next-addr dstate
)))))
566 ;; CMPXCHG is atomic even when misaligned, and x86-64 promises
567 ;; that self-modifying code works correctly, so the fetcher
568 ;; should never see a torn write.
569 (%primitive sb
!vm
::signed-sap-cas-32
570 (int-sap (dstate-cur-addr dstate
))
571 1 disp new-disp
))))))
573 (setf (sb!vm
::fdefn-has-static-callers fdefn
) 0))) ; Clear static link flag