/[cmucl]/src/clx/clx.asd
ViewVC logotype

Diff of /src/clx/clx.asd

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

revision 1.1 by rtoy, Wed Jun 17 15:46:26 2009 UTC revision 1.2 by rtoy, Wed Jun 17 18:22:45 2009 UTC
# Line 0  Line 1 
1    ;;; -*- Lisp -*- mode
2    
3    ;;; Original copyright message from defsystem.lisp:
4    
5    ;;;                      TEXAS INSTRUMENTS INCORPORATED
6    ;;;                               P.O. BOX 2909
7    ;;;                            AUSTIN, TEXAS 78769
8    ;;;
9    ;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
10    ;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
11    ;;;
12    ;;; Permission is granted to any individual or institution to use,
13    ;;; copy, modify, and distribute this software, provided that this
14    ;;; complete copyright and permission notice is maintained, intact, in
15    ;;; all copies and supporting documentation.
16    ;;;
17    ;;; Texas Instruments Incorporated provides this software "as is"
18    ;;; without express or implied warranty.
19    ;;;
20    ;;; Franz Incorporated provides this software "as is" without express
21    ;;; or implied warranty.
22    
23    (defpackage :clx-system (:use :cl :asdf))
24    (in-package :clx-system)
25    
26    (pushnew :clx-ansi-common-lisp *features*)
27    
28    (defclass clx-source-file (cl-source-file) ())
29    (defclass xrender-source-file (clx-source-file) ())
30    
31    ;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of
32    ;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-)
33    (defclass example-source-file (cl-source-file) ())
34    
35    (defclass legacy-file (static-file) ())
36    
37    (defsystem CLX
38        :depends-on (#+sbcl sb-bsd-sockets)
39        :version "0.7.2"
40        :serial t
41        :default-component-class clx-source-file
42        :components
43        ((:file "package")
44         (:file "depdefs")
45         (:file "clx")
46         #-(or openmcl allegro) (:file "dependent")
47         #+openmcl (:file "dep-openmcl")
48         #+allegro (:file "dep-allegro")
49         (:file "macros")
50         (:file "bufmac")
51         (:file "buffer")
52         (:file "display")
53         (:file "gcontext")
54         (:file "input")
55         (:file "requests")
56         (:file "fonts")
57         (:file "graphics")
58         (:file "text")
59         (:file "attributes")
60         (:file "translate")
61         (:file "keysyms")
62         (:file "manager")
63         (:file "image")
64         (:file "resource")
65         #+allegro
66         (:file "excldep" :pathname "excldep.lisp")
67         (:module extensions
68                  :pathname #.(make-pathname :directory '(:relative))
69                  :components
70                  ((:file "shape")
71                   (:file "big-requests")
72                   (:file "xvidmode")
73                   (:xrender-source-file "xrender")
74                   (:file "glx")
75                   (:file "gl" :depends-on ("glx"))
76                   (:file "dpms")
77                   (:file "xtest")
78                   (:file "screensaver")
79                   (:file "xinerama")))
80         (:module demo
81                  :default-component-class example-source-file
82                  :components
83                  ((:file "bezier")
84                   ;; KLUDGE: this requires "bezier" for proper operation,
85                   ;; but we don't declare that dependency here, because
86                   ;; asdf doesn't load example files anyway.
87                   (:file "beziertest")
88                   (:file "clclock")
89                   (:file "clipboard")
90                   (:file "clx-demos")
91                   (:file "gl-test")
92                   ;; FIXME: compiling this generates 30-odd spurious code
93                   ;; deletion notes.  Find out why, and either fix or
94                   ;; workaround the problem.
95                   (:file "mandel")
96                   (:file "menu")
97                   (:file "zoid")))
98         (:module test
99                  :default-component-class example-source-file
100                  :components
101                  ((:file "image")
102                   ;; KLUDGE: again, this depends on "zoid"
103                   (:file "trapezoid")))
104         (:static-file "NEWS")
105         (:static-file "CHANGES")
106         (:static-file "README")
107         (:static-file "README-R5")
108         (:legacy-file "exclMakefile")
109         (:legacy-file "exclREADME")
110         (:legacy-file "exclcmac" :pathname "exclcmac.lisp")
111         (:legacy-file "excldepc" :pathname "excldep.c")
112         (:legacy-file "sockcl" :pathname "sockcl.lisp")
113         (:legacy-file "socket" :pathname "socket.c")
114         (:legacy-file "defsystem" :pathname "defsystem.lisp")
115         (:legacy-file "provide" :pathname "provide.lisp")
116         (:legacy-file "cmudep" :pathname "cmudep.lisp")
117         (:module manual
118                  ;; TODO: teach asdf how to process texinfo files
119                  :components ((:static-file "clx.texinfo")))
120         (:module debug
121                  :default-component-class legacy-file
122                  :components
123                  ((:file "debug" :pathname "debug.lisp")
124                   (:file "describe" :pathname "describe.lisp")
125                   (:file "event-test" :pathname "event-test.lisp")
126                   (:file "keytrans" :pathname "keytrans.lisp")
127                   (:file "trace" :pathname "trace.lisp")
128                   (:file "util" :pathname "util.lisp")))))
129    
130    (defmethod perform ((o load-op) (f example-source-file))
131      ;; do nothing.  We want to compile them when CLX is compiled, but
132      ;; not load them when CLX is loaded.
133      t)
134    
135    #+sbcl
136    (defmethod perform :around ((o compile-op) (f xrender-source-file))
137      ;; RENDER would appear to be an inherently slow protocol; further,
138      ;; it's not set in stone, and consequently we care less about speed
139      ;; than we do about correctness.
140      (handler-bind ((sb-ext:compiler-note #'muffle-warning))
141        (call-next-method)))
142    
143    #+sbcl
144    (defmethod perform :around ((o compile-op) (f clx-source-file))
145      ;; our CLX library should compile without WARNINGs, and ideally
146      ;; without STYLE-WARNINGs.  Since it currently does, let's enforce
147      ;; it here so that we can catch regressions easily.
148      (let ((on-warnings (operation-on-warnings o))
149            (on-failure (operation-on-failure o)))
150        (unwind-protect
151             (progn
152               (setf (operation-on-warnings o) :error
153                     (operation-on-failure o) :error)
154               ;; a variety of accessors, such as AREF-CARD32, are not
155               ;; declared INLINE.  Without this (non-ANSI)
156               ;; static-type-inference behaviour, SBCL emits an extra 100
157               ;; optimization notes (roughly one fifth of all of the
158               ;; notes emitted).  Since the internals are unlikely to
159               ;; change much, and certainly the internals should stay in
160               ;; sync, enabling this extension is a win.  (Note that the
161               ;; use of this does not imply that applications using CLX
162               ;; calls that expand into calls to these accessors will be
163               ;; optimized in the same way).
164               (let ((sb-ext:*derive-function-types* t)
165                     (sadx (find-symbol "STACK-ALLOCATE-DYNAMIC-EXTENT" :sb-c))
166                     (sadx-var (find-symbol "*STACK-ALLOCATE-DYNAMIC-EXTENT*" :sb-ext)))
167                 ;; deeply unportable stuff, this.  I will be shot.  We
168                 ;; want to enable the dynamic-extent declarations in CLX.
169                 (when (and sadx (sb-c::policy-quality-name-p sadx))
170                   ;; no way of setting it back short of yet more yukky stuff
171                   (proclaim `(optimize (,sadx 3))))
172                 (if sadx-var
173                     (progv (list sadx-var) (list t)
174                       (call-next-method))
175                     (call-next-method))))
176          (setf (operation-on-warnings o) on-warnings
177                (operation-on-failure o) on-failure))))
178    
179    #+sbcl
180    (defmethod perform :around (o (f clx-source-file))
181      ;; SBCL signals an error if DEFCONSTANT is asked to redefine a
182      ;; constant unEQLly.  For CLX's purposes, however, we are defining
183      ;; structured constants (lists and arrays) not for EQLity, but for
184      ;; the purposes of constant-folding operations such as (MEMBER FOO
185      ;; +BAR+), so it is safe to abort the redefinition provided the
186      ;; structured data is sufficiently equal.
187      (handler-bind
188          ((sb-ext:defconstant-uneql
189               (lambda (c)
190                 ;; KLUDGE: this really means "don't warn me about
191                 ;; efficiency of generic array access, please"
192                 (declare (optimize (sb-ext:inhibit-warnings 3)))
193                 (let ((old (sb-ext:defconstant-uneql-old-value c))
194                       (new (sb-ext:defconstant-uneql-new-value c)))
195                   (typecase old
196                     (list (when (equal old new) (abort c)))
197                     (string (when (and (typep new 'string)
198                                        (string= old new))
199                               (abort c)))
200                     (simple-vector
201                      (when (and (typep new 'simple-vector)
202                                 (= (length old) (length new))
203                                 (every #'eql old new))
204                        (abort c)))
205                     (array
206                      (when (and (typep new 'array)
207                                 (equal (array-dimensions old)
208                                        (array-dimensions new))
209                                 (equal (array-element-type old)
210                                        (array-element-type new))
211                                 (dotimes (i (array-total-size old) t)
212                                   (unless (eql (row-major-aref old i)
213                                                (row-major-aref new i))
214                                     (return nil))))
215                        (abort c))))))))
216        (call-next-method)))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5