1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
;; This is "target:tools/pclcom.lisp"
(in-package "USER")
(when (find-package "PCL")
(setf (compiler-macro-function 'make-instance) nil)
;;
;; Undefine all generic functions exported from Lisp so that bootstrapping
;; doesn't get confused.
(let ((class (find-class 'generic-function nil)))
(when class
(do-external-symbols (sym "LISP")
(when (and (fboundp sym)
(typep (fdefinition sym) class))
(fmakunbound sym))
(let ((ssym `(setf ,sym)))
(when (and (fboundp ssym)
(typep (fdefinition ssym) class))
(fmakunbound ssym))))))
;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.
(let ((wot (find-symbol "*FIND-CLASS*" "PCL")))
(when (and wot (boundp wot))
(do-hash (name ignore (symbol-value wot))
(declare (ignore ignore))
(let ((class (find-class name nil)))
(cond ((not class))
((typep class 'kernel::std-class)
(setf (kernel:class-cell-class
(kernel:find-class-cell name))
nil)
(setf (info type kind name) nil))
(t
(setf (kernel:class-pcl-class class) nil)))))))
(rename-package "PCL" "OLD-PCL")
(make-package "PCL"))
(when (find-package "SLOT-ACCESSOR-NAME")
(rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))
(setf c:*suppress-values-declaration* t)
(pushnew :setf *features*)
(setf (search-list "pcl:") '("target:pcl/"))
(let ((obj (make-pathname :defaults "pcl:defsys"
:type (c:backend-fasl-file-type c:*backend*))))
(when (< (or (file-write-date obj) 0)
(file-write-date "pcl:defsys.lisp"))
(compile-file "pcl:defsys" :byte-compile t)))
(load "pcl:defsys" :verbose t)
(import 'kernel:funcallable-instance-p (find-package "PCL"))
(with-compilation-unit
(:optimize '(optimize (debug #+small .5 #-small 2)
(speed 2) (safety #+small 0 #-small 2)
(inhibit-warnings 2))
:optimize-interface '(optimize-interface #+small (safety 1))
:context-declarations
'((:external (declare (optimize-interface (safety 2) (debug 1))))
((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
(declare (optimize (speed 0))))))
(pcl::compile-pcl))
|
