LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031667. :SYSTEM-TYPE :LOGICAL :VERSION 11. :TYPE "LISP" :NAME "GC-DEFS" :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 2758727919. :AUTHOR "REL3" :LENGTH-IN-BYTES 7626. :LENGTH-IN-BLOCKS 8. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ;;; -*- Mode:Common-Lisp; Package:SI; Base:8.; -*-;;;                           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) 1984,1987 Texas Instruments Incorporated. All rights reserved.;** (c) Copyright 1980 Massachusetts Institute of Technology **;;; Edit History;;;                   Patch;;;   Date    Author  Number   Description;;;--------------------------------------------------------------------;;; 07-25-86    ab      --     Moved INHIBIT-GC-FLIPS here from;;;                              KERNEL:UNKERNEL; SYS2-LMMAC-GC.;;; 10-5-86     ab             Moved most DEFVARs here from GC, GC-AREA-SUPPORT,;;;                              DAEMONS.;;; 01-25-87    ab             Minimal TGC integration.;;; 02-12-87    ab             More TGC integration.;;; 03-09-87    ab             Moved Idle-Scavenging vars here from ;;;                              KERNEL;PROCESS-DEFINITIONS.  Other misc.;;; 04-12-87    ab   *N 1.9    Make *gc-console-idle-delay* behave as documented.;;;                  *N 1.11   Macros for supporting gc notifications properly.;;;;;; GC Vars;;;;;; Ucode vars:;;;;;; %GC-Flip-Ready:              T when we're done scavenging (and also trivially;;;                            when there's no oldspace).;;; %Page-Cons-Alarm:            Incremented every time a new region is created.;;;                            Grows by number of pages assigned to that region.;;; Inhibit-Scavenging-Flag:     T when someone wants all scavenge work inhibited;;;                            temporarily.;;;;;; Misc(DEFCONSTANT number-of-generations (1+ %region-max-generation))(DEFCONSTANT indirection-cell-size 2.)(DEFPARAMETER gc-fraction-of-ram-for-generation-zero 0.1  "This parameter controls the maximum generation 0 volume as a fraction of the installed physical memory.");; Indirected to SYSTEM-COMMUNICATION-AREA.(DEFVAR %gc-generation-number :UNBOUND   "A number incremented at each flip.")(PROCLAIM '(SPECIAL %address-space-quantum-size-in-pages));;;;;; Idle scavenging support.(DEFVAR inhibit-idle-scavenging-flag nil);If NIL scavenger runs when no processes runnable(DEFVAR gc-idle-scavenge-quantum 50.);Argument to %GC-SCAVENGE used in that case(DEFVAR *gc-console-delay-interval* 30."Number of seconds the console may be unused before idle scavenging may kick in.NIL means no delay; T means disable idle scavenging.")(forward-value-cell 'gc-console-delay '*gc-console-delay-interval*);;;;;; Statistics counters(DEFVAR gc-collection-counters (MAKE-ARRAY Number-of-Generations :INITIAL-ELEMENT 0)  "Counters of the total number of collections done for each generation.")(DEFVAR gc-garbage-collected (MAKE-ARRAY Number-of-Generations :INITIAL-ELEMENT 0)  "Accumulators of the total garbage collected for each generation.")(DEFVAR gc-work-done (MAKE-ARRAY Number-of-Generations :INITIAL-ELEMENT 0)  "Accumulators of the total work done for each generation.")(DEFVAR gc-generational-flip-counters (MAKE-ARRAY Number-of-Generations :INITIAL-ELEMENT 0)  "Accumulators of the total work done for each generation.")(DEFVAR flip-size (MAKE-ARRAY Number-of-Generations :INITIAL-ELEMENT 0))(DEFVAR gc-initial-copyspace-size 0  "The sum of the free-pointers of those regions converted from newspace tocopyspace before the current flip.");;;;;; Flip Process parameters(DEFVAR gc-type-of-flip 6  "Type of the last GC flip")(DEFVAR *gc-max-incremental-generation* 1  "The maximum generation which will be incrementally flipped and collected by gc-process.")(FORWARD-VALUE-CELL 'gc-max-incremental-generation '*gc-max-incremental-generation*)  (DEFVAR GC-Process nil);;;;;; Training(DEFVAR *training-session-started* nil);for training SESSION;;;;;; INIT LISTS(DEFVAR gc-every-flip-list nil); Forms to evaluate on every flip(DEFVAR gc-after-flip-list nil); Forms to evaluate after flipping(DEFVAR after-full-gc-initialization-list nil   "Forms to evaluate after a FULL-GC.")(DEFVAR full-gc-initizialization-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 only for batch-style collections.  T means notify on all GC collections (automatic and batch).  NIL means turn off GC notifications entirely.  This is not recommended.")(DEFVAR gc-report-stream t   "Stream to write GC messages on.  NIL means none.  T means make notifications using TV:NOTIFY.  Any other value should be a stream on which to make the notifications.")(DEFVAR *gc-daemon-notifications* t)(DEFVAR gc-daemon-report-stream t   "Stream to write GC DAEMON warnings on.  NIL means none.  T means make notifications using TV:NOTIFY.  Any other value should be a stream on which to make the notifications.");;;;;; GC Inlines, Macros;;;(DEFMACRO inhibit-gc-flips (&body body)  "Execute the BODY making sure no GC flip happens during it."  `(LET-GLOBALLY ((inhibit-gc-flips current-process))     . ,body))(DEFMACRO with-gc-notifications-forced-maybe (&body body)  "Execute the BODY forcing gc notifications."  `(LET ((gc-report *gc-notifications*))     . ,body))(DEFMACRO with-batch-gc-notifications (&body body)  `(LET ((gc-report *gc-notifications*))      . ,body))(DEFMACRO with-verbose-gc-notifications-only (&body body)  `(LET ((gc-report (EQ *gc-notifications* t)))     . ,body))(DEFMACRO with-gc-notifications-forced (&body body)  `(LET-GLOBALLY ((gc-report-stream t))      . ,body))(DEFMACRO with-gc-notifications-inhibited (&body body)  `(LET-GLOBALLY ((gc-report-stream nil))      . ,body))(PROCLAIM '(inline gc-active-p))(DEFUN gc-active-p ()  (AND (VARIABLE-BOUNDP gc-process)       gc-process       (ASSOC GC-PROCESS Active-Processes :TEST #'EQ)))(PROCLAIM '(inline gc-in-progress-p))(DEFUN gc-in-progress-p ()  ;; If not done scavenging and oldspace exists,  ;; we're in middle of collection.  (AND (NOT %GC-Flip-Ready)       GC-Oldspace-Exists))(DEFUN gc-arrest-reasons ()  "Returns GC Process's arrest reasons if it is arrested; else NIL."  (AND gc-process       (SEND gc-process :arrest-reasons)))(PROCLAIM '(inline generation-collection-in-progress-p))(DEFUN generation-collection-in-progress-p (generation)  (AND (gc-in-progress-p)       (= (FLOOR gc-type-of-flip 2) generation)))(DEFUN current-collection-type ()  (DECLARE (VALUES generation promote-flag))  (WHEN (gc-in-progress-p)    (MULTIPLE-VALUE-BIND (gen pro)(FLOOR gc-type-of-flip 2)      (VALUES gen (IF (ZEROP pro) nil :promote)))))(PROCLAIM '(inline scavenger-active-p))(DEFUN scavenger-active-p ()  (NOT inhibit-scavenging-flag))ally dirty any memory page (through normal use or during GC), we need;;; to have swap band space to accomodate this address space.;;;;;; GC uses this value as a first-approximation to gc-usable-free-space (amount;;; of free space that can be used to copy objects), but then adjusts it in;;; several ways.  See below.(DEFUN usable-address-space ()  "Returns the amount of free address space (in words) that is available ifyou do not run garbage collection."  (LET* ((usable-address-space-limit   (usable-address-space-limit)) (pages-not-needing-swap-spa