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

Contents of /src/tools/pclcom.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.34 - (show 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 ;;; -*- Package: USER -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;;
5 (ext:file-comment
6 "$Header: /tiger/var/lib/cvsroots/cmucl/src/tools/pclcom.lisp,v 1.34 2009/06/17 21:08:21 rtoy Rel $")
7 ;;;
8 ;;; **********************************************************************
9 ;;;
10 (in-package "CL-USER")
11 (setf lisp::*enable-package-locked-errors* nil)
12
13 (when (find-package "PCL")
14 ;; Load the lisp:documentation functions.
15 (load "target:code/misc")
16
17 ;;
18 ;; Blow away make-instance optimizer so that it doesn't confuse
19 ;; bootstrapping.
20 (setf (compiler-macro-function 'make-instance) nil)
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 ;;
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 (let ((class (kernel::find-class 'generic-function nil)))
34 (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 (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
49 (when (boundp 'kernel::*defstruct-hooks*)
50 (let ((sym (find-symbol "REINITIALIZE-STRUCTURE-CLASS" "PCL")))
51 (when sym
52 (setq kernel::*defstruct-hooks*
53 (delete sym kernel::*defstruct-hooks*)))))
54
55 ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots.
56 (let ((wot (kernel::find-symbol "*FIND-CLASS*" "PCL")))
57 (when (and wot (boundp wot))
58 (do-hash (name ignore (symbol-value wot))
59 (declare (ignore ignore))
60 (let ((class (kernel::find-class name nil)))
61 (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 (setf (kernel:%class-pcl-class class) nil)))))))
69
70 ;; 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 (let ((slot-unbound 'pcl::..slot-unbound..))
74 (rename-package "PCL" "OLD-PCL")
75 (make-package "PCL")
76 (import slot-unbound "PCL")
77 (kernel:%set-symbol-package slot-unbound (find-package "PCL"))))
78
79 (when (find-package "CLOS-MOP")
80 (rename-package "CLOS-MOP" "OLD-CLOS-MOP"))
81
82 ;;; Inhibit ANSI :print-function and :print-object defstruct options.
83 (setq kernel::*ansi-defstruct-options-p* nil)
84
85 (setf c:*suppress-values-declaration* t)
86 (setf *features* (adjoin :setf *features*))
87
88 (setf (search-list "pcl:") '("target:pcl/"))
89
90 (let ((obj (make-pathname :defaults "pcl:defsys"
91 :type (c:backend-byte-fasl-file-type c:*backend*))))
92 (when (< (or (file-write-date obj) 0)
93 (file-write-date "pcl:defsys.lisp"))
94 (compile-file "pcl:defsys" :byte-compile t)))
95
96 (load "pcl:defsys" :verbose t)
97
98 (import 'kernel:funcallable-instance-p (find-package "PCL"))
99 (setq *gc-verbose* nil)
100
101 (with-compiler-log-file
102 ("target:compile-pcl.log"
103 :optimize '(optimize (debug #+small .5 #-small 2)
104 (speed 2) (safety #+small 0 #-small 2)
105 (inhibit-warnings 2))
106 :optimize-interface '(optimize-interface #+small (safety 1))
107 :context-declarations
108 '((:external (declare (optimize-interface (safety 2) (debug 1))))
109 ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
110 (declare (optimize (speed 0))))))
111 (pcl::compile-pcl))
112
113
114 (cat-if-anything-changed
115 "pcl:gray-streams-library"
116 "pcl:gray-streams-class"
117 "pcl:gray-streams")
118
119 (cat-if-anything-changed
120 "pcl:simple-streams-library"
121 "pcl:simple-streams/herald"
122 "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 "pcl:simple-streams/socket";)
132 "pcl:simple-streams/iodefs"
133 "pcl:simple-streams/gray-compat")
134
135 (cat-if-anything-changed
136 "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