3
;;; Original copyright message from defsystem.lisp:
5
;;; TEXAS INSTRUMENTS INCORPORATED
7
;;; AUSTIN, TEXAS 78769
9
;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
10
;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
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.
17
;;; Texas Instruments Incorporated provides this software "as is"
18
;;; without express or implied warranty.
20
;;; Franz Incorporated provides this software "as is" without express
21
;;; or implied warranty.
23
(defpackage :clx-system (:use :cl :asdf))
24
(in-package :clx-system)
26
(pushnew :clx-ansi-common-lisp *features*)
28
(defclass clx-source-file (cl-source-file) ())
29
(defclass xrender-source-file (clx-source-file) ())
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) ())
35
(defclass legacy-file (static-file) ())
38
:depends-on (sb-bsd-sockets)
41
:default-component-class clx-source-file
64
:pathname #.(make-pathname :directory '(:relative))
68
(:xrender-source-file "xrender")))
70
:default-component-class example-source-file
73
;; KLUDGE: this requires "bezier" for proper operation,
74
;; but we don't declare that dependency here, because
75
;; asdf doesn't load example files anyway.
79
;; FIXME: compiling this generates 30-odd spurious code
80
;; deletion notes. Find out why, and either fix or
81
;; workaround the problem.
86
:default-component-class example-source-file
89
;; KLUDGE: again, this depends on "zoid"
92
(:static-file "CHANGES")
93
(:static-file "README")
94
(:static-file "README-R5")
95
(:legacy-file "exclMakefile")
96
(:legacy-file "exclREADME")
97
(:legacy-file "exclcmac" :pathname "exclcmac.lisp")
98
(:legacy-file "excldepc" :pathname "excldep.c")
99
(:legacy-file "excldep" :pathname "excldep.lisp")
100
(:legacy-file "sockcl" :pathname "sockcl.lisp")
101
(:legacy-file "socket" :pathname "socket.c")
102
(:legacy-file "defsystem" :pathname "defsystem.lisp")
103
(:legacy-file "provide" :pathname "provide.lisp")
104
(:legacy-file "cmudep" :pathname "cmudep.lisp")
106
;; TODO: teach asdf how to process texinfo files
107
:components ((:static-file "clx.texinfo")))
109
:default-component-class legacy-file
111
((:file "debug" :pathname "debug.lisp")
112
(:file "describe" :pathname "describe.lisp")
113
(:file "event-test" :pathname "event-test.lisp")
114
(:file "keytrans" :pathname "keytrans.lisp")
115
(:file "trace" :pathname "trace.lisp")
116
(:file "util" :pathname "util.lisp")))))
118
(defmethod perform ((o load-op) (f example-source-file))
119
;; do nothing. We want to compile them when CLX is compiled, but
120
;; not load them when CLX is loaded.
124
(defmethod perform :around ((o compile-op) (f xrender-source-file))
125
;; RENDER would appear to be an inherently slow protocol; further,
126
;; it's not set in stone, and consequently we care less about speed
127
;; than we do about correctness.
128
(handler-bind ((sb-ext:compiler-note #'muffle-warning))
132
(defmethod perform :around ((o compile-op) (f clx-source-file))
133
;; our CLX library should compile without WARNINGs, and ideally
134
;; without STYLE-WARNINGs. Since it currently does, let's enforce
135
;; it here so that we can catch regressions easily.
136
(let ((on-warnings (operation-on-warnings o))
137
(on-failure (operation-on-failure o)))
140
(setf (operation-on-warnings o) :error
141
(operation-on-failure o) :error)
142
;; a variety of accessors, such as AREF-CARD32, are not
143
;; declared INLINE. Without this (non-ANSI)
144
;; static-type-inference behaviour, SBCL emits an extra 100
145
;; optimization notes (roughly one fifth of all of the
146
;; notes emitted). Since the internals are unlikely to
147
;; change much, and certainly the internals should stay in
148
;; sync, enabling this extension is a win. (Note that the
149
;; use of this does not imply that applications using CLX
150
;; calls that expand into calls to these accessors will be
151
;; optimized in the same way).
152
(let ((sb-ext:*derive-function-types* t))
153
;; deeply unportable stuff, this. I will be shot. We
154
;; want to enable the dynamic-extent declarations in CLX.
155
(when (sb-c::policy-quality-name-p
156
'sb-c::stack-allocate-dynamic-extent)
157
;; no way of setting it back short of yet more yukky stuff
158
(proclaim '(optimize (sb-c::stack-allocate-dynamic-extent 3))))
160
(setf (operation-on-warnings o) on-warnings
161
(operation-on-failure o) on-failure))))
164
(defmethod perform :around (o (f clx-source-file))
165
;; SBCL signals an error if DEFCONSTANT is asked to redefine a
166
;; constant unEQLly. For CLX's purposes, however, we are defining
167
;; structured constants (lists and arrays) not for EQLity, but for
168
;; the purposes of constant-folding operations such as (MEMBER FOO
169
;; +BAR+), so it is safe to abort the redefinition provided the
170
;; structured data is sufficiently equal.
172
((sb-ext:defconstant-uneql
174
;; KLUDGE: this really means "don't warn me about
175
;; efficiency of generic array access, please"
176
(declare (optimize (sb-ext:inhibit-warnings 3)))
177
(let ((old (sb-ext:defconstant-uneql-old-value c))
178
(new (sb-ext:defconstant-uneql-new-value c)))
180
(list (when (equal old new) (abort c)))
181
(string (when (and (typep new 'string)
185
(when (and (typep new 'simple-vector)
186
(= (length old) (length new))
187
(every #'eql old new))
190
(when (and (typep new 'array)
191
(equal (array-dimensions old)
192
(array-dimensions new))
193
(equal (array-element-type old)
194
(array-element-type new))
195
(dotimes (i (array-total-size old) t)
196
(unless (eql (row-major-aref old i)
197
(row-major-aref new i))
added
removed
src/clx/clx.asd
