src/compiler/target-main.lisp

   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
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   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.
  13
  14 (in-package "SB!C")
  15 \f
  16 ;;;; CL:COMPILE
  17
  18 (defun get-lambda-to-compile (definition-designator)
  19   (if (consp definition-designator)
  20       definition-designator
  21       (multiple-value-bind (definition env-p)
  22                            (function-lambda-expression definition-designator)
  23         (when env-p
  24           (error "~S was defined in a non-null environment."
  25                  definition-designator))
  26         (unless definition
  27           (error "can't find a definition for ~S" definition-designator))
  28         definition)))
  29
  30 ;;; Handle the nontrivial case of CL:COMPILE.
  31 (defun actually-compile (name definition)
  32   (with-compilation-values
  33     (sb!xc:with-compilation-unit ()
  34       ;; FIXME: These bindings were copied from SUB-COMPILE-FILE with
  35       ;; few changes. Once things are stable, the shared bindings
  36       ;; probably be merged back together into some shared utility
  37       ;; macro, or perhaps both merged into one of the existing utility
  38       ;; macros SB-C::WITH-COMPILATION-VALUES or
  39       ;; CL:WITH-COMPILATION-UNIT.
  40       (let* (;; FIXME: Do we need the *INFO-ENVIRONMENT* rebinding
  41              ;; here? It's a literal translation of the old CMU CL
  42              ;; rebinding to (OR *BACKEND-INFO-ENVIRONMENT*
  43              ;; *INFO-ENVIRONMENT*), and it's not obvious whether the
  44              ;; rebinding to itself is needed now that SBCL doesn't
  45              ;; need *BACKEND-INFO-ENVIRONMENT*.
  46              (*info-environment* *info-environment*)
  47              (*lexenv* (make-null-lexenv))
  48              (form (get-lambda-to-compile definition))
  49              (*source-info* (make-lisp-source-info form))
  50              (*toplevel-lambdas* ())
  51              (*block-compile* nil)
  52              (*compiler-error-bailout*
  53               (lambda ()
  54                 (compiler-mumble
  55                  "~2&fatal error, aborting compilation~%")
  56                 (return-from actually-compile (values nil t nil))))
  57              (*current-path* nil)
  58              (*last-source-context* nil)
  59              (*last-original-source* nil)
  60              (*last-source-form* nil)
  61              (*last-format-string* nil)
  62              (*last-format-args* nil)
  63              (*last-message-count* 0)
  64              (*gensym-counter* 0)
  65              ;; FIXME: ANSI doesn't say anything about CL:COMPILE
  66              ;; interacting with these variables, so we shouldn't. As
  67              ;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
  68              ;; binding these variables, so as a quick hack we do so
  69              ;; too. But a proper implementation would have verbosity
  70              ;; controlled by function arguments and lexical variables.
  71              (*compile-verbose* nil)
  72              (*compile-print* nil))
  73         (clear-stuff)
  74         (find-source-paths form 0)
  75         (%compile form (make-core-object)
  76                   :name name
  77                   :path '(original-source-start 0 0))))))
  78
  79 (defun compile (name &optional (definition (or (macro-function name)
  80                                                (fdefinition name))))
  81   #!+sb-doc
  82   "Coerce DEFINITION (by default, the function whose name is NAME)
  83   to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
  84   where if NAME is NIL, THING is the result of compilation, and
  85   otherwise THING is NAME. When NAME is not NIL, the compiled function
  86   is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
  87   (FDEFINITION NAME) otherwise."
  88   (multiple-value-bind (compiled-definition warnings-p failure-p)
  89       (if (compiled-function-p definition)
  90           (values definition nil nil)
  91           (actually-compile name definition))
  92     (cond (name
  93            (if (and (symbolp name)
  94                     (macro-function name))
  95                (setf (macro-function name) compiled-definition)
  96                (setf (fdefinition name) compiled-definition))
  97            (values name warnings-p failure-p))
  98           (t
  99            (values compiled-definition warnings-p failure-p)))))