Changeset 5091

Timestamp:

Sep 4, 2006, 1:25:28 AM (18 years ago)

Author:

Gary Byers

Message:

Conditionalize for #-target-8-bit-chars.

Location:

trunk/ccl

Files:

• compiler/PPC/PPC32/ppc32-arch.lisp (modified) (1 diff)
• compiler/PPC/PPC32/ppc32-vinsns.lisp (modified) (8 diffs)
• compiler/PPC/PPC64/ppc64-arch.lisp (modified) (2 diffs)
• compiler/PPC/PPC64/ppc64-vinsns.lisp (modified) (8 diffs)
• level-0/l0-array.lisp (modified) (2 diffs)
• level-0/l0-pred.lisp (modified) (2 diffs)

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

@@ -177 +177 @@
 (defconstant max-16-bit-ivector-subtag subtag-s16-vector)
 
+#+target-8-bit-chars
 (define-imm-subtag simple-base-string 27)
 (define-imm-subtag s8-vector 26)
 (define-imm-subtag u8-vector 25)
 (defconstant min-8-bit-ivector-subtag subtag-u8-vector)
-(defconstant max-8-bit-ivector-subtag subtag-simple-base-string)
-
-(define-imm-subtag new-string 24)
+(defconstant max-8-bit-ivector-subtag (logior fulltag-immheader (ash 27 ntagbits)))
+
+#-target-8-bit-chars
+(define-imm-subtag simple-base-string 24)
 (define-imm-subtag fixnum-vector 23)
 (define-imm-subtag s32-vector 22)
 (define-imm-subtag u32-vector 21)
 (define-imm-subtag single-float-vector 20)
-(defconstant max-32-bit-ivector-subtag subtag-new-string)
+(defconstant max-32-bit-ivector-subtag (logior fulltag-immheader (ash 24 ntagbits)))
 (defconstant min-cl-ivector-subtag subtag-single-float-vector)
 

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

@@ -862 +862 @@
                                  (tag :u32)))
   :again
-                                        ; The bottom ppc32::fixnumshift bits and the top (- 32 (+ ppc32::fixnumshift 8)) must all be zero.
+  ;; The bottom ppc32::fixnumshift bits and the top (- 32 (+
+  ;; ppc32::fixnumshift 8)) must all be zero.
   (rlwinm. tag object 0 (- ppc32::nbits-in-word ppc32::fixnumshift) (- ppc32::least-significant-bit (+ ppc32::fixnumshift 8)))
   (beq+ crf0 :got-it)
@@ -868 +869 @@
   (b :again)
   :got-it)
