Commit 8ac4c190 authored by William Harold Newman's avatar William Harold Newman
Browse files

0.7.7.40:

	removed 0.7.7.33 changes (by "patch --reverse" on
		"cvs diff -D '2002-09-20 16:29 GMT'
		-D '2002-09-20 16:49 GMT'") because they're too slow.
		(The patches are basically a nice idea and the
		performance problems look fixable, but it doesn't look
		like a few lines of tweaking will fix them. Since I'd
		like to release 0.7.8 in a few days, I don't want a lot
		of development in the main tree, and since the patch
		still unapplies 100% cleanly, this is an appealing way
		to deal with the problem for now.)
	(Actually the "cleanly" above doesn't mean that it actually
		works, because the then-unused COERCE-TO-SIMPLE-VECTOR
		removed in package-data-list.lisp-expr needs to be
		restored too. But once C-TO-S-V is restored, it does
		work.)
parent 0e57ae91
Loading
Loading
Loading
Loading
+28 −0
Original line number Diff line number Diff line
@@ -254,6 +254,14 @@ WORKAROUND:

46:
  type safety errors reported by Peter Van Eynde July 25, 2000:
	a: (COERCE (QUOTE (A B C)) (QUOTE (VECTOR * 4)))
	   => #(A B C)
	   In general lengths of array type specifications aren't
	   checked by COERCE, so it fails when the spec is
	   (VECTOR 4), (STRING 2), (SIMPLE-BIT-VECTOR 3), or whatever.
	b: CONCATENATE has the same problem of not checking the length
	   of specified output array types. MAKE-SEQUENCE and MAP and
	   MERGE also have the same problem.
	c: (COERCE 'AND 'FUNCTION) returns something related to
	   (MACRO-FUNCTION 'AND), but ANSI says it should raise an error.
	h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM))
@@ -363,6 +371,26 @@ WORKAROUND:
  the new output block should start indented 2 or more characters
  rightward of the correct location.

66:
  ANSI specifies that the RESULT-TYPE argument of CONCATENATE must be
  a subtype of SEQUENCE, but CONCATENATE doesn't check this properly:
    (CONCATENATE 'SIMPLE-ARRAY #(1 2) '(3)) => #(1 2 3)
  This also leads to funny behavior when derived type specifiers
  are used, as originally reported by Milan Zamazal for CMU CL (on the
  Debian bugs mailing list (?) 2000-02-27), then reported by Martin
  Atzmueller for SBCL (2000-10-01 on sbcl-devel@lists.sourceforge.net):
    (DEFTYPE FOO () 'SIMPLE-ARRAY)
    (CONCATENATE 'FOO #(1 2) '(3)) 
      => #<ARRAY-TYPE SIMPLE-ARRAY> is a bad type specifier for
           sequence functions.
  The derived type specifier FOO should act the same way as the 
  built-in type SIMPLE-ARRAY here, but it doesn't. That problem
  doesn't seem to exist for sequence types:
    (DEFTYPE BAR () 'SIMPLE-VECTOR)
    (CONCATENATE 'BAR #(1 2) '(3)) => #(1 2 3)
  See also bug #46a./b., and discussion and patch sbcl-devel and
  cmucl-imp 2002-07

67:
  As reported by Winton Davies on a CMU CL mailing list 2000-01-10,
  and reported for SBCL by Martin Atzmueller 2000-10-20: (TRACE GETHASH)
+1 −1
Original line number Diff line number Diff line
@@ -1006,7 +1006,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
             "CODE-INSTRUCTIONS"
             "COERCE-TO-BIT-VECTOR" "COERCE-TO-FUN" "COERCE-TO-LEXENV"
             "COERCE-TO-LIST" "COERCE-TO-SIMPLE-STRING"
             "COERCE-TO-VECTOR"
             "COERCE-TO-SIMPLE-VECTOR" "COERCE-TO-VECTOR"
             "*COLD-INIT-COMPLETE-P*"
             "COMPLEX-DOUBLE-FLOAT-P"
             "COMPLEX-FLOAT-P" "COMPLEX-LONG-FLOAT-P"
+0 −2
Original line number Diff line number Diff line
@@ -1203,8 +1203,6 @@
	   (inherits-list (second x))
	   (class (make-standard-class :name name))
	   (class-cell (find-class-cell name)))
      ;; Needed to open-code the MAP, below
      (declare (type list inherits-list))
      (setf (class-cell-class class-cell) class
	    (info :type :class name) class-cell
	    (info :type :kind name) :instance)
+70 −12
Original line number Diff line number Diff line
@@ -27,11 +27,21 @@
			   (:list '(pop in-object))
			   (:vector '(aref in-object index))))))))

  (def list-to-vector* (make-sequence type length)
  (def list-to-simple-string* (make-string length) schar :list)

  (def list-to-bit-vector* (make-array length :element-type '(mod 2))
    sbit :list)

  (def list-to-vector* (make-sequence-of-type type length)
    aref :list t)

  (def vector-to-vector* (make-sequence type length)
    aref :vector t))
  (def vector-to-vector* (make-sequence-of-type type length)
    aref :vector t)

  (def vector-to-simple-string* (make-string length) schar :vector)

  (def vector-to-bit-vector* (make-array length :element-type '(mod 2))
    sbit :vector))

(defun vector-to-list* (object)
  (let ((result (list nil))
@@ -43,6 +53,24 @@
      (declare (fixnum index))
      (rplacd splice (list (aref object index))))))

(defun string-to-simple-string* (object)
  (if (simple-string-p object)
      object
      (with-array-data ((data object)
			(start)
			(end (length object)))
	(declare (simple-string data))
	(subseq data start end))))

(defun bit-vector-to-simple-bit-vector* (object)
  (if (simple-bit-vector-p object)
      object
      (with-array-data ((data object)
			(start)
			(end (length object)))
	(declare (simple-bit-vector data))
	(subseq data start end))))

(defvar *offending-datum*); FIXME: Remove after debugging COERCE.

;;; These are used both by the full DEFUN function and by various
@@ -52,7 +80,7 @@
;;; argument type is known. It might be better to do this with
;;; DEFTRANSFORMs, though.
(declaim (inline coerce-to-list))
(declaim (inline coerce-to-vector))
(declaim (inline coerce-to-simple-string coerce-to-bit-vector coerce-to-vector))
(defun coerce-to-fun (object)
  ;; (Unlike the other COERCE-TO-FOOs, this one isn't inline, because
  ;; it's so big and because optimizing away the outer ETYPECASE
@@ -88,11 +116,22 @@
				   cons)
	       :format-control "~S can't be coerced to a function."
	       :format-arguments (list object)))))))

