/[cmucl]/src/tools/pclcom.lisp
ViewVC logotype

Contents of /src/tools/pclcom.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12.2.1 - (hide annotations)
Fri Sep 12 17:30:41 1997 UTC (16 years, 7 months ago) by dtc
Branch: RELENG_18
CVS Tags: RELEASE_18a
Changes since 1.12: +5 -1 lines
Re-load the lisp:documentation functions when building PCL with PCL
loaded.
1 ram 1.1
2     (in-package "USER")
3    
4 wlott 1.4 (when (find-package "PCL")
5 dtc 1.12.2.1 ;; Load the lisp:documentation functions.
6     (load "target:code/misc")
7    
8 ram 1.10 ;;
9 dtc 1.12.2.1 ;; Blow away make-instance optimizer so that it doesn't confuse
10     ;; bootstrapping.
11 ram 1.12 (setf (compiler-macro-function 'make-instance) nil)
12     ;;
13 ram 1.10 ;; Undefine all generic functions exported from Lisp so that bootstrapping
14     ;; doesn't get confused.
15     (let ((class (find-class 'generic-function nil)))
16     (when class
17     (do-external-symbols (sym "LISP")
18     (when (and (fboundp sym)
19     (typep (fdefinition sym) class))
20     (fmakunbound sym))
21     (let ((ssym `(setf ,sym)))
22     (when (and (fboundp ssym)
23     (typep (fdefinition ssym) class))
24     (fmakunbound ssym))))))
25    
26     ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.
27     (let ((wot (find-symbol "*FIND-CLASS*" "PCL")))
28     (when (and wot (boundp wot))
29     (do-hash (name ignore (symbol-value wot))
30     (declare (ignore ignore))
31     (let ((class (find-class name nil)))
32     (cond ((not class))
33     ((typep class 'kernel::std-class)
34     (setf (kernel:class-cell-class
35     (kernel:find-class-cell name))
36     nil)
37     (setf (info type kind name) nil))
38     (t
39     (setf (kernel:class-pcl-class class) nil)))))))
40    
41 ram 1.7 (rename-package "PCL" "OLD-PCL")
42     (make-package "PCL"))
43 ram 1.10
44 ram 1.6 (when (find-package "SLOT-ACCESSOR-NAME")
45     (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))
46 wlott 1.4
47 ram 1.1 (setf c:*suppress-values-declaration* t)
48 ram 1.5 (pushnew :setf *features*)
49 ram 1.1
50     (setf (search-list "pcl:") '("target:pcl/"))
51    
52     (let ((obj (make-pathname :defaults "pcl:defsys"
53     :type (c:backend-fasl-file-type c:*backend*))))
54     (when (< (or (file-write-date obj) 0)
55     (file-write-date "pcl:defsys.lisp"))
56 ram 1.11 (compile-file "pcl:defsys" :byte-compile t)))
57 ram 1.1
58     (load "pcl:defsys" :verbose t)
59    
60     (import 'kernel:funcallable-instance-p (find-package "PCL"))
61    
62 ram 1.2 (with-compilation-unit
63 ram 1.9 (:optimize '(optimize (debug #+small .5 #-small 2)
64 ram 1.8 (speed 2) (safety #+small 0 #-small 2)
65 ram 1.3 (inhibit-warnings 2))
66 ram 1.8 :optimize-interface '(optimize-interface #+small (safety 1))
67 ram 1.3 :context-declarations
68 ram 1.9 '((:external (declare (optimize-interface (safety 2) (debug 1))))
69 ram 1.11 ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
70     (declare (optimize (speed 0))))))
71 ram 1.2 (pcl::compile-pcl))

  ViewVC Help
Powered by ViewVC 1.1.5