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

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (show annotations)
Mon Feb 14 13:13:01 1994 UTC (20 years, 2 months ago) by ram
Branch: MAIN
Changes since 1.14: +18 -3 lines
Move environment compacting here from worldload.lisp to make it available to
users.
1 ;;; -*- Log: code.log; Package: Lisp -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; 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 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/purify.lisp,v 1.15 1994/02/14 13:13:01 ram Exp $")
11 ;;;
12 ;;; **********************************************************************
13 ;;;
14 ;;; Storage purifier for Spice Lisp.
15 ;;; Written by Rob MacLachlan and Skef Wholey.
16 ;;;
17 ;;; Rewritten in C by William Lott.
18 ;;;
19 (in-package "LISP")
20 (export 'ext::purify "EXT")
21
22 (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
26 (defun purify (&key root-structures (environment-name "Auxiliary"))
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
35 ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
36 current global environment (as seen in C::*INFO-ENVIRONMENT*.) If NIL is
37 supplied, then environment compaction is inhibited."
38 (when environment-name
39 (let ((old-ie (car *info-environment*)))
40 (setq *info-environment*
41 (list* (make-info-environment :name "Working")
42 (compact-info-environment (first *info-environment*)
43 :name environment-name)
44 (rest *info-environment*)))
45 ;; next 2 lines for GC.
46 (shrink-vector (c::volatile-info-env-table *old-ie*) 0)
47 (setq old-ie nil)))
48
49 (let ((*gc-notify-before*
50 #'(lambda (bytes-in-use)
51 (declare (ignore bytes-in-use))
52 (write-string "[Doing purification: ")
53 (force-output)))
54 (*internal-gc*
55 #'(lambda ()
56 (%purify (get-lisp-obj-address root-structures)
57 (get-lisp-obj-address nil))))
58 (*gc-notify-after*
59 #'(lambda (&rest ignore)
60 (declare (ignore ignore))
61 (write-line "Done.]"))))
62 (gc t))
63 nil)

  ViewVC Help
Powered by ViewVC 1.1.5