From 65f0bdc01f6a1742962c9896ef357f805788ab6c Mon Sep 17 00:00:00 2001
From: cracauer <cracauer>
Date: Tue, 5 Nov 2002 22:45:53 +0000
Subject: [PATCH] Make (time ...) and the profiler do precise measuring of
 space allocation.  It will also not overflow or bomb out when consing amounts
 cross most-positive fixnum.

The new profiler also has an interface to plug in your own print
function (also dictates sorting or results).

This is written on gencgc/x86 but tests indicated the fallsbacks for
other platforms work.

The dfixnum package included here is sketchy.
---
 code/dfixnum.lisp     | 197 +++++++++++++++++
 code/gc.lisp          |  92 ++++++--
 code/profile.lisp     | 482 ++++++++++++++++++++++++++++++------------
 code/time.lisp        |  11 +-
 lisp/gencgc.c         | 113 +++++++++-
 tools/worldbuild.lisp |   3 +-
 tools/worldcom.lisp   |   3 +-
 tools/worldload.lisp  |   3 +-
 8 files changed, 744 insertions(+), 160 deletions(-)
 create mode 100644 code/dfixnum.lisp

diff --git a/code/dfixnum.lisp b/code/dfixnum.lisp
new file mode 100644
index 000000000..00f16c153
--- /dev/null
+++ b/code/dfixnum.lisp
@@ -0,0 +1,197 @@
+;;; -*- Package: dfixnum -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project
+;;; and has been placed in the public domain.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dfixnum.lisp,v 1.1 2002/11/05 22:45:40 cracauer Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;;
+;;; Description: A skeleton of a package to do consing-free arithmetic on
+;;;   integers using two fixnums.  One bit in each fixnum is used for internal
+;;;   calculations, so a 32-bit Lisp implementation with two-bit tags will
+;;;   have 56 bit range in this package (54 bits unsigned).
+;;;
+;;; NOTE: this package is extremly raw and only supports what is needed for
+;;;   the profiler.  It should be considered an interface specification with
+;;;   a partial sketchy implentation.
+;;;
+;;; Author: Martin Cracauer
+;;;
+;;; Compatibility: Runs in any valid Common Lisp.
+
+(defpackage "DFIXNUM"
+  (:export "DFIXNUM" "MAKE-DFIXNUM" dfparttype
+	   "DFIXNUM-INC-DF" "DFIXNUM-INC-HF"
+	   "DFIXNUM-SET-FROM-NUMBER" "DFIXNUM-MAKE-FROM-NUMBER"
+	   "DFIXNUM-INTEGER" "DFIXNUM-SINGLE-FLOAT"
+	   dfixnum-set-df
+	   dfixnum-dec-df dfixnum-dec-hf
+	   dfixnum-single-float dfixnum-single-float-inline
+	   dfixnum-set-single-float dfixnum-inc-single-float
+	   dfixnum-set-pair dfixnum-inc-pair dfixnum-pair-integer
+	   dfixnum-dec-pair dfixnum-copy-pair))
+
+(in-package "DFIXNUM")
+
+(defconstant dfbits #.(- (integer-length most-positive-fixnum) 1))
+(defconstant dfmax #.(expt 2 dfbits))
+(deftype dfparttype () `(integer 0 ,#.(expt 2 dfbits)))
+
+(defstruct dfixnum
+  (h 0 :type dfparttype)
+  (l 0 :type dfparttype))
+
+(defun dfixnum-inc-df (v i)
+  "increments dfixnum v by dfixnum i"
+  (declare (type dfixnum v) (type dfixnum i))
+  (let ((low (+ (dfixnum-l v) (dfixnum-l i))))
+    (if (> low dfmax)
+	(progn
+	  (setf (dfixnum-l v) (- low dfmax))
+	  (incf (dfixnum-h v)))
+      (setf (dfixnum-l v) low)))
+  (let ((high (+ (dfixnum-h v) (dfixnum-h i))))
+    (when (> high dfmax)
+      (error "dfixnum became too big ~a + ~a" v i))
+    (setf (dfixnum-h v) high))
+  v)
+
+(defun dfixnum-set-df (v i)
+  (declare (type dfixnum v) (type dfixnum i))
+  (setf (dfixnum-h v) (dfixnum-h i))
+  (setf (dfixnum-l v) (dfixnum-l i)))
+
+(defun dfixnum-inc-hf (v i)
+  "increments dfixnum v by i (max half fixnum)"
+  (declare (type dfixnum v) (type fixnum i))
+  (when (> i dfmax)
+      (error "not a half-fixnum: ~a" i))
+  (let ((low (+ (dfixnum-l v) i)))
+    (if (> low dfmax)
+	(progn
+	  (setf (dfixnum-l v) (- low dfmax))
+	  (incf (dfixnum-h v)))
+      (setf (dfixnum-l v) (the dfparttype low))))
+  (when (> (+ (dfixnum-h v) i) dfmax)
+    (error "dfixnum became too big ~a + ~a" v i))
+  v)
+
+(defun dfixnum-dec-df (v i)
+  "decrement dfixnum v by dfixnum i"
+  (declare (type dfixnum v) (type dfixnum i))
+  (let ((low (- (dfixnum-l v) (dfixnum-l i)))
+	(high (- (dfixnum-h v) (dfixnum-h i))))
+    (declare (type fixnum low high))
+    (when (< low 0)
+	(decf high)
+	(setf low (+ low dfmax)))
+    (when (< high 0)
+      (error "dfixnum became negative ~a - ~a (~a/~a)" v i low high))
+    (setf (dfixnum-h v) high)
+    (setf (dfixnum-l v) low))
+  v)
+
+(defun dfixnum-dec-hf (v i)
+  "decrement dfixnum v by half-fixnum i"
+  (declare (type dfixnum v) (type (integer 0 #.dfmax) i))
+  (let ((low (- (dfixnum-l v) i))
+	(high (dfixnum-h v)))
+    (declare (type fixnum low high))
+    (when (< low 0)
+	(decf high)
+	(setf low (+ low dfmax)))
+    (when (< high 0)
+      (error "dfixnum became negative ~a - ~a (~a/~a)" v i low high))
+    (setf (dfixnum-h v) high)
+    (setf (dfixnum-l v) low))
+  v)
+
+(defun dfixnum-set-from-number (df i)
+  (declare (type dfixnum df) (optimize (ext:inhibit-warnings 3)))
+  (setf (dfixnum-h df) (ash i (- dfbits)))
+  (setf (dfixnum-l df) (mod i dfmax)))
+
+(defun dfixnum-make-from-number (i)
+  "returns a new dfixnum from number i"
+  (declare (type number i) (optimize (ext:inhibit-warnings 3)))
+  (let ((df (make-dfixnum)))
+    (declare (type dfixnum df))
+    (dfixnum-set-from-number df i)
+    df))
+
+(defun dfixnum-integer (df)
+  (declare (optimize (ext:inhibit-warnings 3)))
+  (+ (* (dfixnum-h df) dfmax)
+     (dfixnum-l df)))
+
+(defun dfixnum-single-float (df)
+  (declare (optimize (ext:inhibit-warnings 3)))
+  (+ (* (coerce (dfixnum-h df) 'single-float) #.(coerce dfmax 'single-float))
+     (coerce (dfixnum-l df) 'single-float)))
+
+(defun dfixnum-single-float-inline (df)
+  (declare (optimize (ext:inhibit-warnings 3)))
+  (+ (* (coerce (dfixnum-h df) 'single-float) #.(coerce dfmax 'single-float))
+     (coerce (dfixnum-l df) 'single-float)))
+(declaim (inline dfixnum-single-float-inline))
+
+(defmacro dfixnum-set-single-float (float df)
+  `(progn
+     (setf
+      ,float
+      (+ (* (coerce (dfixnum-h ,df) 'single-float)
+	    ,#.(coerce dfmax 'single-float))
+	 (coerce (dfixnum-l ,df) 'single-float)))))
+
+(defmacro dfixnum-inc-single-float (float df)
+  `(progn
+     (setf
+      ,float
+      (+ ,float (* (coerce (dfixnum-h ,df) 'single-float)
+		   ,#.(coerce dfmax 'single-float))
+	 (coerce (dfixnum-l ,df) 'single-float)))))
+
+(defmacro dfixnum-set-pair (h l dfnum)
+  `(progn
+     (setf ,h (dfixnum-h ,dfnum))
+     (setf ,l (dfixnum-l ,dfnum))))
+
+(defmacro dfixnum-inc-pair (vh vl ih il)
+  "increments a pair of halffixnums by another pair"
+  `(progn
+     (let ((low (+ ,vl ,il)))
+       (if (> low dfmax)
+	   (progn
+	     (setf ,vl (- low dfmax))
+	     (incf ,vh))
+	 (setf ,vl low)))
+     (let ((high (+ ,vh ,ih)))
+       (when (> high dfmax)
+	 (error "dfixnum became too big ~a/~a + ~a/~a" ,vh ,vl ,ih ,il))
+       (setf ,vh high))))
+
+(defun dfixnum-pair-integer (h l)
+  (+ (* h dfmax) l))
+
+(defmacro dfixnum-dec-pair (vh vl ih il)
+  "decrement dfixnum pair by another pair"
+  `(let ((low (- ,vl ,il))
+	 (high (- ,vh ,ih)))
+     (declare (type fixnum low high))
+     (when (< low 0)
+       (decf high)
+       (setf low (+ low dfmax)))
+     (when (< high 0)
+       (error "dfixnum became negative ~a - ~a/~a - ~a/~a(~a/~a)"
+	      ,vh ,vl ,ih ,il low high))
+     (setf ,vh high)
+     (setf ,vl low)))
+
+(defmacro dfixnum-copy-pair (vh vl ih il)
+  `(progn
+     (setf ,vh ,ih)
+     (setf ,vl ,il)))
diff --git a/code/gc.lisp b/code/gc.lisp
index 5db8ffd1b..7e1ee187f 100644
--- a/code/gc.lisp
+++ b/code/gc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.27 2002/08/27 22:18:24 moore Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.28 2002/11/05 22:45:40 cracauer Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,7 +19,9 @@
 (export '(*before-gc-hooks* *after-gc-hooks* gc gc-on gc-off
 	  *bytes-consed-between-gcs* *gc-verbose* *gc-inhibit-hook*
 	  *gc-notify-before* *gc-notify-after* get-bytes-consed
-	  *gc-run-time* bytes-consed-between-gcs))
+	  *gc-run-time* bytes-consed-between-gcs
+	  get-bytes-consed-integer get-bytes-consed-single-float
+	  get-bytes-consed-dfixnum get-bytes-consed-new))
 
 (in-package "LISP")
 (export '(room))
@@ -53,8 +55,15 @@
        (- (system:sap-int (c::dynamic-space-free-pointer))
 	  (current-dynamic-space-start))))
 
-#+(or cgc gencgc)
-(c-var-frob dynamic-usage "bytes_allocated")
+;; #+(or cgc gencgc)
+;; (c-var-frob dynamic-usage "bytes_allocated")
+
+(alien:def-alien-routine get_bytes_allocated_lower c-call:int)
+(alien:def-alien-routine get_bytes_allocated_upper c-call:int)
+
+(defun dynamic-usage ()
+  (dfixnum:dfixnum-pair-integer
+   (get_bytes_allocated_upper) (get_bytes_allocated_lower)))
 
 (defun static-space-usage ()
   (- (* lisp::*static-space-free-pointer* vm:word-bytes)
@@ -138,27 +147,67 @@
 ;;; Internal State
 ;;; 
 (defvar *last-bytes-in-use* nil)
-(defvar *total-bytes-consed* 0)
+(defvar *total-bytes-consed* (dfixnum:make-dfixnum))
 
-(declaim (type (or index null) *last-bytes-in-use*))
-(declaim (type integer *total-bytes-consed*))
+(declaim (type (or fixnum null) *last-bytes-in-use*))
+(declaim (type dfixnum:dfixnum *total-bytes-consed*))
 
 ;;; GET-BYTES-CONSED -- Exported
 ;;; 
+#+(or cgc gencgc)
+(defun get-bytes-consed-dfixnum ()
+  ;(declare (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
+  (cond ((null *last-bytes-in-use*)
+	 (pushnew
+	  #'(lambda ()
+	      (print "resetting GC counters")
+	      (force-output)
+	      (setf *last-bytes-in-use* nil)
+	      (setf *total-bytes-consed* (dfixnum:make-dfixnum)))
+	  ext:*before-save-initializations*)
+	 (setf *last-bytes-in-use* (dynamic-usage))
+	 (dfixnum:dfixnum-set-from-number *total-bytes-consed* 0))
+	(t
+	 (let* ((bytes (dynamic-usage))
+		(incbytes (- bytes *last-bytes-in-use*)))
+	   (if (< incbytes dfixnum::dfmax)
+	       (dfixnum:dfixnum-inc-hf *total-bytes-consed* incbytes)
+	     (dfixnum:dfixnum-inc-df
+	      *total-bytes-consed*
+	      ;; Kinda fixme - we cons, but it doesn't matter if we consed
+	      ;; more than 250 Megabyte *within* this measuring period anyway.
+	      (let ((df (dfixnum:make-dfixnum)))
+		(dfixnum:dfixnum-set-from-number df incbytes)
+		df)))
+	   (setq *last-bytes-in-use* bytes))))
+  *total-bytes-consed*)
+
+#+(or cgc gencgc)
+(defun get-bytes-consed ()
+  "Returns the number of bytes consed since the first time this function
+  was called.  The first time it is called, it returns zero."
+  (dfixnum:dfixnum-integer (get-bytes-consed-dfixnum)))
+
+#-(or cgc gencgc)
 (defun get-bytes-consed ()
   "Returns the number of bytes consed since the first time this function
   was called.  The first time it is called, it returns zero."
   (declare (optimize (speed 3) (safety 0)(inhibit-warnings 3)))
   (cond ((null *last-bytes-in-use*)
-	 (setq *last-bytes-in-use* (dynamic-usage))
-	 (setq *total-bytes-consed* 0))
-	(t
-	 (let ((bytes (dynamic-usage)))
-	   (incf *total-bytes-consed*
-		 (the index (- bytes *last-bytes-in-use*)))
-	   (setq *last-bytes-in-use* bytes))))
+         (setq *last-bytes-in-use* (dynamic-usage))
+         (setq *total-bytes-consed* 0))
+        (t
+         (let ((bytes (dynamic-usage)))
+           (incf *total-bytes-consed*
+                 (the index (- bytes *last-bytes-in-use*)))
+           (setq *last-bytes-in-use* bytes))))
   *total-bytes-consed*)
 
+#-(or cgc gencgc)
+(defun get-bytes-consed-dfixnum ()
+  ;; A plug until a direct implementation is available.
+  (dfixnum:dfixnum-make-from-number (get-bytes-consed)))
+    
 
 ;;;; Variables and Constants.
 
@@ -389,12 +438,21 @@
 	    #-gencgc (funcall *internal-gc*)
 	    #+gencgc (if (eq *internal-gc* #'collect-garbage)
 			 (funcall *internal-gc* gen)
-			 (funcall *internal-gc*))
+                         (funcall *internal-gc*))
 	    (let* ((post-gc-dyn-usage (dynamic-usage))
 		   (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
 	      (when *last-bytes-in-use*
-		(incf *total-bytes-consed*
-		      (- pre-gc-dyn-usage *last-bytes-in-use*))
+		#+nil(when verbose-p
+		  (format
+		   t "~&Adjusting *last-bytes-in-use* from ~:D to ~:D, gen ~d, pre ~:D ~%"
+		   *last-bytes-in-use*
+		   post-gc-dyn-usage
+		   gen
+		   pre-gc-dyn-usage)
+		  (force-output))
+		(dfixnum:dfixnum-inc-hf
+		 *total-bytes-consed*
+		 (- pre-gc-dyn-usage *last-bytes-in-use*))
 		(setq *last-bytes-in-use* post-gc-dyn-usage))
 	      (setf *need-to-collect-garbage* nil)
 	      (setf *gc-trigger*
diff --git a/code/profile.lisp b/code/profile.lisp
index acc8a8b55..7fb7e782d 100644
--- a/code/profile.lisp
+++ b/code/profile.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.23 2002/11/01 17:43:29 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.24 2002/11/05 22:45:41 cracauer Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -30,10 +30,14 @@
 ;;; will result in use of an erroneously small timing overhead factor.  In CMU
 ;;; CL, this cache is invalidated when a core is saved.
 ;;;
-(in-package "PROFILE")
 
-(export '(*timed-functions* profile profile-all unprofile report-time
-	  reset-time))
+(defpackage "PROFILE"
+  (:export *timed-functions* profile profile-all unprofile reset-time 
+	   report-time report-time-custom *default-report-time-printfunction*
+	   with-spacereport print-spacereports reset-spacereports
+	   delete-spacereports *insert-spacereports*))
+
+(in-package "PROFILE")
 
 
 ;;;; Implementation dependent interfaces:
@@ -94,9 +98,14 @@
 ;;; The Total-Consing macro is called to find the total number of bytes consed
 ;;; since the beginning of time.
 
+(declaim (inline total-consing))
 #+cmu
-(defmacro total-consing ()
-  '(ext:get-bytes-consed))
+(defun total-consing () (ext:get-bytes-consed-dfixnum))
+
+#-cmu
+(eval-when (compile eval)
+  (error "No consing will be reported unless a Total-Consing function is ~
+           defined."))
 
 (eval-when (compile load eval)
 ;; Some macros to implement a very simple "bignum" package consisting
@@ -224,11 +233,12 @@ this, the functions are listed.  If NIL, then always list the functions.")
 ;;; allow for about 2^58 bytes of total consing.  (Assumes positive
 ;;; fixnums are 29 bits long).
 (defvar *enclosed-time* 0)
-(defvar *enclosed-consing* 0)
-(defvar *enclosed-consing-hi* 0)
+(defvar *enclosed-consing-h* 0)
+(defvar *enclosed-consing-l* 0)
 (defvar *enclosed-profilings* 0)
 (declaim (type time-type *enclosed-time*))
-(declaim (type consing-type *enclosed-consing* *enclosed-consing-hi*))
+(declaim (type dfixnum:dfparttype *enclosed-consing-h*))
+(declaim (type dfixnum:dfparttype *enclosed-consing-l*))
 (declaim (fixnum *enclosed-profilings*))
 
 
@@ -254,16 +264,6 @@ this, the functions are listed.  If NIL, then always list the functions.")
 
 (eval-when (compile load eval)
 
-;;; MAKE-PROFILE-ENCAPSULATION  --  Internal
-;;;
-;;;    Return a lambda expression for a function that (when called with the
-;;; function name) will set up that function for profiling.
-;;;
-;;; A function is profiled by replacing its definition with a closure created
-;;; by the following function.  The closure records the starting time, calls
-;;; the original function, and records finishing time.  Other closures are used
-;;; to perform various operations on the encapsulated function.
-;;;
 (defun make-profile-encapsulation (min-args optionals-p)
   (let ((required-args ()))
     (dotimes (i min-args)
@@ -271,12 +271,16 @@ this, the functions are listed.  If NIL, then always list the functions.")
     `(lambda (name callers-p)
        (let* ((time 0)
 	      (count 0)
-	      (consed 0)
-	      (consed-hi 0)
+	      (consed-h 0)
+	      (consed-l 0)
+	      (consed-w/c-h 0)
+	      (consed-w/c-l 0)
 	      (profile 0)
 	      (callers ())
 	      (old-definition (fdefinition name)))
-	 (declare (type time-type time) (type consing-type consed consed-hi)
+	 (declare (type time-type time)
+		  (type dfixnum:dfparttype consed-h consed-l)
+		  (type dfixnum:dfparttype consed-w/c-h consed-w/c-l)
 		  (fixnum count))
 	 (pushnew name *timed-functions*)
 
@@ -310,19 +314,25 @@ this, the functions are listed.  If NIL, then always list the functions.")
 			     (return))))))
 			       
 		   (let ((time-inc 0)
-			 (cons-inc 0)
-			 (cons-inc-hi 0)
+			 (cons-inc-h 0)
+			 (cons-inc-l 0)
 			 (profile-inc 0))
 		     (declare (type time-type time-inc)
-			      (type consing-type cons-inc cons-inc-hi)
+			      (type dfixnum:dfparttype cons-inc-h cons-inc-l)
 			      (fixnum profile-inc))
 		     (multiple-value-prog1
 			 (let ((start-time (quickly-get-time))
-			       (start-consed (total-consing))
+			       (start-consed-h 0)
+			       (start-consed-l 0)
+			       (end-consed-h 0)
+			       (end-consed-l 0)
 			       (*enclosed-time* 0)
-			       (*enclosed-consing* 0)
-			       (*enclosed-consing-hi* 0)
+			       (*enclosed-consing-h* 0)
+			       (*enclosed-consing-l* 0)
 			       (*enclosed-profilings* 0))
+			   (dfixnum:dfixnum-set-pair start-consed-h
+						     start-consed-l
+						     (total-consing))
 			   (multiple-value-prog1
 			       ,(if optionals-p
 				    #+cmu
@@ -342,32 +352,39 @@ this, the functions are listed.  If NIL, then always list the functions.")
 				   #+BSD
 				   (max (- (quickly-get-time) start-time) 0))
 			     ;; How much did we cons so far?
-			     (multiple-value-setq (cons-inc-hi cons-inc)
-			       (let ((diff (- (total-consing) start-consed)))
-				 (values (ash diff (- +fixnum-bits+))
-					 (ldb +fixnum-byte+ diff))))
+			     (dfixnum:dfixnum-set-pair end-consed-h
+						       end-consed-l
+						       (total-consing))
+			     (dfixnum:dfixnum-copy-pair cons-inc-h cons-inc-l
+							end-consed-h
+							end-consed-l)
+			     (dfixnum:dfixnum-dec-pair cons-inc-h cons-inc-l
+						       start-consed-h
+						       start-consed-l)
+			     ;; (incf consed (- cons-inc *enclosed-consing*))
+			     (dfixnum:dfixnum-inc-pair consed-h consed-l
+						       cons-inc-h cons-inc-l)
+			     (dfixnum:dfixnum-inc-pair consed-w/c-h
+						       consed-w/c-l
+						       cons-inc-h cons-inc-l)
 
 			     (setq profile-inc *enclosed-profilings*)
 			     (incf time
 				   (the time-type
-					#-BSD
-					(- time-inc *enclosed-time*)
-					#+BSD
-					(max (- time-inc *enclosed-time*) 0)))
-			     ;; consed = consed + (- cons-inc *enclosed-consing*)
-			     (multiple-value-bind (dhi dlo)
-				 (dfix-sub (cons-inc-hi cons-inc)
-					   (*enclosed-consing-hi* *enclosed-consing*))
-
-			       (dfix-incf (consed-hi consed) (dhi dlo)))
-
+				     #-BSD
+				     (- time-inc *enclosed-time*)
+				     #+BSD
+				     (max (- time-inc *enclosed-time*) 0)))
+			     (dfixnum:dfixnum-dec-pair consed-h consed-l
+						       *enclosed-consing-h*
+						       *enclosed-consing-l*)
 			     (incf profile profile-inc)))
 		       (incf *enclosed-time* time-inc)
 		       ;; *enclosed-consing* = *enclosed-consing + cons-inc
-		       (dfix-incf (*enclosed-consing-hi* *enclosed-consing*)
-				  (cons-inc-hi cons-inc))
-		       (incf *enclosed-profilings*
-			     (the fixnum (1+ profile-inc)))))))
+		       (dfixnum:dfixnum-inc-pair *enclosed-consing-h*
+						 *enclosed-consing-l*
+						 cons-inc-h
+						 cons-inc-l)))))
 	 
 	 (setf (gethash name *profile-info*)
 	       (make-profile-info
@@ -376,14 +393,19 @@ this, the functions are listed.  If NIL, then always list the functions.")
 		:new-definition (fdefinition name)
 		:read-time
 		#'(lambda ()
-		    (let ((total-cons (+ consed (ash consed-hi +fixnum-bits+))))
-		      (values count time total-cons profile callers)))
+		    (values count time
+			    (dfixnum:dfixnum-pair-integer consed-h consed-l)
+			    (dfixnum:dfixnum-pair-integer consed-w/c-h
+							  consed-w/c-l)
+			    profile callers))
 		:reset-time
 		#'(lambda ()
 		    (setq count 0)
 		    (setq time 0)
