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

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (hide annotations)
Mon Feb 14 12:27:03 1994 UTC (20 years, 2 months ago) by ram
Branch: MAIN
Changes since 1.13: +12 -5 lines
Export EXT:PURIFY and remove the :CONSTANTS argument.
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 ram 1.14 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/purify.lisp,v 1.14 1994/02/14 12:27:03 ram 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 ram 1.14 (in-package "LISP")
20     (export 'ext::purify "EXT")
21 ram 1.1
22 wlott 1.12 (alien:def-alien-routine ("purify" %purify) c-call:void
23     (static-roots c-call:unsigned-long)
24     (read-only-roots c-call:unsigned-long))
25 wlott 1.7
26 ram 1.14 (defun purify (&key root-structures)
27     "This function optimizes garbage collection by moving all currently live
28     objects into non-collected storage. ROOT-STRUCTURES is an optional list of
29     objects which should be copied first to maximize locality.
30    
31     DEFSTRUCT structures defined with the (:PURE T) option are moved into
32     read-only storage, further reducing GC cost. List and vector slots of pure
33     structures are also moved into read-only storage."
34 wlott 1.13 (let ((*gc-notify-before*
35     #'(lambda (bytes-in-use)
36     (declare (ignore bytes-in-use))
37     (write-string "[Doing purification: ")
38     (force-output)))
39     (*internal-gc*
40     #'(lambda ()
41     (%purify (get-lisp-obj-address root-structures)
42 ram 1.14 (get-lisp-obj-address nil))))
43 wlott 1.13 (*gc-notify-after*
44     #'(lambda (&rest ignore)
45     (declare (ignore ignore))
46     (write-line "Done.]"))))
47     (gc t))
48 wlott 1.7 nil)

  ViewVC Help
Powered by ViewVC 1.1.5