(defun coerce-to-list (object)
  (etypecase object
    (vector (vector-to-list* object))))

(defun coerce-to-simple-string (object)
  (etypecase object
    (list (list-to-simple-string* object))
    (string (string-to-simple-string* object))
    (vector (vector-to-simple-string* object))))
(defun coerce-to-bit-vector (object)
  (etypecase object
    (list (list-to-bit-vector* object))
    (vector (vector-to-bit-vector* object))))
(defun coerce-to-simple-vector (x)
  (if (simple-vector-p x)
      x
      (replace (make-array (length x)) x)))
(defun coerce-to-vector (object output-type-spec)
  (etypecase object
    (list (list-to-vector* object output-type-spec))
@@ -106,7 +145,10 @@
	   (/show0 "entering COERCE-ERROR")
	   (error 'simple-type-error
		  :format-control "~S can't be converted to type ~S."
		  :format-arguments (list object output-type-spec))))
		  :format-arguments (list object output-type-spec)))
	 (check-result (result)
	   #!+high-security (aver (typep result output-type-spec))
	   result))
    (let ((type (specifier-type output-type-spec)))
      (cond
	((%typep object output-type-spec)
@@ -194,12 +236,28 @@
	 (if (vectorp object)
	     (vector-to-list* object)
	     (coerce-error)))
	((csubtypep type (specifier-type 'string))
	 (check-result
	  (typecase object
	    (list (list-to-simple-string* object))
	    (string (string-to-simple-string* object))
	    (vector (vector-to-simple-string* object))
	    (t
	     (coerce-error)))))
	((csubtypep type (specifier-type 'bit-vector))
	 (check-result
	  (typecase object
	    (list (list-to-bit-vector* object))
	    (vector (vector-to-bit-vector* object))
	    (t
	     (coerce-error)))))
	((csubtypep type (specifier-type 'vector))
	 (check-result
	  (typecase object
	    (list (list-to-vector* object output-type-spec))
	    (vector (vector-to-vector* object output-type-spec))
	    (t
	    (coerce-error))))
	     (coerce-error)))))
	(t
	 (coerce-error))))))

+7 −0
Original line number Diff line number Diff line
@@ -448,10 +448,17 @@
     (/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
     (multiple-value-bind (error-number arguments)
	 (sb!vm:internal-error-args alien-context)

       ;; There's a limit to how much error reporting we can usefully
       ;; do before initialization is complete, but try to be a little
       ;; bit helpful before we die.
       (/show0 "back from INTERNAL-ERROR-ARGS, ERROR-NUMBER=..")
       (/hexstr error-number)
       (/show0 "cold/low ARGUMENTS=..")
       (/hexstr arguments)
       (unless *cold-init-complete-p*
	 (%primitive print "can't recover from error in cold init, halting")
	 (%primitive sb!c:halt))

       (multiple-value-bind (name sb!debug:*stack-top-hint*)
	   (find-interrupted-name)
Loading