-		    (setq consed 0)
-		    (setq consed-hi 0)
+		    (setq consed-h 0)
+		    (setq consed-l 0)
+		    (setq consed-w/c-h 0)
+		    (setq consed-w/c-l 0)
 		    (setq profile 0)
 		    (setq callers ())
 		    t)))))))
@@ -391,6 +413,7 @@ this, the functions are listed.  If NIL, then always list the functions.")
 ); EVAL-WHEN (COMPILE LOAD EVAL)
 
 
+
 ;;; Precompute some encapsulation functions:
 ;;;
 (macrolet ((frob ()
@@ -499,22 +522,6 @@ this, the functions are listed.  If NIL, then always list the functions.")
 	(warn "Preserving current definition of redefined function ~S."
 	      name))))
 
-
-(defmacro report-time (&rest names)
-  "Reports the time spent in the named functions.  Names defaults to the list of
-  all currently profiled functions."
-  `(%report-times ,(if names `',names '*timed-functions*)))
-
-
-(defstruct (time-info
-	    (:constructor make-time-info (name calls time consing callers)))
-  name
-  calls
-  time
-  consing
-  callers)
-
-
 ;;; COMPENSATE-TIME  --  Internal
 ;;;
 ;;;    Return our best guess for the run time in a function, subtracting out
