1 ;;;; stuff that knows how to load compiled code directly into core
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;; A CORE-OBJECT structure holds the state needed to resolve cross-component
15 ;;; references during in-core compilation.
16 (defstruct (core-object
17 (:constructor make-core-object ())
18 #-no-ansi-print-object
19 (:print-object (lambda (x s)
20 (print-unreadable-object (x s :type t)))))
21 ;; A hashtable translating ENTRY-INFO structures to the corresponding actual
22 ;; FUNCTIONs for functions in this compilation.
23 (entry-table (make-hash-table :test 'eq) :type hash-table)
24 ;; A hashtable translating ENTRY-INFO structures to a list of pairs
25 ;; (<code object> . <offset>) describing the places that need to be
26 ;; backpatched to point to the function for ENTRY-INFO.
27 (patch-table (make-hash-table :test 'eq) :type hash-table)
28 ;; A list of all the DEBUG-INFO objects created, kept so that we can
29 ;; backpatch with the source info.
30 (debug-info () :type list))
32 ;;; Note the existence of FUNCTION.
33 (defun note-function (info function object)
34 (declare (type function function)
35 (type core-object object))
36 (let ((patch-table (core-object-patch-table object)))
37 (dolist (patch (gethash info patch-table))
38 (setf (code-header-ref (car patch) (the index (cdr patch))) function))
39 (remhash info patch-table))
40 (setf (gethash info (core-object-entry-table object)) function)
43 ;;; Do "load-time" fixups on the code vector.
44 (defun do-core-fixups (code fixups)
45 (declare (list fixups))
47 (let* ((kind (first info))
49 (name (fixup-name fixup))
50 (flavor (fixup-flavor fixup))
54 (assert (symbolp name))
55 (or (gethash name *assembler-routines*)
56 (error "undefined assembler routine: ~S" name)))
58 (assert (stringp name))
59 (or (sb!impl::foreign-symbol-address-as-integer name)
60 (error "unknown foreign symbol: ~S")))
64 (values (get-lisp-obj-address code) t)))))
65 (sb!vm:fixup-code-object code offset value kind))))
67 ;;; Stick a reference to the function Fun in Code-Object at index I. If the
68 ;;; function hasn't been compiled yet, make a note in the Patch-Table.
69 (defun reference-core-function (code-obj i fun object)
70 (declare (type core-object object) (type functional fun)
72 (let* ((info (leaf-info fun))
73 (found (gethash info (core-object-entry-table object))))
75 (setf (code-header-ref code-obj i) found)
76 (push (cons code-obj i)
77 (gethash info (core-object-patch-table object)))))
80 ;;; Call the top-level lambda function dumped for Entry, returning the
81 ;;; values. Entry may be a :TOP-LEVEL-XEP functional.
82 (defun core-call-top-level-lambda (entry object)
83 (declare (type functional entry) (type core-object object))
84 (funcall (or (gethash (leaf-info entry)
85 (core-object-entry-table object))
86 (error "Unresolved forward reference."))))
88 ;;; Backpatch all the DEBUG-INFOs dumped so far with the specified
89 ;;; SOURCE-INFO list. We also check that there are no outstanding forward
90 ;;; references to functions.
91 (defun fix-core-source-info (info object source-info)
92 (declare (type source-info info) (type core-object object))
93 (assert (zerop (hash-table-count (core-object-patch-table object))))
94 (let ((res (debug-source-for-info info)))
96 (setf (debug-source-info sinfo) source-info))
97 (dolist (info (core-object-debug-info object))
98 (setf (compiled-debug-info-source info) res))
99 (setf (core-object-debug-info object) ()))