X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=d8f4d729c37a58a0606223c2dd73662adce07b40;hb=6cb01770be85e0164c2cdf89e7d6a626dcaf702d;hp=d58a2c25ab52492bae9f22342b8e5bb7de8bb43b;hpb=ba2e958087d35c7cb34c965ba61bb4821ca65bc8;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index d58a2c2..d8f4d72 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -41,17 +41,6 @@ "All DEBUG-CONDITIONs inherit from this type. These are serious conditions that must be handled, but they are not programmer errors.")) -(define-condition no-debug-info (debug-condition) - ((code-component :reader no-debug-info-code-component - :initarg :code-component)) - #!+sb-doc - (:documentation "There is no usable debugging information available.") - (:report (lambda (condition stream) - (fresh-line stream) - (format stream - "no debug information available for ~S~%" - (no-debug-info-code-component condition))))) - (define-condition no-debug-fun-returns (debug-condition) ((debug-fun :reader no-debug-fun-returns-debug-fun :initarg :debug-fun)) @@ -64,8 +53,8 @@ (no-debug-fun-returns-debug-fun condition)))) (format stream "~&Cannot return values from ~:[frame~;~:*~S~] since ~ - the debug information lacks details about returning ~ - values here." + the debug information lacks details about returning ~ + values here." fun))))) (define-condition no-debug-blocks (debug-condition) @@ -382,7 +371,7 @@ ;; This is the byte offset into the component. (offset nil :type index) ;; The original instruction replaced by the breakpoint. - (instruction nil :type (or null (unsigned-byte 32))) + (instruction nil :type (or null sb!vm::word)) ;; A list of user breakpoints at this location. (breakpoints nil :type list)) (def!method print-object ((obj breakpoint-data) str) @@ -550,9 +539,9 @@ (make-lisp-obj (logior (sap-int component-ptr) sb!vm:other-pointer-lowtag))) -;;;; X86 support +;;;; (OR X86 X86-64) support -#!+x86 +#!+(or x86 x86-64) (progn (defun compute-lra-data-from-pc (pc) @@ -598,18 +587,21 @@ (defun x86-call-context (fp &key (depth 0)) (declare (type system-area-pointer fp) (fixnum depth)) - ;;(format t "*CC ~S ~S~%" fp depth) +;; (format t "*CC ~S ~S~%" fp depth) (cond ((not (control-stack-pointer-valid-p fp)) #+nil (format t "debug invalid fp ~S~%" fp) nil) (t ;; Check the two possible frame pointers. - (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset) 4)))) + (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset) + sb!vm::n-word-bytes)))) (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset) - 4)))) + sb!vm::n-word-bytes)))) (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes))) (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes)))) + #+nil (format t " lisp-ocfp=~S~% lisp-ra=~S~% c-ocfp=~S~% c-ra=~S~%" + lisp-ocfp lisp-ra c-ocfp c-ra) (cond ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp) (ra-pointer-valid-p lisp-ra) (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp) @@ -712,10 +704,10 @@ (bogus-debug-fun (let ((fp (frame-pointer frame))) (when (control-stack-pointer-valid-p fp) - #!+x86 + #!+(or x86 x86-64) (multiple-value-bind (ra ofp) (x86-call-context fp) (and ra (compute-calling-frame ofp ra frame))) - #!-x86 + #!-(or x86 x86-64) (compute-calling-frame #!-alpha (sap-ref-sap fp (* ocfp-save-offset @@ -733,7 +725,7 @@ ;;; Get the old FP or return PC out of FRAME. STACK-SLOT is the ;;; standard save location offset on the stack. LOC is the saved ;;; SC-OFFSET describing the main location. -#!-x86 +#!-(or x86 x86-64) (defun get-context-value (frame stack-slot loc) (declare (type compiled-frame frame) (type unsigned-byte stack-slot) (type sb!c:sc-offset loc)) @@ -742,7 +734,7 @@ (if escaped (sub-access-debug-var-slot pointer loc escaped) (stack-ref pointer stack-slot)))) -#!+x86 +#!+(or x86 x86-64) (defun get-context-value (frame stack-slot loc) (declare (type compiled-frame frame) (type unsigned-byte stack-slot) (type sb!c:sc-offset loc)) @@ -754,9 +746,10 @@ (#.ocfp-save-offset (stack-ref pointer stack-slot)) (#.lra-save-offset - (sap-ref-sap pointer (- (* (1+ stack-slot) 4)))))))) + (sap-ref-sap pointer (- (* (1+ stack-slot) + sb!vm::n-word-bytes)))))))) -#!-x86 +#!-(or x86 x86-64) (defun (setf get-context-value) (value frame stack-slot loc) (declare (type compiled-frame frame) (type unsigned-byte stack-slot) (type sb!c:sc-offset loc)) @@ -766,7 +759,7 @@ (sub-set-debug-var-slot pointer loc value escaped) (setf (stack-ref pointer stack-slot) value)))) -#!+x86 +#!+(or x86 x86-64) (defun (setf get-context-value) (value frame stack-slot loc) (declare (type compiled-frame frame) (type unsigned-byte stack-slot) (type sb!c:sc-offset loc)) @@ -778,7 +771,14 @@ (#.ocfp-save-offset (setf (stack-ref pointer stack-slot) value)) (#.lra-save-offset - (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value)))))) + (setf (sap-ref-sap pointer (- (* (1+ stack-slot) + sb!vm::n-word-bytes))) value)))))) + +(defun foreign-function-backtrace-name (sap) + (let ((name (foreign-symbol-in-address sap))) + (if name + (format nil "foreign function: ~A" name) + (format nil "foreign function: #x~X" (sap-int sap))))) ;;; This returns a frame for the one existing in time immediately ;;; prior to the frame referenced by current-fp. This is current-fp's @@ -794,7 +794,7 @@ ;;; Note: Sometimes LRA is actually a fixnum. This happens when lisp ;;; calls into C. In this case, the code object is stored on the stack ;;; after the LRA, and the LRA is the word offset. -#!-x86 +#!-(or x86 x86-64) (defun compute-calling-frame (caller lra up-frame) (declare (type system-area-pointer caller)) (when (control-stack-pointer-valid-p caller) @@ -826,7 +826,8 @@ "undefined function")) (:foreign-function (make-bogus-debug-fun - (format nil "foreign function call land:"))) + (foreign-function-backtrace-name + (int-sap (get-lisp-obj-address lra))))) ((nil) (make-bogus-debug-fun "bogus stack frame")) @@ -837,7 +838,7 @@ escaped) (if up-frame (1+ (frame-number up-frame)) 0) escaped)))))) -#!+x86 +#!+(or x86 x86-64) (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) (/noshow0 "entering COMPUTE-CALLING-FRAME") @@ -847,7 +848,6 @@ (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller) (/noshow0 "at COND") (cond (code - (/noshow0 "in CODE clause") ;; If it's escaped it may be a function end breakpoint trap. (when (and (code-component-p code) (eq (%code-debug-info code) :bogus-lra)) @@ -856,24 +856,19 @@ code (1+ real-lra-slot))) (setq code (code-header-ref code real-lra-slot)) (aver code))) - (t - (/noshow0 "in T clause") - ;; not escaped + ((not escaped) (multiple-value-setq (pc-offset code) (compute-lra-data-from-pc ra)) (unless code (setf code :foreign-function - pc-offset 0 - escaped nil)))) - + pc-offset 0)))) (let ((d-fun (case code (:undefined-function (make-bogus-debug-fun "undefined function")) (:foreign-function (make-bogus-debug-fun - (format nil "foreign function call land: ra=#x~X" - (sap-int ra)))) + (foreign-function-backtrace-name ra))) ((nil) (make-bogus-debug-fun "bogus stack frame")) @@ -893,7 +888,7 @@ (+ sb!vm::thread-interrupt-contexts-offset n)) (* os-context-t))) -#!+x86 +#!+(or x86 x86-64) (defun find-escaped-frame (frame-pointer) (declare (type system-area-pointer frame-pointer)) (/noshow0 "entering FIND-ESCAPED-FRAME") @@ -933,7 +928,7 @@ (return (values code pc-offset context))))))))) -#!-x86 +#!-(or x86 x86-64) (defun find-escaped-frame (frame-pointer) (declare (type system-area-pointer frame-pointer)) (dotimes (index *free-interrupt-context-index* (values nil 0 nil)) @@ -993,25 +988,18 @@ nil)) (values code pc-offset scp)))))))))) -#!-x86 +#!-(or x86 x86-64) (defun find-pc-from-assembly-fun (code scp) "Finds the PC for the return from an assembly routine properly. For some architectures (such as PPC) this will not be the $LRA register." - (let ((return-machine-address - ;; This conditional logic should probably go into - ;; architecture specific files somehow. - #!+ppc (sap-int (sb!vm::context-lr scp)) - #!+sparc (+ (sb!vm:context-register scp sb!vm::lip-offset) 8) - #!-(or ppc sparc) (- (sb!vm:context-register scp sb!vm::lra-offset) - sb!vm:other-pointer-lowtag)) - (code-header-len (* (get-header-data code) - sb!vm:n-word-bytes))) - (values (- return-machine-address - (- (get-lisp-obj-address code) - sb!vm:other-pointer-lowtag) - code-header-len) - return-machine-address))) + (let ((return-machine-address (sb!vm::return-machine-address scp)) + (code-header-len (* (get-header-data code) sb!vm:n-word-bytes))) + (values (- return-machine-address + (- (get-lisp-obj-address code) + sb!vm:other-pointer-lowtag) + code-header-len) + return-machine-address))) ;;; Find the code object corresponding to the object represented by ;;; bits and return it. We assume bogus functions correspond to the @@ -1042,8 +1030,11 @@ register." (defun debug-fun-from-pc (component pc) (let ((info (%code-debug-info component))) (cond - ((not info) - (debug-signal 'no-debug-info :code-component component)) + ((not info) + ;; FIXME: It seems that most of these (at least on x86) are + ;; actually assembler routines, and could be named by looking + ;; at the sb-fasl:*assembler-routines*. + (make-bogus-debug-fun "no debug information for frame")) ((eq info :bogus-lra) (make-bogus-debug-fun "function end breakpoint")) (t @@ -1106,34 +1097,34 @@ register." (sap-ref-32 catch (* sb!vm:catch-block-current-cont-slot sb!vm:n-word-bytes)))) - (let* (#!-x86 + (let* (#!-(or x86 x86-64) (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot)) - #!+x86 + #!+(or x86 x86-64) (ra (sap-ref-sap catch (* sb!vm:catch-block-entry-pc-slot sb!vm:n-word-bytes))) - #!-x86 + #!-(or x86 x86-64) (component (stack-ref catch sb!vm:catch-block-current-code-slot)) - #!+x86 + #!+(or x86 x86-64) (component (component-from-component-ptr (component-ptr-from-pc ra))) (offset - #!-x86 + #!-(or x86 x86-64) (* (- (1+ (get-header-data lra)) (get-header-data component)) sb!vm:n-word-bytes) - #!+x86 + #!+(or x86 x86-64) (- (sap-int ra) (- (get-lisp-obj-address component) sb!vm:other-pointer-lowtag) (* (get-header-data component) sb!vm:n-word-bytes)))) - (push (cons #!-x86 + (push (cons #!-(or x86 x86-64) (stack-ref catch sb!vm:catch-block-tag-slot) - #!+x86 + #!+(or x86 x86-64) (make-lisp-obj - (sap-ref-32 catch (* sb!vm:catch-block-tag-slot - sb!vm:n-word-bytes))) + (sap-ref-word catch (* sb!vm:catch-block-tag-slot + sb!vm:n-word-bytes))) (make-compiled-code-location offset (frame-debug-fun frame))) reversed-result))) @@ -1417,6 +1408,9 @@ register." ;; optional. Stick the extra var in the result ;; element representing the keyword or optional, ;; which is the previous one. + ;; + ;; FIXME: NCONC used for side-effect: the effect is defined, + ;; but this is bad style no matter what. (nconc (car res) (list (compiled-debug-fun-lambda-list-var args (incf i) vars)))) @@ -1756,27 +1750,11 @@ register." ;;; Return the CODE-LOCATION's DEBUG-SOURCE. (defun code-location-debug-source (code-location) - (etypecase code-location - (compiled-code-location - (let* ((info (compiled-debug-fun-debug-info - (code-location-debug-fun code-location))) - (sources (sb!c::compiled-debug-info-source info)) - (len (length sources))) - (declare (list sources)) - (when (zerop len) - (debug-signal 'no-debug-blocks :debug-fun - (code-location-debug-fun code-location))) - (if (= len 1) - (car sources) - (do ((prev sources src) - (src (cdr sources) (cdr src)) - (offset (code-location-toplevel-form-offset code-location))) - ((null src) (car prev)) - (when (< offset (sb!c::debug-source-source-root (car src))) - (return (car prev))))))) - ;; (There used to be more cases back before sbcl-0.7.0, when we - ;; did special tricks to debug the IR1 interpreter.) - )) + (let ((info (compiled-debug-fun-debug-info + (code-location-debug-fun code-location)))) + (or (sb!c::debug-info-source info) + (debug-signal 'no-debug-blocks :debug-fun + (code-location-debug-fun code-location))))) ;;; Returns the number of top level forms before the one containing ;;; CODE-LOCATION as seen by the compiler in some compilation unit. (A @@ -1998,14 +1976,17 @@ register." (defun make-valid-lisp-obj (val) (if (or ;; fixnum - (zerop (logand val 3)) + (zerop (logand val sb!vm:fixnum-tag-mask)) + ;; immediate single float, 64-bit only + #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) + (= (logand val #xff) sb!vm:single-float-widetag) ;; character - (and (zerop (logand val #xffff0000)) ; Top bits zero - (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag + (and (zerop (logandc2 val #x1fffffff)) ; Top bits zero + (= (logand val #xff) sb!vm:character-widetag)) ; char tag ;; unbound marker (= val sb!vm:unbound-marker-widetag) ;; pointer - (and (logand val 1) + (and (logbitp 0 val) ;; Check that the pointer is valid. XXX Could do a better ;; job. FIXME: e.g. by calling out to an is_valid_pointer ;; routine in the C runtime support code @@ -2015,12 +1996,12 @@ register." (< sb!vm:static-space-start val (* sb!vm:*static-space-free-pointer* sb!vm:n-word-bytes)) - (< sb!vm:dynamic-space-start val + (< (current-dynamic-space-start) val (sap-int (dynamic-space-free-pointer)))))) (make-lisp-obj val) :invalid-object)) -#!-x86 +#!-(or x86 x86-64) (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (macrolet ((with-escaped-value ((var) &body forms) `(if escaped @@ -2056,7 +2037,7 @@ register." (sb!sys:without-gcing (with-escaped-value (val) (sb!kernel:make-lisp-obj val)))) - (#.sb!vm:base-char-reg-sc-number + (#.sb!vm:character-reg-sc-number (with-escaped-value (val) (code-char val))) (#.sb!vm:sap-reg-sc-number @@ -2146,7 +2127,7 @@ register." sb!vm:n-word-bytes))))) (#.sb!vm:control-stack-sc-number (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset))) - (#.sb!vm:base-char-stack-sc-number + (#.sb!vm:character-stack-sc-number (with-nfp (nfp) (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))))) @@ -2163,7 +2144,7 @@ register." (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))))))) -#!+x86 +#!+(or x86 x86-64) (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (declare (type system-area-pointer fp)) (macrolet ((with-escaped-value ((var) &body forms) @@ -2191,7 +2172,7 @@ register." (without-gcing (with-escaped-value (val) (make-valid-lisp-obj val)))) - (#.sb!vm:base-char-reg-sc-number + (#.sb!vm:character-reg-sc-number (with-escaped-value (val) (code-char val))) (#.sb!vm:sap-reg-sc-number @@ -2250,16 +2231,16 @@ register." sb!vm:n-word-bytes))))) (#.sb!vm:control-stack-sc-number (stack-ref fp (sb!c:sc-offset-offset sc-offset))) - (#.sb!vm:base-char-stack-sc-number + (#.sb!vm:character-stack-sc-number (code-char - (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) - sb!vm:n-word-bytes))))) + (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) + sb!vm:n-word-bytes))))) (#.sb!vm:unsigned-stack-sc-number - (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) - sb!vm:n-word-bytes)))) + (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) + sb!vm:n-word-bytes)))) (#.sb!vm:signed-stack-sc-number - (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) - sb!vm:n-word-bytes)))) + (signed-sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) + sb!vm:n-word-bytes)))) (#.sb!vm:sap-stack-sc-number (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))))))) @@ -2292,7 +2273,7 @@ register." (compiled-debug-var-sc-offset debug-var)) value)))) -#!-x86 +#!-(or x86 x86-64) (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped) (macrolet ((set-escaped-value (val) `(if escaped @@ -2331,7 +2312,7 @@ register." (without-gcing (set-escaped-value (get-lisp-obj-address value)))) - (#.sb!vm:base-char-reg-sc-number + (#.sb!vm:character-reg-sc-number (set-escaped-value (char-code value))) (#.sb!vm:sap-reg-sc-number (set-escaped-value (sap-int value))) @@ -2430,7 +2411,7 @@ register." (the long-float (realpart value))))) (#.sb!vm:control-stack-sc-number (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value)) - (#.sb!vm:base-char-stack-sc-number + (#.sb!vm:character-stack-sc-number (with-nfp (nfp) (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes)) @@ -2451,7 +2432,7 @@ register." sb!vm:n-word-bytes)) (the system-area-pointer value))))))) -#!+x86 +#!+(or x86 x86-64) (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped) (macrolet ((set-escaped-value (val) `(if escaped @@ -2465,7 +2446,7 @@ register." (without-gcing (set-escaped-value (get-lisp-obj-address value)))) - (#.sb!vm:base-char-reg-sc-number + (#.sb!vm:character-reg-sc-number (set-escaped-value (char-code value))) (#.sb!vm:sap-reg-sc-number (set-escaped-value (sap-int value))) @@ -2529,19 +2510,19 @@ register." (imagpart (the (complex long-float) value)))) (#.sb!vm:control-stack-sc-number (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value)) - (#.sb!vm:base-char-stack-sc-number - (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) - sb!vm:n-word-bytes))) + (#.sb!vm:character-stack-sc-number + (setf (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) + sb!vm:n-word-bytes))) (char-code (the character value)))) (#.sb!vm:unsigned-stack-sc-number - (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) - sb!vm:n-word-bytes))) - (the (unsigned-byte 32) value))) + (setf (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) + sb!vm:n-word-bytes))) + (the sb!vm:word value))) (#.sb!vm:signed-stack-sc-number - (setf (signed-sap-ref-32 + (setf (signed-sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))) - (the (signed-byte 32) value))) + (the (signed-byte #.sb!vm:n-word-bits) value))) (#.sb!vm:sap-stack-sc-number (setf (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))) @@ -2817,7 +2798,7 @@ register." (compiled-debug-fun-compiler-debug-fun what)) :standard) (error ":FUN-END breakpoints are currently unsupported ~ - for the known return convention.")) + for the known return convention.")) (let* ((bpt (%make-breakpoint hook-fun what kind info)) (starter (compiled-debug-fun-end-starter what))) @@ -2905,7 +2886,7 @@ register." (do ((frame frame (frame-down frame))) ((not frame) nil) (when (and (compiled-frame-p frame) - (#!-x86 eq #!+x86 sap= + (#!-(or x86 x86-64) eq #!+(or x86 x86-64) sap= lra (get-context-value frame lra-save-offset lra-sc-offset))) (return t))))) @@ -3239,8 +3220,8 @@ register." (defun get-fun-end-breakpoint-values (scp) (let ((ocfp (int-sap (sb!vm:context-register scp - #!-x86 sb!vm::ocfp-offset - #!+x86 sb!vm::ebx-offset))) + #!-(or x86 x86-64) sb!vm::ocfp-offset + #!+(or x86 x86-64) sb!vm::ebx-offset))) (nargs (make-lisp-obj (sb!vm:context-register scp sb!vm::nargs-offset))) (reg-arg-offsets '#.sb!vm::*register-arg-offsets*) @@ -3257,9 +3238,9 @@ register." ;;;; MAKE-BOGUS-LRA (used for :FUN-END breakpoints) (defconstant bogus-lra-constants - #!-x86 2 #!+x86 3) + #!-(or x86 x86-64) 2 #!+(or x86 x86-64) 3) (defconstant known-return-p-slot - (+ sb!vm:code-constants-offset #!-x86 1 #!+x86 2)) + (+ sb!vm:code-constants-offset #!-(or x86 x86-64) 1 #!+(or x86 x86-64) 2)) ;;; Make a bogus LRA object that signals a breakpoint trap when ;;; returned to. If the breakpoint trap handler returns, REAL-LRA is @@ -3268,6 +3249,8 @@ register." ;;; instruction. (defun make-bogus-lra (real-lra &optional known-return-p) (without-gcing + ;; These are really code labels, not variables: but this way we get + ;; their addresses. (let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts")) (src-end (foreign-symbol-address "fun_end_breakpoint_end")) (trap-loc (foreign-symbol-address "fun_end_breakpoint_trap")) @@ -3282,19 +3265,19 @@ register." (setf (%code-debug-info code-object) :bogus-lra) (setf (code-header-ref code-object sb!vm:code-trace-table-offset-slot) length) - #!-x86 + #!-(or x86 x86-64) (setf (code-header-ref code-object real-lra-slot) real-lra) - #!+x86 + #!+(or x86 x86-64) (multiple-value-bind (offset code) (compute-lra-data-from-pc real-lra) (setf (code-header-ref code-object real-lra-slot) code) (setf (code-header-ref code-object (1+ real-lra-slot)) offset)) (setf (code-header-ref code-object known-return-p-slot) known-return-p) - (system-area-copy src-start 0 dst-start 0 (* length sb!vm:n-byte-bits)) + (system-area-ub8-copy src-start 0 dst-start 0 length) (sb!vm:sanctify-for-execution code-object) - #!+x86 + #!+(or x86 x86-64) (values dst-start code-object (sap- trap-loc src-start)) - #!-x86 + #!-(or x86 x86-64) (let ((new-lra (make-lisp-obj (+ (sap-int dst-start) sb!vm:other-pointer-lowtag)))) (set-header-data