source: trunk/source/level-0/X86/x86-array.lisp @ 10144

Last change on this file since 10144 was 10144, checked in by rme, 12 years ago

Delete stray "n" in %BOOLE-XOR. Wrap whole file in
#+x8664-target (progn ...)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.8 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19#+x8664-target
20(progn
21
22(eval-when (:compile-toplevel :execute)
23  #+x8632-target
24  (require "X8632-ARCH")
25  #+x8664-target
26  (require "X8664-ARCH")
27  (require "X86-LAPMACROS"))
28
29
30
31#+x8664-target
32(progn
33;;; None of the stores in here can be intergenerational; the vector
34;;; is known to be younger than the initial value
35(defx86lapfunction %init-gvector ((len arg_x) (value arg_y) (vector arg_z))
36  (jmp @test)
37  @loop
38  (movq (% value) (@ x8664::misc-data-offset (% vector) (% len)))
39  @test
40  (subq ($ x8664::fixnumone) (% len))
41  (jns @loop)
42  (single-value-return))
43
44;;; "val" is either a fixnum or a uvector with 64-bits of data
45;;; (small bignum, DOUBLE-FLOAT).
46(defx86lapfunction %%init-ivector64 ((len arg_x) (value arg_y) (vector arg_z))
47  (unbox-fixnum value imm0)
48  (testb ($ x8664::fixnummask) (%b value))
49  (je @test)
50  (movq (@ x8664::misc-data-offset (% value)) (% imm0))
51  (jmp @test)
52  @loop
53  (movq (% imm0) (@ x8664::misc-data-offset (% vector) (% len)))
54  @test
55  (subq ($ x8664::fixnumone) (% len))
56  (jns @loop)
57  (single-value-return))
58
59(defun %init-ivector64 (typecode len val uvector)
60  (declare (type (mod 256) typecode))
61  (%%init-ivector64 len
62                    (case typecode
63                      (#.x8664::subtag-fixnum-vector
64                       (require-type val 'fixnum))
65                      (#.x8664::subtag-double-float-vector
66                       (if (typep val 'double-float)
67                         val
68                         (require-type val 'double-float)))
69                      (#.x8664::subtag-s64-vector
70                       (require-type val '(signed-byte 64)))
71                      (#.x8664::subtag-u64-vector
72                       (require-type val '(unsigned-byte 64)))
73                      (t (report-bad-arg uvector
74                                         '(or (simple-array fixnum (*))
75                                           (simple-array double-float (*))
76                                           (simple-array (signed-byte 64) (*))
77                                           (simple-array (unsigned-byte 64) (*))))))
78                    uvector))
79 
80
81(eval-when (:compile-toplevel :execute)
82  (declaim (inline %init-ivector-u32)))
83
84(defun %init-ivector-u32 (len u32val uvector)
85  (declare (type index len)
86           (type (unsigned-byte 32) u32val)
87           (type (simple-array (unsigned-byte 32) (*)) uvector)
88           (optimize (speed 3) (safety 0)))
89  (dotimes (i len uvector)
90    (setf (aref uvector i) u32val)))
91
92(eval-when (:compile-toplevel :execute)
93  (declaim (inline %init-ivector-u16)))
94
95(defun %init-ivector-u16 (len val uvector)
96  (declare (type index len)
97           (type (unsigned-byte 16) val)
98           (type (simple-array (unsigned-byte 16) (*)) uvector)
99           (optimize (speed 3) (safety 0)))
100  (dotimes (i len uvector)
101    (setf (aref uvector i) val)))
102
103                             
104
105(defun %init-ivector32 (typecode len val uvector)
106  (declare (type (unsigned-byte 32) typecode)
107           (type index len))
108  (let* ((u32val (case typecode
109                   (#.x8664::subtag-s32-vector
110                    (logand (the (signed-byte 32)
111                              (require-type val '(signed-byte 32)))
112                            #xffffffff))
113                   (#.x8664::subtag-single-float-vector
114                    (single-float-bits (require-type val 'single-float)))
115                   (#.x8664::subtag-simple-base-string
116                    (char-code val))
117                   (t
118                    (require-type val '(unsigned-byte 32))))))
119    (declare (type (unsigned-byte 32) u32val))
120    (%init-ivector-u32 len u32val uvector)))
121
122(defun %init-misc (val uvector)
123  (let* ((len (uvsize uvector))
124         (typecode (typecode uvector))
125         (fulltag (logand x8664::fulltagmask typecode)))
126    (declare (type index len)
127             (type (unsigned-byte 8) typecode)
128             (type (mod 16) fulltag))
129    (if (or (= fulltag x8664::fulltag-nodeheader-0)
130            (= fulltag x8664::fulltag-nodeheader-1))
131      (%init-gvector len val uvector)
132      (if (= fulltag x8664::ivector-class-64-bit)
133        (%init-ivector64 typecode len val uvector)
134        (if (= fulltag x8664::ivector-class-32-bit)
135          (%init-ivector32 typecode len val uvector)
136          ;; Value must be a fixnum, 1, 8, 16 bits
137          (case typecode
138            (#.x8664::subtag-u16-vector
139             (%init-ivector-u16 len
140                                (require-type val '(unsigned-byte 16))
141                                uvector))
142            (#.x8664::subtag-s16-vector
143             (%init-ivector-u16 len
144                                (logand (the (signed-byte 16)
145                                          (require-type val '(unsigned-byte 16)))
146                                        #xffff)
147                                uvector))
148            (#.x8664::subtag-u8-vector
149             (let* ((v0 (require-type val '(unsigned-byte 8)))
150                    (l0 (ash (the fixnum (1+ len)) -1)))
151               (declare (type (unsigned-byte 8) v0)
152                        (type index l0))
153               (%init-ivector-u16 l0
154                                  (logior (the (unsigned-byte 16) (ash v0 8))
155                                          v0)
156                                  uvector)))
157            (#.x8664::subtag-s8-vector
158             (let* ((v0 (logand #xff
159                                (the (signed-byte 8)
160                                  (require-type val '(signed-byte 8)))))
161                    (l0 (ash (the fixnum (1+ len)) -1)))
162               (declare (type (unsigned-byte 8) v0)
163                        (type index l0))
164               (%init-ivector-u16 l0
165                                  (logior (the (unsigned-byte 16) (ash v0 8))
166                                          v0)
167                                  uvector)))
168            (#.x8664::subtag-bit-vector
169               (let* ((v0 (case val
170                            (1 -1)
171                            (0 0)
172                            (t (report-bad-arg val 'bit))))
173                      (l0 (ash (the fixnum (+ len 63)) -6)))
174                 (declare (type (unsigned-byte 8) v0)
175                          (type index l0))
176                 (%%init-ivector64  l0 v0 uvector)))
177            (t (report-bad-arg uvector
178                               '(or simple-bit-vector
179                                   (simple-array (signed-byte 8) (*))
180                                   (simple-array (unsigned-byte 8) (*))
181                                   (simple-array (signed-byte 16) (*))
182                                   (simple-array (unsigned-byte 16) (*)))))))))))
183             
184
185)
186
187#-x8664-target
188(defun %init-misc (val uvector)
189  (dotimes (i (uvsize uvector) uvector)
190    (setf (uvref uvector i) val)))
191         
192
193;;; Make a new vector of size newsize whose subtag matches that of oldv-arg.
194;;; Blast the contents of the old vector into the new one as quickly as
195;;; possible; leave remaining elements of new vector undefined (0).
196;;; Return new-vector.
197(defun %extend-vector (start oldv newsize)
198  (declare (fixnum start))
199  (let* ((new (%alloc-misc newsize (typecode oldv)))
200         (oldsize (uvsize oldv)))
201    (declare (fixnum oldsize))
202    (do* ((i 0 (1+ i))
203          (j start (1+ j)))
204         ((= i oldsize) new)
205      (declare (fixnum i j))
206      (setf (uvref new j) (uvref oldv i)))))
207   
208
209
210
211
212;;; argument is a vector header or an array header.  Or else.
213(defx86lapfunction %array-header-data-and-offset ((a arg_z))
214  (let ((offset arg_y)
215        (temp temp1))
216    (movq (% rsp) (% temp0))
217    (movl ($ '0) (%l offset))
218    (movq (% a) (% temp))
219    @loop
220    (movq (@ target::arrayH.data-vector (% temp)) (% a))
221    (extract-subtag a imm0)
222    (addq (@ target::arrayH.displacement (% temp)) (% offset))
223    (rcmp (% imm0) ($ target::subtag-vectorH))
224    (movq (% a) (% temp))
225    (jle @loop)
226    (push (% a))
227    (push (% offset))
228    (set-nargs 2)
229    (jmp-subprim  .SPvalues)))
230
231
232
233(defx86lapfunction %boole-clr ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
234  (movq (@ idx (% rsp)) (% temp0))
235  (movq ($ 0) (@ x8664::misc-data-offset (% dest) (% temp0)))
236  (single-value-return 3))
237
238(defx86lapfunction %boole-set ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
239  (movq (@ idx (% rsp)) (% temp0))
240  (movq ($ -1) (@ x8664::misc-data-offset (% dest) (% temp0)))
241  (single-value-return 3))
242
243(defx86lapfunction %boole-1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
244  (movq (@ idx (% rsp)) (% temp0))
245  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
246  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
247  (single-value-return 3))
248
249(defx86lapfunction %boole-2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
250  (movq (@ idx (% rsp)) (% temp0))
251  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
252  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
253  (single-value-return 3))
254
255(defx86lapfunction %boole-c1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
256  (movq (@ idx (% rsp)) (% temp0))
257  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
258  (notq (% imm0))
259  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
260  (single-value-return 3))
261
262(defx86lapfunction %boole-c2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
263  (movq (@ idx (% rsp)) (% temp0))
264  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
265  (notq (% imm0))
266  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
267  (single-value-return 3))
268
269(defx86lapfunction %boole-and ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
270  (movq (@ idx (% rsp)) (% temp0))
271  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
272  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
273  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
274  (single-value-return 3))
275
276(defx86lapfunction %boole-ior ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
277  (movq (@ idx (% rsp)) (% temp0))
278  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
279  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
280  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
281  (single-value-return 3))
282
283(defx86lapfunction %boole-xor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
284  (movq (@ idx (% rsp)) (% temp0))
285  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
286  (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
287  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
288  (single-value-return 3))
289
290(defx86lapfunction %boole-eqv ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
291  (movq (@ idx (% rsp)) (% temp0))
292  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
293  (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
294  (notq (% imm0))
295  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
296  (single-value-return 3))
297
298(defx86lapfunction %boole-nand ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
299  (movq (@ idx (% rsp)) (% temp0))
300  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
301  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
302  (notq (% imm0))
303  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
304  (single-value-return 3))
305
306(defx86lapfunction %boole-nor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
307  (movq (@ idx (% rsp)) (% temp0))
308  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
309  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
310  (notq (% imm0))
311  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
312  (single-value-return 3))
313
314(defx86lapfunction %boole-andc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
315  (movq (@ idx (% rsp)) (% temp0))
316  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
317  (notq (% imm0))
318  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
319  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
320  (single-value-return 3))
321
322(defx86lapfunction %boole-andc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
323  (movq (@ idx (% rsp)) (% temp0))
324  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
325  (notq (% imm0))
326  (andq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
327  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
328  (single-value-return 3))
329
330(defx86lapfunction %boole-orc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
331  (movq (@ idx (% rsp)) (% temp0))
332  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
333  (notq (% imm0))
334  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
335  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
336  (single-value-return 3))
337
338(defx86lapfunction %boole-orc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
339  (movq (@ idx (% rsp)) (% temp0))
340  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
341  (notq (% imm0))
342  (orq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
343  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
344  (single-value-return 3))
345
346(defparameter *simple-bit-boole-functions* ())
347
348(setq *simple-bit-boole-functions*
349      (vector
350       #'%boole-clr
351       #'%boole-set
352       #'%boole-1
353       #'%boole-2
354       #'%boole-c1
355       #'%boole-c2
356       #'%boole-and
357       #'%boole-ior
358       #'%boole-xor
359       #'%boole-eqv
360       #'%boole-nand
361       #'%boole-nor
362       #'%boole-andc1
363       #'%boole-andc2
364       #'%boole-orc1
365       #'%boole-orc2))
366
367(defun %simple-bit-boole (op b1 b2 result)
368  (let* ((f (svref *simple-bit-boole-functions* op)))
369    (dotimes (i (ash (the fixnum (+ (length result) 63)) -6) result)
370      (funcall f i b1 b2 result))))
371
372(defx86lapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
373  (check-nargs 3)
374  (jmp-subprim .SParef2))
375
376(defx86lapfunction %aref3 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (k arg_z))
377  (check-nargs 4)
378  (pop (% ra0))
379  (pop (% temp0))
380  (discard-reserved-frame)
381  (push (% ra0))
382  (jmp-subprim .SParef3))
383
384(defx86lapfunction %aset2 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (newval arg_z))
385  (check-nargs 4)
386  (pop (% ra0))
387  (pop (% temp0))
388  (discard-reserved-frame)
389  (push (% ra0))
390  (jmp-subprim .SPaset2))
391
392(defx86lapfunction %aset3 ((array 16) (i 8) #|(ra 0)|# (j arg_x) (k arg_y) (newval arg_z))
393  (check-nargs 5)
394  (pop (% ra0))
395  (pop (% temp0))
396  (pop (% temp1))
397  (discard-reserved-frame)
398  (push (% ra0))
399  (jmp-subprim .SPaset3))
400
401)  ; #+x8664-target
402
Note: See TracBrowser for help on using the repository browser.