Index: /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp
===================================================================
--- /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp	(revision 5538)
+++ /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp	(revision 5539)
@@ -350,4 +350,19 @@
   (add dest dim1 j))
 
+;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
+(define-ppc32-vinsn 3d-unscaled-index (((dest :imm)
+                                        (dim1 :u32)
+                                        (dim2 :u32))
+				       ((dim1 :u32)
+                                        (dim2 :u32)
+                                        (i :imm)
+					(j :imm)
+                                        (k :imm)))
+  (mullw dim1 dim1 dim2)
+  (mullw dim2 j dim2)
+  (mullw dim1 i dim1)
+  (add dim2 dim1 dim2)
+  (add dest dim2 k))
+
 
 (define-ppc32-vinsn 2d-dim1 (((dest :u32))
@@ -355,4 +370,12 @@
   (lwz dest (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
   (srawi dest dest ppc32::fixnumshift))
+
+(define-ppc32-vinsn 3d-dims (((dim1 :u32)
+                              (dim2 :u32))
+                             ((header :lisp)))
+  (lwz dim1 (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
+  (lwz dim2 (+ ppc32::misc-data-offset (* 4 (+ 2 ppc32::arrayH.dim0-cell))) header)
+  (srawi dim1 dim1 ppc32::fixnumshift)
+  (srawi dim2 dim2 ppc32::fixnumshift))
 
 ;; Return dim1 (unboxed)
@@ -366,4 +389,19 @@
   (twlge j dim)
   (srawi dim dim ppc32::fixnumshift))
+
+(define-ppc32-vinsn check-3d-bound (((dim1 :u32)
+                                     (dim2 :u32))
+                                    ((i :imm)
+                                     (j :imm)
+                                     (k :imm)
+                                     (header :lisp)))
+  (lwz dim1 (+ ppc32::misc-data-offset (* 4 ppc32::arrayH.dim0-cell)) header)
+  (twlge i dim1)
+  (lwz dim1 (+ ppc32::misc-data-offset (* 4 (1+ ppc32::arrayH.dim0-cell))) header)
+  (twlge j dim1)
+  (lwz dim2 (+ ppc32::misc-data-offset (* 4 (+ 2 ppc32::arrayH.dim0-cell))) header)
+  (twlge k dim2)
+  (srawi dim1 dim1 ppc32::fixnumshift)
+  (srawi dim2 dim2 ppc32::fixnumshift))
 
 (define-ppc32-vinsn array-data-vector-ref (((dest :lisp))
@@ -2782,4 +2820,30 @@
   (lwz tag ppc32::arrayH.rank object)
   (cmpwi crf tag (ash 2 ppc32::fixnumshift))
+  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc32::fixnumshift)))
+       
+  (lwz flags ppc32::arrayH.flags object)
+  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc32::fixnumshift)))
+  (bne crf :bad)
+  (cmpw crf tag flags)
+  (beq crf :good)
+  :bad
+  (uuo_interr type-error object)
+  :good)
+
+(define-ppc32-vinsn trap-unless-simple-array-3 (()
+                                                ((object :lisp)
+                                                 (expected-flags :u32const)
+                                                 (type-error :u8const))
+                                                ((tag :u8)
+                                                 (flags :u32)
+                                                 (crf :crf)))
+  (clrlwi tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (cmpwi crf tag ppc32::tag-misc)
+  (bne crf :bad)
+  (lbz tag ppc32::misc-subtag-offset object)
+  (cmpwi crf tag ppc32::subtag-arrayH)
+  (bne crf :bad) 
+  (lwz tag ppc32::arrayH.rank object)
+  (cmpwi crf tag (ash 3 ppc32::fixnumshift))
   (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc32::fixnumshift)))
        
