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

Contents of /src/tools/pclcom.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.34 - (hide annotations)
Wed Jun 17 21:08:21 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, cross-sparc-branch-base, intl-branch-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.33: +1 -4 lines
There is no external-formats library.  Don't try to build it and don't
try to add it to the distribution.
1 dtc 1.19 ;;; -*- Package: USER -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;;
5     (ext:file-comment
6 rtoy 1.34 "$Header: /tiger/var/lib/cvsroots/cmucl/src/tools/pclcom.lisp,v 1.34 2009/06/17 21:08:21 rtoy Rel $")
7 dtc 1.19 ;;;
8     ;;; **********************************************************************
9     ;;;
10 gerd 1.30 (in-package "CL-USER")
11 toy 1.32 (setf lisp::*enable-package-locked-errors* nil)
12 ram 1.1
13 wlott 1.4 (when (find-package "PCL")
14 dtc 1.13 ;; Load the lisp:documentation functions.
15     (load "target:code/misc")
16    
17 ram 1.10 ;;
18 dtc 1.13 ;; Blow away make-instance optimizer so that it doesn't confuse
19     ;; bootstrapping.
20 ram 1.12 (setf (compiler-macro-function 'make-instance) nil)
21 dtc 1.21 ;;
22     ;; Blow away other compiler-macros exported from Lisp so that bootstrapping
23     ;; doesn't get confused.
24     (setf (compiler-macro-function 'slot-value) nil)
25     (setf (compiler-macro-function 'slot-boundp) nil)
26 ram 1.12 ;;
27 gerd 1.27 ;; Undefine all generic functions exported from Lisp so that
28     ;; bootstrapping doesn't get confused, but convert condition
29     ;; accessor gfs to normal functions beforehand, for the obvious
30     ;; reason.
31     (when (fboundp 'conditions::make-early-condition-accessors-generic)
32     (conditions::make-early-condition-accessors-generic nil))
33 gerd 1.24 (let ((class (kernel::find-class 'generic-function nil)))
34 ram 1.10 (when class
35     (do-external-symbols (sym "LISP")
36     (when (and (fboundp sym)
37     (typep (fdefinition sym) class))
38     (fmakunbound sym))
39     (let ((ssym `(setf ,sym)))
40     (when (and (fboundp ssym)
41     (typep (fdefinition ssym) class))
42     (fmakunbound ssym))))))
43    
44 gerd 1.24 (let ((sym (find-symbol "%CHECK-GF-REDEFINITION" "PCL")))
45     (when sym
46     (setq lisp::*setf-fdefinition-hook*
47     (delete (symbol-function sym) lisp::*setf-fdefinition-hook*))))
48 gerd 1.25
49     (when (boundp 'kernel::*defstruct-hooks*)
50     (let ((sym (find-symbol "REINITIALIZE-STRUCTURE-CLASS" "PCL")))
51     (when sym
52     (setq kernel::*defstruct-hooks*
53 gerd 1.31 (delete sym kernel::*defstruct-hooks*)))))
54 gerd 1.24
55 ram 1.10 ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.
56 gerd 1.24 (let ((wot (kernel::find-symbol "*FIND-CLASS*" "PCL")))
57 ram 1.10 (when (and wot (boundp wot))
58     (do-hash (name ignore (symbol-value wot))
59     (declare (ignore ignore))
60 gerd 1.24 (let ((class (kernel::find-class name nil)))
61 ram 1.10 (cond ((not class))
62     ((typep class 'kernel::std-class)
63     (setf (kernel:class-cell-class
64     (kernel:find-class-cell name))
65     nil)
66     (setf (info type kind name) nil))
67     (t
68 gerd 1.24 (setf (kernel:%class-pcl-class class) nil)))))))
69 ram 1.10
70 dtc 1.18 ;; Rename the PCL package to OLD-PCL, then restoring pcl::class and
71     ;; pcl::..slot-unbound.. back to the PCL package as they need be
72     ;; consistent with the symbols recognised by the compiler.
73 gerd 1.24 (let ((slot-unbound 'pcl::..slot-unbound..))
74 dtc 1.16 (rename-package "PCL" "OLD-PCL")
75     (make-package "PCL")
76 dtc 1.18 (import slot-unbound "PCL")
77     (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))
78 wlott 1.4
79 pw 1.15 (when (find-package "CLOS-MOP")
80     (rename-package "CLOS-MOP" "OLD-CLOS-MOP"))
81 pw 1.22
82     ;;; Inhibit ANSI :print-function and :print-object defstruct options.
83     (setq kernel::*ansi-defstruct-options-p* nil)
84 pw 1.15
85 ram 1.1 (setf c:*suppress-values-declaration* t)
86 gerd 1.24 (setf *features* (adjoin :setf *features*))
87 ram 1.1
88     (setf (search-list "pcl:") '("target:pcl/"))
89    
90     (let ((obj (make-pathname :defaults "pcl:defsys"
91 dtc 1.14 :type (c:backend-byte-fasl-file-type c:*backend*))))
92 ram 1.1 (when (< (or (file-write-date obj) 0)
93     (file-write-date "pcl:defsys.lisp"))
94 ram 1.11 (compile-file "pcl:defsys" :byte-compile t)))
95 ram 1.1
96     (load "pcl:defsys" :verbose t)
97    
98     (import 'kernel:funcallable-instance-p (find-package "PCL"))
99 gerd 1.24 (setq *gc-verbose* nil)
100 ram 1.1
101 toy 1.23 (with-compiler-log-file
102     ("target:compile-pcl.log"
103     :optimize '(optimize (debug #+small .5 #-small 2)
104 ram 1.8 (speed 2) (safety #+small 0 #-small 2)
105 ram 1.3 (inhibit-warnings 2))
106 ram 1.8 :optimize-interface '(optimize-interface #+small (safety 1))
107 ram 1.3 :context-declarations
108 ram 1.9 '((:external (declare (optimize-interface (safety 2) (debug 1))))
109 ram 1.11 ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
110     (declare (optimize (speed 0))))))
111 ram 1.2 (pcl::compile-pcl))
112 dtc 1.20
113    
114     (cat-if-anything-changed
115     "pcl:gray-streams-library"
116     "pcl:gray-streams-class"
117     "pcl:gray-streams")
118 toy 1.28
119     (cat-if-anything-changed
120     "pcl:simple-streams-library"
121 toy 1.29 "pcl:simple-streams/herald"
122 toy 1.28 "pcl:simple-streams/classes"
123     "pcl:simple-streams/internal"
124     "pcl:simple-streams/strategy"
125     "pcl:simple-streams/impl"
126     "pcl:simple-streams/null"
127     "pcl:simple-streams/direct"
128     "pcl:simple-streams/file"
129     "pcl:simple-streams/string"
130     "pcl:simple-streams/terminal"
131 rtoy 1.33 "pcl:simple-streams/socket";)
132     "pcl:simple-streams/iodefs"
133     "pcl:simple-streams/gray-compat")
134    
135     (cat-if-anything-changed
136 toy 1.29 "pcl:iodefs-library"
137     "pcl:simple-streams/iodefs")
138    
139     (cat-if-anything-changed
140     "pcl:gray-compat-library"
141     "pcl:simple-streams/gray-compat")

  ViewVC Help
Powered by ViewVC 1.1.5