src/cold/compile-cold-sbcl.lisp

   1 ;;;; Compile the fundamental system sources (not CLOS, and possibly
   2 ;;;; not some other warm-load-only stuff like DESCRIBE) to produce
   3 ;;;; object files. Also set *TARGET-OBJECT-FILES* to all of their
   4 ;;;; names.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   9 ;;;; This software is derived from the CMU CL system, which was
  10 ;;;; written at Carnegie Mellon University and released into the
  11 ;;;; public domain. The software is in the public domain and is
  12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  13 ;;;; files for more information.
  14
  15 (in-package "SB-COLD")
  16
  17 ;;;; $Header$
  18
  19 (defvar *target-object-file-names*)
  20
  21 ;;; KLUDGE..
  22 ;;;
  23 ;;; CMU CL (as of 2.4.6 for Debian, anyway) issues warnings (and not just
  24 ;;; STYLE-WARNINGs, either, alas) when it tries to interpret code containing
  25 ;;; references to undefined functions. The most common problem is that
  26 ;;; macroexpanded code refers to this function, which isn't defined until late.
  27 ;;;
  28 ;;; This
  29 ;;;   #+cmu (defun sb!kernel::do-arg-count-error (&rest rest)
  30 ;;;        (error "stub version of do-arg-count-error, rest=~S" rest))
  31 ;;; doesn't work, with or without this
  32 ;;;   (compile 'sb!kernel::do-arg-count-error))
  33 ;;; so perhaps I should try
  34 ;;;   (declaim (ftype ..) ..)
  35 ;;; instead?
  36 (declaim (ftype (function (&rest t) nil) sb!kernel::do-arg-count-error))
  37
  38 (let ((reversed-target-object-file-names nil))
  39   (for-stems-and-flags (stem flags)
  40     (unless (find :not-target flags)
  41       ;; FIXME: Remove these GC calls after fixing the problem of ridiculous
  42       ;; bootstrap memory bloat.
  43       (push (target-compile-stem stem
  44                                  :assem-p (find :assem flags)
  45                                  :ignore-failure-p (find :ignore-failure-p
  46                                                          flags))
  47             reversed-target-object-file-names)
  48       #!+sb-show (warn-when-cl-snapshot-diff *cl-snapshot*)))
  49   (setf *target-object-file-names*
  50         (nreverse reversed-target-object-file-names)))