Index: /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp
===================================================================
--- /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp	(revision 5538)
+++ /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp	(revision 5539)
@@ -395,4 +395,19 @@
 
 
+;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
+(define-ppc64-vinsn 3d-unscaled-index (((dest :imm)
+                                        (dim1 :u64)
+                                        (dim2 :u64))
+				       ((dim1 :u64)
+                                        (dim2 :u64)
+                                        (i :imm)
+					(j :imm)
+                                        (k :imm)))
+  (mulld dim1 dim1 dim2)
+  (mulld dim2 j dim2)
+  (mulld dim1 i dim1)
+  (add dim2 dim1 dim2)
+  (add dest dim2 k))
+
 
 (define-ppc64-vinsn 2d-32-scaled-index (((dest :u64))
@@ -409,4 +424,12 @@
   (ld dest (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
   (sradi dest dest ppc64::fixnumshift))
+
+(define-ppc64-vinsn 3d-dims (((dim1 :u64)
+                              (dim2 :u64))
+                             ((header :lisp)))
+  (ld dim1 (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
+  (ld dim2 (+ ppc64::misc-data-offset (* 8 (+ 2 ppc64::arrayH.dim0-cell))) header)
+  (sradi dim1 dim1 ppc64::fixnumshift)
+  (sradi dim2 dim2 ppc64::fixnumshift))
 
 ;;; Return dim1 (unboxed)
@@ -420,4 +443,19 @@
   (tdlge j dim)
   (sradi dim dim ppc64::fixnumshift))
+
+(define-ppc64-vinsn check-3d-bound (((dim1 :u64)
+                                     (dim2 :u64))
+                                    ((i :imm)
+                                     (j :imm)
+                                     (k :imm)
+                                     (header :lisp)))
+  (ld dim1 (+ ppc64::misc-data-offset (* 8 ppc64::arrayH.dim0-cell)) header)
+  (tdlge i dim1)
+  (ld dim1 (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
+  (tdlge j dim1)
+  (ld dim2 (+ ppc64::misc-data-offset (* 8 (+ 2 ppc64::arrayH.dim0-cell))) header)
+  (tdlge k dim2)
+  (sradi dim1 dim1 ppc64::fixnumshift)
+  (sradi dim2 dim2 ppc64::fixnumshift))
 
 (define-ppc64-vinsn array-data-vector-ref (((dest :lisp))
@@ -459,4 +497,29 @@
   (ld tag ppc64::arrayH.rank object)
   (cmpdi crf tag (ash 2 ppc64::fixnumshift))
+  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc64::fixnumshift)))
+  (ld flags ppc64::arrayH.flags object)
+  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc64::fixnumshift)))
+  (bne crf :bad)
+  (cmpd crf tag flags)
+  (beq crf :good)
+  :bad
+  (uuo_interr type-error object)
+  :good)
+
+(define-ppc64-vinsn trap-unless-simple-array-3 (()
+                                               ((object :lisp)
+                                                (expected-flags :u64const)
+                                                (type-error :u8const))
+                                               ((tag :u8)
+                                                (flags :u64)
+                                                (crf :crf)))
+  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
+  (cmpdi crf tag ppc64::fulltag-misc)
+  (bne crf :bad)
+  (lbz tag ppc64::misc-subtag-offset object)
+  (cmpdi crf tag ppc64::subtag-arrayH)
+  (bne crf :bad) 
+  (ld tag ppc64::arrayH.rank object)
+  (cmpdi crf tag (ash 3 ppc64::fixnumshift))
   (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc64::fixnumshift)))
   (ld flags ppc64::arrayH.flags object)
