/[cmucl]/src/clx/exclcmac.lisp
ViewVC logotype

Contents of /src/clx/exclcmac.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Thu Nov 7 16:57:44 1991 UTC (22 years, 5 months ago) by ram
Branch: MAIN
CVS Tags: RELEASE_18a, RELEASE_18b
Branch point for: RELENG_18
Changes since 1.1: +62 -115 lines
CLX R5 changes.
1 ram 1.1 ;;; -*- Mode: common-lisp; Package: xlib; Base: 10; Lowercase: Yes -*-
2     ;;;
3     ;;; CLX -- exclcmac.cl
4     ;;; This file provides for inline expansion of some functions.
5     ;;;
6     ;;; Copyright (c) 1989 Franz Inc, Berkeley, Ca.
7     ;;;
8     ;;; Permission is granted to any individual or institution to use, copy,
9     ;;; modify, and distribute this software, provided that this complete
10     ;;; copyright and permission notice is maintained, intact, in all copies and
11     ;;; supporting documentation.
12     ;;;
13     ;;; Franz Incorporated provides this software "as is" without
14     ;;; express or implied warranty.
15     ;;;
16    
17 ram 1.2 (in-package :xlib)
18 ram 1.1
19     ;;
20     ;; Type predicates
21     ;;
22 ram 1.2 (excl:defcmacro card8p (x)
23 ram 1.1 (let ((xx (gensym)))
24     `(let ((,xx ,x))
25     (declare (optimize (speed 3) (safety 0))
26     (fixnum ,xx))
27 ram 1.2 (and (excl:fixnump ,xx) (> #.(expt 2 8) ,xx) (>= ,xx 0)))))
28 ram 1.1
29 ram 1.2 (excl:defcmacro card16p (x)
30 ram 1.1 (let ((xx (gensym)))
31     `(let ((,xx ,x))
32     (declare (optimize (speed 3) (safety 0))
33     (fixnum ,xx))
34 ram 1.2 (and (excl:fixnump ,xx) (> #.(expt 2 16) ,xx) (>= ,xx 0)))))
35 ram 1.1
36 ram 1.2 (excl:defcmacro int8p (x)
37 ram 1.1 (let ((xx (gensym)))
38     `(let ((,xx ,x))
39     (declare (optimize (speed 3) (safety 0))
40     (fixnum ,xx))
41 ram 1.2 (and (excl:fixnump ,xx) (> #.(expt 2 7) ,xx) (>= ,xx #.(expt -2 7))))))
42 ram 1.1
43 ram 1.2 (excl:defcmacro int16p (x)
44 ram 1.1 (let ((xx (gensym)))
45     `(let ((,xx ,x))
46     (declare (optimize (speed 3) (safety 0))
47     (fixnum ,xx))
48 ram 1.2 (and (excl:fixnump ,xx) (> #.(expt 2 15) ,xx) (>= ,xx #.(expt -2 15))))))
49 ram 1.1
50     ;; Card29p, card32p, int32p are too large to expand inline
51    
52    
53     ;;
54     ;; Type transformers
55     ;;
56 ram 1.2 (excl:defcmacro card8->int8 (x)
57 ram 1.1 (let ((xx (gensym)))
58     `(let ((,xx ,x))
59     ,(declare-bufmac)
60     (declare (type card8 ,xx))
61     (the int8 (if (logbitp 7 ,xx)
62     (the int8 (- ,xx #x100))
63     ,xx)))))
64 ram 1.2 (excl:defcmacro int8->card8 (x)
65 ram 1.1 `(locally ,(declare-bufmac)
66     (the card8 (ldb (byte 8 0) (the int8 ,x)))))
67    
68 ram 1.2 (excl:defcmacro card16->int16 (x)
69 ram 1.1 (let ((xx (gensym)))
70     `(let ((,xx ,x))
71     ,(declare-bufmac)
72     (declare (type card16 ,xx))
73     (the int16 (if (logbitp 15 ,xx)
74     (the int16 (- ,xx #x10000))
75     ,xx)))))
76    
77 ram 1.2 (excl:defcmacro int16->card16 (x)
78 ram 1.1 `(locally ,(declare-bufmac)
79     (the card16 (ldb (byte 16 0) (the int16 ,x)))))
80    
81 ram 1.2 (excl:defcmacro card32->int32 (x)
82 ram 1.1 (let ((xx (gensym)))
83     `(let ((,xx ,x))
84     ,(declare-bufmac)
85     (declare (type card32 ,xx))
86     (the int32 (if (logbitp 31 ,xx)
87     (the int32 (- ,xx #x100000000))
88     ,xx)))))
89    
90 ram 1.2 (excl:defcmacro int32->card32 (x)
91 ram 1.1 `(locally ,(declare-bufmac)
92     (the card32 (ldb (byte 32 0) (the int32 ,x)))))
93    
94 ram 1.2 (excl:defcmacro char->card8 (char)
95 ram 1.1 `(locally ,(declare-bufmac)
96     (the card8 (char-code (the string-char ,char)))))
97    
98 ram 1.2 (excl:defcmacro card8->char (card8)
99 ram 1.1 `(locally ,(declare-bufmac)
100     (the string-char (code-char (the card8 ,card8)))))
101    
102    
103     ;;
104     ;; Array accessors and setters
105     ;;
106 ram 1.2 (excl:defcmacro aref-card8 (a i)
107 ram 1.1 `(locally ,(declare-bufmac)
108 ram 1.2 (the card8 (sys:memref (the buffer-bytes ,a)
109     #.(comp::mdparam 'comp::md-svector-data0-adj)
110     (the array-index ,i)
111     :unsigned-byte))))
112    
113     (excl:defcmacro aset-card8 (v a i)
114 ram 1.1 `(locally ,(declare-bufmac)
115 ram 1.2 (setf (sys:memref (the buffer-bytes ,a)
116     #.(comp::mdparam 'comp::md-svector-data0-adj)
117     (the array-index ,i)
118     :unsigned-byte)
119     (the card8 ,v))))
120    
121     (excl:defcmacro aref-int8 (a i)
122 ram 1.1 `(locally ,(declare-bufmac)
123 ram 1.2 (the int8 (sys:memref (the buffer-bytes ,a)
124     #.(comp::mdparam 'comp::md-svector-data0-adj)
125     (the array-index ,i)
126     :signed-byte))))
127    
128     (excl:defcmacro aset-int8 (v a i)
129 ram 1.1 `(locally ,(declare-bufmac)
130 ram 1.2 (setf (sys:memref (the buffer-bytes ,a)
131     #.(comp::mdparam 'comp::md-svector-data0-adj)
132     (the array-index ,i)
133     :signed-byte)
134     (the int8 ,v))))
135 ram 1.1
136 ram 1.2 (excl:defcmacro aref-card16 (a i)
137 ram 1.1 `(locally ,(declare-bufmac)
138     (the card16 (sys:memref (the buffer-bytes ,a)
139     #.(comp::mdparam 'comp::md-svector-data0-adj)
140     (the array-index ,i)
141     :unsigned-word))))
142    
143 ram 1.2 (excl:defcmacro aset-card16 (v a i)
144 ram 1.1 `(locally ,(declare-bufmac)
145     (setf (sys:memref (the buffer-bytes ,a)
146 ram 1.2 #.(comp::mdparam 'comp::md-svector-data0-adj)
147     (the array-index ,i)
148     :unsigned-word)
149     (the card16 ,v))))
150 ram 1.1
151 ram 1.2 (excl:defcmacro aref-int16 (a i)
152 ram 1.1 `(locally ,(declare-bufmac)
153     (the int16 (sys:memref (the buffer-bytes ,a)
154     #.(comp::mdparam 'comp::md-svector-data0-adj)
155     (the array-index ,i)
156     :signed-word))))
157    
158 ram 1.2 (excl:defcmacro aset-int16 (v a i)
159 ram 1.1 `(locally ,(declare-bufmac)
160     (setf (sys:memref (the buffer-bytes ,a)
161     #.(comp::mdparam 'comp::md-svector-data0-adj)
162     (the array-index ,i)
163     :signed-word)
164     (the int16 ,v))))
165    
166 ram 1.2 (excl:defcmacro aref-card32 (a i)
167 ram 1.1 `(locally ,(declare-bufmac)
168     (the card32 (sys:memref (the buffer-bytes ,a)
169     #.(comp::mdparam 'comp::md-svector-data0-adj)
170     (the array-index ,i)
171     :unsigned-long))))
172    
173 ram 1.2 (excl:defcmacro aset-card32 (v a i)
174 ram 1.1 `(locally ,(declare-bufmac)
175     (setf (sys:memref (the buffer-bytes ,a)
176     #.(comp::mdparam 'comp::md-svector-data0-adj)
177     (the array-index ,i)
178     :unsigned-long)
179     (the card32 ,v))))
180    
181 ram 1.2 (excl:defcmacro aref-int32 (a i)
182 ram 1.1 `(locally ,(declare-bufmac)
183     (the int32 (sys:memref (the buffer-bytes ,a)
184     #.(comp::mdparam 'comp::md-svector-data0-adj)
185     (the array-index ,i)
186     :signed-long))))
187    
188 ram 1.2 (excl:defcmacro aset-int32 (v a i)
189 ram 1.1 `(locally ,(declare-bufmac)
190     (setf (sys:memref (the buffer-bytes ,a)
191     #.(comp::mdparam 'comp::md-svector-data0-adj)
192     (the array-index ,i)
193     :signed-long)
194     (the int32 ,v))))
195    
196 ram 1.2 (excl:defcmacro aref-card29 (a i)
197 ram 1.1 ;; Don't need to mask bits here since X protocol guarantees top bits zero
198     `(locally ,(declare-bufmac)
199     (the card29 (sys:memref (the buffer-bytes ,a)
200     #.(comp::mdparam 'comp::md-svector-data0-adj)
201     (the array-index ,i)
202     :unsigned-long))))
203    
204 ram 1.2 (excl:defcmacro aset-card29 (v a i)
205 ram 1.1 ;; I also assume here Lisp is passing a number that fits in 29 bits.
206     `(locally ,(declare-bufmac)
207     (setf (sys:memref (the buffer-bytes ,a)
208     #.(comp::mdparam 'comp::md-svector-data0-adj)
209     (the array-index ,i)
210     :unsigned-long)
211     (the card29 ,v))))
212    
213     ;;
214     ;; Font accessors
215     ;;
216 ram 1.2 (excl:defcmacro font-id (font)
217 ram 1.1 ;; Get font-id, opening font if needed
218     (let ((f (gensym)))
219     `(let ((,f ,font))
220     (or (font-id-internal ,f)
221     (open-font-internal ,f)))))
222    
223 ram 1.2 (excl:defcmacro font-font-info (font)
224 ram 1.1 (let ((f (gensym)))
225     `(let ((,f ,font))
226     (or (font-font-info-internal ,f)
227     (query-font ,f)))))
228    
229 ram 1.2 (excl:defcmacro font-char-infos (font)
230 ram 1.1 (let ((f (gensym)))
231     `(let ((,f ,font))
232     (or (font-char-infos-internal ,f)
233     (progn (query-font ,f)
234     (font-char-infos-internal ,f))))))
235    
236    
237     ;;
238     ;; Miscellaneous
239     ;;
240 ram 1.2 (excl:defcmacro current-process ()
241 ram 1.1 `(the (or mp::process null) (and mp::*scheduler-stack-group*
242     mp::*current-process*)))
243    
244 ram 1.2 (excl:defcmacro process-wakeup (process)
245 ram 1.1 (let ((proc (gensym)))
246     `(let ((.pw-curproc. mp::*current-process*)
247     (,proc ,process))
248     (when (and .pw-curproc. ,proc)
249     (if (> (mp::process-priority ,proc)
250     (mp::process-priority .pw-curproc.))
251     (mp::process-allow-schedule ,proc))))))
252    
253 ram 1.2 (excl:defcmacro buffer-new-request-number (buffer)
254 ram 1.1 (let ((buf (gensym)))
255     `(let ((,buf ,buffer))
256     (declare (type buffer ,buf))
257     (setf (buffer-request-number ,buf)
258     (ldb (byte 16 0) (1+ (buffer-request-number ,buf)))))))
259    
260    

  ViewVC Help
Powered by ViewVC 1.1.5