+
+(define-ppc32-vinsn require-char-code (()
+                                       ((object :lisp))
+                                       ((crf0 (:crf 0))
+                                        (crf1 :crf)
+                                        (tag :u32)))
+  :again
+  (clrlwi. tag object (- ppc32::nbits-in-word ppc32::nlisptagbits))
+  (lis tag (ash #x110000 -16))
+  (cmplwi crf1 object tag)
+  (bne crf0 :bad)
+  (blt+ crf1 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-mod-char-code-limit object)
+  (b :again)
+  :got-it)
+
 
 (define-ppc32-vinsn box-fixnum (((dest :imm))
@@ -2317 +2335 @@
 
 
-(define-ppc32-vinsn u8->char (((dest :lisp))
-                              ((src :u8))
+(define-ppc32-vinsn u32->char (((dest :lisp))
+                              ((src :u32))
                               ())
   (slwi dest src ppc32::charcode-shift)
@@ -3218 +3236 @@
   (bctr))
 
-(define-ppc32-vinsn %schar (((char :imm))
+(define-ppc32-vinsn %schar8 (((char :imm))
                             ((str :lisp)
                              (idx :imm))
-                            ((imm :u32)
-                             (cr0 (:crf 0))))
+                            ((imm :u32)))
   (srwi imm idx ppc32::fixnumshift)
   (addi imm imm ppc32::misc-data-offset)
@@ -3229 +3246 @@
   (addi char imm ppc32::subtag-character))
 
-(define-ppc32-vinsn %set-schar (()
+(define-ppc32-vinsn %schar32 (((char :imm))
+                              ((str :lisp)
+                               (idx :imm))
+                              ((imm :u32)))
+  (addi imm idx ppc32::misc-data-offset)
+  (lwzx imm str imm)
+  (slwi imm imm ppc32::charcode-shift)
+  (addi char imm ppc32::subtag-character))
+
+
+(define-ppc32-vinsn %set-schar8 (()
                                 ((str :lisp)
                                  (idx :imm)
@@ -3242 +3269 @@
   )
 
-(define-ppc32-vinsn %set-scharcode (()
+(define-ppc32-vinsn %set-schar32 (()
+                                  ((str :lisp)
+                                   (idx :imm)
+                                   (char :imm))
+                                  ((imm :u32)
+                                   (imm1 :u32)
+                                   (cr0 (:crf 0))))
+  (addi imm idx ppc32::misc-data-offset)
+  (srwi imm1 char ppc32::charcode-shift)
+  (stwx imm1 str imm)
+  )
+
+(define-ppc32-vinsn %set-scharcode8 (()
                                     ((str :lisp)
                                      (idx :imm)
@@ -3256 +3295 @@
 
 
-(define-ppc32-vinsn %scharcode (((code :imm))
-                                ((str :lisp)
-                                 (idx :imm))
-                                ((imm :u32)
-                                 (cr0 (:crf 0))))
+(define-ppc32-vinsn %set-scharcode32 (()
+                                    ((str :lisp)
+                                     (idx :imm)
+                                     (code :imm))
+                                    ((imm :u32)
+                                     (imm1 :u32)))
+  (addi imm idx ppc32::misc-data-offset)
+  (srwi imm1 code ppc32::fixnumshift)
+  (stwx imm1 str imm)
+  )
+
+(define-ppc32-vinsn %scharcode8 (((code :imm))
+                                 ((str :lisp)
+                                  (idx :imm))
+                                 ((imm :u32)
+                                  (cr0 (:crf 0))))
   (srwi imm idx ppc32::fixnumshift)
   (addi imm imm ppc32::misc-data-offset)
   (lbzx imm str imm)
+  (slwi code imm ppc32::fixnumshift))
+
+(define-ppc32-vinsn %scharcode32 (((code :imm))
+                                 ((str :lisp)
+                                  (idx :imm))
+                                 ((imm :u32)
+                                  (cr0 (:crf 0))))
+  (addi imm idx ppc32::misc-data-offset)
+  (lwzx imm str imm)
   (slwi code imm ppc32::fixnumshift))
 
@@ -3347 +3406 @@
 (define-ppc32-vinsn load-character-constant (((dest :lisp))
                                              ((code :u8const)))
-  (ori dest ppc::rzero (:apply logior (:apply ash code ppc32::charcode-shift) ppc32::subtag-character)))
+  (ori dest ppc::rzero (:apply logior (:apply ash (:apply logand #x255 code) ppc32::charcode-shift) ppc32::subtag-character))
+  ((:pred (:not = 0 (:apply ldb (byte 16 8) code)))
+   (oris dest dest (:apply ldb (byte 16 8) code))))
+
 
 (define-ppc32-vinsn %symbol->symptr (((dest :lisp))

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

@@ -217 +217 @@
 (define-cl-array-subtag u32-vector ivector-class-32-bit 2)
 (define-cl-array-subtag single-float-vector ivector-class-32-bit 3)
-(define-cl-array-subtag new-string ivector-class-32-bit 5)
+#-target-8-bit-chars
+(define-cl-array-subtag xsimple-base-string ivector-class-32-bit 5)
 (define-cl-array-subtag s16-vector ivector-class-other-bit 1)
 (define-cl-array-subtag u16-vector ivector-class-other-bit 2)
@@ -223 +224 @@
 (define-cl-array-subtag s8-vector ivector-class-8-bit 1)
 (define-cl-array-subtag u8-vector ivector-class-8-bit 2)
+#+target-8-bit-chars
 (define-cl-array-subtag simple-base-string ivector-class-8-bit 5)
 

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

@@ -940 +940 @@
                                  (tag :u32)))
   :again
-  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+ ppc64::fixnumshift 8)) must all be zero.
+  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
+  ;; ppc64::fixnumshift 8)) must all be zero.
   (rldicr. tag object (- 64 ppc64::fixnumshift) 55)
   (beq+ crf0 :got-it)
@@ -946 +947 @@
   (b :again)
   :got-it)
+
+(define-ppc64-vinsn require-u8 (()
+                                ((object :lisp))
+                                ((crf0 (:crf 0))
+                                 (tag :u32)))
+  :again
+  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
+  ;; ppc64::fixnumshift 8)) must all be zero.
+  (rldicr. tag object (- 64 ppc64::fixnumshift) 55)
+  (beq+ crf0 :got-it)
+  (uuo_intcerr arch::error-object-not-unsigned-byte-8 object)
+  (b :again)
+  :got-it)
+
+(define-ppc64-vinsn require-char-code (()
+                                       ((object :lisp))
+                                       ((crf0 (:crf 0))
+                                        (crf1 :crf)
+                                        (tag :u32)))
+  :again
+  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
+  (lis tag (ash #x110000 -16))
+  (cmpldi crf1 object tag)
+  (bne crf0 :bad)
+  (blt+ crf1 :got-it)
+  :bad
+  (uuo_intcerr arch::error-object-not-mod-char-code-limit object)
+  (b :again)
+  :got-it)
+
 
 (define-ppc64-vinsn box-fixnum (((dest :imm))
@@ -2292 +2323 @@
   (addi dest dest ppc64::subtag-character))
 
-(define-ppc64-vinsn u8->char (((dest :lisp))
-                              ((src :u8))
-                              ())
+(define-ppc64-vinsn u32->char (((dest :lisp))
+                              ((src :u32))
+                               ())
   (sldi dest src ppc64::charcode-shift)
   (ori dest dest ppc64::subtag-character))
@@ -3225 +3256 @@
   (bctr))
 
-(define-ppc64-vinsn %schar (((char :imm))
-                            ((str :lisp)
-                             (idx :imm))
-                            ((imm :u32)
-                             (cr0 (:crf 0))))
+(define-ppc64-vinsn %schar8 (((char :imm))
+                             ((str :lisp)
+                              (idx :imm))
+                             ((imm :u32)
+                              (cr0 (:crf 0))))
   (srdi imm idx ppc64::fixnumshift)
   (addi imm imm ppc64::misc-data-offset)
@@ -3236 +3267 @@
   (ori char imm ppc64::subtag-character))
 
-(define-ppc64-vinsn %set-schar (()
+(define-ppc64-vinsn %schar32 (((char :imm))
+                              ((str :lisp)
+                               (idx :imm))
+                              ((imm :u32)
+                               (cr0 (:crf 0))))
+  (srdi imm idx 1)
+  (addi imm imm ppc64::misc-data-offset)
+  (lwzx imm str imm)
+  (rldicr imm imm ppc64::charcode-shift (- 63 ppc64::charcode-shift))
+  (ori char imm ppc64::subtag-character))
+
+(define-ppc64-vinsn %set-schar8 (()
                                 ((str :lisp)
                                  (idx :imm)
@@ -3249 +3291 @@
   )
 
-(define-ppc64-vinsn %set-scharcode (()
-                                    ((str :lisp)
-                                     (idx :imm)
-                                     (code :imm))
-                                    ((imm :u64)
-                                     (imm1 :u64)
-                                     (cr0 (:crf 0))))
+(define-ppc64-vinsn %set-schar32 (()
+                                ((str :lisp)
+                                 (idx :imm)
+                                 (char :imm))
+                                ((imm :u64)
+                                 (imm1 :u64)
+                                 (cr0 (:crf 0))))
+  (srdi imm idx 1)
+  (addi imm imm ppc64::misc-data-offset)
+  (srdi imm1 char ppc64::charcode-shift)
+  (stwx imm1 str imm)
+  )
+
+(define-ppc64-vinsn %set-scharcode8 (()
+                                     ((str :lisp)
+                                      (idx :imm)
+                                      (code :imm))
+                                     ((imm :u64)
+                                      (imm1 :u64)
+                                      (cr0 (:crf 0))))
   (srdi imm idx ppc64::fixnumshift)
   (addi imm imm ppc64::misc-data-offset)
@@ -3262 +3317 @@
   )
 
-
-(define-ppc64-vinsn %scharcode (((code :imm))
-                                ((str :lisp)
-                                 (idx :imm))
-                                ((imm :u64)
-                                 (cr0 (:crf 0))))
+(define-ppc64-vinsn %set-scharcode32 (()
+                                      ((str :lisp)
+                                       (idx :imm)
+                                       (code :imm))
+                                      ((imm :u64)
+                                       (imm1 :u64)
+                                       (cr0 (:crf 0))))
+  (srdi imm idx 1)
+  (addi imm imm ppc64::misc-data-offset)
+  (srdi imm1 code ppc64::fixnumshift)
+  (stwx imm1 str imm)
+  )
+
+
+(define-ppc64-vinsn %scharcode8 (((code :imm))
+                                 ((str :lisp)
+                                  (idx :imm))
+                                 ((imm :u64)
+                                  (cr0 (:crf 0))))
   (srdi imm idx ppc64::fixnumshift)
   (addi imm imm ppc64::misc-data-offset)
   (lbzx imm str imm)
+  (sldi code imm ppc64::fixnumshift))
+
+(define-ppc64-vinsn %scharcode32 (((code :imm))
+                                  ((str :lisp)
+                                   (idx :imm))
+                                  ((imm :u64)
+                                   (cr0 (:crf 0))))
+  (srdi imm idx 1)
+  (addi imm imm ppc64::misc-data-offset)
+  (lwzx imm str imm)
   (sldi code imm ppc64::fixnumshift))
 
@@ -3355 +3433 @@
                                              ((code :u8const))
                                              ())
-  (ori dest ppc::rzero (:apply logior (:apply ash code 8) ppc64::subtag-character)))
+  (ori dest ppc::rzero (:apply logior (:apply ash code 8) ppc64::subtag-character))
+  ((:pred (:not = 0 (:apply ldb (byte 16 8) code)))
+   (oris dest dest (:apply ldb (byte 16 8) code))))
 
 

trunk/ccl/level-0/l0-array.lisp

@@ -60 +60 @@
      (signed-byte 32)
      fixnum
-     character
+     #-target-8-bit-chars character #+target-8-bit-chars unused
      (unsigned-byte 8)
      (signed-byte 8)
-     character
+     #+target-8-bit-chars character #-target-8-bit-chars unused
      (unsigned-byte 16)
      (signed-byte 16)
@@ -93 +93 @@
      #+target-8-bit-chars character #-target-8-bit-chars unused
      unused
-     unused
+     #-target-8-bit-chars character #+target-8-bit-chars unused
      unused
      unused

trunk/ccl/level-0/l0-pred.lisp

@@ -449 +449 @@
     simple-unsigned-long-vector         ; 21
     simple-signed-long-vector           ; 22
-    simple-fixnum-vector                ; 24
-    new-simple-string                   ; 24
+    simple-fixnum-vector                ; 23
+    #+target-8-bit-chars bogus
+    #-target-8-bit-chars simple-base-string ; 24
     simple-unsigned-byte-vector         ; 25
     simple-signed-byte-vector           ; 26
-    simple-base-string                  ; 27
+    #+target-8-bit-chars simple-base-string ; 27
+    #-target-8-bit-chars bogus
     simple-unsigned-word-vector         ; 28
     simple-signed-word-vector           ; 29
@@ -563 +565 @@
     #+target-8-bit-chars simple-base-string #-target-8-bit-chars bogus
     bogus
-    bogus
+    #-target-8-bit-chars simple-base-string #+target-8-bit-chars bogus
     bogus
     bogus