Skip to content
Snippets Groups Projects
Commit bd075b4b authored by dtc's avatar dtc
Browse files

GENCGC interface.

parent 2be576e2
No related branches found
No related tags found
No related merge requests found
...@@ -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.22 1997/11/04 09:10:44 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.23 1997/11/04 16:00:14 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -301,7 +301,8 @@ ...@@ -301,7 +301,8 @@
;;;; Internal GC ;;;; Internal GC
(alien:def-alien-routine collect-garbage c-call:int) (alien:def-alien-routine collect-garbage c-call:int
#+gencgc (last-gen c-call:int))
#-ibmrt #-ibmrt
(alien:def-alien-routine set-auto-gc-trigger c-call:void (alien:def-alien-routine set-auto-gc-trigger c-call:void
...@@ -353,7 +354,9 @@ ...@@ -353,7 +354,9 @@
;;; called. The FORCE-P flags controls if a GC should occur even if the ;;; called. The FORCE-P flags controls if a GC should occur even if the
;;; dynamic usage is not greater than *GC-TRIGGER*. ;;; dynamic usage is not greater than *GC-TRIGGER*.
;;; ;;;
(defun sub-gc (&key (verbose-p *gc-verbose*) force-p) ;;; For GENCGC all generations < GEN will be GC'ed.
;;;
(defun sub-gc (&key (verbose-p *gc-verbose*) force-p #+gencgc (gen 0))
(unless *already-maybe-gcing* (unless *already-maybe-gcing*
(let* ((*already-maybe-gcing* t) (let* ((*already-maybe-gcing* t)
(start-time (get-internal-run-time)) (start-time (get-internal-run-time))
...@@ -383,7 +386,10 @@ ...@@ -383,7 +386,10 @@
(carefully-funcall hook)) (carefully-funcall hook))
(when *gc-trigger* (when *gc-trigger*
(clear-auto-gc-trigger)) (clear-auto-gc-trigger))
(funcall *internal-gc*) #-gencgc (funcall *internal-gc*)
#+gencgc (if (eq *internal-gc* #'collect-garbage)
(funcall *internal-gc* gen)
(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*
...@@ -420,11 +426,20 @@ ...@@ -420,11 +426,20 @@
;;; ;;;
;;; This is the user advertised garbage collection function. ;;; This is the user advertised garbage collection function.
;;; ;;;
#-gencgc
(defun gc (&optional (verbose-p *gc-verbose*)) (defun gc (&optional (verbose-p *gc-verbose*))
"Initiates a garbage collection. The optional argument, VERBOSE-P, "Initiates a garbage collection. The optional argument, VERBOSE-P,
which defaults to the value of the variable *GC-VERBOSE* controls which defaults to the value of the variable *GC-VERBOSE* controls
whether or not GC statistics are printed." whether or not GC statistics are printed."
(sub-gc :verbose-p verbose-p :force-p t)) (sub-gc :verbose-p verbose-p :force-p t))
;;;
#+gencgc
(defun gc (&key (verbose *gc-verbose*) (gen 0) (full nil))
"Initiates a garbage collection. The keyword :VERBOSE, which
defaults to the value of the variable *GC-VERBOSE* controls whether or
not GC statistics are printed. The keyword :GEN defaluts to 0, and
controls the number of generations to garbage collect."
(sub-gc :verbose-p verbose :force-p t :gen (if full 6 gen)))
;;;; Auxiliary Functions. ;;;; Auxiliary Functions.
......
...@@ -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/purify.lisp,v 1.18 1994/10/31 04:11:27 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/purify.lisp,v 1.19 1997/11/04 16:00:16 dtc Rel $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -71,5 +71,6 @@ ...@@ -71,5 +71,6 @@
#'(lambda (&rest ignore) #'(lambda (&rest ignore)
(declare (ignore ignore)) (declare (ignore ignore))
(write-line "Done.]")))) (write-line "Done.]"))))
(gc t)) #-gencgc (gc t)
#+gencgc (gc :verbose t))
nil) nil)
...@@ -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/save.lisp,v 1.31 1997/03/15 16:58:59 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.32 1997/11/04 16:00:15 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -153,7 +153,7 @@ ...@@ -153,7 +153,7 @@
(if purify (if purify
(purify :root-structures root-structures (purify :root-structures root-structures
:environment-name environment-name) :environment-name environment-name)
(gc)) #-gencgc (gc) #+gencgc (gc :full t))
(dolist (f *before-save-initializations*) (funcall f)) (dolist (f *before-save-initializations*) (funcall f))
(flet (flet
((restart-lisp () ((restart-lisp ()
......
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