Index: /trunk/ccl/compiler/PPC/ppc2.lisp
===================================================================
--- /trunk/ccl/compiler/PPC/ppc2.lisp	(revision 5538)
+++ /trunk/ccl/compiler/PPC/ppc2.lisp	(revision 5539)
@@ -1597,4 +1597,72 @@
 
 
+(defun ppc2-aset3 (seg vreg xfer  array i j k new safe type-keyword  dim0 dim1 dim2)
+  (with-ppc-local-vinsn-macros (seg target)
+    (let* ((i-known-fixnum (acode-fixnum-form-p i))
+           (j-known-fixnum (acode-fixnum-form-p j))
+           (k-known-fixnum (acode-fixnum-form-p k))
+           (arch (backend-target-arch *target-backend*))
+           (is-node (member type-keyword (arch::target-gvector-types arch)))
+           (constval (ppc2-constant-value-ok-for-type-keyword type-keyword new))
+           (needs-memoization (and is-node (ppc2-acode-needs-memoization new)))
+           (src)
+           (unscaled-i)
+           (unscaled-j)
+           (unscaled-k)
+           (val-reg (ppc2-target-reg-for-aset vreg type-keyword))
+           (constidx
+            (and dim0 dim1 dim2 i-known-fixnum j-known-fixnum k-known-fixnum
+                 (>= i-known-fixnum 0)
+                 (>= j-known-fixnum 0)
+                 (>= k-known-fixnum 0)
+                 (< i-known-fixnum dim0)
+                 (< j-known-fixnum dim1)
+                 (< k-known-fixnum dim2)
+                 (+ (* i-known-fixnum dim1 dim2)
+                    (* j-known-fixnum dim2)
+                    k-known-fixnum))))
+      (progn
+        (if constidx
+          (multiple-value-setq (src val-reg)
+            (ppc2-two-targeted-reg-forms seg array ($ ppc::temp0) new val-reg))
+          (progn
+            (setq src ($ ppc::temp1)
+                  unscaled-i ($ ppc::temp0)
+                  unscaled-j ($ ppc::arg_x)
+                  unscaled-k ($ ppc::arg_y))
+            (ppc2-push-register
+             seg
+             (ppc2-one-untargeted-reg-form seg array ($ ppc::arg_z)))
+            (ppc2-four-targeted-reg-forms seg
+                                            i ($ ppc::temp0)
+                                            j ($ ppc::arg_x)
+                                            k ($ ppc::arg_y)
+                                            new val-reg)
+            (ppc2-pop-register seg src)))
+        (when safe      
+          (when (typep safe 'fixnum)
+            (! trap-unless-simple-array-3
+               src
+               (dpb safe target::arrayH.flags-cell-subtag-byte
+                    (ash 1 $arh_simple_bit))
+               (nx-error-for-simple-3d-array-type type-keyword)))
+          (unless i-known-fixnum
+            (! trap-unless-fixnum unscaled-i))
+          (unless j-known-fixnum
+            (! trap-unless-fixnum unscaled-j))
+          (unless k-known-fixnum
+            (! trap-unless-fixnum unscaled-k)))
+        (with-imm-target () dim1
+          (with-imm-target (dim1) dim2
+            (let* ((idx-reg ($ ppc::arg_y)))
+              (unless constidx
+                (if safe                  
+                  (! check-3d-bound dim1 dim2 unscaled-i unscaled-j unscaled-k src)
+                  (! 3d-dims dim1 dim2 src))
+                (! 3d-unscaled-index idx-reg dim1 dim2 unscaled-i unscaled-j unscaled-k))
+              (let* ((v ($ ppc::arg_x)))
+                (! array-data-vector-ref v src)
+                (ppc2-vset1 seg vreg xfer type-keyword v idx-reg constidx val-reg (ppc2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval needs-memoization)))))))))
+
 (defun ppc2-aref2 (seg vreg xfer array i j safe typekeyword &optional dim0 dim1)
   (with-ppc-local-vinsn-macros (seg vreg xfer)
@@ -1640,4 +1708,58 @@
             (ppc2-vref1 seg vreg xfer typekeyword v idx-reg constidx)))))))
 
+
+
+(defun ppc2-aref3 (seg vreg xfer array i j k safe typekeyword &optional dim0 dim1 dim2)
+  (with-ppc-local-vinsn-macros (seg vreg xfer)
+    (let* ((i-known-fixnum (acode-fixnum-form-p i))
+           (j-known-fixnum (acode-fixnum-form-p j))
+           (k-known-fixnum (acode-fixnum-form-p k))
+           (src)
+           (unscaled-i)
+           (unscaled-j)
+           (unscaled-k)
+           (constidx
+            (and dim0 dim1 i-known-fixnum j-known-fixnum k-known-fixnum
+                 (>= i-known-fixnum 0)
+                 (>= j-known-fixnum 0)
+                 (>= k-known-fixnum 0)
+                 (< i-known-fixnum dim0)
+                 (< j-known-fixnum dim1)
+                 (< k-known-fixnum dim2)
+                 (+ (* i-known-fixnum dim1 dim2)
+                    (* j-known-fixnum dim2)
+                    k-known-fixnum))))
+      (if constidx
+        (setq src (ppc2-one-targeted-reg-form seg array ($ ppc::arg_z)))
+        (multiple-value-setq (src unscaled-i unscaled-j unscaled-k)
+          (ppc2-four-untargeted-reg-forms seg
+                                           array ppc::temp0
+                                           i ppc::arg_x
+                                           j ppc::arg_y
+                                           k ppc::arg_z)))
+      (when safe        
+        (when (typep safe 'fixnum)
+          (! trap-unless-simple-array-3
+             src
+             (dpb safe target::arrayH.flags-cell-subtag-byte
+                  (ash 1 $arh_simple_bit))
+             (nx-error-for-simple-3d-array-type typekeyword)))
+        (unless i-known-fixnum
+          (! trap-unless-fixnum unscaled-i))
+        (unless j-known-fixnum
+          (! trap-unless-fixnum unscaled-j))
+        (unless k-known-fixnum
+          (! trap-unless-fixnum unscaled-k)))
+      (with-node-target (src) idx-reg
+        (with-imm-target () dim1
+          (with-imm-target (dim1) dim2
+            (unless constidx
+              (if safe                    
+                (! check-3d-bound dim1 dim2 unscaled-i unscaled-j unscaled-k src)
+                (! 3d-dims dim1 dim2 src))
+              (! 3d-unscaled-index idx-reg dim1 dim2 unscaled-i unscaled-j unscaled-k))))
+        (with-node-target (idx-reg) v
+          (! array-data-vector-ref v src)
+          (ppc2-vref1 seg vreg xfer typekeyword v idx-reg constidx))))))
 
 
@@ -5431,4 +5553,5 @@
   (ppc2-reference-list seg vreg xfer form t t))
 
