/[cmucl]/src/code/purify.lisp
ViewVC logotype

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12.1.1 - (hide annotations) (vendor branch)
Tue Mar 3 08:20:46 1992 UTC (22 years, 1 month ago) by wlott
Branch: gengc
Changes since 1.12: +19 -17 lines
Merged trunk changes
1 ram 1.1 ;;; -*- Log: code.log; Package: Lisp -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.11 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7     ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8     ;;;
9     (ext:file-comment
10 wlott 1.12.1.1 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/purify.lisp,v 1.12.1.1 1992/03/03 08:20:46 wlott Exp $")
11 ram 1.11 ;;;
12 ram 1.1 ;;; **********************************************************************
13     ;;;
14     ;;; Storage purifier for Spice Lisp.
15     ;;; Written by Rob MacLachlan and Skef Wholey.
16     ;;;
17 wlott 1.10 ;;; Rewritten in C by William Lott.
18 ram 1.1 ;;;
19 wlott 1.12.1.1 ;;; Reduced to almost nothing with the advent of the generational garbage
20     ;;; collector by William Lott.
21     ;;;
22 ram 1.1 (in-package 'lisp)
23    
24 wlott 1.8 (defun purify (&key root-structures constants)
25 wlott 1.12.1.1 (declare (ignore root-structures constants))
26     (let* ((generations (num-generations))
27     (thresholds (make-array generations)))
28     (do ((gen 1 (1+ gen)))
29     ((= gen generations))
30     (setf (aref thresholds gen)
31     (cons (bytes-allocated-between-flips gen)
32     (tenure-threshold gen))))
33     (set-num-generations 1)
34     (set-num-generations generations)
35     (do ((gen 1 (1+ gen)))
36     ((= gen generations))
37     (let ((noise (aref thresholds gen)))
38     (set-bytes-allocated-between-flips gen (car noise))
39     (set-tenure-threshold gen (cdr noise)))))
40 wlott 1.7 nil)

  ViewVC Help
Powered by ViewVC 1.1.5