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