+
 (defppc2 ppc2-vector vector (seg vreg xfer arglist)
   (ppc2-allocate-initialized-gvector seg vreg xfer
@@ -7415,4 +7538,5 @@
       (ppc2-aref2 seg vreg xfer arr i j safe type-keyword dim0 dim1))))
 
+
 (defppc2 ppc2-general-aref2 general-aref2 (seg vreg xfer arr i j)
   (let* ((atype0 (acode-form-type arr t))
@@ -7420,10 +7544,12 @@
          (atype (if (array-ctype-p ctype) ctype))
          (keyword (and atype
-                           (= 2 (length (array-ctype-dimensions atype)))
-                           (not (array-ctype-complexp atype))
-                           (funcall
-                            (arch::target-array-type-name-from-ctype-function
-                             (backend-target-arch *target-backend*))
-                            atype))))
+                       (let* ((dims (array-ctype-dimensions atype)))
+                         (and (typep dims 'list)
+                              (= 2 (length dims))))
+                       (not (array-ctype-complexp atype))
+                       (funcall
+                        (arch::target-array-type-name-from-ctype-function
+                         (backend-target-arch *target-backend*))
+                        atype))))
     (cond (keyword
            (let* ((dims (array-ctype-dimensions atype))
@@ -7439,5 +7565,5 @@
                            *nx-nil*
                            (nx-lookup-target-uvector-subtag keyword ))
-                         keyword ;(make-acode (%nx1-operator immediate) )
+                         keyword        ;(make-acode (%nx1-operator immediate) )
                          (if (typep dim0 'fixnum) dim0) (if (typep dim1 'fixnum) dim1))))
           (t
@@ -7447,4 +7573,60 @@
                                           j ($ ppc::arg_z))
            (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2)))))  )
