source: branches/working-0711-perf/ccl/level-0/X86/x86-array.lisp @ 9443

Last change on this file since 9443 was 9443, checked in by gb, 12 years ago

%EXTEND-VECTOR changes.

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