Changeset 5478

Timestamp:

Nov 5, 2006, 6:36:35 AM (18 years ago)

Author:

Gary Byers

Message:

2d aref support/changes.

Location:

trunk/ccl/compiler/PPC

Files:

• PPC32/ppc32-vinsns.lisp (modified) (4 diffs)
• PPC64/ppc64-vinsns.lisp (modified) (2 diffs)

trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp

@@ -86 +86 @@
   (lwzx dest v scaled-idx))
 
+
 (define-ppc32-vinsn misc-ref-c-u32  (((dest :u32))
                                      ((v :lisp)
@@ -312 +313 @@
   (twlge idx temp))
 
-(define-ppc32-vinsn 2d-unscaled-index (((dest :u32))
-                                       ((array :lisp)
+(define-ppc32-vinsn 2d-unscaled-index (((dest :imm)
+                                        (dim1 :u32))
+                                       ((dim1 :u32)
                                         (i :imm)
-                                        (j :imm)
-                                        (dim1 :u32)))
-  (mullw dest i dim1)
-  (add dest dest j))
-
-
-
-(define-ppc32-vinsn 2d-32-scaled-index (((dest :u32))
-                                        ((array :lisp)
-                                         (i :imm)
-                                         (j :imm)
-                                         (dim1 :u32)))
-  (mullw dest i dim1)
-  (add dest dest j)
-  (la dest ppc32::misc-data-offset dest))
+                                        (j :imm)))
+  (mullw dim1 i dim1)
+  (add dest dim1 j))
+
 
 (define-ppc32-vinsn 2d-dim1 (((dest :u32))
@@ -2746 +2737 @@
   (rlwinm dest src (:apply - 32 count) count 31))
 
+
+(define-ppc32-vinsn trap-unless-simple-array-2 (()
+                                                ((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 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 sign-extend-halfword (((dest :imm))
                                           ((src :imm)))
@@ -3114 +3135 @@
     (((dest :double-float))
      ((high t)
-      (low t))
-     ((align :u32)))
-  (clrrwi align ppc::sp 3)
-  (stw high -8 align)
-  (stw low -4 align)
-  (lfd dest -8 align ))
+      (low t)))
+  (stw high -8 ppc::sp)
+  (stw low -4 ppc::sp)
+  (lfd dest -8 ppc::sp ))
 
 (define-ppc32-vinsn load-single-float-constant

trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp

@@ -353 +353 @@
   (tdlge idx temp))
 
-(define-ppc64-vinsn 2d-unscaled-index (((dest :u64))
-                                       ((array :lisp)
-                                        (i :imm)
-                                        (j :imm)
-                                        (dim1 :u64)))
-  (mulld dest i dim1)
-  (add dest dest j))
+(define-ppc64-vinsn 2d-unscaled-index (((dest :imm)
+                                        (dim1 :u32))
+                                       ((dim1 :u32)
+                                        (i :imm)
+                                        (j :imm)))
+  (mulld dim1 i dim1)
+  (add dest dim1 j))
 
 
@@ -409 +409 @@
   (ld flags ppc64::arrayH.flags header)
   (td 27 flags xreg))
+
+
+(define-ppc64-vinsn trap-unless-simple-array-2 (()
+                                               ((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 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)