+
+
+(defppc2 ppc2-%aref3 simple-typed-aref3 (seg vreg xfer typename arr i j k &optional dim0 dim1 dim2)
+  (if (null vreg)
+    (progn
+      (ppc2-form seg nil nil arr)
+      (ppc2-form seg nil nil i)
+      (ppc2-form seg nil nil j)
+      (ppc2-form seg nil xfer k)))
+  (let* ((type-keyword (ppc2-immediate-operand typename))
+         (fixtype (nx-lookup-target-uvector-subtag type-keyword ))
+         (safe (unless *ppc2-reckless* fixtype))
+         (dim0 (acode-fixnum-form-p dim0))
+         (dim1 (acode-fixnum-form-p dim1))
+         (dim2 (acode-fixnum-form-p dim2)))
+    (ppc2-aref3 seg vreg xfer arr i j k safe type-keyword dim0 dim1 dim2)))
+
+(defppc2 ppc2-general-aref3 general-aref3 (seg vreg xfer arr i j k)
+  (let* ((atype0 (acode-form-type arr t))
+         (ctype (if atype0 (specifier-type atype0)))
+         (atype (if (array-ctype-p ctype) ctype))
+         (keyword (and atype
+                       (let* ((dims (array-ctype-dimensions atype)))
+                         (and (typep dims 'list)
+                           (= 3 (length dims))))
+                       (not (array-ctype-complexp atype))
+                       (funcall
+                        (arch::target-array-type-name-from-ctype-function
+                         (backend-target-arch *target-backend*))
+                        atype))))
+    (cond (keyword
+           (let* ((dims (array-ctype-dimensions atype))
+                  (dim0 (car dims))
+                  (dim1 (cadr dims))
+                  (dim2 (caddr dims)))
+             (ppc2-aref3 seg
+                         vreg
+                         xfer
+                         arr
+                         i
+                         j
+                         k
+                         (if *ppc2-reckless*
+                           *nx-nil*
+                           (nx-lookup-target-uvector-subtag keyword ))
+                         keyword ;(make-acode (%nx1-operator immediate) )
+                         (if (typep dim0 'fixnum) dim0)
+                         (if (typep dim1 'fixnum) dim1)
+                         (if (typep dim2 'fixnum) dim2))))
+          (t
+           (ppc2-four-targeted-reg-forms seg
+                                         arr ($ ppc::temp0)
+                                         i ($ ppc::arg_x)
+                                         j ($ ppc::arg_y)
+                                         k ($ ppc::arg_z))
+           (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef3))))))
 
 (defppc2 ppc2-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1)
@@ -7462,10 +7644,12 @@
          (atype (if (array-ctype-p ctype) ctype))
          (keyword (and atype
-                           (= 2 (length (array-ctype-dimensions atype)))
-                           (not (array-ctype-complexp atype))
-                           (funcall
-                            (arch::target-array-type-name-from-ctype-function
-                             (backend-target-arch *target-backend*))
-                            atype))))
+                       (let* ((dims (array-ctype-dimensions atype)))
+                         (and (typep dims 'list)
+                           (= 2 (length dims))))
+                       (not (array-ctype-complexp atype))
+                       (funcall
+                        (arch::target-array-type-name-from-ctype-function
+                         (backend-target-arch *target-backend*))
+                        atype))))
     (cond (keyword
            (let* ((dims (array-ctype-dimensions atype))
@@ -7491,4 +7675,57 @@
                                          new ($ ppc::arg_z))
            (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset2))))))
+
+
+(defppc2 ppc2-general-aset3 general-aset3 (seg vreg xfer arr i j k new)
+  (let* ((atype0 (acode-form-type arr t))
+         (ctype (if atype0 (specifier-type atype0)))
+         (atype (if (array-ctype-p ctype) ctype))
+         (keyword (and atype
+                       (let* ((dims (array-ctype-dimensions atype)))
+                         (unless (atom dims)
+                           (= 3 (length dims))))
+                       (not (array-ctype-complexp atype))
+                       (funcall
+                        (arch::target-array-type-name-from-ctype-function
+                         (backend-target-arch *target-backend*))
+                        atype))))
+    (cond (keyword
+           (let* ((dims (array-ctype-dimensions atype))
+                  (dim0 (car dims))
+                  (dim1 (cadr dims))
+                  (dim2 (caddr dims)))
+             (ppc2-aset3 seg
+                         vreg
+                         xfer
+                         arr
+                         i
+                         j
+                         k
+                         new
+                         (unless *ppc2-reckless*
+                           (nx-lookup-target-uvector-subtag keyword ))
+                         keyword
+                         (if (typep dim0 'fixnum) dim0)
+                         (if (typep dim1 'fixnum) dim1)
+                         (if (typep dim2 'fixnum) dim2))))
+          (t
+           (ppc2-push-register seg (ppc2-one-untargeted-reg-form seg arr ($ ppc::arg_z)))
+           (ppc2-four-targeted-reg-forms seg
+                                         i ($ ppc::temp0)
+                                         j ($ ppc::arg_x)
+                                         k ($ ppc::arg_y)
+                                         new ($ ppc::arg_z))
+           (ppc2-pop-register seg ($ ppc::temp1))
+           (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3))))))
+
+(defppc2 ppc2-%aset3 simple-typed-aset3 (seg vreg xfer typename arr i j k new &optional dim0 dim1 dim2)
+  (let* ((type-keyword (ppc2-immediate-operand typename))
+         (fixtype (nx-lookup-target-uvector-subtag type-keyword))
+         (safe (unless *ppc2-reckless* fixtype))
+         (dim0 (acode-fixnum-form-p dim0))
+         (dim1 (acode-fixnum-form-p dim1))
+         (dim2 (acode-fixnum-form-p dim2)))
+    (ppc2-aset3 seg vreg xfer arr i j k new safe type-keyword dim0 dim1 dim2)))
+