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

Diff of /src/tools/pclcom.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by toy, Tue Dec 3 01:42:27 2002 UTC revision 1.23.2.2 by gerd, Wed Mar 19 17:03:52 2003 UTC
# Line 25  Line 25 
25    ;;    ;;
26    ;; Undefine all generic functions exported from Lisp so that bootstrapping    ;; Undefine all generic functions exported from Lisp so that bootstrapping
27    ;; doesn't get confused.    ;; doesn't get confused.
28    (let ((class (find-class 'generic-function nil)))    (let ((class (kernel::find-class 'generic-function nil)))
29      (when class      (when class
30        (do-external-symbols (sym "LISP")        (do-external-symbols (sym "LISP")
31          (when (and (fboundp sym)          (when (and (fboundp sym)
# Line 36  Line 36 
36                       (typep (fdefinition ssym) class))                       (typep (fdefinition ssym) class))
37              (fmakunbound ssym))))))              (fmakunbound ssym))))))
38    
39      (let ((sym (find-symbol "%CHECK-GF-REDEFINITION" "PCL")))
40        (when sym
41          (setq lisp::*setf-fdefinition-hook*
42                (delete (symbol-function sym) lisp::*setf-fdefinition-hook*))))
43    
44    ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.    ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.
45    (let ((wot (find-symbol "*FIND-CLASS*" "PCL")))    (let ((wot (kernel::find-symbol "*FIND-CLASS*" "PCL")))
46      (when (and wot (boundp wot))      (when (and wot (boundp wot))
47        (do-hash (name ignore (symbol-value wot))        (do-hash (name ignore (symbol-value wot))
48          (declare (ignore ignore))          (declare (ignore ignore))
49          (let ((class (find-class name nil)))          (let ((class (kernel::find-class name nil)))
50            (cond ((not class))            (cond ((not class))
51                  ((typep class 'kernel::std-class)                  ((typep class 'kernel::std-class)
52                   (setf (kernel:class-cell-class                   (setf (kernel:class-cell-class
# Line 49  Line 54 
54                         nil)                         nil)
55                   (setf (info type kind name) nil))                   (setf (info type kind name) nil))
56                  (t                  (t
57                   (setf (kernel:class-pcl-class class) nil)))))))                   (setf (kernel:%class-pcl-class class) nil)))))))
58    
59    ;; Rename the PCL package to OLD-PCL, then restoring pcl::class and    ;; Rename the PCL package to OLD-PCL, then restoring pcl::class and
60    ;; pcl::..slot-unbound.. back to the PCL package as they need be    ;; pcl::..slot-unbound.. back to the PCL package as they need be
# Line 58  Line 63 
63          (slot-unbound 'pcl::..slot-unbound..))          (slot-unbound 'pcl::..slot-unbound..))
64      (rename-package "PCL" "OLD-PCL")      (rename-package "PCL" "OLD-PCL")
65      (make-package "PCL")      (make-package "PCL")
66        #+nil
67      (shadowing-import class "PCL")      (shadowing-import class "PCL")
68        #+nil
69      (kernel:%set-symbol-package class (find-package "PCL"))      (kernel:%set-symbol-package class (find-package "PCL"))
70      (import slot-unbound "PCL")      (import slot-unbound "PCL")
71      (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))      (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))
# Line 73  Line 80 
80  (setq kernel::*ansi-defstruct-options-p* nil)  (setq kernel::*ansi-defstruct-options-p* nil)
81    
82  (setf c:*suppress-values-declaration* t)  (setf c:*suppress-values-declaration* t)
83  (pushnew :setf *features*)  (setf *features* (adjoin :setf *features*))
84    
85  (setf (search-list "pcl:") '("target:pcl/"))  (setf (search-list "pcl:") '("target:pcl/"))
86    
# Line 86  Line 93 
93  (load "pcl:defsys" :verbose t)  (load "pcl:defsys" :verbose t)
94    
95  (import 'kernel:funcallable-instance-p (find-package "PCL"))  (import 'kernel:funcallable-instance-p (find-package "PCL"))
96    (setq *gc-verbose* nil)
97    
98  (with-compiler-log-file  (with-compiler-log-file
99      ("target:compile-pcl.log"      ("target:compile-pcl.log"

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.23.2.2

  ViewVC Help
Powered by ViewVC 1.1.5