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

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (show annotations)
Tue Nov 4 16:00:16 1997 UTC (16 years, 5 months ago) by dtc
Branch: MAIN
CVS Tags: double-double-array-base, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, unicode-string-buffer-base, sse2-packed-base, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2007-06, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, double-double-init-x86, sse2-checkpoint-2008-10-01, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, unicode-string-buffer-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.18: +3 -2 lines
GENCGC interface.
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 1997/11/04 16:00:16 dtc Rel $")
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 (export 'ext::purify "EXT")
19
20 (alien:def-alien-routine ("purify" %purify) c-call:void
21 (static-roots c-call:unsigned-long)
22 (read-only-roots c-call:unsigned-long))
23
24
25 ;;; COMPACT-ENVIRONMENT-AUX -- Internal
26 ;;;
27 ;;; Compact the info environment. Written with gratuitous recursion to
28 ;;; make sure that our (and compact-info-environment's) local variables are
29 ;;; above the stack top when purify runs.
30 ;;;
31 (defun compact-environment-aux (name n)
32 (cond
33 ((zerop n)
34 (let ((old-ie (car *info-environment*)))
35 (setq *info-environment*
36 (list* (make-info-environment :name "Working")
37 (compact-info-environment (first *info-environment*)
38 :name name)
39 (rest *info-environment*)))
40 (shrink-vector (c::volatile-info-env-table old-ie) 0)))
41 (t
42 (compact-environment-aux name (1- n))
43 n)))
44
45
46 (defun purify (&key root-structures (environment-name "Auxiliary"))
47 "This function optimizes garbage collection by moving all currently live
48 objects into non-collected storage. ROOT-STRUCTURES is an optional list of
49 objects which should be copied first to maximize locality.
50
51 DEFSTRUCT structures defined with the (:PURE T) option are moved into
52 read-only storage, further reducing GC cost. List and vector slots of pure
53 structures are also moved into read-only storage.
54
55 ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
56 current global environment (as seen in C::*INFO-ENVIRONMENT*.) If NIL is
57 supplied, then environment compaction is inhibited."
58
59 (when environment-name (compact-environment-aux environment-name 200))
60
61 (let ((*gc-notify-before*
62 #'(lambda (bytes-in-use)
63 (declare (ignore bytes-in-use))
64 (write-string "[Doing purification: ")
65 (force-output)))
66 (*internal-gc*
67 #'(lambda ()
68 (%purify (get-lisp-obj-address root-structures)
69 (get-lisp-obj-address nil))))
70 (*gc-notify-after*
71 #'(lambda (&rest ignore)
72 (declare (ignore ignore))
73 (write-line "Done.]"))))
74 #-gencgc (gc t)
75 #+gencgc (gc :verbose t))
76 nil)

  ViewVC Help
Powered by ViewVC 1.1.5