[Sbcl-commits] CVS: sbcl/src/compiler/generic early-objdef.lisp,1.23,1.24 genesis.lisp,1.94,1.95 interr.lisp,1.13,1.14 late-type-vops.lisp,1.7,1.8 vm-array.lisp,1.7,1.8 vm-fndb.lisp,1.25,1.26 vm-tran.lisp,1.58,1.59 vm-typetran.lisp,1.7,1.8

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13722/src/compiler/generic

Modified Files:
	early-objdef.lisp genesis.lisp interr.lisp late-type-vops.lisp 
	vm-array.lisp vm-fndb.lisp vm-tran.lisp vm-typetran.lisp 
Log Message:
0.8.16.25:
	Merge the rest of character_branch under #!+sb-unicode
	... untested with #!+sb-unicode, but it seems to work OK without.
		One more build/test cycle to go.

	This patch brought to you by --ifdef


Index: early-objdef.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/early-objdef.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- early-objdef.lisp	27 Oct 2004 16:39:59 -0000	1.23
+++ early-objdef.lisp	2 Nov 2004 08:37:54 -0000	1.24
@@ -167,6 +167,7 @@
   simple-array-unsigned-byte-16     ; 10011110
   simple-array-nil                  ; 10100010
   simple-base-string                ; 10100110
+  #!+sb-unicode simple-character-string
   simple-bit-vector                 ; 10101010
   simple-vector                     ; 10101110
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
@@ -195,15 +196,18 @@
   simple-array                      ; 11011110
   complex-vector-nil                ; 11100010
   complex-base-string               ; 11100110
+  #!+sb-unicode complex-character-string
   complex-bit-vector                ; 11101010
   complex-vector                    ; 11101110
   complex-array                     ; 11110010
 
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   unused12                          ; 11110110
-  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+  #!+(and #.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+          (not sb-unicode))
   unused13                          ; 11111010
-  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+  #!+(and #.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+          (not sb-unicode))
   unused14                          ; 11111110
 )
 

Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -d -r1.94 -r1.95
--- genesis.lisp	1 Nov 2004 18:21:00 -0000	1.94
+++ genesis.lisp	2 Nov 2004 08:37:54 -0000	1.95
@@ -2106,6 +2106,11 @@
     (read-string-as-bytes *fasl-input-stream* string)
     (base-string-to-core string)))
 
