LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031669. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "GC-SYSTEM-INTERFACES" :DIRECTORY ("REL3-SOURCE" "MEMORY-MANAGEMENT") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758727942. :AUTHOR "REL3" :LENGTH-IN-BYTES 4441. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ;;; -*- 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 (b)(3)(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 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.(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)));;;;;; TGC Start-Young-Consing Support(DEFPARAMETER *tgc-non-generation-0-consers*      '((zwei:zwei-area 1)(compiler:macro-compiled-program 1)(nr-sym 3)(*kernel-symbol-area* 3)(*user-symbol-area* 3)(*compiler-symbol-area* 3)));;;;;; Hash-Table support.;;; This function is called by many of the HASH routines.(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.(DEFUN gc-maybe-scavenge ()  (WHEN (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)))(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))   )ation-list nil   "Forms to evaluate before a FULL-GC.");;;;;; Mode & semaphore vars(DEFVAR Gc-Batch-Mode nil "If this is non-nil, a user-initiated complete GC is in progress.Legal values are :FULL or :IMMEDIATE.")(DEFVAR gc-flip-lock nil "Flipping must be done with this lock locked.") (DEFVAR inhibit-gc-flips nil  "Non-NIL prevents flipping from happening.  See the macro INHIBIT-GC-FLIPS.") (DEFVAR gc-oldspace-exists nil  "T after flipping until oldspace is reclaimed; then NIL.") ;;;;;; Notifications;; Internal var.(DEFVAR gc-report nil)(DEFVAR *gc-notifications* :batch-only  "Controls GC notifications made to the user.  :BATCH-ONLY means notify