CVS: sbcl/src/code class.lisp,1.43,1.44 stream.lisp,1.42,1.43

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv7345/src/code

Modified Files:
        class.lisp stream.lisp 
Log Message:
0.8.1.40:
        * Fix optimizer of BIT-NOT;
        * remove explicit type check in PEEK-CHAR.


Index: class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/class.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- class.lisp  17 Jul 2003 08:14:30 -0000      1.43
+++ class.lisp  18 Jul 2003 05:47:23 -0000      1.44
@@ -485,19 +485,18 @@
        (setf (layout-invalid layout) nil
              (classoid-layout classoid) layout))
 
-    (let ((inherits (layout-inherits layout)))
-      (dotimes (i (length inherits)) ; FIXME: should be DOVECTOR
-       (let* ((super (layout-classoid (svref inherits i)))
-              (subclasses (or (classoid-subclasses super)
-                              (setf (classoid-subclasses super)
-                                    (make-hash-table :test 'eq)))))
-         (when (and (eq (classoid-state super) :sealed)
-                    (not (gethash classoid subclasses)))
-           (warn "unsealing sealed class ~S in order to subclass it"
-                 (classoid-name super))
-           (setf (classoid-state super) :read-only))
-         (setf (gethash classoid subclasses)
-               (or destruct-layout layout))))))
+    (dovector (super-layout (layout-inherits layout))
+      (let* ((super (layout-classoid super-layout))
+             (subclasses (or (classoid-subclasses super)
+                             (setf (classoid-subclasses super)
+                                   (make-hash-table :test 'eq)))))
+        (when (and (eq (classoid-state super) :sealed)
+                   (not (gethash classoid subclasses)))
+          (warn "unsealing sealed class ~S in order to subclass it"
+                (classoid-name super))
+          (setf (classoid-state super) :read-only))
+        (setf (gethash classoid subclasses)
+              (or destruct-layout layout)))))
 
   (values))
 ); EVAL-WHEN
@@ -1282,9 +1281,8 @@
   (let ((inherits (layout-inherits layout))
        (classoid (layout-classoid layout)))
     (modify-classoid classoid)
-    (dotimes (i (length inherits)) ; FIXME: DOVECTOR
-      (let* ((super (svref inherits i))
-            (subs (classoid-subclasses (layout-classoid super))))
+    (dovector (super inherits)
+      (let ((subs (classoid-subclasses (layout-classoid super))))
        (when subs
          (remhash classoid subs)))))
   (values))

Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- stream.lisp 16 Jul 2003 08:26:01 -0000      1.42
+++ stream.lisp 18 Jul 2003 05:47:23 -0000      1.43
@@ -332,20 +332,9 @@
                            eof-value
                            recursive-p)
   (declare (ignore recursive-p))
-  ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
-  ;; the compiler doesn't seem to be smart enough to go from there to
-  ;; imposing a type check. Figure out why (because PEEK-TYPE is an
-  ;; &OPTIONAL argument?) and fix it, and then this explicit type
-  ;; check can go away.
-  (unless (typep peek-type '(or character boolean))
-    (error 'simple-type-error
-          :datum peek-type
-          :expected-type '(or character boolean)
-          :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
-          :format-arguments (list peek-type '(or character boolean))))
   (let ((stream (in-synonym-of stream)))
     (cond ((typep stream 'echo-stream)
-          (echo-misc stream 
+          (echo-misc stream
                      :peek-char
                      peek-type
                      (list eof-error-p eof-value)))



-------------------------------------------------------
This SF.net email is sponsored by: VM Ware
With VMware you can run multiple operating systems on a single machine.
WITHOUT REBOOTING! Mix Linux / Windows / Novell virtual machines at the
same time. Free trial click here: http://www.vmware.com/wl/offer/345/0