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

;;;-*- Mode: Lisp; Package: CCL -*-
;;;
;;;   Copyright (C) 2010 Clozure Associates
;;;   This file is part of Clozure CL.  
;;;
;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
;;;   License , known as the LLGPL and distributed with Clozure CL as the
;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
;;;   conflict, the preamble takes precedence.  
;;;
;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
;;;
;;;   The LLGPL is also available online at
;;;   http://opensource.franz.com/preamble.html

(in-package "CCL")

(eval-when (:compile-toplevel :execute)
  (require "ARM-ARCH")
  (require "ARM-LAPMACROS"))


;;; Users of this shouldn't make assumptions about return value.


(eval-when (:compile-toplevel :execute)
;;; Assumptions made by %init-misc
  (assert (and (< arm::max-32-bit-ivector-subtag
                  arm::max-8-bit-ivector-subtag
                  arm::max-16-bit-ivector-subtag)
               (eql arm::max-32-bit-ivector-subtag arm::subtag-simple-base-string)
               (eql arm::max-16-bit-ivector-subtag arm::subtag-s16-vector)
               (eql arm::max-8-bit-ivector-subtag 223))))


(defarmlapfunction %init-misc ((val arg_y)
                               (miscobj arg_z))
  (getvheader imm0 miscobj)
  (bic temp1 imm0 (:$ arm::subtag-mask))
  (movs temp1 (:lsr temp1 (:$ (- arm::num-subtag-bits arm::fixnumshift))))
  (extract-lowbyte imm2 imm0)
  (extract-fulltag imm1 imm0)
  (bxeq lr)
  (cmp imm1 (:$ arm::fulltag-nodeheader))
  (bne @ivector)
  (mov imm1 (:$ arm::misc-data-offset))
  @node-loop
  (subs temp1 temp1 '1)
  (str val (:@ miscobj imm1))
  (add imm1 imm1 '1)
  (bne @node-loop)
  (bx lr)
  @ivector
  (build-lisp-frame imm0)
  (mov imm1 (:$ arm::misc-data-offset))
  (mov imm2 (:lsr imm2 (:$ 3)))
  (bl @dispatch)
  (b @u32)                              ;bignum,0
  (b @u32)                              ;single-float
  (b @u32)                              ;double-float
  (b @u32)                              ;macptr
  (b @u32)                              ;dead-macptr
  (b @u32)                              ;code-vector, 5
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @bad)
  (b @single-float-vector)              ;20
  (b @u32)
  (b @s32)
  (b @fixnum)
  (b @string)
  (b @u8)
  (b @s8)
  (b @string8)
  (b @u16)
  (b @s16)
  (b @double-float-vector)
  (b @bit-vector)
  @dispatch
  (add pc lr (:lsl imm2 (:$ arm::word-shift)))
  @u32
  ;; Non-negative fixnum, positive one-digit bignum, two-digit bignum with
  ;; high word 0.
  (tst val (:$ #x80000003))
  (moveq imm0 (:lsr val (:$ arm::fixnumshift)))
  (beq @word-set-loop)
  (extract-typecode imm0 val)
  (cmp imm0 (:$ arm::subtag-bignum))
  (bne @bad)
  (getvheader imm0 val)
  (header-size imm0 imm0)
  (cmp imm0 (:$ 1))
  (bne @u32-two-digit)
  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
  (cmp imm0 (:$ 0))
  (bmi @bad)
  (b @word-set-loop)
  @u32-two-digit
  (cmp imm0 (:$ 2))
  (ldr imm0 (:@ val (:$ (+ arm::misc-data-offset 4))))
  (bne @bad)
  (cmp imm0 (:$ 0))
  (bne @bad)
  (b @word-set-loop)
  @s32
  ;; A fixnum or a 1-digit bignum.
  (ands imm0 val (:$ arm::tag-mask))
  (moveq imm0 (:asr val (:$ arm::fixnumshift)))
  (beq @word-set-loop)
  (cmp imm0 (:$ arm::tag-misc))
  (ldrbeq imm0 (:@ val (:$ arm::misc-subtag-offset)))
  (cmp imm0 (:$ arm::subtag-bignum))
  (bne @bad)
  (getvheader imm0 val)
  (header-size imm0 imm0)
  (cmp imm0 (:$ 1))
  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
  (bne @bad)
  @word-set-loop
  (subs temp1 temp1 '1)
  (str imm0 (:@ miscobj imm1))
  (add imm1 imm1 '1)
  (bne @word-set-loop)
  (return-lisp-frame)
  @string
  (extract-lowbyte imm0 val)
  (cmp imm0 (:$ arm::subtag-character))
  (mov imm0 (:lsr val (:$ arm::charcode-shift)))
  (beq @word-set-loop)
  @bad
  (mov arg_x  '#.$xnotelt)
  (set-nargs 3)
  (call-symbol %err-disp)
  @fixnum
  (tst val (:$ arm::fixnum-mask))
  (unbox-fixnum imm0 val)
  (bne @word-set-loop)
  (b @bad)
  @single-float-vector
  (extract-subtag imm0 val)
  (cmp imm0 (:$ arm::subtag-single-float-vector))
  (bne @bad)
  (ldr imm0 (:@ val (:$ arm::misc-data-offset)))
  (b @word-set-loop)
  @u16
  (mov imm0 (:lsl val (:$ (- 16 arm::fixnumshift))))
  (mov imm0 (:lsr val (:$ 16)))
  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))
  (bne @bad)
  @set16
  (orr imm0 imm0 (:lsl imm0 (:$ 16)))
  (add imm2 temp1 '1)
  (mov temp1 (:$ (- arm::fixnumone)))
  (and temp1 temp1 (:lsr imm2 (:$ 1)))
  (b @word-set-loop)
  @s16
  (mov imm0 (:lsl val (:$ (- 16 arm::fixnumshift))))
  (mov imm0 (:asr val (:$ 16)))
  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))
  (bne @bad)
  (b @set16)
  @u8
  (mov imm0 (:lsl val (:$ (- 24 arm::fixnumshift))))
  (mov imm0 (:lsr val (:$ 24)))
  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))  
  (bne @bad)
  @set8
  (orr imm0 imm0 (:lsl imm0 (:$ 8)))
  (orr imm0 imm0 (:lsl imm0 (:$ 16)))
  (unbox-fixnum imm2 temp1)
  (add imm2 imm2 (:$ 3))
  (mov imm2 (:lsr imm2 (:$ 2)))
  (box-fixnum temp1 imm2)
  (b @word-set-loop)
  @s8
  (mov imm0 (:lsl val (:$ (- 24 arm::fixnumshift))))
  (mov imm0 (:asr val (:$ 24)))
  (cmp val (:lsl imm0 (:$ arm::fixnumshift)))  
  (beq @set8)
  (b @bad)
  @string8
  (extract-lowbyte imm0 val)
  (cmp imm0 (:$ arm::subtag-character))
  (mov imm0 (:lsr imm0 (:$ arm::charcode-shift)))
  (bne @bad)
  (cmp imm0 (:$ #xff))
  (bls @set8)
  (b @bad)
  @bit-vector
  (cmp val '1)
  (moveq imm0 (:$ -1))
  (movne imm0 (:$ 0))
  (bhi @bad)
  (unbox-fixnum imm2 temp1)
  (add imm2 imm2 (:$ 31))
  (mov imm2 (:lsr imm2 (:$ 5)))
  (box-fixnum temp1 imm2)
  (b @word-set-loop)
  @double-float-vector
  (extract-typecode imm0 val)
  (cmp imm0 (:$ arm::subtag-double-float))
  (bne @bad)
  (ldrd imm0 (:@ val (:$ arm::double-float.value)))
  (mov imm2 (:$ arm::misc-dfloat-offset))
  @double-float-loop
  (subs temp1 temp1 '1)
  (strd imm0 (:@ miscobj imm2))
  (add imm2 imm2 (:$ 8))
  (bne @double-float-loop)
  (return-lisp-frame imm0))



;;; Make a new vector of size newsize whose subtag matches that of oldv-arg.
;;; Blast the contents of the old vector into the new one as quickly as
;;; possible; leave remaining elements of new vector undefined (0).
;;; Return new-vector.
(defun %extend-vector (start oldv newsize)
  (declare (fixnum start))
  (let* ((new (%alloc-misc newsize (typecode oldv)))
         (oldsize (uvsize oldv)))
    (declare (fixnum oldsize))
    (do* ((i 0 (1+ i))
          (j start (1+ j)))
         ((= i oldsize) new)
      (declare (fixnum i j))
      (setf (uvref new j) (uvref oldv i)))))

#+later
(defarmlapfunction %extend-vector ((start-arg arg_x) (oldv-arg arg_y) (newsize arg_z))
  (let ((oldv save0)
        (oldsize save1)
        (oldsubtag save2)
        (start-offset save3))
    (save-lisp-context)
    (:regsave save3 0)
    (vpush save0)
    (vpush save1)
    (vpush save2)
    (vpush save3)
    (mov oldv oldv-arg)
    (mov start-offset start-arg)
    (getvheader imm0 oldv)
    (header-length oldsize imm0)
    (header-subtag[fixnum] oldsubtag imm0)
    (mov arg_y newsize)
    (mov arg_z oldsubtag)
    (bla .SPmisc-alloc)
    (extrwi imm0 oldsubtag arm::ntagbits (- 32 (+  arm::fixnumshift arm::ntagbits)))
    (cmpwi cr0 oldsize 0)
    (cmpwi cr1 imm0 arm::fulltag-nodeheader)
    (cmpwi cr2 oldsubtag '#.arm::max-32-bit-ivector-subtag)
    (la imm1 arm::misc-data-offset start-offset)
    (mov imm3 (:$ arm::misc-data-offset))
    (beq cr0 @done)
    (bne cr1 @imm)
    ;; copy nodes.  New vector is "new", so no memoization required.
    @node-loop
    (cmpwi cr0 oldsize '1)
    (lwzx temp0 oldv imm1)
    (addi imm1 imm1 4)
    (subi oldsize oldsize '1)
    (stwx temp0 arg_z imm3)
    (addi imm3 imm3 4)
    (bne cr0 @node-loop)
    ;;Restore registers.  New vector's been in arg_z all this time.
    @done
    (lwz save3 0 vsp)
    (lwz save2 4 vsp)
    (lwz save1 8 vsp)
    (lwz save0 12 vsp)
    (restore-full-lisp-context)
    (blr)
    @imm
    (unbox-fixnum imm2 oldsize)
    (unbox-fixnum imm3 start-offset)
    (mov imm1 (:$ arm::misc-data-offset))
    (la imm4 arm::misc-data-offset start-offset)
    (cmpwi cr1 oldsubtag '#.arm::max-8-bit-ivector-subtag)
    (cmpwi cr0 oldsubtag '#.arm::max-16-bit-ivector-subtag)
    (ble cr2 @fullword-loop)
    (cmpwi cr2 oldsubtag '#.arm::subtag-bit-vector)
    (ble cr1 @8-bit)
    (ble cr0 @16-bit)
    (beq cr2 @1-bit)
    ;; 64-bit (double-float) vectors.  There's a different
    ;; initial offset, but we're always word-aligned, so that
    ;; part's easy.
    (mov imm1 (:$ arm::misc-dfloat-offset))   ; scaled destination pointer
    (slwi imm2 imm2 1)                  ; twice as many fullwords
    (slwi imm3 imm3 3)                  ; convert dword count to byte offset
    (la imm4 arm::misc-dfloat-offset imm3)      ; scaled source pointer
    (b @fullword-loop)
    ;; The bitvector case is hard if START-OFFSET isn't on an 8-bit boundary,
    ;;  and can be turned into the 8-bit case otherwise.
    ;; The 8-bit case is hard if START-OFFSET isn't on a 16-bit boundary, 
    ;;  and can be turned into the 16-bit case otherwise.
    ;; The 16-bit case is hard if START-OFFSET isn't on a 32-bit boundary, 
    ;;  and can be turned into the 32-bit case otherwise.
    ;; Hmm.
    @1-bit
    (clrlwi. imm0 imm3 (- 32 3))
    (bne- cr0 @hard-1-bit)
    (srwi imm3 imm3 3)                  ; bit offset to byte offset
    (addi imm2 imm2 7)
    (srwi imm2 imm2 3)                  ; bit count to byte count
    @8-bit
    ; If the byte offset's even, copy half as many halfwords
    (clrlwi. imm0 imm3 (- 32 1))
    (bne- cr0 @hard-8-bit)
    (addi imm2 imm2 1)
    (srwi imm2 imm2 1)                  ; byte count to halfword count
    (srwi imm3 imm3 1)                  ; byte offset to halfword offset
    @16-bit
    ; If the halfword offset's even, copy half as many fullwords
    (clrlwi. imm0 imm3 (- 32 1))
    (bne- cr0 @hard-16-bit)
    (addi imm2 imm2 1)
    (srwi imm2 imm2 1)                  ; halfword count to fullword count
    (mov imm1 (:$ arm::misc-data-offset))   
    @fullword-loop
    (cmpwi cr0 imm2 1)
    (lwzx imm0 oldv imm4)
    (addi imm4 imm4 4)
    (subi imm2 imm2 1)
    (stwx imm0 arg_z imm1)
    (addi imm1 imm1 4)
    (bne cr0 @fullword-loop)
    (b @done)
    ;;; This can just do a uvref/uvset loop.  Cases that can
    ;;; cons (x32, double-float) have already been dealt with.
    @hard-1-bit
    @hard-8-bit
    @hard-16-bit
    (let ((newv save4)
          (outi save5)
          (oldlen save6))
      (vpush save4)
      (vpush save5)
      (vpush save6)
      (mov newv arg_z)
      (sub oldlen oldsize start-offset)
      (mov outi (:$ 0))
      @hard-loop
      (mov arg_y oldv)
      (mov arg_z start-offset)
      (bla .SPmisc-ref)
      (mov arg_x newv)
      (mov arg_y outi)
      (bla .SPmisc-set)
      (la outi '1 outi)
      (cmpw cr0 outi oldlen)
      (la start-offset '1 start-offset)
      (bne @hard-loop)
      (mov arg_z newv)
      (vpop save6)
      (vpop save5)
      (vpop save4)
      (b @done))))

;;; argument is a vector header or an array header.  Or else.
(defarmlapfunction %array-header-data-and-offset ((a arg_z))
  (let ((offset arg_y)
        (disp arg_x)
        (temp temp0))
    (mov offset (:$ 0))
    (mov temp a)
    @loop
    (ldr a (:@ temp (:$ target::arrayH.data-vector)))
    (ldrb imm0 (:@ a (:$ target::misc-subtag-offset)))
    (cmp imm0 (:$ target::subtag-vectorH))
    (ldr disp (:@ temp (:$ target::arrayH.displacement)))
    (mov temp a)
    (add offset offset disp)
    (ble  @loop)
    (mov temp0 vsp)
    (vpush1 a)
    (vpush1 offset)
    (set-nargs 2)
    (ba .SPvalues)))

(defarmlapfunction %boole-clr ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (mov imm0 (:$ 0))
  (b @test)
  @loop
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-set ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (mov imm0 (:$ -1))
  (b @test)
  @loop
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b1 imm2))
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-c1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (mvn imm0 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-c2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b1 imm2))
  (mvn imm0 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-and ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (and imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-ior ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (orr imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-xor ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (eor imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-eqv ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (eor imm0 imm0 imm1)
  (mvn imm0 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-nand ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (and imm0 imm0 imm1)
  (mvn imm0 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-nor ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (orr imm0 imm0 imm1)
  (mvn imm0 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-andc1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (bic imm0 imm1 imm0)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-andc2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (bic imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-orc1 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (mvn imm0 imm0)
  (orr imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defarmlapfunction %boole-orc2 ((len 0) (b0 arg_x) (b1 arg_y) (dest arg_z))
  (vpop1 temp0)
  (mov imm2 (:$ arm::misc-data-offset))
  (b @test)
  @loop
  (ldr imm0 (:@ b0 imm2))
  (ldr imm1 (:@ b1 imm2))
  (mvn imm1 imm1)
  (orr imm0 imm0 imm1)
  (str imm0 (:@ dest imm2))
  (add imm2 imm2 (:$ 4))
  @test
  (subs temp0 temp0 '1)
  (bpl @loop)
  (bx lr))

(defparameter *simple-bit-boole-functions* ())

(setq *simple-bit-boole-functions*
      (vector
       #'%boole-clr
       #'%boole-set
       #'%boole-1
       #'%boole-2
       #'%boole-c1
       #'%boole-c2
       #'%boole-and
       #'%boole-ior
       #'%boole-xor
       #'%boole-eqv
       #'%boole-nand
       #'%boole-nor
       #'%boole-andc1
       #'%boole-andc2
       #'%boole-orc1
       #'%boole-orc2))

(defun %simple-bit-boole (op b1 b2 result)
  (funcall (svref *simple-bit-boole-functions* op)
           (ash (the fixnum (+ (length result) 31)) -5)
           b1
           b2
           result))


(defarmlapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
  (check-nargs 3)
  (ba .SParef2))

(defarmlapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z))
  (check-nargs 4)
  (vpop1 temp0)
  (ba .SParef3))


(defarmlapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z))
  (check-nargs 4)
  (vpop1 temp0)
  (ba .SPaset2))

(defarmlapfunction %aset3 ((array #.target::node-size) (i 0) (j arg_x) (k arg_y)  (newval arg_z))
  (check-nargs 5)
  (vpop1 temp0)
  (vpop1 temp1)
  (ba .SPaset3))