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 @@
;;; 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.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 @@
;;;; 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
(alien:def-alien-routine set-auto-gc-trigger c-call:void
......@@ -353,7 +354,9 @@
;;; called. The FORCE-P flags controls if a GC should occur even if the
;;; 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*
(let* ((*already-maybe-gcing* t)
(start-time (get-internal-run-time))
......@@ -383,7 +386,10 @@
(carefully-funcall hook))
(when *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))
(bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage)))
(when *last-bytes-in-use*
......@@ -420,11 +426,20 @@
;;;
;;; This is the user advertised garbage collection function.
;;;
#-gencgc
(defun gc (&optional (verbose-p *gc-verbose*))
"Initiates a garbage collection. The optional argument, VERBOSE-P,
which defaults to the value of the variable *GC-VERBOSE* controls
whether or not GC statistics are printed."
(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.
......
......@@ -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/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 @@
#'(lambda (&rest ignore)
(declare (ignore ignore))
(write-line "Done.]"))))
(gc t))
#-gencgc (gc t)
#+gencgc (gc :verbose t))
nil)
......@@ -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/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 @@
(if purify
(purify :root-structures root-structures
:environment-name environment-name)
(gc))
#-gencgc (gc) #+gencgc (gc :full t))
(dolist (f *before-save-initializations*) (funcall f))
(flet
((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