0.8.13.77.character.1

	Rename BASE-CHAR-WIDETAG to CHARACTER-WIDETAG (and similar
	renamings in the x86 backend for SCs and the like)
	... all tests pass, all contribs build.

contrib/sb-aclrepl/inspect.lisp

@@ -681,7 +681,7 @@ cons cells and LIST-TYPE is :normal, :dotted, or :cyclic"
   (description-maybe-internals "character ~W char-code #x~2,'0X"
 			       (list object (char-code object))
 			       "[#x~8,'0X]"
-			       (logior sb-vm:base-char-widetag 
+			       (logior sb-vm:character-widetag 
 				       (ash (char-code object)
 					    sb-vm:n-widetag-bits))))
 

package-data-list.lisp-expr

@@ -1099,7 +1099,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "ARRAY-TYPE" "ARRAY-TYPE-COMPLEXP"
                "ARRAY-TYPE-DIMENSIONS" "ARRAY-TYPE-ELEMENT-TYPE"
                "ARRAY-TYPE-P" "ARRAY-TYPE-SPECIALIZED-ELEMENT-TYPE"
-               "ASH-INDEX" "ASSERT-ERROR" "BASE-CHAR-P" "BASE-STRING-P"
+               "ASH-INDEX" "ASSERT-ERROR" "BASE-STRING-P"
                "BINDING-STACK-POINTER-SAP" "BIT-BASH-COPY" "BIT-INDEX"
                "BOGUS-ARG-TO-VALUES-LIST-ERROR" "BOOLE-CODE"
                "BOUNDING-INDICES-BAD-ERROR" "BYTE-SPECIFIER" "%BYTE-BLT"
@@ -1135,6 +1135,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "DYNAMIC-USAGE"
                "EFFECTIVE-FIND-POSITION-TEST"
                "EFFECTIVE-FIND-POSITION-KEY" "ERROR-NUMBER-OR-LOSE"
+	       "EXTENDED-CHAR-P"
                "FAILED-%WITH-ARRAY-DATA" "FDEFINITION-OBJECT"
                "FDOCUMENTATION" "FILENAME"
                "FIND-AND-INIT-OR-CHECK-LAYOUT" "FLOAT-EXPONENT"
@@ -1203,7 +1204,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "NUMERIC-TYPE-CLASS" "NUMERIC-TYPE-COMPLEXP"
                "NUMERIC-TYPE-EQUAL" "NUMERIC-TYPE-FORMAT"
                "NUMERIC-TYPE-HIGH" "NUMERIC-TYPE-LOW" "NUMERIC-TYPE-P"
-               "OBJECT-NOT-ARRAY-ERROR" "OBJECT-NOT-BASE-CHAR-ERROR"
+               "OBJECT-NOT-ARRAY-ERROR" "OBJECT-NOT-CHARACTER-ERROR"
                "OBJECT-NOT-BASE-STRING-ERROR" "OBJECT-NOT-BIGNUM-ERROR"
                "OBJECT-NOT-BIT-VECTOR-ERROR" "OBJECT-NOT-COMPLEX-ERROR"
                "OBJECT-NOT-COMPLEX-FLOAT-ERROR"
@@ -1924,8 +1925,9 @@ structure representations"
 	       "ANY-REG-SC-NUMBER" "ARRAY-DATA-SLOT" "ARRAY-DIMENSIONS-OFFSET"
 	       "ARRAY-DISPLACED-P-SLOT" "ARRAY-DISPLACEMENT-SLOT"
 	       "ARRAY-ELEMENTS-SLOT" "ARRAY-FILL-POINTER-P-SLOT"
-	       "ARRAY-FILL-POINTER-SLOT" "ATOMIC-FLAG" "BASE-CHAR-REG-SC-NUMBER"
-	       "BASE-CHAR-STACK-SC-NUMBER" "BASE-CHAR-WIDETAG"
+	       "ARRAY-FILL-POINTER-SLOT" "ATOMIC-FLAG"
+	       "CHARACTER-REG-SC-NUMBER"
+	       "CHARACTER-STACK-SC-NUMBER" "CHARACTER-WIDETAG"
 	       "BIGNUM-DIGITS-OFFSET" "BIGNUM-WIDETAG" "BINDING-SIZE"
 	       "BINDING-SYMBOL-SLOT" "BINDING-VALUE-SLOT" "BREAKPOINT-TRAP"
 	       "N-BYTE-BITS" "BYTE-REG-SC-NUMBER"
