X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fclass.lisp;h=535914c6cadb9688c04216667c1b90b6a8e32e17;hb=77d1a39f28fe8d240cf441a9a54a80d4bc98ea52;hp=6845b19e5474276ac89ae24597f41a413517a9ae;hpb=cf4cb9554515c59eddbde38d1cf236339c37f55f;p=sbcl.git

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 6845b19..535914c 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -358,8 +358,8 @@
 			      inherits
 			      :key #'layout-proper-name)
 		(warn "change in superclasses of class ~S:~%  ~
-		       ~A superclasses: ~S~%  ~
-		       ~A superclasses: ~S"
+                       ~A superclasses: ~S~%  ~
+                       ~A superclasses: ~S"
 		      name
 		      old-context
 		      (map 'list #'layout-proper-name old-inherits)
@@ -370,8 +370,8 @@
 		(when diff
 		  (warn
 		   "in class ~S:~%  ~
-		    ~:(~A~) definition of superclass ~S is incompatible with~%  ~
-		    ~A definition."
+                    ~:(~A~) definition of superclass ~S is incompatible with~%  ~
+                    ~A definition."
 		   name
 		   old-context
 		   (layout-proper-name (svref old-inherits diff))
@@ -380,15 +380,15 @@
 	(let ((old-length (layout-length old-layout)))
 	  (unless (= old-length length)
 	    (warn "change in instance length of class ~S:~%  ~
-		   ~A length: ~W~%  ~
-		   ~A length: ~W"
+                   ~A length: ~W~%  ~
+                   ~A length: ~W"
 		  name
 		  old-context old-length
 		  context length)
 	    t))
 	(unless (= (layout-depthoid old-layout) depthoid)
 	  (warn "change in the inheritance structure of class ~S~%  ~
-		 between the ~A definition and the ~A definition"
+                 between the ~A definition and the ~A definition"
 		name old-context context)
 	  t))))
 
@@ -415,7 +415,7 @@
     ;; system from scratch, so we no longer need this functionality in
     ;; order to maintain the SBCL system by modifying running images.
     (error "The class ~S was not changed, and there's no guarantee that~@
-	    the loaded code (which expected another layout) will work."
+            the loaded code (which expected another layout) will work."
 	   (layout-proper-name layout)))
   (values))
 
@@ -431,7 +431,7 @@
   (let ((layout (find-layout name)))
     (init-or-check-layout layout
 			  (or (find-classoid name nil)
-			      (make-undefined-classoid name))
+			      (layout-classoid layout))
 			  length
 			  inherits
 			  depthoid)))
@@ -702,13 +702,17 @@
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 (defun find-classoid (name &optional (errorp t) environment)
   #!+sb-doc
-  "Return the class with the specified NAME. If ERRORP is false, then NIL is
-   returned when no such class exists."
+  "Return the class with the specified NAME. If ERRORP is false, then
+NIL is returned when no such class exists."
   (declare (type symbol name) (ignore environment))
   (let ((res (classoid-cell-classoid (find-classoid-cell name))))
     (if (or res (not errorp))
 	res
-	(error "class not yet defined:~%  ~S" name))))
+	(error 'simple-type-error
+               :datum nil
+               :expected-type 'class
+               :format-control "class not yet defined:~%  ~S" 
+               :format-arguments (list name)))))
 (defun (setf find-classoid) (new-value name)
   #-sb-xc (declare (type (or null classoid) new-value))
   (cond
@@ -931,11 +935,9 @@
   (setq
    *built-in-classes*
    '((t :state :read-only :translation t)
-     (character :enumerable t :translation base-char
-                :prototype-form (code-char 42))
-     (base-char :enumerable t
-		:inherits (character)
-		:codes (#.sb!vm:base-char-widetag)
+     (character :enumerable t 
+                :codes (#.sb!vm:character-widetag)
+                :translation (character-set)
                 :prototype-form (code-char 42))
      (symbol :codes (#.sb!vm:symbol-header-widetag)
              :prototype-form '#:mu)
@@ -1241,6 +1243,21 @@
       :inherits (base-string simple-string string vector simple-array
 		 array sequence)
       :prototype-form (make-array 0 :element-type 'base-char))
+     #!+sb-unicode
+     (character-string
+      :translation (vector character)
+      :codes (#.sb!vm:complex-character-string-widetag)
+      :direct-superclasses (string)
+      :inherits (string vector array sequence)
+      :prototype-form (make-array 0 :element-type 'character :fill-pointer t))
+     #!+sb-unicode
+     (simple-character-string
+      :translation (simple-array character (*))
+      :codes (#.sb!vm:simple-character-string-widetag)
+      :direct-superclasses (character-string simple-string)
+      :inherits (character-string simple-string string vector simple-array
+		 array sequence)
+      :prototype-form (make-array 0 :element-type 'character))
      (list
       :translation (or cons (member nil))
       :inherits (sequence))
@@ -1254,12 +1271,18 @@
       :inherits (symbol list sequence)
       :direct-superclasses (symbol list)
       :prototype-form 'nil)
-     
      (stream
       :state :read-only
       :depth 3
-      :inherits (instance)
-      :prototype-form (make-broadcast-stream)))))
+      :inherits (instance))
+     (file-stream
+      :state :read-only
+      :depth 5
+      :inherits (stream))
+     (string-stream
+      :state :read-only
+      :depth 5
+      :inherits (stream)))))
 
 ;;; See also src/code/class-init.lisp where we finish setting up the
 ;;; translations for built-in types.