Skip to content
Snippets Groups Projects
Commit 65f0bdc0 authored by cracauer's avatar cracauer
Browse files

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.
parent f055faed
No related branches found
No related tags found
No related merge requests found
;;; -*- 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)))
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -19,7 +19,9 @@
(export '(*before-gc-hooks* *after-gc-hooks* gc gc-on gc-off (export '(*before-gc-hooks* *after-gc-hooks* gc gc-on gc-off
*bytes-consed-between-gcs* *gc-verbose* *gc-inhibit-hook* *bytes-consed-between-gcs* *gc-verbose* *gc-inhibit-hook*
*gc-notify-before* *gc-notify-after* get-bytes-consed *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") (in-package "LISP")
(export '(room)) (export '(room))
...@@ -53,8 +55,15 @@ ...@@ -53,8 +55,15 @@
(- (system:sap-int (c::dynamic-space-free-pointer)) (- (system:sap-int (c::dynamic-space-free-pointer))
(current-dynamic-space-start)))) (current-dynamic-space-start))))
#+(or cgc gencgc) ;; #+(or cgc gencgc)
(c-var-frob dynamic-usage "bytes_allocated") ;; (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 () (defun static-space-usage ()
(- (* lisp::*static-space-free-pointer* vm:word-bytes) (- (* lisp::*static-space-free-pointer* vm:word-bytes)
...@@ -138,27 +147,67 @@ ...@@ -138,27 +147,67 @@
;;; Internal State ;;; Internal State
;;; ;;;
(defvar *last-bytes-in-use* nil) (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 (or fixnum null) *last-bytes-in-use*))
(declaim (type integer *total-bytes-consed*)) (declaim (type dfixnum:dfixnum *total-bytes-consed*))
;;; GET-BYTES-CONSED -- Exported ;;; 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 () (defun get-bytes-consed ()
"Returns the number of bytes consed since the first time this function "Returns the number of bytes consed since the first time this function
was called. The first time it is called, it returns zero." was called. The first time it is called, it returns zero."
(declare (optimize (speed 3) (safety 0)(inhibit-warnings 3))) (declare (optimize (speed 3) (safety 0)(inhibit-warnings 3)))
(cond ((null *last-bytes-in-use*) (cond ((null *last-bytes-in-use*)
(setq *last-bytes-in-use* (dynamic-usage)) (setq *last-bytes-in-use* (dynamic-usage))
(setq *total-bytes-consed* 0)) (setq *total-bytes-consed* 0))
(t (t
(let ((bytes (dynamic-usage))) (let ((bytes (dynamic-usage)))
(incf *total-bytes-consed* (incf *total-bytes-consed*
(the index (- bytes *last-bytes-in-use*))) (the index (- bytes *last-bytes-in-use*)))
(setq *last-bytes-in-use* bytes)))) (setq *last-bytes-in-use* bytes))))
*total-bytes-consed*) *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. ;;;; Variables and Constants.
...@@ -389,12 +438,21 @@ ...@@ -389,12 +438,21 @@
#-gencgc (funcall *internal-gc*) #-gencgc (funcall *internal-gc*)
#+gencgc (if (eq *internal-gc* #'collect-garbage) #+gencgc (if (eq *internal-gc* #'collect-garbage)
(funcall *internal-gc* gen) (funcall *internal-gc* gen)
(funcall *internal-gc*)) (funcall *internal-gc*))
(let* ((post-gc-dyn-usage (dynamic-usage)) (let* ((post-gc-dyn-usage (dynamic-usage))
(bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage))) (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
(when *last-bytes-in-use* (when *last-bytes-in-use*
(incf *total-bytes-consed* #+nil(when verbose-p
(- pre-gc-dyn-usage *last-bytes-in-use*)) (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)) (setq *last-bytes-in-use* post-gc-dyn-usage))
(setf *need-to-collect-garbage* nil) (setf *need-to-collect-garbage* nil)
(setf *gc-trigger* (setf *gc-trigger*
......
This diff is collapsed.
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -274,7 +274,7 @@
;;; TIME-GET-SYS-INFO -- Internal ;;; 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 () (defun time-get-sys-info ()
(multiple-value-bind (user sys faults) (multiple-value-bind (user sys faults)
...@@ -323,10 +323,10 @@ ...@@ -323,10 +323,10 @@
(setq real-time-overhead (- new-real-time old-real-time)) (setq real-time-overhead (- new-real-time old-real-time))
(setq cons-overhead (- new-bytes-consed old-bytes-consed)) (setq cons-overhead (- new-bytes-consed old-bytes-consed))
;; Now get the initial times. ;; Now get the initial times.
(setq old-real-time (get-internal-real-time))
(multiple-value-setq (multiple-value-setq
(old-run-utime old-run-stime old-page-faults old-bytes-consed) (old-run-utime old-run-stime old-page-faults old-bytes-consed)
(time-get-sys-info)) (time-get-sys-info))
(setq old-real-time (get-internal-real-time))
(let ((start-gc-run-time *gc-run-time*)) (let ((start-gc-run-time *gc-run-time*))
(multiple-value-prog1 (multiple-value-prog1
;; Execute the form and return its values. ;; Execute the form and return its values.
...@@ -343,7 +343,7 @@ ...@@ -343,7 +343,7 @@
~S second~:P of system run time~% ~ ~S second~:P of system run time~% ~
~@[[Run times include ~S second~:P GC run time]~% ~]~ ~@[[Run times include ~S second~:P GC run time]~% ~]~
~S page fault~:P and~% ~ ~S page fault~:P and~% ~
~S bytes consed.~%" ~:D bytes consed.~%"
(max (/ (- new-real-time old-real-time) (max (/ (- new-real-time old-real-time)
(float internal-time-units-per-second)) (float internal-time-units-per-second))
0.0) 0.0)
...@@ -353,4 +353,5 @@ ...@@ -353,4 +353,5 @@
(/ (float gc-run-time) (/ (float gc-run-time)
(float internal-time-units-per-second))) (float internal-time-units-per-second)))
(max (- new-page-faults old-page-faults) 0) (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)))))))
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
* *
* Douglas Crosher, 1996, 1997, 1998, 1999. * 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 @@ ...@@ -48,18 +48,25 @@
* and only a few rare messages are printed at level 1. * and only a few rare messages are printed at level 1.
*/ */
unsigned gencgc_verbose = 0; unsigned gencgc_verbose = 0;
unsigned counters_verbose = 0;
/* /*
* To enable the use of page protection to help avoid the scavenging * To enable the use of page protection to help avoid the scavenging
* of pages that don't have pointers to younger generations. * of pages that don't have pointers to younger generations.
*/ */
#ifndef AT_ITA
#ifdef __NetBSD__ #ifdef __NetBSD__
/* NetBSD on x86 has no way to retrieve the faulting address in the /* 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. */ * SIGSEGV handler, so for the moment we can't use page protection. */
boolean enable_page_protection = FALSE; boolean enable_page_protection = FALSE;
#else #else /* Netbsd */
boolean enable_page_protection = TRUE; 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. * Hunt for pointers to old-space, when GCing generations >= verify_gen.
...@@ -131,6 +138,12 @@ boolean enable_pointer_filter = TRUE; ...@@ -131,6 +138,12 @@ boolean enable_pointer_filter = TRUE;
*/ */
unsigned long bytes_allocated = 0; 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. * GC trigger; a value of 0xffffffff represents disabled.
*/ */
...@@ -6387,6 +6400,8 @@ char *alloc(int nbytes) ...@@ -6387,6 +6400,8 @@ char *alloc(int nbytes)
gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0 gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0
&& (nbytes & 0x7) == 0); && (nbytes & 0x7) == 0);
bytes_allocated_sum += nbytes;
if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) { if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) {
/* Already within a pseudo atomic. */ /* Already within a pseudo atomic. */
void *new_free_pointer; void *new_free_pointer;
...@@ -6469,7 +6484,6 @@ char *alloc(int nbytes) ...@@ -6469,7 +6484,6 @@ char *alloc(int nbytes)
do_pending_interrupt(); do_pending_interrupt();
goto retry2; goto retry2;
} }
return (void *) new_obj; return (void *) new_obj;
} }
...@@ -6499,7 +6513,6 @@ char *alloc(int nbytes) ...@@ -6499,7 +6513,6 @@ char *alloc(int nbytes)
do_pending_interrupt(); do_pending_interrupt();
goto retry2; goto retry2;
} }
return result; return result;
} }
} }
...@@ -6535,3 +6548,93 @@ lispobj * component_ptr_from_pc(lispobj *pc) ...@@ -6535,3 +6548,93 @@ lispobj * component_ptr_from_pc(lispobj *pc)
return NULL; 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
}
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -104,6 +104,7 @@
"target:code/string" "target:code/string"
"target:code/mipsstrops" "target:code/mipsstrops"
"target:code/misc" "target:code/misc"
"target:code/dfixnum"
,@(unless (c:backend-featurep :gengc) ,@(unless (c:backend-featurep :gengc)
'("target:code/gc")) '("target:code/gc"))
,@(when (c:backend-featurep :gengc) ,@(when (c:backend-featurep :gengc)
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -203,6 +203,7 @@
(comf "target:code/commandline") (comf "target:code/commandline")
(unless (c:backend-featurep :gengc) (unless (c:backend-featurep :gengc)
(comf "target:code/dfixnum")
(comf "target:code/room") (comf "target:code/room")
(comf "target:code/gc") (comf "target:code/gc")
(comf "target:code/purify")) (comf "target:code/purify"))
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;; If you want to use this code or any part of CMU Common Lisp, please contact ;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; 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 @@ ...@@ -127,6 +127,7 @@
(maybe-byte-load "code:setf-funs") (maybe-byte-load "code:setf-funs")
(maybe-byte-load "code:module") (maybe-byte-load "code:module")
(maybe-byte-load "code:loop") (maybe-byte-load "code:loop")
(maybe-byte-load "code:dfixnum")
#-(or gengc runtime) (maybe-byte-load "code:room") #-(or gengc runtime) (maybe-byte-load "code:room")
;;; Overwrite some cold-loaded stuff with byte-compiled versions, if any. ;;; Overwrite some cold-loaded stuff with byte-compiled versions, if any.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment