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

Contents of /src/code/purify.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (hide annotations)
Mon Feb 14 14:05:23 1994 UTC (20 years, 2 months ago) by ram
Branch: MAIN
Changes since 1.16: +25 -11 lines
Put in a weird GC hack in hope that it will prevent us from retaining lots of
info environment garbage.
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.17 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/purify.lisp,v 1.17 1994/02/14 14:05:23 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.17
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 ram 1.15 (defun purify (&key root-structures (environment-name "Auxiliary"))
49 ram 1.14 "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 ram 1.15 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 ram 1.17
61     (when environment-name (compact-environment-aux environment-name 200))
62 ram 1.15
63 wlott 1.13 (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 ram 1.14 (get-lisp-obj-address nil))))
72 wlott 1.13 (*gc-notify-after*
73     #'(lambda (&rest ignore)
74     (declare (ignore ignore))
75     (write-line "Done.]"))))
76     (gc t))
77 wlott 1.7 nil)

  ViewVC Help
Powered by ViewVC 1.1.5