From a322537cdaeca331fa17e82fc00f1d8f478aa725 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 13 Jul 1993 16:58:30 +0000 Subject: [PATCH] Tweaked compilation of an incompatible defstruct definition to compare to the previously compiled layout, rather than the current run-time definition. As well as being somewhat more intuitive, this was needed to support redefinition of the CLASS class. --- code/defstruct.lisp | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/code/defstruct.lisp b/code/defstruct.lisp index f61845988..d17849a73 100644 --- a/code/defstruct.lisp +++ b/code/defstruct.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.47 1993/03/15 00:11:58 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.48 1993/07/13 16:58:30 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1150,7 +1150,8 @@ ;;; forward referenced layout.) The third value is true if this is an ;;; incompatible redefinition, in which case it is the old layout. ;;; -(defun ensure-structure-class (info inherits old-context new-context) +(defun ensure-structure-class (info inherits old-context new-context + &optional compiler-layout) (multiple-value-bind (class old-layout) (destructuring-bind (&optional name (class 'structure-class) @@ -1166,7 +1167,8 @@ :inherits inherits :inheritance-depth (length inherits) :length (dd-length info) - :info info))) + :info info)) + (old-layout (or compiler-layout old-layout))) (cond ((not old-layout) (values class new-layout nil)) @@ -1345,9 +1347,13 @@ ;;; the INFO TYPE COMPILER-LAYOUT. ;;; (defun %compiler-only-defstruct (info inherits) - (multiple-value-bind (class layout old-layout) - (ensure-structure-class info inherits - "current" "compiled") + (multiple-value-bind + (class layout old-layout) + (let ((clayout (info type compiler-layout (dd-name info)))) + (ensure-structure-class info inherits + (if clayout "previously compiled" "current") + "compiled" + clayout)) (cond (old-layout (undefine-structure (layout-info old-layout)) -- GitLab