Changeset 5221

Timestamp:

Sep 19, 2006, 12:38:38 AM (18 years ago)

Author:

Gary Byers

Message:

vinsns for REQUIRE-[US][8,16,32,64]

Location:

trunk/ccl/compiler/PPC

Files:

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

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

@@ -857 +857 @@
 
 
+(define-ppc32-vinsn require-s8 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0 ))
+                                 (crf1 :crf)
+                                 (tag :u32)))
+  :again
+  (clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (slwi tag object (- ppc32::nbits-in-word (+ 8 ppc32::fixnumshift)))
+  (srawi tag tag (- ppc32::nbits-in-word (+ 8 ppc32::fixnumshift)))
+  (cmpw crf1 tag object)
+  (bne- crf1 :bad)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-8 object)
+  (b :again)
+  :got-it)
+
 (define-ppc32-vinsn require-u8 (()
                                 ((object :lisp))
@@ -869 +886 @@
   (b :again)
   :got-it)
+
+(define-ppc32-vinsn require-s16 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0 ))
+                                 (crf1 :crf)
+                                 (tag :u32)))
+  :again
+  (clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (slwi tag object (- ppc32::nbits-in-word (+ 16 ppc32::fixnumshift)))
+  (srawi tag tag (- ppc32::nbits-in-word (+ 16 ppc32::fixnumshift)))
+  (cmpw crf1 tag object)
+  (bne- crf1 :bad)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-16 object)
+  (b :again)
+  :got-it)
+
+(define-ppc32-vinsn require-u16 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0))
+                                 (tag :u32)))
+  :again
+  ;; The bottom ppc32::fixnumshift bits and the top (- 32 (+
+  ;; ppc32::fixnumshift 16)) must all be zero.
+  (rlwinm. tag object 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 16)))
+  (beq+ crf0 :got-it)
+  (uuo_intcerr arch::error-object-not-unsigned-byte-16 object)
+  (b :again)
+  :got-it)
+
+(define-ppc32-vinsn require-s32 (()
+                                 ((src :lisp))
+                                 ((crfx :crf)
+                                  (crfy :crf)
+                                  (tag :u32)))
+  :again
+  (clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (cmpwi crfx tag ppc32::tag-fixnum)
+  (cmpwi crfy tag ppc32::tag-misc)
+  (beq+ crfx :got-it)
+  (bne- crfy :bad)
+  (lwz tag ppc32::misc-header-offset src)
+  (cmpwi crfx tag ppc32::one-digit-bignum-header)
+  (beq+ crfx :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-32 src)
+  (b :again)
+  :got-it)
+
+
+(define-ppc32-vinsn require-u32 (()
+                                 ((src :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (temp :u32)))
+  :again
+  (rlwinm. temp src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) 0)
+  (beq+ crf0 :got-it)
+  (clrlwi temp src (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (cmpwi crf0 temp ppc32::tag-misc)
+  (bne- crf0 :bad)
+  (lwz temp ppc32::misc-header-offset src)
+  (cmpwi crf1 temp ppc32::two-digit-bignum-header)
+  (cmpwi crf0 temp ppc32::one-digit-bignum-header)
+  (lwz temp ppc32::misc-data-offset src)
+  (beq crf1 :two)
+  (bne crf0 :bad)
+  (cmpwi crf0 temp 0)
+  (bgt+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-unsigned-byte-32 src)
+  (b :again)
+  :two
+  (lwz temp (+ ppc32::misc-data-offset 4) src)
+  (cmpwi crf0 temp 0)
+  (bne- crf0 :bad)
+  :got-it)
+
+(define-ppc32-vinsn require-s64 (()
+                                 ((src :lisp))
+                                 ((crfx :crf)
+                                  (crfy :crf)
+                                  (tag :u32)))
+  :again
+  (clrlwi tag src (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (cmpwi crfx tag ppc32::tag-fixnum)
+  (cmpwi crfy tag ppc32::tag-misc)
+  (beq+ crfx :got-it)
+  (bne- crfy :bad)
+  (lwz tag ppc32::misc-header-offset src)
+  (cmpwi crfx tag ppc32::one-digit-bignum-header)
+  (cmpwi crfy tag ppc32::two-digit-bignum-header)
+  (lwz tag ppc32::misc-data-offset src)
+  (beq+ crfx :got-it)
+  (beq+ crfy :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-64 src)
+  (b :again)
+  :got-it)
+
+(define-ppc32-vinsn require-u64 (()
+                                 ((src :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (crf2 :crf)
+                                  (temp :u32)))
+  :again
+  (rlwinm. temp src 0 (- ppc32::nbits-in-word ppc32::fixnumshift) 0)
+  (beq+ crf0 :got-it)
+  (clrlwi temp src (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (cmpwi crf0 temp ppc32::tag-misc)
+  (bne- crf0 :bad)
+  (lwz temp ppc32::misc-header-offset src)
+  (cmpwi crf2 temp ppc32::three-digit-bignum-header)
+  (cmpwi crf1 temp ppc32::two-digit-bignum-header)
+  (cmpwi crf0 temp ppc32::one-digit-bignum-header)
+  (lwz temp ppc32::misc-data-offset src)
+  (beq crf2 :three)
+  (beq crf1 :two)
+  (bne crf0 :bad)
+  (cmpwi crf0 temp 0)
+  (bgt+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-unsigned-byte-64 src)
+  (b :again)
+  :three
+  (lwz temp (+ ppc32::misc-data-offset 8) src)
+  (cmpwi crf0 temp 0)
+  (beq+ crf0 :got-it)
+  (b :bad)
+  :two
+  (lwz temp (+ ppc32::misc-data-offset 4) src)
+  (cmpwi crf0 temp 0)
+  (blt- crf0 :bad)
+  :got-it)
+
+
 
 (define-ppc32-vinsn require-char-code (()

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

@@ -935 +935 @@
 
 
+(define-ppc64-vinsn require-s8 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0))
+                                 (crf1 :crf)
+                                 (tag :s64)))
+  :again
+  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
+  (sldi tag object (- ppc64::nbits-in-word (+ 8 ppc64::fixnumshift)))
+  (sradi tag tag (- ppc64::nbits-in-word (+ 8 ppc64::fixnumshift)))
+  (cmpd crf1 tag object)
+  (bne- crf1 :bad)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-8 object)
+  (b :again)
+  :got-it)
+
 (define-ppc64-vinsn require-u8 (()
                                 ((object :lisp))
@@ -948 +965 @@
   :got-it)
 
-(define-ppc64-vinsn require-u8 (()
+(define-ppc64-vinsn require-s16 (()
+                                 ((object :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (tag :s64)))
+  :again
+  (sldi tag object (- ppc64::nbits-in-word (+ 16 ppc64::fixnumshift)))
+  (sradi tag tag (- ppc64::nbits-in-word (+ 16 ppc64::fixnumshift)))
+  (cmpd crf1 tag object)
+  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
+  (bne- crf1 :bad)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-16 object)
+  (b :again)
+  :got-it)
+
+(define-ppc64-vinsn require-u16 (()
                                 ((object :lisp))
                                 ((crf0 (:crf 0))
-                                 (tag :u32)))
+                                 (tag :s64)))
   :again
   ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
   ;; ppc64::fixnumshift 8)) must all be zero.
-  (rldicr. tag object (- 64 ppc64::fixnumshift) 55)
+  (rldicr. tag object (- 64 ppc64::fixnumshift) 47)
   (beq+ crf0 :got-it)
-  (uuo_intcerr arch::error-object-not-unsigned-byte-8 object)
+  (uuo_intcerr arch::error-object-not-unsigned-byte-16 object)
   (b :again)
   :got-it)
+
+(define-ppc64-vinsn require-s32 (()
+                                 ((object :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (tag :s64)))
+  :again
+  (sldi tag object (- ppc64::nbits-in-word (+ 32 ppc64::fixnumshift)))
+  (sradi tag tag (- ppc64::nbits-in-word (+ 32 ppc64::fixnumshift)))
+  (cmpd crf1 tag object)
+  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
+  (bne- crf1 :bad)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-32 object)
+  (b :again)
+  :got-it)
+
+(define-ppc64-vinsn require-u32 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0))
+                                 (tag :s64)))
+  :again
+  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
+  ;; ppc64::fixnumshift 32)) must all be zero.
+  (rldicr. tag object (- 64 ppc64::fixnumshift) 31)
+  (beq+ crf0 :got-it)
+  (uuo_intcerr arch::error-object-not-unsigned-byte-32 object)
+  (b :again)
+  :got-it)
+
+(define-ppc64-vinsn require-s64 (()
+                                 ((object :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (tag :s64)))
+  :again
+  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
+  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
+  (beq+ crf0 :got-it)
+  (cmpdi crf1 tag ppc64::fulltag-misc)
+  (bne- crf1 :bad)
+  (ld tag ppc64::misc-header-offset object)
+  (cmpdi crf0 tag ppc64::two-digit-bignum-header)
+  (beq+ crf0 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-signed-byte-64 object)
+  (b :again)
+  :got-it)
+
+(define-ppc64-vinsn require-u64 (()
+                                 ((object :lisp))
+                                 ((crf0 (:crf 0))
+                                  (crf1 :crf)
+                                  (crf2 :crf)
+                                  (temp :u64)))
+  (clrldi. temp object (- ppc64::nbits-in-word ppc64::fixnumshift))
+  (clrldi temp object (- ppc64::nbits-in-word ppc64::ntagbits))
+  (cmpdi crf1 temp ppc64::fulltag-misc)
+  (sradi temp object ppc64::fixnumshift)
+  (beq crf0 :good-if-positive)
+  (bne crf1 :bad)
+  (ld temp ppc64::misc-header-offset object)
+  (cmpdi crf0 temp  ppc64::three-digit-bignum-header)
+  (cmpdi crf2 temp ppc64::two-digit-bignum-header)
+  (beq crf0 :three-digit)
+  (bne crf2 :bad)
+  ;; two-digit case.  Must be positive.
+  (ld temp ppc64::misc-data-offset object)
+  (rotldi temp temp 32)
+  :good-if-positive
+  (cmpdi crf1 temp 0)
+  (bge crf1 :good)
+  :bad
+  (uuo_interr arch::error-object-not-unsigned-byte-64 object)
+  :three-digit
+  (lwz temp (+ ppc64::misc-data-offset 8) object)
+  (cmpwi crf1 temp 0)
+  (bne crf1 :bad)
+  :good
+  )
+
 
 (define-ppc64-vinsn require-char-code (()