+#!+sb-unicode
+(clone-cold-fop (fop-character-string)
+		(fop-small-character-string)
+  (bug "CHARACTER-STRING dumped by cross-compiler."))
+
 (clone-cold-fop (fop-vector)
 		(fop-small-vector)
   (let* ((size (clone-arg))

Index: interr.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/interr.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- interr.lisp	27 Oct 2004 16:39:59 -0000	1.13
+++ interr.lisp	2 Nov 2004 08:37:54 -0000	1.14
@@ -61,6 +61,11 @@
    "Object is not of type STRING.")
   (object-not-base-string
    "Object is not of type BASE-STRING.")
+  (object-not-vector-nil
+   "Object is not of type (VECTOR NIL).")
+  #!+sb-unicode
+  (object-not-character-string
+   "Object is not of type (VECTOR CHARACTER).")
   (object-not-bit-vector
    "Object is not of type BIT-VECTOR.")
   (object-not-array

Index: late-type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/late-type-vops.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- late-type-vops.lisp	27 Oct 2004 16:39:59 -0000	1.7
+++ late-type-vops.lisp	2 Nov 2004 08:37:54 -0000	1.8
@@ -66,7 +66,8 @@
 
 (!define-type-vops simple-string-p check-simple-string nil
     object-not-simple-string-error
-  (simple-base-string-widetag simple-array-nil-widetag))
+  (#!+sb-unicode simple-character-string-widetag
+   simple-base-string-widetag simple-array-nil-widetag))
 
 (macrolet
     ((define-simple-array-type-vops ()
@@ -109,11 +110,15 @@
   (funcallable-instance-header-widetag))
 
 (!define-type-vops array-header-p nil nil nil
-  (simple-array-widetag complex-base-string-widetag complex-bit-vector-widetag
+  (simple-array-widetag
+   #!+sb-unicode complex-character-string-widetag
+   complex-base-string-widetag complex-bit-vector-widetag
    complex-vector-widetag complex-array-widetag complex-vector-nil-widetag))
 
 (!define-type-vops stringp check-string nil object-not-string-error
-  (simple-base-string-widetag complex-base-string-widetag
+  (#!+sb-unicode simple-character-string-widetag
+   #!+sb-unicode complex-character-string-widetag
+   simple-base-string-widetag complex-base-string-widetag
    simple-array-nil-widetag complex-vector-nil-widetag))
 
 (!define-type-vops base-string-p check-base-string nil object-not-base-string-error
@@ -127,6 +132,11 @@
     object-not-vector-nil-error
   (simple-array-nil-widetag complex-vector-nil-widetag))
 
+#!+sb-unicode
+(!define-type-vops character-string-p check-character-string nil
+    object-not-character-string-error
+  (simple-character-string-widetag complex-character-string-widetag))
+
 (!define-type-vops vectorp check-vector nil object-not-vector-error
   (complex-vector-widetag .
    #.(append

Index: vm-array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-array.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- vm-array.lisp	27 Oct 2004 16:40:00 -0000	1.7
+++ vm-array.lisp	2 Nov 2004 08:37:54 -0000	1.8
@@ -64,6 +64,7 @@
 	 (nil #:mu 0 simple-array-nil
 	      :complex-typecode #.sb!vm:complex-vector-nil-widetag
 	      :importance 0)
+         #!-sb-unicode
 	 (character ,(code-char 0) 8 simple-base-string
 		    ;; (SIMPLE-BASE-STRINGs are stored with an extra
 		    ;; trailing #\NULL for convenience in calling out
@@ -71,6 +72,19 @@
 		    :n-pad-elements 1
 	            :complex-typecode #.sb!vm:complex-base-string-widetag
 	            :importance 17)
+         #!+sb-unicode
+	 (base-char ,(code-char 0) 8 simple-base-string
+		    ;; (SIMPLE-BASE-STRINGs are stored with an extra
+		    ;; trailing #\NULL for convenience in calling out
+		    ;; to C.)
+		    :n-pad-elements 1
+	            :complex-typecode #.sb!vm:complex-base-string-widetag
+	            :importance 17)
+         #!+sb-unicode
+	 (character ,(code-char 0) 32 simple-character-string
+		    :n-pad-elements 1
+	            :complex-typecode #.sb!vm:complex-character-string-widetag
+	            :importance 17)
 	 (single-float 0.0f0 32 simple-array-single-float
 	  :importance 6)
 	 (double-float 0.0d0 64 simple-array-double-float

Index: vm-fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-fndb.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- vm-fndb.lisp	10 Aug 2004 15:38:13 -0000	1.25
+++ vm-fndb.lisp	2 Nov 2004 08:37:54 -0000	1.26
@@ -22,6 +22,8 @@
 	   complex-vector-p
 	   base-char-p %standard-char-p %instancep
 	   base-string-p simple-base-string-p
+           #!+sb-unicode character-string-p
+           #!+sb-unicode simple-character-string-p
 	   array-header-p
 	   simple-array-p simple-array-nil-p vector-nil-p
 	   simple-array-unsigned-byte-2-p

Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- vm-tran.lisp	27 Oct 2004 16:40:00 -0000	1.58
+++ vm-tran.lisp	2 Nov 2004 08:37:54 -0000	1.59
@@ -49,6 +49,8 @@
 	(give-up-ir1-transform)
 	`(etypecase string
 	  ((simple-array character (*)) (data-vector-ref string index))
+          #!+sb-unicode
+	  ((simple-array base-char (*)) (data-vector-ref string index))
 	  ((simple-array nil (*)) (data-vector-ref string index))))))
 
 (deftransform hairy-data-vector-ref ((array index) (array t) *)
@@ -99,6 +101,9 @@
 	`(etypecase string
 	  ((simple-array character (*))
 	   (data-vector-set string index new-value))
+          #!+sb-unicode
+	  ((simple-array base-char (*))
+	   (data-vector-set string index new-value))
 	  ((simple-array nil (*))
 	   (data-vector-set string index new-value))))))
 

Index: vm-typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-typetran.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- vm-typetran.lisp	27 Oct 2004 16:40:00 -0000	1.7
+++ vm-typetran.lisp	2 Nov 2004 08:37:54 -0000	1.8
@@ -19,6 +19,7 @@
 ;;; They shouldn't be used explicitly.
 (define-type-predicate base-string-p base-string)
 (define-type-predicate bignump bignum)
+#!+sb-unicode (define-type-predicate character-string-p (vector character))
 (define-type-predicate complex-double-float-p (complex double-float))
 (define-type-predicate complex-single-float-p (complex single-float))
 #!+long-float
@@ -92,6 +93,8 @@
 (define-type-predicate simple-array-complex-long-float-p
 		       (simple-array (complex long-float) (*)))
 (define-type-predicate simple-base-string-p simple-base-string)
+#!+sb-unicode (define-type-predicate simple-character-string-p
+                  (simple-array character (*)))
 (define-type-predicate system-area-pointer-p system-area-pointer)
 (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
 (define-type-predicate signed-byte-32-p (signed-byte 32))