;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 130.2 ;;; Reason: ;;; GC:STATUS now reports (SI:ESTIMATED-DUMP-SIZE). ;;; ;;; Some things that were printed on *error-output* are now done with WARN. ;;; ;;; Also doc-string improvements. ;;; Written 11-Nov-88 16:48:28 by keith at site Gigamos Cambridge ;;; while running on Tonic from band 4 ;;; with Experimental System 130.1, Experimental ZWEI 128.0, Experimental ZMail 75.0, Experimental Local-File 77.0, Experimental File-Server 26.0, Experimental Unix-Interface 16.0, Experimental Tape 27.0, Experimental Lambda-Diag 19.0, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, 11/11. ; From modified file DJ: L.SYS2; GC.LISP#359 at 11-Nov-88 16:48:43 #10R GARBAGE-COLLECTOR#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "GARBAGE-COLLECTOR"))) (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; GC  " (defun gc-on (&key degree) "Set the current configuration of the GC, and start it up if necessary. The trade-off between the desire to reclaim as much garbage as possible and the desire not to let the GC interfere with the user is represented as an integer DEGREE between 0 and 3. The degree 0 represents the minimal amount of garbage collection (other than turning it off), with little impact on performance. The degree 3 is the \"safest\" degree; it tries to garbage collect everything in dynamic storage, without regard to performance. Interactive users should specify 0, 1, or 2. Large batch programs or server hosts should use 3. If you do not specify DEGREE, the current value of GC::*GC-DEGREE* is used. The initial value is 1." (check-type degree (or null (integer 0 3))) (if (memq :gc-suspect (send *gc-process* :arrest-reasons)) ;;$$$ Issue a warning, not a printout! <11nov88 keith> (warn "~Not enabling automatic garbage collection: the GC has been forcibly disabled.~@ (It was probably in an inconsistent state when the machine was last booted.)~@ Save your files and reboot after rebuilding your LISP world!~") (progn (when degree (setq *gc-degree* degree)) (configure *gc-degree*) (send *gc-process* :preset 'gc-process) (send *gc-process* :reset) (send *gc-process* :run-reason :enable) (send *gc-process* :revoke-arrest-reason :gc-stopped) (setq *gc-process-control* :active) t))) )) ; From modified file DJ: L.SYS2; GC.LISP#359 at 11-Nov-88 16:48:46 #10R GARBAGE-COLLECTOR#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "GARBAGE-COLLECTOR"))) (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; GC  " (defun status (&optional (stream *standard-output*)) (flet ((out (string &rest args) (apply #'format stream string args))) (let ((sdb (compute-storage-distribution)) (on? (not (memq :gc-stopped (send *gc-process* :arrest-reasons)))) (*print-base* 10.)) ;; If the GC ever got in trouble, abuse the silly human and exit. (when (memq :gc-suspect (send *gc-process* :arrest-reasons)) (out "~%The garbage collector has been forcibly disabled because it was in an~@ inconsistent state when the machine was last booted. Save your files and reboot!") (return-from status (values))) (time::print-uptime stream) (terpri stream) ;; General status of the GC -- on/off, active/inactive. (cond ((not on?) (if (null *gc-status*) (out "~%The automatic garbage collector is disabled.~%") (out "~%The automatic garbage collector is disabled, but someone has recently~@ condemned ~:D words of volatility ~D storage.~%" *oldspace-words* *gc-status*))) ((null *gc-status*) (out "~%The automatic garbage collector is enabled.~%")) (t (out "~%The automatic garbage collector is enabled,~@ and has recently condemned ~:D words of volatility ~D storage.~%" *oldspace-words* *gc-status*))) ;; General information about the distribution of storage. I like this format. (out "~%There are ~:D words of dynamic space, ~:D words of static space, and~@ ~:D words of free space. Free space consists of ~:D words of unallocated~@ storage plus ~D/~D of the ~:D words of storage already allocated to specific~@ regions but not yet used.~%" (loop for l from 0 to 3 summing (aref sdb l)) (aref sdb 4) (aref sdb 5) (si::unallocated-space) ;; We do this in case of losing zetalisp readtable (numerator *unused-space-free-fraction*) (denominator *unused-space-free-fraction*) (si::unused-space)) ;; Describe each dynamic level. I don't like this format. (out "~%Dynamic space storage distribution:~%") (out "~%~6@TLevel Current Size Threshold Mode") (loop for level from 3 downto 0 for control = (aref *level-control* level) for size = (loop for l from level to 3 summing (aref sdb l)) do (out "~%~8@T~D ~10:D~@[~ (+ ~:D condemned words)~%~~] ~10:D ~A" level (aref sdb level) (and (eq *gc-status* level) *oldspace-words*) (typecase control (fixnum control) (null (if (< (distance-until-flip level :batch sdb) 0) "Passed" "None")) (otherwise (let ((distance (distance-until-flip level :incremental sdb))) (if (> distance 0) (+ distance (aref sdb level)) "Passed")))) (typecase control (fixnum "Flips when size exceeds threshold.") (null "Automatic flipping disabled.") (otherwise "Defer flips as long as possible.")))) (terpri stream) ;; Report on the progress of the scavenger if there is a GC in progress. (when (not (null *gc-status*)) (let ((scavenged 0) (scavengeable 0) (evacuated (read-meter sys:%transporter-words-copied)) (condemned *oldspace-words*)) (with-quick-region-area-accessors (for-every-region (region) (when (= (%region-scavenge-enable region) 1) (incf scavengeable (%region-free-pointer region)) (incf scavenged (%region-gc-pointer region))))) (out "~%Of the ~:D words of condemned storage, ~:D words have already been evacuated~@ to copyspace. The scavenger has scanned ~D% of the existing scavengeable storage,~@ with somewhere between ~:D and ~:D words of storage yet to be scanned.~@ Up to ~:D words of free space may be required to contain additional evacuated objects.~%" condemned evacuated (truncate (percentage scavenged scavengeable)) (- scavengeable scavenged) (+ (- scavengeable scavenged) (- condemned evacuated)) (- condemned evacuated)) (when ( *batch-reclaim-count* 0) (out "Some process is doing a batch scavenge.~%")))) ;; Don't report anything about processes inhibiting flipping, since by definition ;; at least one process (the gc-process, during a reclaim) is doing it, and other ;; instances are going to be ultra-rare. Let WAIT-FOR-FLIP-ALLOWED do it. ;; Might give a very brief summary of the gc statistics. ;; Might report amount of storage allocated/reclaimed since cold boot (clear ;; *condemned-newspace-words* on booting to do this). ;; Might report highest virtual address (as in "The minimum size paging partition ;; needed to run this world is 58,000 blocks.") (out "~%Estimated size to dump this world is ~D blocks." (si:estimate-dump-size)) ;; Might say something about the distribution of reference volatilities ("426 pages ;; in WORKING-STORAGE-AREA contain pointers to level 3 storage, 849 to level 2...") ;; I don't know how expensive that is to compute. (out "~%") (values)))) ;;;Following deleted since we want the flip to occur after the whole :before-cold ;;;initialization list is run and everybody has had a chance to clean up. ;;;(disk-save) now directly calls (gc:maybe-flip-level-2) ;;;(add-initialization "Flip level 2" '(maybe-flip-level-2) '(:before-cold)) ))