source: branches/arm/level-0/ARM/arm-array.lisp @ 13756

Last change on this file since 13756 was 13756, checked in by gb, 9 years ago

More code.

File size: 17.7 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2010 Clozure Associates
4;;;   This file is part of Clozure CL. 
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   Clozure CL 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  (require "ARM-ARCH")
21  (require "ARM-LAPMACROS"))
22
23
24;;; Users of this shouldn't make assumptions about return value.
25
26
27(eval-when (:compile-toplevel :execute)
28;;; Assumptions made by %init-misc
29  (assert (and (< arm::max-32-bit-ivector-subtag
30                  arm::max-8-bit-ivector-subtag
31                  arm::max-16-bit-ivector-subtag)
32               (eql arm::max-32-bit-ivector-subtag arm::subtag-simple-base-string)
33               (eql arm::max-16-bit-ivector-subtag arm::subtag-s16-vector)
34               (eql arm::max-8-bit-ivector-subtag 223))))
35
36
37(defarmlapfunction %init-misc ((val arg_y)
38                               (miscobj arg_z))
39  (getvheader imm0 miscobj)
40  (bic temp1 imm0 (:$ arm::subtag-mask))
41  (movs temp1 (:lsr temp1 (:$ (- arm::num-subtag-bits arm::fixnumshift))))
42  (extract-lowbyte imm2 imm0)
43  (extract-fulltag imm1 imm0)
44  (bxeq lr)
45  (cmp imm1 (:$ arm::fulltag-nodeheader))
46  (bne @ivector)
47  (mov imm1 (:$ arm::misc-data-offset))
48  @node-loop
49  (subs temp1 temp1 '1)
50  (str val (:@ miscobj imm1))
51  (add imm1 imm1 '1)
52  (bne @node-loop)
53  (bx lr)
54  @ivector
55  (build-lisp-frame imm0)
56  (mov imm1 (:$ arm::misc-data-offset))
57  (mov imm2 (:lsr imm2 (:$ 3)))
58  (bl @dispatch)
59  (b @u32)                              ;bignum,0
60  (b @u32)                              ;single-float
61  (b @u32)                              ;double-float
62  (b @u32)                              ;macptr
63  (b @u32)                              ;dead-macptr
64  (b @u32)                              ;code-vector, 5
65  (b @bad)
66  (b @bad)
67  (b @bad)
68  (b @bad)
69  (b @bad)
70  (b @bad)
71  (b @bad)
72  (b @bad)
73  (b @bad)
74  (b @bad)
75  (b @bad)
76  (b @bad)
77  (b @bad)
78  (b @bad)
79  (b @single-float-vector)              ;20
80  (b @u32)
81  (b @s32)
82  (b @fixnum)
83  (b @string)
84  (b @u8)
85  (b @s8)
86  (b @string8)
87  (b @u16)
88  (b @s16)
89  (b @double-float-vector)
90  (b @bit-vector)
91  @dispatch
92  (add pc lr (:lsl imm2 (:$ arm::word-shift)))
93  @u32
94  ;; Non-negative fixnum, positive one-digit bignum, two-digit bignum with
95  ;; high word 0.
96  (tst val (:$ #x80000003))
97  (moveq imm0 (:lsr val (:$ arm::fixnumshift)))
98  (beq @word-set-loop)
99  (extract-typecode imm0 val)
100  (cmp imm0 (:$ arm::subtag-bignum))
101  (bne @bad)
102  (getvheader imm0 val)
103  (header-size imm0 imm0)
104  (cmp imm0 (:$ 1))
105  (bne @u32-two-digit)
106  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
107  (cmp imm0 (:$ 0))
108  (bmi @bad)
109  (b @word-set-loop)
110  @u32-two-digit
111  (cmp imm0 (:$ 2))
112  (ldr imm0 (:@ val (:$ (+ arm::misc-data-offset 4))))
113  (bne @bad)
114  (cmp imm0 (:$ 0))
115  (bne @bad)
116  (b @word-set-loop)
117  @s32
118  ;; A fixnum or a 1-digit bignum.
119  (ands imm0 val (:$ arm::tag-mask))
120  (moveq imm0 (:asr val (:$ arm::fixnumshift)))
121  (beq @word-set-loop)
122  (cmp imm0 (:$ arm::tag-misc))
123  (ldrbeq imm0 (:@ val (:$ arm::misc-subtag-offset)))
124  (cmp imm0 (:$ arm::subtag-bignum))
125  (bne @bad)
126  (getvheader imm0 val)
127  (header-size imm0 imm0)
128  (cmp imm0 (:$ 1))
129  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
130  (bne @bad)
131  @word-set-loop
132  (subs temp1 temp1 '1)
133  (str imm0 (:@ miscobj imm1))
134  (add imm1 imm1 '1)
135  (bne @word-set-loop)
136  (return-lisp-frame)
137  @string
138  (extract-lowbyte imm0 val)
139  (cmp imm0 (:$ arm::subtag-character))
140  (mov imm0 (:lsr imm0 (:$ arm::charcode-shift)))
141  (beq @word-set-loop)
142  @bad
143  (mov arg_x  '#.$xnotelt)
144  (set-nargs 3)
145  (call-symbol %err-disp)
146  @fixnum
147  (tst val (:$ arm::fixnum-mask))
148  (unbox-fixnum imm0 val)
149  (bne @word-set-loop)
150  (b @bad)
151  @single-float-vector
152  (extract-subtag imm0 val)
153  (cmp imm0 (:$ arm::subtag-single-float-vector))
154  (bne @bad)
155  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
156  (b @word-set-loop)
157  @u16
158  (mov imm0 (:lsl val (:$ (- 16 arm::fixnumshift))))
159  (mov imm0 (:lsr val (:$ 16)))
160  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))
161  (bne @bad)
162  @set16
163  (orr imm0 imm0 (:lsl imm0 (:$ 16)))
164  (add imm2 temp1 '1)
165  (mov temp1 (:$ (- arm::fixnumone)))
166  (and temp1 temp1 (:lsr imm2 (:$ 1)))
167  (b @word-set-loop)
168  @s16
169  (mov imm0 (:lsl val (:$ (- 16 arm::fixnumshift))))
170  (mov imm0 (:asr val (:$ 16)))
171  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))
172  (bne @bad)
173  (b @set16)
174  @u8
175  (mov imm0 (:lsl val (:$ (- 24 arm::fixnumshift))))
176  (mov imm0 (:lsr val (:$ 24)))
177  (cmp val (:lsl imm0 (:$ arm::fixnumshift))) 
178  (bne @bad)
179  @set8
180  (orr imm0 imm0 (:lsl imm0 (:$ 8)))
181  (orr imm0 imm0 (:lsl imm0 (:$ 16)))
182  (unbox-fixnum imm2 temp1)
183  (add imm2 imm2 (:$ 3))
184  (mov imm2 (:lsr imm2 (:$ 2)))
185  (box-fixnum temp1 imm2)
186  (b @word-set-loop)
187  @s8
188  (mov imm0 (:lsl val (:$ (- 24 arm::fixnumshift))))
189  (mov imm0 (:asr val (:$ 24)))
190  (cmp val (:lsl imm0 (:$ arm::fixnumshift))) 
191  (beq @set8)
192  (b @bad)
193  @string8
194  (extract-lowbyte imm0 val)
195  (cmp imm0 (:$ arm::subtag-character))
196  (mov imm0 (:lsr imm0 (:$ arm::charcode-shift)))
197  (bne @bad)
198  (cmp imm0 (:$ #xff))
199  (bls @set8)
200  (b @bad)
201  @bit-vector
202  (cmp val '1)
203  (moveq imm0 (:$ -1))
204  (movne imm0 (:$ 0))
205  (bhi @bad)
206  (unbox-fixnum imm2 temp1)
207  (add imm2 imm2 (:$ 31))
208  (mov imm2 (:lsr imm2 (:$ 5)))
209  (box-fixnum temp1 imm2)
210  (b @word-set-loop)
211  @double-float-vector
212  (extract-typecode imm0 val)
213  (cmp imm0 (:$ arm::subtag-double-float))
214  (bne @bad)
215  (ldrd imm0 (:@ val (:$ arm::double-float.value)))
216  (mov imm2 (:$ arm::misc-dfloat-offset))
217  @double-float-loop
218  (subs temp1 temp1 '1)
219  (strd imm0 (:@ miscobj imm2))
220  (add imm2 imm2 (:$ 8))
221  (bne @double-float-loop)
222  (return-lisp-frame imm0))
223
224
225
226;;; Make a new vector of size newsize whose subtag matches that of oldv-arg.
227;;; Blast the contents of the old vector into the new one as quickly as
228;;; possible; leave remaining elements of new vector undefined (0).
229;;; Return new-vector.
230(defun %extend-vector (start oldv newsize)
231  (declare (fixnum start))
232  (let* ((new (%alloc-misc newsize (typecode oldv)))
233         (oldsize (uvsize oldv)))
234    (declare (fixnum oldsize))
235    (do* ((i 0 (1+ i))
236          (j start (1+ j)))
237         ((= i oldsize) new)
238      (declare (fixnum i j))
239      (setf (uvref new j) (uvref oldv i)))))
240
241#+later
242(defarmlapfunction %extend-vector ((start-arg arg_x) (oldv-arg arg_y) (newsize arg_z))
243  (let ((oldv save0)
244        (oldsize save1)
245        (oldsubtag save2)
246        (start-offset save3))
247    (save-lisp-context)
248    (:regsave save3 0)
249    (vpush save0)
250    (vpush save1)
251    (vpush save2)
252    (vpush save3)
253    (mov oldv oldv-arg)
254    (mov start-offset start-arg)
255    (getvheader imm0 oldv)
256    (header-length oldsize imm0)
257    (header-subtag[fixnum] oldsubtag imm0)
258    (mov arg_y newsize)
259    (mov arg_z oldsubtag)
260    (bla .SPmisc-alloc)
261    (extrwi imm0 oldsubtag arm::ntagbits (- 32 (+  arm::fixnumshift arm::ntagbits)))
262    (cmpwi cr0 oldsize 0)
263    (cmpwi cr1 imm0 arm::fulltag-nodeheader)
264    (cmpwi cr2 oldsubtag '#.arm::max-32-bit-ivector-subtag)
265    (la imm1 arm::misc-data-offset start-offset)
266    (mov imm3 (:$ arm::misc-data-offset))
267    (beq cr0 @done)
268    (bne cr1 @imm)
269    ;; copy nodes.  New vector is "new", so no memoization required.
270    @node-loop
271    (cmpwi cr0 oldsize '1)
272    (lwzx temp0 oldv imm1)
273    (addi imm1 imm1 4)
274    (subi oldsize oldsize '1)
275    (stwx temp0 arg_z imm3)
276    (addi imm3 imm3 4)
277    (bne cr0 @node-loop)
278    ;;Restore registers.  New vector's been in arg_z all this time.
279    @done
280    (lwz save3 0 vsp)
281    (lwz save2 4 vsp)
282    (lwz save1 8 vsp)
283    (lwz save0 12 vsp)
284    (restore-full-lisp-context)
285    (blr)
286    @imm
287    (unbox-fixnum imm2 oldsize)
288    (unbox-fixnum imm3 start-offset)
289    (mov imm1 (:$ arm::misc-data-offset))
290    (la imm4 arm::misc-data-offset start-offset)
291    (cmpwi cr1 oldsubtag '#.arm::max-8-bit-ivector-subtag)
292    (cmpwi cr0 oldsubtag '#.arm::max-16-bit-ivector-subtag)
293    (ble cr2 @fullword-loop)
294    (cmpwi cr2 oldsubtag '#.arm::subtag-bit-vector)
295    (ble cr1 @8-bit)
296    (ble cr0 @16-bit)
297    (beq cr2 @1-bit)
298    ;; 64-bit (double-float) vectors.  There's a different
299    ;; initial offset, but we're always word-aligned, so that
300    ;; part's easy.
301    (mov imm1 (:$ arm::misc-dfloat-offset))   ; scaled destination pointer
302    (slwi imm2 imm2 1)                  ; twice as many fullwords
303    (slwi imm3 imm3 3)                  ; convert dword count to byte offset
304    (la imm4 arm::misc-dfloat-offset imm3)      ; scaled source pointer
305    (b @fullword-loop)
306    ;; The bitvector case is hard if START-OFFSET isn't on an 8-bit boundary,
307    ;;  and can be turned into the 8-bit case otherwise.
308    ;; The 8-bit case is hard if START-OFFSET isn't on a 16-bit boundary,
309    ;;  and can be turned into the 16-bit case otherwise.
310    ;; The 16-bit case is hard if START-OFFSET isn't on a 32-bit boundary,
311    ;;  and can be turned into the 32-bit case otherwise.
312    ;; Hmm.
313    @1-bit
314    (clrlwi. imm0 imm3 (- 32 3))
315    (bne- cr0 @hard-1-bit)
316    (srwi imm3 imm3 3)                  ; bit offset to byte offset
317    (addi imm2 imm2 7)
318    (srwi imm2 imm2 3)                  ; bit count to byte count
319    @8-bit
320    ; If the byte offset's even, copy half as many halfwords
321    (clrlwi. imm0 imm3 (- 32 1))
322    (bne- cr0 @hard-8-bit)
323    (addi imm2 imm2 1)
324    (srwi imm2 imm2 1)                  ; byte count to halfword count
325    (srwi imm3 imm3 1)                  ; byte offset to halfword offset
326    @16-bit
327    ; If the halfword offset's even, copy half as many fullwords
328    (clrlwi. imm0 imm3 (- 32 1))
329    (bne- cr0 @hard-16-bit)
330    (addi imm2 imm2 1)
331    (srwi imm2 imm2 1)                  ; halfword count to fullword count
332    (mov imm1 (:$ arm::misc-data-offset))   
333    @fullword-loop
334    (cmpwi cr0 imm2 1)
335    (lwzx imm0 oldv imm4)
336    (addi imm4 imm4 4)
337    (subi imm2 imm2 1)
338    (stwx imm0 arg_z imm1)
339    (addi imm1 imm1 4)
340    (bne cr0 @fullword-loop)
341    (b @done)
342    ;;; This can just do a uvref/uvset loop.  Cases that can
343    ;;; cons (x32, double-float) have already been dealt with.
344    @hard-1-bit
345    @hard-8-bit
346    @hard-16-bit
347    (let ((newv save4)
348          (outi save5)
349          (oldlen save6))
350      (vpush save4)
351      (vpush save5)
352      (vpush save6)
353      (mov newv arg_z)
354      (sub oldlen oldsize start-offset)
355      (mov outi (:$ 0))
356      @hard-loop
357      (mov arg_y oldv)
358      (mov arg_z start-offset)
359      (bla .SPmisc-ref)
360      (mov arg_x newv)
361      (mov arg_y outi)
362      (bla .SPmisc-set)
363      (la outi '1 outi)
364      (cmpw cr0 outi oldlen)
365      (la start-offset '1 start-offset)
366      (bne @hard-loop)
367      (mov arg_z newv)
368      (vpop save6)
369      (vpop save5)
370      (vpop save4)
371      (b @done))))
372
373;;; argument is a vector header or an array header.  Or else.
374(defarmlapfunction %array-header-data-and-offset ((a arg_z))
375  (let ((offset arg_y)
376        (disp arg_x)
377        (temp temp0))
378    (mov offset (:$ 0))
379    (mov temp a)
380    @loop
381    (ldr a (:@ temp (:$ target::arrayH.data-vector)))
382    (ldrb imm0 (:@ a (:$ target::misc-subtag-offset)))
383    (cmp imm0 (:$ target::subtag-vectorH))
384    (ldr disp (:@ temp (:$ target::arrayH.displacement)))
385    (mov temp a)
386    (add offset offset disp)
387    (ble  @loop)
388    (mov temp0 vsp)
389    (vpush1 a)
390    (vpush1 offset)
391    (set-nargs 2)
392    (ba .SPvalues)))
393
394(defarmlapfunction %boole-clr ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
395  (vpop1 temp0)
396  (mov imm2 (:$ arm::misc-data-offset))
397  (mov imm0 (:$ 0))
398  (b @test)
399  @loop
400  (str imm0 (:@ dest imm2))
401  (add imm2 imm2 (:$ 4))
402  @test
403  (subs temp0 temp0 '1)
404  (bpl @loop)
405  (bx lr))
406
407(defarmlapfunction %boole-set ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
408  (vpop1 temp0)
409  (mov imm2 (:$ arm::misc-data-offset))
410  (mov imm0 (:$ -1))
411  (b @test)
412  @loop
413  (str imm0 (:@ dest imm2))
414  (add imm2 imm2 (:$ 4))
415  @test
416  (subs temp0 temp0 '1)
417  (bpl @loop)
418  (bx lr))
419
420(defarmlapfunction %boole-1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
421  (vpop1 temp0)
422  (mov imm2 (:$ arm::misc-data-offset))
423  (b @test)
424  @loop
425  (ldr imm0 (:@ b0 imm2))
426  (str imm0 (:@ dest imm2))
427  (add imm2 imm2 (:$ 4))
428  @test
429  (subs temp0 temp0 '1)
430  (bpl @loop)
431  (bx lr))
432
433(defarmlapfunction %boole-2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
434  (vpop1 temp0)
435  (mov imm2 (:$ arm::misc-data-offset))
436  (b @test)
437  @loop
438  (ldr imm0 (:@ b1 imm2))
439  (str imm0 (:@ dest imm2))
440  (add imm2 imm2 (:$ 4))
441  @test
442  (subs temp0 temp0 '1)
443  (bpl @loop)
444  (bx lr))
445
446(defarmlapfunction %boole-c1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
447  (vpop1 temp0)
448  (mov imm2 (:$ arm::misc-data-offset))
449  (b @test)
450  @loop
451  (ldr imm0 (:@ b0 imm2))
452  (mvn imm0 imm0)
453  (str imm0 (:@ dest imm2))
454  (add imm2 imm2 (:$ 4))
455  @test
456  (subs temp0 temp0 '1)
457  (bpl @loop)
458  (bx lr))
459
460(defarmlapfunction %boole-c2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
461  (vpop1 temp0)
462  (mov imm2 (:$ arm::misc-data-offset))
463  (b @test)
464  @loop
465  (ldr imm0 (:@ b1 imm2))
466  (mvn imm0 imm0)
467  (str imm0 (:@ dest imm2))
468  (add imm2 imm2 (:$ 4))
469  @test
470  (subs temp0 temp0 '1)
471  (bpl @loop)
472  (bx lr))
473
474(defarmlapfunction %boole-and ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
475  (vpop1 temp0)
476  (mov imm2 (:$ arm::misc-data-offset))
477  (b @test)
478  @loop
479  (ldr imm0 (:@ b0 imm2))
480  (ldr imm1 (:@ b1 imm2))
481  (and imm0 imm0 imm1)
482  (str imm0 (:@ dest imm2))
483  (add imm2 imm2 (:$ 4))
484  @test
485  (subs temp0 temp0 '1)
486  (bpl @loop)
487  (bx lr))
488
489(defarmlapfunction %boole-ior ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
490  (vpop1 temp0)
491  (mov imm2 (:$ arm::misc-data-offset))
492  (b @test)
493  @loop
494  (ldr imm0 (:@ b0 imm2))
495  (ldr imm1 (:@ b1 imm2))
496  (orr imm0 imm0 imm1)
497  (str imm0 (:@ dest imm2))
498  (add imm2 imm2 (:$ 4))
499  @test
500  (subs temp0 temp0 '1)
501  (bpl @loop)
502  (bx lr))
503
504(defarmlapfunction %boole-xor ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
505  (vpop1 temp0)
506  (mov imm2 (:$ arm::misc-data-offset))
507  (b @test)
508  @loop
509  (ldr imm0 (:@ b0 imm2))
510  (ldr imm1 (:@ b1 imm2))
511  (eor imm0 imm0 imm1)
512  (str imm0 (:@ dest imm2))
513  (add imm2 imm2 (:$ 4))
514  @test
515  (subs temp0 temp0 '1)
516  (bpl @loop)
517  (bx lr))
518
519(defarmlapfunction %boole-eqv ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
520  (vpop1 temp0)
521  (mov imm2 (:$ arm::misc-data-offset))
522  (b @test)
523  @loop
524  (ldr imm0 (:@ b0 imm2))
525  (ldr imm1 (:@ b1 imm2))
526  (eor imm0 imm0 imm1)
527  (mvn imm0 imm0)
528  (str imm0 (:@ dest imm2))
529  (add imm2 imm2 (:$ 4))
530  @test
531  (subs temp0 temp0 '1)
532  (bpl @loop)
533  (bx lr))
534
535(defarmlapfunction %boole-nand ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
536  (vpop1 temp0)
537  (mov imm2 (:$ arm::misc-data-offset))
538  (b @test)
539  @loop
540  (ldr imm0 (:@ b0 imm2))
541  (ldr imm1 (:@ b1 imm2))
542  (and imm0 imm0 imm1)
543  (mvn imm0 imm0)
544  (str imm0 (:@ dest imm2))
545  (add imm2 imm2 (:$ 4))
546  @test
547  (subs temp0 temp0 '1)
548  (bpl @loop)
549  (bx lr))
550
551(defarmlapfunction %boole-nor ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
552  (vpop1 temp0)
553  (mov imm2 (:$ arm::misc-data-offset))
554  (b @test)
555  @loop
556  (ldr imm0 (:@ b0 imm2))
557  (ldr imm1 (:@ b1 imm2))
558  (orr imm0 imm0 imm1)
559  (mvn imm0 imm0)
560  (str imm0 (:@ dest imm2))
561  (add imm2 imm2 (:$ 4))
562  @test
563  (subs temp0 temp0 '1)
564  (bpl @loop)
565  (bx lr))
566
567(defarmlapfunction %boole-andc1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
568  (vpop1 temp0)
569  (mov imm2 (:$ arm::misc-data-offset))
570  (b @test)
571  @loop
572  (ldr imm0 (:@ b0 imm2))
573  (ldr imm1 (:@ b1 imm2))
574  (bic imm0 imm1 imm0)
575  (str imm0 (:@ dest imm2))
576  (add imm2 imm2 (:$ 4))
577  @test
578  (subs temp0 temp0 '1)
579  (bpl @loop)
580  (bx lr))
581
582(defarmlapfunction %boole-andc2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
583  (vpop1 temp0)
584  (mov imm2 (:$ arm::misc-data-offset))
585  (b @test)
586  @loop
587  (ldr imm0 (:@ b0 imm2))
588  (ldr imm1 (:@ b1 imm2))
589  (bic imm0 imm0 imm1)
590  (str imm0 (:@ dest imm2))
591  (add imm2 imm2 (:$ 4))
592  @test
593  (subs temp0 temp0 '1)
594  (bpl @loop)
595  (bx lr))
596
597(defarmlapfunction %boole-orc1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
598  (vpop1 temp0)
599  (mov imm2 (:$ arm::misc-data-offset))
600  (b @test)
601  @loop
602  (ldr imm0 (:@ b0 imm2))
603  (ldr imm1 (:@ b1 imm2))
604  (mvn imm0 imm0)
605  (orr imm0 imm0 imm1)
606  (str imm0 (:@ dest imm2))
607  (add imm2 imm2 (:$ 4))
608  @test
609  (subs temp0 temp0 '1)
610  (bpl @loop)
611  (bx lr))
612
613(defarmlapfunction %boole-orc2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
614  (vpop1 temp0)
615  (mov imm2 (:$ arm::misc-data-offset))
616  (b @test)
617  @loop
618  (ldr imm0 (:@ b0 imm2))
619  (ldr imm1 (:@ b1 imm2))
620  (mvn imm1 imm1)
621  (orr imm0 imm0 imm1)
622  (str imm0 (:@ dest imm2))
623  (add imm2 imm2 (:$ 4))
624  @test
625  (subs temp0 temp0 '1)
626  (bpl @loop)
627  (bx lr))
628
629(defparameter *simple-bit-boole-functions* ())
630
631(setq *simple-bit-boole-functions*
632      (vector
633       #'%boole-clr
634       #'%boole-set
635       #'%boole-1
636       #'%boole-2
637       #'%boole-c1
638       #'%boole-c2
639       #'%boole-and
640       #'%boole-ior
641       #'%boole-xor
642       #'%boole-eqv
643       #'%boole-nand
644       #'%boole-nor
645       #'%boole-andc1
646       #'%boole-andc2
647       #'%boole-orc1
648       #'%boole-orc2))
649
650(defun %simple-bit-boole (op b1 b2 result)
651  (funcall (svref *simple-bit-boole-functions* op)
652           (ash (the fixnum (+ (length result) 31)) -5)
653           b1
654           b2
655           result))
656
657
658(defarmlapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
659  (check-nargs 3)
660  (ba .SParef2))
661
662(defarmlapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z))
663  (check-nargs 4)
664  (vpop1 temp0)
665  (ba .SParef3))
666
667
668(defarmlapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z))
669  (check-nargs 4)
670  (vpop1 temp0)
671  (ba .SPaset2))
672
673(defarmlapfunction %aset3 ((array #.target::node-size) (i 0) (j arg_x) (k arg_y)  (newval arg_z))
674  (check-nargs 5)
675  (vpop1 temp0)
676  (vpop1 temp1)
677  (ba .SPaset3))
678 
679
Note: See TracBrowser for help on using the repository browser.