#|

You need this bootstrap file on early August 2000 HEAD (not release
18) sources.  The first error you get when you're missing this one is
when compiling target:code/exports:

Exporting these symbols from the KERNEL package:
(KERNEL::ORDER-LAYOUT-INHERITS)
results in name conflicts with these packages:
CONDITIONS 

It's continuable by uninterning the symbol, but kernel.core will fail:
[...]
TYPE-INIT
Calling top-level forms.
%primitive halt called; the party is over.
LDB monitor
ldb>


Message-ID: <398DBEF6.54802D01@scieneer.com>
Date: Mon, 07 Aug 2000 05:39:34 +1000
From: "Douglas T. Crosher" <dtc@scieneer.com>
Reply-To: dtc@cmucl.cons.org
X-Mailer: Mozilla 4.74 [en] (X11; U; Linux 2.2.16-3 i586)
X-Accept-Language: en
MIME-Version: 1.0
To: cmucl-imp@cons.org
Subject: Boostrapping stream and condition class layout changes.
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Status: RO
X-Status: F
Content-Length: 1726
Lines: 57


The bootstrap code below will be needed to build with the
current source which corrects the layout of the stream
and condition classes.

Regards
Douglas Crosher

-=-=-
|#
(in-package "KERNEL")

;;; Fix the stream class.
(setf (layout-inheritance-depth (class-layout (find-class 'stream))) 3)

;;; New code need when compiling error.lisp
(export 'order-layout-inherits)
(defun order-layout-inherits (layouts)
  (declare (simple-vector layouts))
  (let ((length (length layouts))
	(max-depth -1))
    (dotimes (i length)
      (let ((depth (layout-inheritance-depth (svref layouts i))))
	(when (> depth max-depth)
	  (setf max-depth depth))))
    (let* ((new-length (max (1+ max-depth) length))
	   (inherits (make-array new-length)))
      (dotimes (i length)
	(let* ((layout (svref layouts i))
	       (depth (layout-inheritance-depth layout)))
	  (unless (eql depth -1)
	    (unless (eql (svref inherits depth) 0)
	      (error "Layout depth confict: ~S~%" layouts))
	    (setf (svref inherits depth) layout))))
      (do ((i 0 (1+ i))
	   (j 0))
	  ((>= i length))
	(declare (type index i j))
	(let* ((layout (svref layouts i))
	       (depth (layout-inheritance-depth layout)))
	  (when (eql depth -1)
	    (loop (when (eql (svref inherits j) 0)
		    (return))
		  (incf j))
	    (setf (svref inherits j) layout))))
      (do ((i (1- new-length) (1- i)))
	  ((< i 0))
	(declare (type fixnum i))
	(when (eql (svref inherits i) 0)
	  (setf (svref inherits i) (svref inherits (1+ i)))))
      inherits)))

;;; Fix all the condition classes.
(do-hash (subclass layout (class-subclasses (find-class 'condition)))
  (declare (ignore subclass))
  (setf (layout-inherits layout)
	(order-layout-inherits (layout-inherits layout))))