1 ;;;; This is some very low-level support for debugger :FUNCTION-END
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 (defconstant bogus-lra-constants 2)
16 (defconstant real-lra-slot (+ code-constants-offset 0))
17 (defconstant known-return-p-slot (+ code-constants-offset 1))
19 (defun make-bogus-lra (real-lra &optional known-return-p)
21 "Make a bogus LRA object that signals a breakpoint trap when returned to. If
22 the breakpoint trap handler returns to the fake component, the fake code
23 template returns to real-lra. This returns three values: the bogus LRA
24 object, the code component it points to, and the pc-offset for the trap
27 (let* ((src-start (truly-the system-area-pointer
28 (%primitive foreign-symbol-address
29 "function_end_breakpoint_guts")))
30 (src-end (truly-the system-area-pointer
31 (%primitive foreign-symbol-address
32 "function_end_breakpoint_end")))
33 (trap-loc (truly-the system-area-pointer
34 (%primitive foreign-symbol-address
35 "function_end_breakpoint_trap")))
36 (length (sap- src-end src-start))
37 (code-object (%primitive allocate-code-object
38 (1+ bogus-lra-constants)
40 (dst-start (code-instructions code-object)))
41 (declare (type system-area-pointer src-start src-end dst-start trap-loc)
43 (setf (code-header-ref code-object code-debug-info-slot) nil)
44 (setf (code-header-ref code-object code-trace-table-offset-slot) length)
45 (setf (code-header-ref code-object real-lra-slot) real-lra)
46 (setf (code-header-ref code-object known-return-p-slot) known-return-p)
47 (system-area-copy src-start 0 dst-start 0 (* length byte-bits))
49 (make-lisp-obj (+ (sap-int dst-start) other-pointer-type))))
50 (sb!kernel:set-header-data new-lra
51 (logandc2 (+ code-constants-offset
57 (sap- trap-loc src-start))))))