Changeset 5447

Timestamp:

Nov 3, 2006, 11:38:01 AM (18 years ago)

Author:

Gary Byers

Message:

Change handling of 2d-aref.

File:

• trunk/ccl/compiler/nx1.lisp (modified) (1 diff)

trunk/ccl/compiler/nx1.lisp

@@ -791 +791 @@
 
 (defnx1 nx1-%aref2 ((%aref2)) (&whole whole &environment env arr i j)
-  ;; For now, we only care about the (simple-array double-float (* *)) case.
-  (let* ((subtype
-          (cond ((nx-form-typep arr '(simple-array double-float (* *)) env)
-                 :double-float-vector)
-                ((nx-form-typep arr '(simple-array single-float (* *)) env)
-                 :single-float-vector))))
-    (if subtype
-      (let* ((ctype (specifier-type (nx-form-type arr env)))
-             (dims (array-ctype-dimensions ctype))
-             (dim0 (car dims))
-             (dim1 (cadr dims)))
-        (make-acode (%nx1-operator aref2)
-                    (nx1-form subtype)
-                    (nx1-form arr)
-                    (nx1-form i)
-                    (nx1-form j)
-                    (nx1-form (if (typep dim0 'fixnum) dim0))
-                    (nx1-form (if (typep dim1 'fixnum) dim1))))
-        (nx1-treat-as-call whole))))
+  (let* ((arch (backend-target-arch *target-backend*))
+         (ctype (specifier-type (nx-form-type arr env)))
+         (atype (if (csubtypep ctype (specifier-type '(array * (* *)))) ctype))
+         (simple-atype (if (and atype
+                                (csubtypep atype (specifier-type '(simple-array * (* *)))))
+                         atype))
+         (type-keyword (if atype
+                         (funcall
+                          (arch::target-array-type-name-from-ctype-function arch)
+                          atype))))
+    (if (and type-keyword simple-atype)
+      (let* ((dims (array-ctype-dimensions atype))
+             (dim0 (car dims))
+             (dim1 (cadr dims)))
+        (make-acode (%nx1-operator simple-typed-aref2)
+                    (nx1-form type-keyword)
+                    (nx1-form arr)
+                    (nx1-form i)
+                    (nx1-form j)
+                    (nx1-form (if (typep dim0 'fixnum) dim0))
+                    (nx1-form (if (typep dim1 'fixnum) dim1))))
+      (make-acode (%nx1-operator general-aref2)
+                  (nx1-form arr)
+                  (nx1-form i)
+                  (nx1-form j)))))
 
 (defun nx1-1d-vset (arr newval dim0 env)