(rename-package package
(package-name package)
(cons "SB-C-CALL" (package-nicknames package))))
-
-;;; KLUDGE: This is created here (instead of in package-data-list.lisp-expr)
-;;; because it doesn't have any symbols in it, so even if it's
-;;; present at cold load time, genesis thinks it's unimportant
-;;; and doesn't dump it. There's gotta be a better way, but for now
-;;; I'll just do it here. (As noted below, I'd just as soon have this
-;;; go away entirely, so I'm disinclined to fiddle with it too much.)
-;;; -- WHN 19991206
-;;;
-;;; FIXME: Why do slot accessor names need to be interned anywhere? For
-;;; low-level debugging? Perhaps this should go away, or at least
-;;; be optional, controlled by SB-SHOW or something.
-(defpackage "SB-SLOT-ACCESSOR-NAME"
- (:use))
\f
;;;; compiling and loading more of the system
-;;; KLUDGE: In SBCL, almost all in-the-flow-of-control package hacking has
-;;; gone away in favor of package setup controlled by tables. However, that
-;;; mechanism isn't smart enough to handle shadowing, and since this shadowing
-;;; is inherently a non-ANSI KLUDGE anyway (i.e. there ought to be no
-;;; difference between e.g. CL:CLASS and SB-PCL:CLASS) there's not much
-;;; point in trying to polish it by implementing a non-KLUDGEy way of
-;;; setting it up. -- WHN 19991203
-(let ((*package* (the package (find-package "SB-PCL"))))
- (shadow '(;; CLASS itself and operations thereon
- "CLASS" "CLASS-NAME" "CLASS-OF" "FIND-CLASS"
- ;; some system classes
- "BUILT-IN-CLASS" "STANDARD-CLASS" "STRUCTURE-CLASS"))
- ;; Of the shadowing symbols above, these are external symbols in CMU CL ca.
- ;; 19991203. I'm not sure what's the basis of the decision to export some and
- ;; not others; we'll just follow along..
- (export (mapcar #'intern '("CLASS-NAME" "CLASS-OF" "FIND-CLASS"))))
+(let* ((sys *default-pathname-defaults*)
+ (src
+ (merge-pathnames
+ (make-pathname :directory '(:relative "src" :wild-inferiors)
+ :name :wild :type :wild)
+ sys))
+ (contrib
+ (merge-pathnames
+ (make-pathname :directory '(:relative "contrib" :wild-inferiors)
+ :name :wild :type :wild)
+ sys)))
+ (setf (logical-pathname-translations "SYS")
+ `(("SYS:SRC;**;*.*.*" ,src)
+ ("SYS:CONTRIB;**;*.*.*" ,contrib))))
;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
;;; COMPILE-PCL, at least some of which we should probably have too:
;; (arbitrary) linearization of the declared build
;; order dependencies from the old PCL defsys.lisp
;; dependency database.
- "src/pcl/walk"
- "src/pcl/early-low"
- "src/pcl/macros"
- "src/pcl/compiler-support"
- "src/pcl/low"
- "src/pcl/slot-name"
- "src/pcl/defclass"
- "src/pcl/defs"
- "src/pcl/fngen"
- "src/pcl/cache"
- "src/pcl/dlisp"
- "src/pcl/dlisp2"
- "src/pcl/boot"
- "src/pcl/vector"
- "src/pcl/slots-boot"
- "src/pcl/combin"
- "src/pcl/dfun"
- "src/pcl/fast-init"
- "src/pcl/braid"
- "src/pcl/dlisp3"
- "src/pcl/generic-functions"
- "src/pcl/slots"
- "src/pcl/init"
- "src/pcl/std-class"
- "src/pcl/cpl"
- "src/pcl/fsc"
- "src/pcl/methods"
- "src/pcl/fixup"
- "src/pcl/defcombin"
- "src/pcl/ctypes"
- "src/pcl/env"
- "src/pcl/documentation"
- "src/pcl/print-object"
- "src/pcl/precom1"
- "src/pcl/precom2"
+ #+nil "src/pcl/walk" ; #+NIL = moved to build-order.lisp-expr
+ "SRC;PCL;EARLY-LOW"
+ "SRC;PCL;MACROS"
+ "SRC;PCL;COMPILER-SUPPORT"
+ "SRC;PCL;LOW"
+ "SRC;PCL;SLOT-NAME"
+ "SRC;PCL;DEFCLASS"
+ "SRC;PCL;DEFS"
+ "SRC;PCL;FNGEN"
+ "SRC;PCL;CACHE"
+ "SRC;PCL;DLISP"
+ "SRC;PCL;DLISP2"
+ "SRC;PCL;BOOT"
+ "SRC;PCL;VECTOR"
+ "SRC;PCL;SLOTS-BOOT"
+ "SRC;PCL;COMBIN"
+ "SRC;PCL;DFUN"
+ "SRC;PCL;CTOR"
+ "SRC;PCL;BRAID"
+ "SRC;PCL;DLISP3"
+ "SRC;PCL;GENERIC-FUNCTIONS"
+ "SRC;PCL;SLOTS"
+ "SRC;PCL;INIT"
+ "SRC;PCL;STD-CLASS"
+ "SRC;PCL;CPL"
+ "SRC;PCL;FSC"
+ "SRC;PCL;METHODS"
+ "SRC;PCL;FIXUP"
+ "SRC;PCL;DEFCOMBIN"
+ "SRC;PCL;CTYPES"
+ "SRC;PCL;ENV"
+ "SRC;PCL;DOCUMENTATION"
+ "SRC;PCL;PRINT-OBJECT"
+ "SRC;PCL;PRECOM1"
+ "SRC;PCL;PRECOM2"
;; miscellaneous functionality which depends on CLOS
- "src/code/force-delayed-defbangmethods"
+ "SRC;CODE;FORCE-DELAYED-DEFBANGMETHODS"
+ "SRC;CODE;LATE-CONDITION"
;; CLOS-level support for the Gray OO streams
;; extension (which is also supported by various
;; lower-level hooks elsewhere in the code)
- "src/pcl/gray-streams-class"
- "src/pcl/gray-streams"
+ "SRC;PCL;GRAY-STREAMS-CLASS"
+ "SRC;PCL;GRAY-STREAMS"
;; other functionality not needed for cold init, moved
;; to warm init to reduce peak memory requirement in
;; cold init
- "src/code/describe"
- "src/code/inspect"
- "src/code/profile"
- "src/code/ntrace"
- "src/code/foreign"
- "src/code/run-program"
+ "SRC;CODE;DESCRIBE"
+ "SRC;CODE;DESCRIBE-POLICY"
+ "SRC;CODE;INSPECT"
+ "SRC;CODE;PROFILE"
+ "SRC;CODE;NTRACE"
+ "SRC;CODE;FOREIGN"
+ "SRC;CODE;RUN-PROGRAM"
;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
;; facility is still used in our ANSI DESCRIBE
;; facility, and should be compiled and loaded after
;; our DESCRIBE facility is compiled and loaded.
- "src/pcl/describe"))
+ "SRC;PCL;DESCRIBE"))
- (let ((fullname (concatenate 'string stem ".lisp")))
+ (let ((fullname (concatenate 'string "SYS:" stem ".LISP")))
(sb-int:/show "about to compile" fullname)
- (multiple-value-bind
- (compiled-truename compilation-warnings-p compilation-failure-p)
- (compile-file fullname)
- (declare (ignore compilation-warnings-p))
- (sb-int:/show "done compiling" fullname)
- (cond (compilation-failure-p
- (error "COMPILE-FILE of ~S failed." fullname))
- (t
- (unless (load compiled-truename)
- (error "LOAD of ~S failed." compiled-truename))
- (sb-int:/show "done loading" compiled-truename))))))
+ (flet ((report-recompile-restart (stream)
+ (format stream "Recompile file ~S" fullname))
+ (report-continue-restart (stream)
+ (format stream
+ "Continue, using possibly bogus file ~S"
+ (compile-file-pathname fullname))))
+ (tagbody
+ retry-compile-file
+ (multiple-value-bind (output-truename warnings-p failure-p)
+ (compile-file fullname)
+ (declare (ignore warnings-p))
+ (sb-int:/show "done compiling" fullname)
+ (cond ((not output-truename)
+ (error "COMPILE-FILE of ~S failed." fullname))
+ (failure-p
+ (unwind-protect
+ (restart-case
+ (error "FAILURE-P was set when creating ~S."
+ output-truename)
+ (recompile ()
+ :report report-recompile-restart
+ (go retry-compile-file))
+ (continue ()
+ :report report-continue-restart
+ (setf failure-p nil)))
+ ;; Don't leave failed object files lying around.
+ (when (and failure-p (probe-file output-truename))
+ (delete-file output-truename)
+ (format t "~&deleted ~S~%" output-truename))))
+ ;; Otherwise: success, just fall through.
+ (t nil))
+ (unless (load output-truename)
+ (error "LOAD of ~S failed." output-truename))
+ (sb-int:/show "done loading" output-truename))))))
\f
;;;; setting package documentation
"public: the default package for user code and data")
#+sb-doc (setf (documentation (find-package "KEYWORD") t)
"public: home of keywords")
-
-;;; KLUDGE: It'd be nicer to do this in the table with the other
-;;; non-standard packages. -- WHN 19991206
-#+sb-doc (setf (documentation (find-package "SB-SLOT-ACCESSOR-NAME") t)
- "private: home of CLOS slot accessor internal names")
-
-;;; FIXME: There doesn't seem to be any easy way to get package doc strings
-;;; through the cold boot process. They need to be set somewhere. Maybe the
-;;; easiest thing to do is to read them out of package-data-list.lisp-expr
-;;; now?