@@ -2004,7 +2006,7 @@ structure representations"
 	       "FUNCALLABLE-INSTANCE-LAYOUT-SLOT"
 	       "FUNCALLABLE-INSTANCE-LEXENV-SLOT"
 	       "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
-	       "IMMEDIATE-BASE-CHAR-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
+	       "IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
 	       "IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*"
 	       "INSTANCE-HEADER-WIDETAG" "INSTANCE-POINTER-LOWTAG"
 	       "INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"

src/code/array.lisp

@@ -91,7 +91,7 @@
     ;; and for all in any reasonable user programs.)
     ((t)
      (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
-    ((base-char standard-char)
+    ((base-char standard-char character)
      (values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
     ((bit)
      (values #.sb!vm:simple-bit-vector-widetag 1))
@@ -110,7 +110,7 @@
     ;; Pick off some easy common cases.
     ((t)
      #.sb!vm:complex-vector-widetag)
-    ((base-char)
+    ((base-char character)
      #.sb!vm:complex-base-string-widetag)
     ((nil)
      #.sb!vm:complex-vector-nil-widetag)
@@ -120,7 +120,7 @@
     (t
      (pick-vector-type type
        (nil #.sb!vm:complex-vector-nil-widetag)
-       (base-char #.sb!vm:complex-base-string-widetag)
+       (character #.sb!vm:complex-base-string-widetag)
        (bit #.sb!vm:complex-bit-vector-widetag)
        (t #.sb!vm:complex-vector-widetag)))))
 
@@ -854,7 +854,7 @@
 	  ,@(map 'list
 		 (lambda (saetp)
 		   `((simple-array ,(sb!vm:saetp-specifier saetp) (*))
-		     ,(if (eq (sb!vm:saetp-specifier saetp) 'base-char)
+		     ,(if (eq (sb!vm:saetp-specifier saetp) 'character)
 			  *default-init-char-form*
 			  (sb!vm:saetp-initial-element-default saetp))))
 		 (remove-if-not

src/code/class.lisp

@@ -931,8 +931,10 @@
   (setq
    *built-in-classes*
    '((t :state :read-only :translation t)
-     (character :enumerable t :translation base-char
+     (character :enumerable t 
+                :codes (#.sb!vm:character-widetag)
                 :prototype-form (code-char 42))
+     #+nil
      (base-char :enumerable t
 		:inherits (character)
 		:codes (#.sb!vm:base-char-widetag)

src/code/cross-type.lisp

@@ -371,7 +371,7 @@
      (cond ((typep x 'standard-char)
 	    ;; (Note that SBCL doesn't distinguish between BASE-CHAR and
 	    ;; CHARACTER.)
-	    (find-classoid 'base-char))
+	    (find-classoid 'character))
 	   ((not (characterp x))
 	    nil)
 	   (t

src/code/debug-int.lisp

@@ -1998,7 +1998,7 @@ register."
        (zerop (logand val 3))
        ;; character
        (and (zerop (logand val #xffff0000)) ; Top bits zero
-	    (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
+	    (= (logand val #xff) sb!vm:character-widetag)) ; char tag
        ;; unbound marker
        (= val sb!vm:unbound-marker-widetag)
        ;; pointer
@@ -2053,7 +2053,7 @@ register."
        (sb!sys:without-gcing
         (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
 
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
          (code-char val)))
       (#.sb!vm:sap-reg-sc-number
@@ -2143,7 +2143,7 @@ register."
                                       sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (with-nfp (nfp)
          (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
                                               sb!vm:n-word-bytes)))))
@@ -2188,7 +2188,7 @@ register."
        (without-gcing
 	(with-escaped-value (val)
 	  (make-valid-lisp-obj val))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
 	 (code-char val)))
       (#.sb!vm:sap-reg-sc-number
@@ -2247,7 +2247,7 @@ register."
 			       sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (code-char
 	(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
 			     sb!vm:n-word-bytes)))))
@@ -2328,7 +2328,7 @@ register."
        (without-gcing
 	(set-escaped-value
 	  (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
@@ -2427,7 +2427,7 @@ register."
 	       (the long-float (realpart value)))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (with-nfp (nfp)
 	 (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
 					 sb!vm:n-word-bytes))
@@ -2462,7 +2462,7 @@ register."
        (without-gcing
 	(set-escaped-value
 	  (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
@@ -2526,7 +2526,7 @@ register."
 	     (imagpart (the (complex long-float) value))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
 					 sb!vm:n-word-bytes)))
 	     (char-code (the character value))))

src/code/deftypes-for-target.lisp

@@ -60,6 +60,8 @@
 
 (sb!xc:deftype atom () '(not cons))
 
+(sb!xc:deftype base-char () 'character)
+
 (sb!xc:deftype extended-char ()
   #!+sb-doc
   "Type of CHARACTERs that aren't BASE-CHARs."

src/code/fd-stream.lisp

@@ -251,7 +251,7 @@
 		      (:none character)
 		      (:line character)
 		      (:full character))
-  (if (and (base-char-p byte) (char= byte #\Newline))
+  (if (char= byte #\Newline)
       (setf (fd-stream-char-pos stream) 0)
       (incf (fd-stream-char-pos stream)))
   (setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))

src/code/interr.lisp

@@ -190,10 +190,10 @@
 (deferr unbound-symbol-error (symbol)
   (error 'unbound-variable :name symbol))
 
-(deferr object-not-base-char-error (object)
+(deferr object-not-character-error (object)
   (error 'type-error
 	 :datum object
-	 :expected-type 'base-char))
+	 :expected-type 'character))
 
 (deferr object-not-sap-error (object)
   (error 'type-error

src/code/late-type.lisp

@@ -2096,22 +2096,22 @@
 	       (if (eq (car dims) '*)
 		   (case eltype
 		     (bit 'bit-vector)
-		     (base-char 'base-string)
+		     ((base-char character) 'base-string)
 		     (* 'vector)
 		     (t `(vector ,eltype)))
 		   (case eltype
 		     (bit `(bit-vector ,(car dims)))
-		     (base-char `(base-string ,(car dims)))
+		     ((base-char character) `(base-string ,(car dims)))
 		     (t `(vector ,eltype ,(car dims)))))
 	       (if (eq (car dims) '*)
 		   (case eltype
 		     (bit 'simple-bit-vector)
-		     (base-char 'simple-base-string)
+		     ((base-char character) 'simple-base-string)
 		     ((t) 'simple-vector)
 		     (t `(simple-array ,eltype (*))))
 		   (case eltype
 		     (bit `(simple-bit-vector ,(car dims)))
-		     (base-char `(simple-base-string ,(car dims)))
+		     ((base-char character) `(simple-base-string ,(car dims)))
 		     ((t) `(simple-vector ,(car dims)))
 		     (t `(simple-array ,eltype ,dims))))))
 	  (t

src/code/pred.lisp

@@ -64,6 +64,7 @@
   ;; the type it tests for in the Common Lisp type system, and since it's
   ;; only used in the implementation of a few specialized things.)
   (def-type-predicate-wrapper double-float-p)
+  (def-type-predicate-wrapper extended-char-p)
   (def-type-predicate-wrapper fdefn-p)
   (def-type-predicate-wrapper fixnump)
   (def-type-predicate-wrapper floatp)
@@ -78,7 +79,7 @@
   (def-type-predicate-wrapper ratiop)
   (def-type-predicate-wrapper realp)
   (def-type-predicate-wrapper short-float-p)
-  (def-type-predicate-wrapper sb!kernel:simple-array-p)
+  (def-type-predicate-wrapper simple-array-p)
   (def-type-predicate-wrapper simple-bit-vector-p)
   (def-type-predicate-wrapper simple-base-string-p)
   (def-type-predicate-wrapper simple-string-p)

src/compiler/generic/early-objdef.lisp

@@ -136,7 +136,7 @@
   return-pc-header                  ; 00110110
   value-cell-header                 ; 00111010
   symbol-header                     ; 00111110
-  base-char                         ; 01000010
+  character                         ; 01000010
   sap                               ; 01000110
   unbound-marker                    ; 01001010
   weak-pointer                      ; 01001110

src/compiler/generic/early-type-vops.lisp

@@ -11,7 +11,7 @@
 (in-package "SB!VM")
 
 (defparameter *immediate-types*
-  (list unbound-marker-widetag base-char-widetag))
+  (list unbound-marker-widetag character-widetag))
 
 (defparameter *fun-header-widetags*
   (list funcallable-instance-header-widetag

src/compiler/generic/genesis.lisp

@@ -444,7 +444,7 @@
 			   type)))
 
 (defun make-character-descriptor (data)
-  (make-other-immediate-descriptor data sb!vm:base-char-widetag))
+  (make-other-immediate-descriptor data sb!vm:character-widetag))
 
 (defun descriptor-beyond (des offset type)
   (let* ((low (logior (+ (logandc2 (descriptor-low des) sb!vm:lowtag-mask)

src/compiler/generic/interr.lisp

@@ -130,8 +130,8 @@
    "Object is not a WEAK-POINTER.")
   (object-not-instance
    "Object is not a INSTANCE.")
-  (object-not-base-char
-   "Object is not of type BASE-CHAR.")
+  (object-not-character
+   "Object is not a CHARACTER.")
   (nil-fun-returned
    "A function with declared result type NIL returned.")
   (nil-array-accessed

src/compiler/generic/late-type-vops.lisp

@@ -83,9 +83,9 @@
 		  *specialized-array-element-type-properties*))))
   (define-simple-array-type-vops))
 
-(!define-type-vops base-char-p check-base-char base-char
-    object-not-base-char-error
-  (base-char-widetag))
+(!define-type-vops characterp check-character character
+    object-not-character-error
+  (character-widetag))
 
 (!define-type-vops system-area-pointer-p check-system-area-pointer
       system-area-pointer

src/compiler/generic/primtype.lisp

@@ -66,7 +66,7 @@
 
 ;;; other primitive immediate types
 (/show0 "primtype.lisp 68")
-(!def-primitive-type base-char (base-char-reg any-reg))
+(!def-primitive-type character (character-reg any-reg))
 
 ;;; primitive pointer types
 (/show0 "primtype.lisp 73")
@@ -311,8 +311,8 @@
 	    (values (primitive-type-or-lose (classoid-name type)) t))
 	   (funcallable-instance
 	    (part-of function))
-	   (base-char
-	    (exactly base-char))
+	   (character
+	    (exactly character))
 	   (cons-type
 	    (part-of list))
 	   (t

src/compiler/generic/vm-array.lisp

@@ -64,7 +64,7 @@
 	 (nil #:mu 0 simple-array-nil
 	      :complex-typecode #.sb!vm:complex-vector-nil-widetag
 	      :importance 0)
-	 (base-char ,(code-char 0) 8 simple-base-string
+	 (character ,(code-char 0) 8 simple-base-string
 		    ;; (SIMPLE-BASE-STRINGs are stored with an extra
 		    ;; trailing #\NULL for convenience in calling out
 		    ;; to C.)

src/compiler/generic/vm-tran.lisp

@@ -36,6 +36,7 @@
 ;;;; character support
 
 ;;; In our implementation there are really only BASE-CHARs.
+#+nil
 (define-source-transform characterp (obj)
   `(base-char-p ,obj))
 

src/compiler/generic/vm-typetran.lisp

@@ -17,7 +17,6 @@
 
 ;;; These type predicates are used to implement simple cases of TYPEP.
 ;;; They shouldn't be used explicitly.
-(define-type-predicate base-char-p base-char)
 (define-type-predicate base-string-p base-string)
 (define-type-predicate bignump bignum)
 (define-type-predicate complex-double-float-p (complex double-float))