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

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19.54.1 - (show annotations)
Mon Feb 8 17:15:48 2010 UTC (4 years, 2 months ago) by rtoy
Branch: intl-branch
Changes since 1.19: +3 -1 lines
Add (intl:textdomain "cmucl") to the files to set the textdomain.
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 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/purify.lisp,v 1.19.54.1 2010/02/08 17:15:48 rtoy Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Storage purifier for Spice Lisp.
13 ;;; Written by Rob MacLachlan and Skef Wholey.
14 ;;;
15 ;;; Rewritten in C by William Lott.
16 ;;;
17 (in-package "LISP")
18 (intl:textdomain "cmucl")
19
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
27 ;;; COMPACT-ENVIRONMENT-AUX -- Internal
28 ;;;
29 ;;; Compact the info environment. Written with gratuitous recursion to
30 ;;; make sure that our (and compact-info-environment's) local variables are
31 ;;; above the stack top when purify runs.
32 ;;;
33 (defun compact-environment-aux (name n)
34 (cond
35 ((zerop n)
36 (let ((old-ie (car *info-environment*)))
37 (setq *info-environment*
38 (list* (make-info-environment :name "Working")
39 (compact-info-environment (first *info-environment*)
40 :name name)
41 (rest *info-environment*)))
42 (shrink-vector (c::volatile-info-env-table old-ie) 0)))
43 (t
44 (compact-environment-aux name (1- n))
45 n)))
46
47
48 (defun purify (&key root-structures (environment-name "Auxiliary"))
49 "This function optimizes garbage collection by moving all currently live
50 objects into non-collected storage. ROOT-STRUCTURES is an optional list of
51 objects which should be copied first to maximize locality.
52
53 DEFSTRUCT structures defined with the (:PURE T) option are moved into
54 read-only storage, further reducing GC cost. List and vector slots of pure
55 structures are also moved into read-only storage.
56
57 ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
58 current global environment (as seen in C::*INFO-ENVIRONMENT*.) If NIL is
59 supplied, then environment compaction is inhibited."
60
61 (when environment-name (compact-environment-aux environment-name 200))
62
63 (let ((*gc-notify-before*
64 #'(lambda (bytes-in-use)
65 (declare (ignore bytes-in-use))
66 (write-string "[Doing purification: ")
67 (force-output)))
68 (*internal-gc*
69 #'(lambda ()
70 (%purify (get-lisp-obj-address root-structures)
71 (get-lisp-obj-address nil))))
72 (*gc-notify-after*
73 #'(lambda (&rest ignore)
74 (declare (ignore ignore))
75 (write-line "Done.]"))))
76 #-gencgc (gc t)
77 #+gencgc (gc :verbose t))
78 nil)

  ViewVC Help
Powered by ViewVC 1.1.5