;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.194
;;; Reason:
;;;  Clearly nobody ever tried using gc:gc-system-release-initialization-list...
;;; Written 26-Jan-88 15:53:02 by pld at site Gigamos Cambridge
;;; while running on James Brown from band 2
;;; with Experimental System 123.192, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.13, SDU ROM 102.


; From modified file DJ: L.SYS2; GC.LISP#347 at 26-Jan-88 15:55:39
#10R GARBAGE-COLLECTOR#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "GARBAGE-COLLECTOR")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; GC  "

(defun full-gc (&key mode (verbose t))
  "Do a complete batch-style garbage collection in this process.
If MODE is :SYSTEM-RELEASE, magic things happen to clean up the world."
  (check-type mode (member () :system-release))
  (let* ((stream (if verbose *standard-output* #'null-stream)))
    (report-elapsed-time stream 0 "FULL-GC"
      (lambda ()
	(report-elapsed-time stream 2 "reclamation of oldspace"
	  #'reclaim-oldspace :batch)
	(report-elapsed-time stream 2 "before full gc initializations"
	  #'initializations 'full-gc-initialization-list t)
	(when (eq mode :system-release)
	  ;; this should perhaps look at an additional initialization list.
	  ;; Do these before linearizing property lists (for obvious reasons).
	  (report-elapsed-time stream 4 "removal of previous method definitions"
	    #'remove-previous-method-definitions)
	  (report-elapsed-time stream 4 "removal of previous symbol function definitions"
	    #'remove-previous-symbol-definitions)
	  (report-elapsed-time stream 4 "linearization of flavor plists"
	    #'linearize-flavor-property-lists)
	  (report-elapsed-time stream 4 "linearization of symbol plists"
	    #'linearize-symbol-property-lists)
	  (when gc-system-release-initialization-list
	    (report-elapsed-time stream 4 "random system-release gc initializations"
	      #'initializations 'gc-system-release-initialization-list t)))
	(let ((gc-enabled t))
	  (unwind-protect
	    (let ((*report-stream* stream))
	      (report-elapsed-time stream 2 "turning off gc, reclaim oldspace"
		#'(lambda () (gc-off :reset t) (setq gc-enabled nil)))
	      (let-if (eq mode :system-release)
		      ((*all-flips-to-higher-address-space* t))
		(report-elapsed-time stream 2 "flip and reclaim level 0"
		  #'flip :volatility 0 :reclaim-mode :batch))
	      (when (eq mode :system-release)
		;; Do another flip to move regions down to low part of address space (maybe).
		 (report-elapsed-time stream 2 "flip and reclaim level 0"
			#'flip :volatility 0 :reclaim-mode :batch))
	      (gc:gc-on)
	      (setq gc-enabled t))
	    (or gc-enabled
		(format t "~&WARNING: ** GC NOT ENABLED. YOU MUST DO (GC:GC-ON) TO ENABLED IT~%"))))
	(report-elapsed-time stream 2 "after full gc initializations"
	  #'initializations 'after-full-gc-initialization-list t)))))

))