Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl
In directory usw-pr-cvs1:/tmp/cvs-serv18600

Modified Files:
	version.lisp-expr 
Log Message:
0.7.8.54:
	simpleminded release-might-be-tomorrow fix for non-toplevel
		DEFSTRUCT bug (antireported by WHN on cmucl-imp,
		pointed out by CSR on #lisp:-)


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.605
retrieving revision 1.606
diff -u -d -r1.605 -r1.606
--- version.lisp-expr	22 Oct 2002 13:26:10 -0000	1.605
+++ version.lisp-expr	24 Oct 2002 13:23:25 -0000	1.606
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.8.53"
+"0.7.8.54"

Update of /cvsroot/sbcl/sbcl/tests
In directory usw-pr-cvs1:/tmp/cvs-serv18600/tests

Modified Files:
	defstruct.impure.lisp 
Log Message:
0.7.8.54:
	simpleminded release-might-be-tomorrow fix for non-toplevel
		DEFSTRUCT bug (antireported by WHN on cmucl-imp,
		pointed out by CSR on #lisp:-)


Index: defstruct.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/defstruct.impure.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- defstruct.impure.lisp	13 Oct 2002 19:59:44 -0000	1.8
+++ defstruct.impure.lisp	24 Oct 2002 13:23:26 -0000	1.9
@@ -375,6 +375,19 @@
 ;;; Even with bug 210, these assertions succeeded.
 (assert (typep (nth-value 1 (ignore-errors *bug210*)) 'unbound-variable))
 (assert (typep (nth-value 1 (ignore-errors (make-bug210b))) 'unbound-variable))
+
+;;; In sbcl-0.7.8.53, DEFSTRUCT blew up in non-toplevel contexts
+;;; because it implicitly assumed that EVAL-WHEN (COMPILE) stuff
+;;; setting up compiler-layout information would run before the
+;;; constructor function installing the layout was compiled. Make sure
+;;; that doesn't happen again.
+(defun foo-0-7-8-53 () (defstruct foo-0-7-8-53 x (y :not)))
+(assert (not (find-class 'foo-0-7-8-53 nil)))
+(foo-0-7-8-53)
+(assert (find-class 'foo-0-7-8-53 nil))
+(let ((foo-0-7-8-53 (make-foo-0-7-8-53 :x :s)))
+  (assert (eq (foo-0-7-8-53-x foo-0-7-8-53) :s))
+  (assert (eq (foo-0-7-8-53-y foo-0-7-8-53) :not)))
 
 ;;; success
 (format t "~&/returning success~%")

Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv18600/src/code

Modified Files:
	defstruct.lisp 
Log Message:
0.7.8.54:
	simpleminded release-might-be-tomorrow fix for non-toplevel
		DEFSTRUCT bug (antireported by WHN on cmucl-imp,
		pointed out by CSR on #lisp:-)


Index: defstruct.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defstruct.lisp,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- defstruct.lisp	17 Oct 2002 19:56:05 -0000	1.46
+++ defstruct.lisp	24 Oct 2002 13:23:25 -0000	1.47
@@ -27,10 +27,36 @@
 	  (t res))))
 
 ;;; Delay looking for compiler-layout until the constructor is being
-;;; compiled, since it doesn't exist until after the EVAL-WHEN (COMPILE)
-;;; stuff is compiled.
+;;; compiled, since it doesn't exist until after the EVAL-WHEN
+;;; (COMPILE) stuff is compiled. (Or, in the oddball case when
+;;; DEFSTRUCT is executing in a non-toplevel context, the
+;;; compiler-layout still doesn't exist at compilation time, and we
+;;; delay still further.)
 (sb!xc:defmacro %delayed-get-compiler-layout (name)
-  `',(compiler-layout-or-lose name))
+  (let ((layout (info :type :compiler-layout name)))
+    (cond (layout
+	   ;; ordinary case: When the DEFSTRUCT is at top level,
+	   ;; then EVAL-WHEN (COMPILE) stuff will have set up the
+	   ;; layout for us to use.
+	   (unless (typep (layout-info layout) 'defstruct-description)
+	     (error "Class is not a structure class: ~S" name))
+	   `,layout)
+	  (t
+	   ;; KLUDGE: In the case that DEFSTRUCT is not at top-level
+	   ;; the layout doesn't exist at compile time. In that case
+	   ;; we laboriously look it up at run time. This code will
+	   ;; run on every constructor call and will likely be quite
+	   ;; slow, so if anyone cares about performance of
+	   ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
+	   ;; cleverer. -- WHN 2002-10-23
+	   (sb!c::compiler-note
+	    "implementation limitation: ~
+             Non-toplevel DEFSTRUCT constructors are slow.")
+	   (let ((layout (gensym "LAYOUT")))
+	     `(let ((,layout (info :type :compiler-layout ',name)))
+		(unless (typep (layout-info ,layout) 'defstruct-description)
+		  (error "Class is not a structure class: ~S" ',name))
+		,layout))))))
 
 ;;; Get layout right away.
 (sb!xc:defmacro compile-time-find-layout (name)