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

Last change on this file since 13067 was 13067, checked in by rme, 10 years ago

Update copyright notices.

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