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

Last change on this file since 13413 was 13413, checked in by gb, 10 years ago

%SIMPLE-BIT-BOOLE passes the length (in 64-bit words) to the LAP
primitives; the primitives do the loop themselves, and do most of
it 128 bits at a time.

Note that we may be sloppy about storing into alignment/pad words
at the end of the vector. That shouldn't matter, but bignum
normalization code might care.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.5 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;;; In each of these "simple BOOLE functions", the LEN argument
234;;; describes the size of the bit vectors in whole or partial
235;;; native-sized words.  The 0th word (and, if the number of
236;;; words is even, the last word) are not aligned on 16-byte
237;;; boundaries; any intervening pairs of words are aligned on
238;;; 16-byte boundaries, and we can use aligned SSE2 instructions
239;;; to process these bits 128 at a time.
240
241(defx86lapfunction %boole-clr ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
242  (movq (@ len (% rsp)) (% temp0))
243  (orl ($ 1) (%l temp0))
244  (pxor (% xmm0) (% xmm0))
245  (jmp @test)
246  @loop
247  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
248  @test
249  (subq ($ '2) (% temp0))
250  (jg @loop)
251  (movq ($ 0) (@ x8664::misc-data-offset (% dest)))
252  (single-value-return 3))
253
254(defx86lapfunction %boole-set ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
255  (movq (@ len (% rsp)) (% temp0))
256  (orl ($ '1) (%l temp0))
257  (pcmpeqb (% xmm0) (% xmm0))
258  (jmp @test)
259  @loop
260  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
261  @test
262  (subq ($ '2) (% temp0))
263  (jg @loop)
264  (movq ($ -1) (@ x8664::misc-data-offset (% dest)))
265  (single-value-return 3)
266  (:align 4))
267
268(defx86lapfunction %boole-1 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
269  (movq (@ len (% rsp)) (% temp0))
270  (orl ($ '1) (%l temp0))
271  (jmp @test)
272  @loop
273  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
274  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
275  @test
276  (subq ($ '2) (% temp0))
277  (jg @loop)
278  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
279  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
280  (single-value-return 3))
281
282(defx86lapfunction %boole-2 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
283  (movq (@ len (% rsp)) (% temp0))
284  (orl ($ '1) (%l temp0))
285  (jmp @test)
286  @loop
287  (movaps (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
288  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
289  @test
290  (subq ($ '2) (% temp0))
291  (jg @loop)
292  (movq (@ x8664::misc-data-offset (% b1)) (% imm0))
293  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
294  (single-value-return 3))
295
296(defx86lapfunction %boole-c1 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
297  (movq (@ len (% rsp)) (% temp0))
298  (pcmpeqb (% xmm1) (% xmm1))
299  (orl ($ '1) (%l temp0))
300  (jmp @test)
301  @loop
302  (movdqa (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
303  (pxor (% xmm1) (% xmm0))
304  (movdqa (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
305  @test
306  (subq ($ '2) (% temp0))
307  (jg @loop)
308  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
309  (notq (% imm0))
310  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
311  (single-value-return 3))
312
313(defx86lapfunction %boole-c2 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
314  (movq (@ len (% rsp)) (% temp0))
315  (pcmpeqb (% xmm1) (% xmm1))
316  (orl ($ '1) (%l temp0))
317  (jmp @test)
318  @loop
319  (movaps (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
320  (pxor (% xmm1) (% xmm0))
321  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
322  @test
323  (subq ($ '2) (% temp0))
324  (jg @loop)
325  (movq (@ x8664::misc-data-offset (% b1)) (% imm0))
326  (notq (% imm0))
327  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
328  (single-value-return 3))
329
330(defx86lapfunction %boole-and ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
331  (movq (@ len (% rsp)) (% temp0))
332  (orl ($ '1) (%l temp0))
333  (jmp @test)
334  @loop
335  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
336  (pand (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
337  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
338  @test
339  (subq ($ '2) (% temp0))
340  (jg @loop)
341  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
342  (andq (@ x8664::misc-data-offset (% b1)) (% imm0))
343  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
344  (single-value-return 3))
345
346(defx86lapfunction %boole-ior ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
347  (movq (@ len (% rsp)) (% temp0))
348  (orl ($ '1) (%l temp0))
349  (jmp @test)
350  @loop
351  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
352  (por (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
353  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
354  @test
355  (subq ($ '2) (% temp0))
356  (jg @loop)
357  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
358  (orq (@ x8664::misc-data-offset (% b1)) (% imm0))
359  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
360  (single-value-return 3))
361
362(defx86lapfunction %boole-xor ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
363  (movq (@ len (% rsp)) (% temp0))
364  (orl ($ '1) (%l temp0))
365  (jmp @test)
366  @loop
367  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
368  (pxor (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
369  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
370  @test
371  (subq ($ '2) (% temp0))
372  (jg @loop)
373  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
374  (xorq (@ x8664::misc-data-offset (% b1)) (% imm0))
375  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
376  (single-value-return 3))
377
378(defx86lapfunction %boole-eqv ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
379  (movq (@ len (% rsp)) (% temp0))
380  (orl ($ '1) (%l temp0))
381  (pcmpeqb (% xmm1) (% xmm1))
382  (jmp @test)
383  @loop
384  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
385  (pxor (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
386  (pxor (% xmm1) (% xmm0))
387  (movaps(% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
388  @test
389  (subq ($ '2) (% temp0))
390  (jg @loop) 
391  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
392  (xorq (@ x8664::misc-data-offset (% b1)) (% imm0))
393  (notq (% imm0))
394  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
395  (single-value-return 3))
396
397(defx86lapfunction %boole-nand ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
398  (movq (@ len (% rsp)) (% temp0))
399  (orl ($ '1) (%l temp0))
400  (pcmpeqb (% xmm1) (% xmm1))
401  (jmp @test)
402  @loop
403  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
404  (pand (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
405  (pxor (% xmm1) (% xmm0))
406  (movaps(% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
407  @test
408  (subq ($ '2) (% temp0))
409  (jg @loop) 
410  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
411  (andq (@ x8664::misc-data-offset (% b1)) (% imm0))
412  (notq (% imm0))
413  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
414  (single-value-return 3))
415
416(defx86lapfunction %boole-nor ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
417  (movq (@ len (% rsp)) (% temp0))
418  (orl ($ '1) (%l temp0))
419  (pcmpeqb (% xmm1) (% xmm1))
420  (jmp @test)
421  @loop
422  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
423  (por (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
424  (pxor (% xmm1) (% xmm0))
425  (movaps(% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
426  @test
427  (subq ($ '2) (% temp0))
428  (jg @loop) 
429  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
430  (orq (@ x8664::misc-data-offset (% b1)) (% imm0))
431  (notq (% imm0))
432  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
433  (single-value-return 3))
434
435(defx86lapfunction %boole-andc1 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
436  (movq (@ len (% rsp)) (% temp0))
437  (orl ($ '1) (%l temp0))
438  (pcmpeqb (% xmm1) (% xmm1))
439  (jmp @test)
440  @loop
441  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
442  (pxor (% xmm1) (% xmm0))
443  (pand (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
444  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
445  @test
446  (subq ($ '2) (% temp0))
447  (jg @loop) 
448  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
449  (notq (% imm0))
450  (andq (@ x8664::misc-data-offset (% b1)) (% imm0))
451  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
452  (single-value-return 3))
453
454(defx86lapfunction %boole-andc2 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
455  (movq (@ len (% rsp)) (% temp0))
456  (orl ($ '1) (%l temp0))
457  (pcmpeqb (% xmm1) (% xmm1))
458  (jmp @test)
459  @loop
460  (movaps (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
461  (pxor (% xmm1) (% xmm0))
462  (pand (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
463  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
464  @test
465  (subq ($ '2) (% temp0))
466  (jg @loop) 
467  (movq (@ x8664::misc-data-offset (% b1)) (% imm0))
468  (notq (% imm0))
469  (andq (@ x8664::misc-data-offset (% b0)) (% imm0))
470  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
471  (single-value-return 3))
472
473(defx86lapfunction %boole-orc1 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
474  (movq (@ len (% rsp)) (% temp0))
475  (orl ($ '1) (%l temp0))
476  (pcmpeqb (% xmm1) (% xmm1))
477  (jmp @test)
478  @loop
479  (movaps (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
480  (pxor (% xmm1) (% xmm0))
481  (por (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
482  (movaps (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
483  @test
484  (subq ($ '2) (% temp0))
485  (jg @loop) 
486  (movq (@ x8664::misc-data-offset (% b0)) (% imm0))
487  (notq (% imm0))
488  (orq (@ x8664::misc-data-offset (% b1)) (% imm0))
489  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
490  (single-value-return 3))
491
492(defx86lapfunction %boole-orc2 ((len 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
493  (movq (@ len (% rsp)) (% temp0))
494  (orl ($ '1) (%l temp0))
495  (pcmpeqb (% xmm1) (% xmm1))
496  (jmp @test)
497  @loop
498  (movaps (@ x8664::misc-data-offset (% b1) (% temp0)) (% xmm0))
499  (pxor (% xmm1) (% xmm0))
500  (por (@ x8664::misc-data-offset (% b0) (% temp0)) (% xmm0))
501  (movq (% xmm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
502  @test
503  (subq ($ '2) (% temp0))
504  (jg @loop) 
505  (movq (@ x8664::misc-data-offset (% b1)) (% imm0))
506  (notq (% imm0))
507  (orq (@ x8664::misc-data-offset (% b0)) (% imm0))
508  (movq (% imm0) (@ x8664::misc-data-offset (% dest)))
509  (single-value-return 3))
510
511(defparameter *simple-bit-boole-functions* ())
512
513(setq *simple-bit-boole-functions*
514      (vector
515       #'%boole-clr
516       #'%boole-set
517       #'%boole-1
518       #'%boole-2
519       #'%boole-c1
520       #'%boole-c2
521       #'%boole-and
522       #'%boole-ior
523       #'%boole-xor
524       #'%boole-eqv
525       #'%boole-nand
526       #'%boole-nor
527       #'%boole-andc1
528       #'%boole-andc2
529       #'%boole-orc1
530       #'%boole-orc2))
531
532(defun %simple-bit-boole (op b1 b2 result)
533  (funcall (svref *simple-bit-boole-functions* op)
534           (ash (the fixnum (+ (length result) 63)) -6)
535           b1
536           b2
537           result))
538
539(defx86lapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
540  (check-nargs 3)
541  (jmp-subprim .SParef2))
542
543(defx86lapfunction %aref3 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (k arg_z))
544  (check-nargs 4)
545  (pop (% ra0))
546  (pop (% temp0))
547  (discard-reserved-frame)
548  (push (% ra0))
549  (jmp-subprim .SParef3))
550
551(defx86lapfunction %aset2 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (newval arg_z))
552  (check-nargs 4)
553  (pop (% ra0))
554  (pop (% temp0))
555  (discard-reserved-frame)
556  (push (% ra0))
557  (jmp-subprim .SPaset2))
558
559(defx86lapfunction %aset3 ((array 16) (i 8) #|(ra 0)|# (j arg_x) (k arg_y) (newval arg_z))
560  (check-nargs 5)
561  (pop (% ra0))
562  (pop (% temp0))
563  (pop (% temp1))
564  (discard-reserved-frame)
565  (push (% ra0))
566  (jmp-subprim .SPaset3))
567
568)  ; #+x8664-target
569
Note: See TracBrowser for help on using the repository browser.