;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.282
;;; Reason:
;;;  Create (gc:remove-previous-function-spec-definitions) and add it to
;;;  (gc:full-gc :mode :system-release)
;;; Written 14-May-88 13:38:37 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.281, Experimental Local-File 73.6, Experimental FILE-Server 22.5, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS2; GC.LISP#353 at 14-May-88 13:38:37
#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 "removal of previous function spec definitions"
	    #'remove-previous-function-spec-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)))))

))

; From modified file DJ: L.SYS2; GC.LISP#353 at 14-May-88 13:38:49
#10R GARBAGE-COLLECTOR#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "GARBAGE-COLLECTOR")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; GC  "

(defun remove-previous-function-spec-definitions ()
  (let ((count 0))
    (maphash #'(lambda (key &rest ignore)
		 (when (eq (second key) :previous-definition)
		   (send si:function-spec-hash-table :rem-hash key)
		   (incf count)))
	     si:function-spec-hash-table)
    count))

))