1 ;;;; functions from classic CMU CL src/compiler/main.lisp which are
2 ;;;; needed only (and which may make sense only) on the
3 ;;;; cross-compilation target, not the cross-compilation host
5 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
19 ;;;; COMPILE and UNCOMPILE
21 (defun get-lambda-to-compile (definition)
22 (if (consp definition)
24 (multiple-value-bind (def env-p)
25 (function-lambda-expression definition)
27 (error "~S was defined in a non-null environment." definition))
29 (error "Can't find a definition for ~S." definition))
32 ;;; Find the function that is being compiled by COMPILE and bash its name to
33 ;;; NAME. We also substitute for any references to name so that recursive
34 ;;; calls will be compiled direct. Lambda is the top-level lambda for the
35 ;;; compilation. A REF for the real function is the only thing in the
36 ;;; top-level lambda other than the bind and return, so it isn't too hard to
38 (defun compile-fix-function-name (lambda name)
39 (declare (type clambda lambda) (type (or symbol cons) name))
43 (node-cont (lambda-bind lambda))))))
44 (setf (leaf-name fun) name)
45 (let ((old (gethash name *free-functions*)))
46 (when old (substitute-leaf fun old)))
49 (defun compile (name &optional (definition (fdefinition name)))
51 "Compiles the function whose name is Name. If Definition is supplied,
52 it should be a lambda expression that is compiled and then placed in the
53 function cell of Name. If Name is Nil, the compiled code object is
55 (with-compilation-values
56 (sb!xc:with-compilation-unit ()
57 (let* ((*info-environment* (or *backend-info-environment*
59 (*lexenv* (make-null-lexenv))
60 (form `#',(get-lambda-to-compile definition))
61 (*source-info* (make-lisp-source-info form))
62 (*top-level-lambdas* ())
63 (*converting-for-interpreter* nil)
65 (*compiler-error-bailout*
68 "~2&fatal error, aborting compilation~%")
69 (return-from compile (values nil t nil))))
71 (*last-source-context* nil)
72 (*last-original-source* nil)
73 (*last-source-form* nil)
74 (*last-format-string* nil)
75 (*last-format-args* nil)
76 (*last-message-count* 0)
77 (*compile-object* (make-core-object))
79 ;; FIXME: ANSI doesn't say anything about CL:COMPILE
80 ;; interacting with these variables, so we shouldn't. As
81 ;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
82 ;; binding these variables, so as a quick hack we do so
83 ;; too. But a proper implementation would have verbosity
84 ;; controlled by function arguments and lexical variables.
85 (*compile-verbose* nil)
86 (*compile-print* nil))
88 (find-source-paths form 0)
89 (let ((lambda (ir1-top-level form '(original-source-start 0 0) t)))
91 (compile-fix-function-name lambda name)
93 (block-component (node-block (lambda-bind lambda))))
94 (*all-components* (list component)))
95 (local-call-analyze component))
97 (multiple-value-bind (components top-components)
98 (find-initial-dfo (list lambda))
99 (let ((*all-components* (append components top-components)))
100 (dolist (component *all-components*)
101 (compile-component component))))
103 (let* ((res1 (core-call-top-level-lambda lambda *compile-object*))
104 (result (or name res1)))
105 (fix-core-source-info *source-info* *compile-object* res1)
107 (setf (fdefinition name) res1))