@@ -578,14 +585,84 @@ this, the functions are listed.  If NIL, then always list the functions.")
 		(max 7 (ceiling (safe-log10 total-calls)))
 		(+ 5 (max 5 (ceiling (safe-log10 max-time/call)))))))))
 
-(defun %report-times (names)
+(defstruct (time-info
+	    (:constructor make-time-info
+			  (name calls time consing consing-w/c callers)))
+  name
+  calls
+  time
+  consing
+  consing-w/c
+  callers)
+
+(defstruct (time-totals)
+  (time 0.0)
+  (consed 0)
+  (calls 0))
+
+(defun report-times-time (time action)
+  (case action
+    (:head
+     (format *trace-output*
+	     "~&  Consed    |   Calls   |    Secs   | Sec/Call  | Bytes/C.  | Name:~@
+	       -----------------------------------------------------------------------~%")
+     (return-from report-times-time))
+
+    (:tail
+     (format *trace-output*
+	     "-------------------------------------------------------------------~@
+	      ~11:D |~10:D |           |           |           | Total~%"
+	     (time-totals-consed time) (time-totals-calls time)))
+    (:sort (sort time #'>= :key #'time-info-time))
+    (:one-function
+     (format *trace-output*
+	     "~11:D |~10:D |~10,3F |~10,5F |~10:D | ~S~%"
+	     (floor (time-info-consing time))
+	     (time-info-calls time)
+	     (time-info-time time)
+	     (/ (time-info-time time) (float (time-info-calls time)))
+	     (round
+	       (/ (time-info-consing time) (float (time-info-calls time))))
+	     (time-info-name time)))
+    (t
+     (error "Unknown action for profiler report: ~s" action))))
+
+(defun report-times-space (time action)
+  (case action
+    (:head
+     (format *trace-output*
+	     "~& Consed w/c |  Consed    |   Calls   | Sec/Call  | Bytes/C.  | Name:~@
+	       -----------------------------------------------------------------------~%")
+     (return-from report-times-space))
+    
+    (:tail
+     (format *trace-output*
+	     "-------------------------------------------------------------------~@
+	      :-)         |~11:D |~10:D |           |           | Total~%"
+	     (time-totals-consed time) (time-totals-calls time)))
+    (:sort (sort time #'>= :key #'time-info-consing))
+    (:one-function
+     (format *trace-output*
+	     "~11:D |~11:D |~10:D |~10,5F |~10:D | ~S~%"
+	     (floor (time-info-consing-w/c time))
+	     (floor (time-info-consing time))
+	     (time-info-calls time)
+	     (/ (time-info-time time) (float (time-info-calls time)))
+	     (round
+	      (/ (time-info-consing time) (float (time-info-calls time))))
+	     (time-info-name time)))
+    (t
+     (error "Unknown action for profiler report"))))
+
+(defparameter *default-report-time-printfunction* #'report-times-time)
+
+(defun %report-times (names
+		      &key (printfunction *default-report-time-printfunction*))
   (declare (optimize (speed 0)))
   (unless (boundp '*call-overhead*)
     (compute-time-overhead))
   (let ((info ())
-	(ext:*gc-verbose* nil)
-	separator)
-    (setf *no-calls* nil)
+	(no-call ()))
     (dolist (name names)
       (let ((pinfo (profile-info-or-lose name)))
 	(unless (eq (fdefinition name)
@@ -594,51 +671,31 @@ this, the functions are listed.  If NIL, then always list the functions.")
 	         PROFILE it again to record calls to the new definition."
 		name))
 	(multiple-value-bind
-	      (calls time consing profile callers)
+	    (calls time consing consing-w/c profile callers)
 	    (funcall (profile-info-read-time pinfo))
 	  (if (zerop calls)
-	      (push name *no-calls*)
+	      (push name no-call)
 	      (push (make-time-info name calls
 				    (compensate-time calls time profile)
 				    consing
+				    consing-w/c
 				    (sort (copy-seq callers)
 					  #'>= :key #'cdr))
 		    info)))))
     
-    (setq info (sort info #'>= :key #'time-info-time))
-
-    (multiple-value-bind (total-time total-consed total-calls
-				     time-width cons-width calls-width
-				     time/call-width)
-	(compute-totals-and-widths info)
-
-      ;; Create the separator string of the appropriate length.  The
-      ;; 11 is for the column spacing and the 10 is for a reasonable
-      ;; length for the name of the function.
-      (setf separator (make-string (+ 11 10 time-width cons-width calls-width
-			      time/call-width)
-			   :initial-element #\-))
-      (format *trace-output*
-	      "~&~V@A | ~V@A | ~V@A | ~V@A | Name:~@
-	       ~A~%"
-	      time-width "Seconds"
-	      cons-width "Consed"
-	      calls-width "Calls"
-	      time/call-width "Sec/Call"
-	      separator)
+    (setq info (funcall printfunction info :sort))
+
+    (funcall printfunction nil :head)
 
+    (let ((totals (make-time-totals)))
       (dolist (time info)
-	(format *trace-output*
-		"~V,3F | ~V:D | ~V:D | ~V,5F | ~S~%"
-		time-width
-		(time-info-time time)
-		cons-width
-		(time-info-consing time)
-		calls-width
-		(time-info-calls time)
-		time/call-width
-		(/ (time-info-time time) (float (time-info-calls time)))
-		(time-info-name time))
+	(incf (time-totals-time totals) (time-info-time time))
+	(incf (time-totals-calls totals) (time-info-calls time))
+	(incf (time-totals-consed totals) (time-info-consing time))
+
+	(funcall printfunction time :one-function)
+
+	#+nil
 	(let ((callers (time-info-callers time)))
 	  (when callers
 	    (dolist (x (subseq callers 0 (min (length callers) 5)))
@@ -646,32 +703,23 @@ this, the functions are listed.  If NIL, then always list the functions.")
 	      (print-caller-info (car x) *trace-output*)
 	      (terpri *trace-output*))
 	    (terpri *trace-output*))))
+      (funcall printfunction totals :tail))
+    
+    #+nil
+    (when no-call
       (format *trace-output*
-	      "~A~@
-	      ~V,3F | ~V:D | ~V:D | ~VA | Total~%"
-	      separator
-	      time-width total-time
-	      cons-width total-consed
-	      calls-width total-calls
-	      time/call-width " ")
-
-      (format *trace-output*
-	      "~%Estimated total profiling overhead: ~4,2F seconds~%"
-	      (* *total-profile-overhead* (float total-calls))))
-
-    (when *no-calls*
-      (let ((num-no-calls (length *no-calls*)))
-        (if (and *no-calls-limit*
-		 (numberp *no-calls-limit*)
-		 (> num-no-calls *no-calls-limit*))
-            (format *trace-output*
-                    "~%~@(~r~) profiled functions were not called. ~
-                      ~%See the variable profile::*no-calls* for a list."
-                    num-no-calls)
-            (format *trace-output*
-                    "~%The following profiled functions were not called:~
-                ~%~{~<~%~:; ~A~>~}~%"
-                    *no-calls*))))
+	      "~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
+	      (sort no-call #'string<
+		    :key #'(lambda (n)
+			     (cond ((symbolp n)
+				    (symbol-name n))
+				   ((and (listp n)
+					 (eq (car n) 'setf)
+					 (consp (cdr n))
+					 (symbolp (cadr n)))
+				    (symbol-name (cadr n)))
+				   (t
+				    (princ-to-string n)))))))
     (values)))
 
 
@@ -685,6 +733,26 @@ this, the functions are listed.  If NIL, then always list the functions.")
     (funcall (profile-info-reset-time (profile-info-or-lose name))))
   (values))
 
+
+(defmacro report-time (&rest names)
+  "Reports the time spent in the named functions.  Names defaults to the list
+  of all currently profiled functions."
+  `(%report-times ,(if names `',names '*timed-functions*)))
+
+(defun report-time-custom (&key names printfunction)
+  "Reports the time spent in the named functions.  Names defaults to the list
+  of all currently profiled functions.  Uses printfunction."
+  (%report-times (or names *timed-functions*)
+		 :printfunction
+		 (or (typecase printfunction
+		       (null *default-report-time-printfunction*)
+		       (function printfunction)
+		       (symbol
+		        (case printfunction
+			  (:space #'report-times-space)
+			  (:time #'report-times-time))))
+		     (error "Cannot handle printfunction ~s" printfunction))))
+
 
 ;;;; Overhead computation.
 
@@ -739,3 +807,157 @@ this, the functions are listed.  If NIL, then always list the functions.")
 (pushnew #'(lambda ()
 	     (makunbound '*call-overhead*))
 	 ext:*before-save-initializations*)
+
+
+;;;
+;;; (with-spacereport <tag> <body> ...) and friends
+;;;
+
+;;; TODO:
+;;; - if counting place haven't been allocated at compile time, try to do it
+;;;   at load time
+;;; - Introduce a mechanism that detects whether *all* calls were the same
+;;;   amount of bytes (single variable).
+;;; - record the source file and place this report appears in
+;;; - detect whether this is a nested spacereport and if so, record
+;;;   the outer reports
+
+;; This struct is used for whatever counting the checkpoints do
+;; AND
+;; stores information we find at compile time
+(defstruct spacereport-info
+  (n 0 :type fixnum)
+  (consed-h 0 :type dfixnum:dfparttype)
+  (consed-l 0 :type dfixnum:dfparttype)
+  (codesize -1 :type fixnum))
+
+;; In the usual case, the hashtable with entries will be allocated at
+;; compile or load time
+(eval-when (load eval)
+  (defvar *spacereports* (make-hash-table)))
+
+;;
+;; Helper functions
+;;
+(defun format-quotient (p1 p2 width komma)
+  (let (format)
+    (cond ((= 0 p2)
+	   (make-string width :initial-element #\ ))
+	  ((and (integerp p1)
+		(integerp p2)
+		(zerop (rem p1 p2)))
+	   (setf format (format nil "~~~d:D!~a"
+				(- width komma 1)
+				(make-string komma :initial-element #\ )))
+	   (format nil format (/ p1 p2)))
+	  (t
+	   (setf format (format nil "~~~d,~df" width komma))
+	   (format nil format (/ (float p1) (float p2)))))))
+
+(defun deep-list-length (list)
+  (let ((length 0))
+    (dolist (e list)
+      (when (listp e)
+	(incf length (deep-list-length e)))
+      (incf length))
+    length))      
+
+;; bunch for tests for above
+#+nil
+(defun test-format-quotient ()
+  (print (format-quotient 10 5 10 2))
+  (print (format-quotient 10 3 10 2))
+  (print (format-quotient 10 5 10 0))
+  (print (format-quotient 10 3 10 0))
+  (print (format-quotient 10 0 10 0)))
+
+(defvar *insert-spacereports* t)
+
+;; Main wrapper macro for user - exported
+(defmacro with-spacereport (name-or-args &body body)
+  (if (not *insert-spacereports*)
+      `(progn ,@body)
+      (let ((name
+	     (typecase name-or-args
+	       (symbol name-or-args)
+	       (cons (first name-or-args))
+	       (t (error "Spacereport args neither symbol nor cons") nil)))
+	    (options (if (consp name-or-args)
+			 (rest name-or-args)
+			 nil)))
+	(when (gethash name *spacereports*)
+	  (unless (find :mok options)
+	    (warn "spacereport for ~a was requested before, resetting it"
+		  name)))
+	(setf (gethash name *spacereports*) (make-spacereport-info))
+	(setf (spacereport-info-codesize (gethash name *spacereports*))
+	      (deep-list-length body))
+
+	`(let* ((counterplace nil)
+		(place (gethash ,name *spacereports*))
+		(start-h 0)
+		(start-l 0))
+	  (declare (type dfixnum:dfparttype start-h start-l))
+	  (declare (type (or dfixnum:dfixnum null) counterplace))
+	  (declare (type (or spacereport-info null) place))
+
+	  ;; Make sure counter is there
+	  (unless place
+	    ;; Ups, it isn't, so create it...
+	    (setf place (make-spacereport-info))
+	    (setf (gethash ,name *spacereports*) place)
+	    (print
+	     "with-spaceprofile had to create place, leaked bytes to outer
+              spacereports in nested calls"))
+
+	  ;; Remember bytes already consed at start
+	  (setf counterplace (total-consing))
+	  (dfixnum:dfixnum-set-pair start-h start-l counterplace)
+
+	  (prog1
+	      (progn ,@body)
+
+	    (incf (spacereport-info-n place))
+	    ;; Add bytes newly consed.
+	    ;; first update counterplace.
+	    (total-consing)
+	    (dfixnum:dfixnum-inc-pair (spacereport-info-consed-h place)
+				      (spacereport-info-consed-l place)
+				      (dfixnum::dfixnum-h counterplace)
+				      (dfixnum::dfixnum-l counterplace))
+	    (dfixnum:dfixnum-dec-pair (spacereport-info-consed-h place)
+				      (spacereport-info-consed-l place)
+				      start-h
+				      start-l))))))
+
+(defun print-spacereports (&optional (stream *trace-output*))
+  (maphash #'(lambda (key value)
+	       (format
+		stream
+		"~&~10:D bytes ~9:D calls ~a b/call: ~a (sz ~d)~%"
+		(dfixnum:dfixnum-pair-integer
+		 (spacereport-info-consed-h value)
+		 (spacereport-info-consed-l value))
+		(spacereport-info-n value)
+		(format-quotient (dfixnum:dfixnum-pair-integer
+				  (spacereport-info-consed-h value)
+				  (spacereport-info-consed-l value))
+				 (spacereport-info-n value)
+				 10 2)
+		key
+		(spacereport-info-codesize value)))
+	   *spacereports*))
+
+(defun reset-spacereports ()
+  (maphash #'(lambda (key value)
+	       (declare (ignore key))
+	       (setf (spacereport-info-consed-h value) 0)
+	       (setf (spacereport-info-consed-l value) 0)
+	       (setf (spacereport-info-n value) 0))
+	   *spacereports*))
+
+(defun delete-spacereports ()
+  (maphash #'(lambda (key value)
+	       (declare (ignore value))
+	       (remhash key *spacereports*))
+	   *spacereports*))
diff --git a/code/time.lisp b/code/time.lisp
index 9e66c921b..701fcb8bc 100644
--- a/code/time.lisp
+++ b/code/time.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.19 2000/06/07 07:11:02 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.20 2002/11/05 22:45:41 cracauer Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -274,7 +274,7 @@
 
 ;;; TIME-GET-SYS-INFO  --  Internal
 ;;;
-;;;    Return all the files that we want time to report.
+;;;    Return all the values that we want time to report.
 ;;;
 (defun time-get-sys-info ()
   (multiple-value-bind (user sys faults)
@@ -323,10 +323,10 @@
     (setq real-time-overhead (- new-real-time old-real-time))
     (setq cons-overhead (- new-bytes-consed old-bytes-consed))
     ;; Now get the initial times.
+    (setq old-real-time (get-internal-real-time))
     (multiple-value-setq
         (old-run-utime old-run-stime old-page-faults old-bytes-consed)
       (time-get-sys-info))
-    (setq old-real-time (get-internal-real-time))
     (let ((start-gc-run-time *gc-run-time*))
     (multiple-value-prog1
         ;; Execute the form and return its values.
@@ -343,7 +343,7 @@
 		 ~S second~:P of system run time~%  ~
 		 ~@[[Run times include ~S second~:P GC run time]~%  ~]~
 		 ~S page fault~:P and~%  ~
-		 ~S bytes consed.~%"
+		 ~:D bytes consed.~%"
 		(max (/ (- new-real-time old-real-time)
 			(float internal-time-units-per-second))
 		     0.0)
@@ -353,4 +353,5 @@
 		  (/ (float gc-run-time)
 		     (float internal-time-units-per-second)))
 		(max (- new-page-faults old-page-faults) 0)
-		(max (- new-bytes-consed old-bytes-consed) 0)))))))
+		(max (- new-bytes-consed old-bytes-consed cons-overhead)
+		     0)))))))
diff --git a/lisp/gencgc.c b/lisp/gencgc.c
index 4159a6235..2b6926336 100644
--- a/lisp/gencgc.c
+++ b/lisp/gencgc.c
@@ -7,7 +7,7 @@
  *
  * Douglas Crosher, 1996, 1997, 1998, 1999.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.27 2002/08/27 22:18:31 moore Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.28 2002/11/05 22:45:48 cracauer Exp $
  *
  */
 
@@ -48,18 +48,25 @@
  * and only a few rare messages are printed at level 1.
  */
 unsigned gencgc_verbose = 0;
+unsigned counters_verbose = 0;
 
 /*
  * To enable the use of page protection to help avoid the scavenging
  * of pages that don't have pointers to younger generations.
  */
+#ifndef AT_ITA
 #ifdef __NetBSD__
+
 /* NetBSD on x86 has no way to retrieve the faulting address in the
  * SIGSEGV handler, so for the moment we can't use page protection. */
 boolean  enable_page_protection = FALSE;
-#else
+#else /* Netbsd */
 boolean  enable_page_protection = TRUE;
-#endif
+#endif /* Netbsd */
+
+#else /* we are ITA */
+boolean  enable_page_protection = FALSE;
+#endif /* ITA */
 
 /*
  * Hunt for pointers to old-space, when GCing generations >= verify_gen.
@@ -131,6 +138,12 @@ boolean enable_pointer_filter = TRUE;
  */
 unsigned long bytes_allocated = 0;
 
+/*
+ * The total amount of bytes ever allocated.  Not decreased by GC.
+ */
+
+volatile unsigned long long bytes_allocated_sum = 0;
+
 /*
  * GC trigger; a value of 0xffffffff represents disabled.
  */
@@ -6387,6 +6400,8 @@ char *alloc(int nbytes)
   gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0
 	    && (nbytes & 0x7) == 0);
 
+  bytes_allocated_sum += nbytes;
+
   if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) {
     /* Already within a pseudo atomic. */
     void *new_free_pointer;
@@ -6469,7 +6484,6 @@ char *alloc(int nbytes)
 	do_pending_interrupt();
 	goto retry2;
       }
-
       return (void *) new_obj;
     }
 
@@ -6499,7 +6513,6 @@ char *alloc(int nbytes)
       do_pending_interrupt();
       goto retry2;
     }
-
     return result;
   }
 }
@@ -6535,3 +6548,93 @@ lispobj * component_ptr_from_pc(lispobj *pc)
 
   return NULL;
 }
+
+/*
+ * Get lower and upper(middle) 28 bits of total allocation
+ */
+int get_bytes_consed_lower(void)
+{
+  return (int)bytes_allocated_sum & 0xFFFFFFF;
+}
+
+int get_bytes_consed_upper(void)
+{
+  return ((int)bytes_allocated_sum / 0x10000000) & 0xFFFFFFF;
+}
+
+#define current_region_free_pointer SymbolValue(CURRENT_REGION_FREE_POINTER)
+#define current_region_end_addr     SymbolValue(CURRENT_REGION_END_ADDR)
+
+int get_bytes_allocated_lower(void)
+{
+  int size = bytes_allocated;
+  static int previous = -1;
+
+  if (current_region_end_addr != boxed_region.end_addr) {
+    fprintf(stderr, "NOT BOXED: %d %d %d\n"
+	    ,current_region_end_addr, boxed_region.end_addr
+	    ,unboxed_region.end_addr);
+  }
+
+  if (current_region_end_addr == boxed_region.end_addr) {
+    size += current_region_free_pointer - (int)boxed_region.start_addr;
+  } else {
+    size += current_region_free_pointer - (int)unboxed_region.start_addr;
+  }
+
+  if (counters_verbose)
+    fprintf(stderr, ">%10d%10d%10d%10d%10d (max%d @0x%X)\n", size
+	    ,previous != -1? size - previous: -1
+	    ,current_region_free_pointer - (int)boxed_region.start_addr
+	    ,(int)boxed_region.free_pointer - (int)boxed_region.start_addr
+	    ,(int)unboxed_region.free_pointer - (int)unboxed_region.start_addr
+	    ,boxed_region.end_addr - (int)boxed_region.start_addr
+	    ,boxed_region.start_addr
+	    );
+
+  previous = size;
+
+  return (int)size & 0xFFFFFFF;
+}
+
+int get_bytes_allocated_upper(void)
+{
+  int size = bytes_allocated;
+
+  if (current_region_end_addr == boxed_region.end_addr) {
+    size += current_region_free_pointer - (int)boxed_region.start_addr;
+  } else {
+    size += current_region_free_pointer - (int)unboxed_region.start_addr;
+  }
+  return ((int)size / 0x10000000) & 0xFFFFFFF;
+}
+
+void print_bytes_allocated_sum(void)
+{
+#if 0
+  int size;
+  /*
+	      gc_alloc_update_page_tables(0, &);
+	      gc_alloc_update_page_tables(1, &unboxed_region);
+  */
+
+  size = bytes_allocated;
+
+  if (current_region_end_addr == boxed_region.end_addr) {
+    size += current_region_free_pointer - boxed_region.start_addr;
+    size += unboxed_region.free_pointer - unboxed_region.start_addr;
+  } else {
+    size += current_region_free_pointer - unboxed_region.start_addr;
+    size += boxed_region.free_pointer - boxed_region.start_addr;
+  }
+  fprintf(stdout, "manually counted: %10d %10d %10d\n"
+	  , size, size - bytes_allocated, size - bytes_allocated_sum);
+
+  /*
+  fprintf(stdout, "%llu -> %d / %d\n", bytes_allocated_sum
+	  ,get_bytes_consed_upper(), get_bytes_consed_lower());
+  fprintf(stdout, "0x%llX -> 0x%x / 0x%x\n", bytes_allocated_sum
+	  ,get_bytes_consed_upper(), get_bytes_consed_lower());
+  */
+#endif
+}
diff --git a/tools/worldbuild.lisp b/tools/worldbuild.lisp
index 8f521ecf5..210a95288 100644
--- a/tools/worldbuild.lisp
+++ b/tools/worldbuild.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.44 2002/08/27 22:18:35 moore Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.45 2002/11/05 22:45:53 cracauer Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -104,6 +104,7 @@
     "target:code/string"
     "target:code/mipsstrops"
     "target:code/misc"
+    "target:code/dfixnum"
     ,@(unless (c:backend-featurep :gengc)
 	'("target:code/gc"))
     ,@(when (c:backend-featurep :gengc)
diff --git a/tools/worldcom.lisp b/tools/worldcom.lisp
index 46ae866d1..ab9692910 100644
--- a/tools/worldcom.lisp
+++ b/tools/worldcom.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.82 2002/08/27 22:18:35 moore Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.83 2002/11/05 22:45:53 cracauer Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -203,6 +203,7 @@
 (comf "target:code/commandline")
 
 (unless (c:backend-featurep :gengc)
+  (comf "target:code/dfixnum")
   (comf "target:code/room")
   (comf "target:code/gc")
   (comf "target:code/purify"))
diff --git a/tools/worldload.lisp b/tools/worldload.lisp
index aac8a354d..848ab7d66 100644
--- a/tools/worldload.lisp
+++ b/tools/worldload.lisp
@@ -6,7 +6,7 @@
 ;;; If you want to use this code or any part of CMU Common Lisp, please contact
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldload.lisp,v 1.97 2002/10/04 15:11:13 pmai Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldload.lisp,v 1.98 2002/11/05 22:45:53 cracauer Exp $
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -127,6 +127,7 @@
 (maybe-byte-load "code:setf-funs")
 (maybe-byte-load "code:module")
 (maybe-byte-load "code:loop")
+(maybe-byte-load "code:dfixnum")
 #-(or gengc runtime) (maybe-byte-load "code:room")
 
 ;;; Overwrite some cold-loaded stuff with byte-compiled versions, if any.
-- 
GitLab