/[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.7 by pw, Sat Mar 23 18:51:23 2002 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      ;; Blow away other compiler-macros exported from Lisp so that bootstrapping
22      ;; doesn't get confused.
23      (setf (compiler-macro-function 'slot-value) nil)
24      (setf (compiler-macro-function 'slot-boundp) nil)
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 (find-class 'generic-function nil)))
# Line 34  Line 51 
51                  (t                  (t
52                   (setf (kernel:class-pcl-class class) nil)))))))                   (setf (kernel:class-pcl-class class) nil)))))))
53    
54    (rename-package "PCL" "OLD-PCL")    ;; Rename the PCL package to OLD-PCL, then restoring pcl::class and
55    (make-package "PCL"))    ;; pcl::..slot-unbound.. back to the PCL package as they need be
56      ;; consistent with the symbols recognised by the compiler.
57      (let ((class 'pcl::class)
58            (slot-unbound 'pcl::..slot-unbound..))
59        (rename-package "PCL" "OLD-PCL")
60        (make-package "PCL")
61        (shadowing-import class "PCL")
62        (kernel:%set-symbol-package class (find-package "PCL"))
63        (import slot-unbound "PCL")
64        (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))
65    
66  (when (find-package  "SLOT-ACCESSOR-NAME")  (when (find-package  "SLOT-ACCESSOR-NAME")
67    (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))    (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME"))
68    
69    (when (find-package "CLOS-MOP")
70      (rename-package "CLOS-MOP" "OLD-CLOS-MOP"))
71    
72    ;;; Inhibit ANSI :print-function and :print-object defstruct options.
73    (setq kernel::*ansi-defstruct-options-p* nil)
74    
75  (setf c:*suppress-values-declaration* t)  (setf c:*suppress-values-declaration* t)
76  (pushnew :setf *features*)  (pushnew :setf *features*)
77    
78  (setf (search-list "pcl:") '("target:pcl/"))  (setf (search-list "pcl:") '("target:pcl/"))
79    
80  (let ((obj (make-pathname :defaults "pcl:defsys"  (let ((obj (make-pathname :defaults "pcl:defsys"
81                            :type (c:backend-fasl-file-type c:*backend*))))                            :type (c:backend-byte-fasl-file-type c:*backend*))))
82    (when (< (or (file-write-date obj) 0)    (when (< (or (file-write-date obj) 0)
83             (file-write-date "pcl:defsys.lisp"))             (file-write-date "pcl:defsys.lisp"))
84      (compile-file "pcl:defsys" :byte-compile t)))      (compile-file "pcl:defsys" :byte-compile t)))
# Line 65  Line 97 
97         ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))         ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
98          (declare (optimize (speed 0))))))          (declare (optimize (speed 0))))))
99   (pcl::compile-pcl))   (pcl::compile-pcl))
100    
101    
102    (cat-if-anything-changed
103     "pcl:gray-streams-library"
104     "pcl:gray-streams-class"
105     "pcl:gray-streams")

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

  ViewVC Help
Powered by ViewVC 1.1.5