From ed3c374ab9e71c80bcc62794ff7764575895d06f Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 22 May 1993 16:16:24 +0000
Subject: [PATCH] Fixed the core file format to include information about what
 blocks have been allocated instead of assuming that all allocated blocks will
 have stuff in them.

---
 compiler/generic/gengc-genesis.lisp | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/compiler/generic/gengc-genesis.lisp b/compiler/generic/gengc-genesis.lisp
index 84d18b629..a0bea4fa0 100644
--- a/compiler/generic/gengc-genesis.lisp
+++ b/compiler/generic/gengc-genesis.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/gengc-genesis.lisp,v 1.6 1993/05/21 17:41:16 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/gengc-genesis.lisp,v 1.7 1993/05/22 16:16:24 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -914,6 +914,8 @@
     (frob mach::handle-exception)
     (frob di::handle-breakpoint)
     (frob di::handle-function-end-breakpoint)
+    (frob lisp::do-before-gc-stuff)
+    (frob lisp::do-after-gc-stuff)
     (frob lisp::fdefinition-object)
     (frob apply))
   (macrolet ((frob (symbol value)
@@ -2181,13 +2183,17 @@
 (defstruct (range
 	    (:print-function %print-range))
   ;;
+  ;; The core address this range corresponds to.
   (address (required-argument) :type address)
   ;;
-  bytes
+  ;; The number of bytes at that address to dump.
+  (bytes 0 :type (unsigned-byte #.vm:word-bits))
   ;;
-  pieces
+  ;; List of (sap . bytes) indicating where to get the bytes to dump.
+  (pieces nil :type list)
   ;;
-  next)
+  ;; The next range in the chain, sorted by by address.
+  (next nil :type (or null range)))
 
 (defun %print-range (range stream depth)
   (declare (ignore depth))
@@ -2362,6 +2368,9 @@
 			  :element-type '(unsigned-byte 8)
 			  :if-exists :rename-and-delete)
       (write-magic-number version)
+      (write-long *heap-start*)
+      (write-long (ash (- *heap-free-pointer* *heap-start*) (- block-shift)))
+      (write-long 0)
       (let* ((chunks-start *header-fill-pointer*)
 	     (chunks (compute-ranges generations)))
 	(write-chunks chunks)
-- 
GitLab