/[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.12 by ram, Wed May 8 14:49:36 1996 UTC revision 1.12.2.5 by dtc, Tue Jun 6 10:07:49 2000 UTC
# Line 1  Line 1 
1    ;;; -*- Package: USER -*-
2    ;;;
3    ;;; **********************************************************************
4    ;;;
5    (ext:file-comment
6      "$Header$")
7    ;;;
8    ;;; **********************************************************************
9    ;;;
10  (in-package "USER")  (in-package "USER")
11    
12  (when (find-package "PCL")  (when (find-package "PCL")
13      ;; Load the lisp:documentation functions.
14      (load "target:code/misc")
15    
16    ;;    ;;
17    ;; Blow away make-instance optimizer so that it doesn't confuse bootstrapping.    ;; Blow away make-instance optimizer so that it doesn't confuse
18      ;; bootstrapping.
19    (setf (compiler-macro-function 'make-instance) nil)    (setf (compiler-macro-function 'make-instance) nil)
20    ;;    ;;
21    ;; Undefine all generic functions exported from Lisp so that bootstrapping    ;; Undefine all generic functions exported from Lisp so that bootstrapping
# Line 34  Line 46 
46                  (t                  (t
47                   (setf (kernel:class-pcl-class class) nil)))))))                   (setf (kernel:class-pcl-class class) nil)))))))
48    
49    (rename-package "PCL" "OLD-PCL")    ;; Rename the PCL package to OLD-PCL, then restoring pcl::class and
50    (make-package "PCL"))    ;; pcl::..slot-unbound.. back to the PCL package as they need be
51      ;; consistent with the symbols recognised by the compiler.
52      (let ((class 'pcl::class)
53            (slot-unbound 'pcl::..slot-unbound..))
54        (rename-package "PCL" "OLD-PCL")
55        (make-package "PCL")
56        (shadowing-import class "PCL")
57        (kernel:%set-symbol-package class (find-package "PCL"))
58        (import slot-unbound "PCL")
59        (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))
60    
61  (when (find-package  "SLOT-ACCESSOR-NAME")  (when (find-package  "SLOT-ACCESSOR-NAME")
62    (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))    (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))
63    
64    (when (find-package "CLOS-MOP")
65      (rename-package "CLOS-MOP" "OLD-CLOS-MOP"))
66    
67  (setf c:*suppress-values-declaration* t)  (setf c:*suppress-values-declaration* t)
68  (pushnew :setf *features*)  (pushnew :setf *features*)
69    
70  (setf (search-list "pcl:") '("target:pcl/"))  (setf (search-list "pcl:") '("target:pcl/"))
71    
72  (let ((obj (make-pathname :defaults "pcl:defsys"  (let ((obj (make-pathname :defaults "pcl:defsys"
73                            :type (c:backend-fasl-file-type c:*backend*))))                            :type (c:backend-byte-fasl-file-type c:*backend*))))
74    (when (< (or (file-write-date obj) 0)    (when (< (or (file-write-date obj) 0)
75             (file-write-date "pcl:defsys.lisp"))             (file-write-date "pcl:defsys.lisp"))
76      (compile-file "pcl:defsys" :byte-compile t)))      (compile-file "pcl:defsys" :byte-compile t)))
# Line 65  Line 89 
89         ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))         ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
90          (declare (optimize (speed 0))))))          (declare (optimize (speed 0))))))
91   (pcl::compile-pcl))   (pcl::compile-pcl))
92    
93    
94    (cat-if-anything-changed
95     "pcl:gray-streams-library"
96     "pcl:gray-streams-class"
97     "pcl:gray-streams")

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.12.2.5

  ViewVC Help
Powered by ViewVC 1.1.5