;;; -*- Mode:Common-Lisp; Package:System-Internals; Base:8.; patch-file t; -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987- 1989 Texas Instruments Incorporated. All rights reserved.

;;; This file contains gc-related routines used by other parts of the system.

;;;
;;; Edit History
;;;
;;;                   Patch
;;;   Date    Author  Number   Description
;;;------------------------------------------------------------------------------
;;; 02-08-87    ab      --     - Original.  Init list stuff and routine called by disk-save.
;;; 03-09-87    ab             - Added GC-MAYBE-SCAVENGE for scheduler idle scavenging
;;;                            support.
;;; 03-15-87    ab             - Added support for :AFTER-SYSTEM-BUILD keyword.
;;;                            Have build procedure make certain areas static.
;;; 04-12-87    ab             - Turn GC-ON after system build.
;;; 05-13-87    ab    *P GC 4  - Make symbol areas default cons generation 1 instead of 3.
;;; 05-28-87    ab    *P GC 7  - Cons nearly everything in generation 0.  Benchmarks
;;;                            show that reducing number of GCYPs helps performance.
;;;                              Also put forms to set swapin quanta on GC-System-Build-Forms-After
;;; 07-29-87    ab    GC 10    - Fix idle scavenging not to be so disruptive. [SPR 5770]
;;; 08-26-87    ab    GC 18    - Remove idle scavenging changes in patch GC 10.
;;; 01-16-88    RJF            - Removed Zwei-area from generation 1 cons area list

(DEFUN fix-gc-state-for-disk-save ()
  (WHEN (gc-active-p)
    (PROCESS-DISABLE Gc-Process)
    ;; Make sure we are not flipped
    (gc-reclaim-oldspace))
  (gc-reset-history-counters))

(ADD-INITIALIZATION "Fix state of garbage collector." '(fix-gc-state-for-disk-save) '(:before-cold))


;;;(ADD-INITIALIZATION "Clear History Lists" '(zwei:CLEAR-ALL-HISTORIES) '(:FULL-GC))
(DELETE-INITIALIZATION "Dismount File System" '(:FULL-GC))
(DELETE-INITIALIZATION "Discard old namespace objects" '(:FULL-GC))

(ADD-INITIALIZATION "Find max virtual address" '(find-max-virtual-address) '(:cold))

;;;
;;; System Build Support

(DEFPARAMETER system-build-static-areas-list
	      '(MACRO-COMPILED-PROGRAM nr-sym))
;;; *kernel-symbol-area* *compiler-symbol-area* *user-symbol-area*))

(DEFPARAMETER Gc-System-Build-Forms-Before
	      '((setq aux-crash-list nil)
		(DOLIST (area system-build-static-areas-list)
		  (make-area-regions-static (SYMBOL-VALUE area)))))

(DEFPARAMETER Gc-System-Build-Forms-After
	      '((gc-on)
		(trim-static-area-regions)
		(set-all-swapin-quanta 3)
		(set-swapin-quantum-of-area 'pdl-area 0)
		(set-swapin-quantum-of-area 'linear-pdl-area 0)))

;;;
;;; TGC Start-Young-Consing Support

(DEFPARAMETER *tgc-non-generation-0-consers*
	      '())


;;;
;;; Hash-Table support.
;;; This function is called by many of the HASH routines.
;;;
;;; 5-13-87.  Moved this to KERNEL; HASH.

;;;(DEFUN gc-need-rehash-p (hash-table)
;;;  "Used to determine if a hash-table needs a rehash because of a GC flip."
;;;  (AND (/= (hash-table-gc-generation-number hash-table) %gc-generation-number)
;;;       (neq (hash-table-hash-function hash-table ) 'equal-hash)))

;;;
;;; Idle Scavenge support.
;;; This function is called by scheduler when it has nothing else to do.

(DEFVAR *gc-last-scav-time* 0)

(DEFUN gc-maybe-scavenge ()
  (IF (AND (NOT inhibit-idle-scavenging-flag)
	   (NOT inhibit-scavenging-flag)
	   (NOT %gc-flip-ready)
	   (NOT %scavenger-ws-enable)
	   (OR (NULL *gc-console-delay-interval*)
	       (AND (NUMBERP *gc-console-delay-interval*)
		    (< *gc-console-delay-interval*
		       (TRUNCATE (time-difference (time-in-60ths)
						  w:kbd-last-activity-time) 60.)))))
      (%gc-scavenge gc-idle-scavenge-quantum)
      (%SCRUB)))

(DEFUN collapse-duplicate-pnames ()
  (LET ((count 0)
	(total-size 0)
	tem-pkg)
    (DEFPACKAGE gc-pkg (:USE nil) (:SIZE 80000.))
    (SETQ tem-pkg (pkg-find-package 'gc-pkg))
    (MAPATOMS-NR-SYM
     #'(LAMBDA (symbol &aux tem)
	;; Collapse the pname if this is not the first symbol with this pname.
	 (WHEN (AND (SYMBOL-PACKAGE symbol)	; Otherwise INTERN would side-effect the symbol.
		    (/= (%P-DATA-TYPE (SYMBOL-NAME symbol)) Dtp-Header-Forward))
	   (WHEN (AND (NEQ symbol (SETQ tem (INTERN symbol tem-pkg)))
		      (NEQ (SYMBOL-NAME symbol) (SYMBOL-NAME tem)))
	     (LET ((%Inhibit-Read-Only t))
	       (STRUCTURE-FORWARD (SYMBOL-NAME symbol) (SYMBOL-NAME tem)))
	     (INCF total-size (%STRUCTURE-TOTAL-SIZE (SYMBOL-NAME tem)))
	     (INCF count 1)))))
    (KILL-PACKAGE tem-pkg)
    (RETURN-STORAGE (PROG1 tem-pkg (SETF tem-pkg nil)))
    (GC-REPORT "Collapsing duplicate pnames.  Collapsed ~:D symbol names saving ~:D words."
	       count total-size)) 
  )