;;; -*- 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 (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) 1984- 1989 Texas Instruments Incorporated. All rights reserved. ; ** (c) Copyright 1980 Massachusetts Institute of Technology ** ;;; ;;; Edit History ;;; ;;; Patch ;;; Date Author Number Description ;;;-------------------------------------------------------------------- ;;; 07-25-86 ab -- o Moved INHIBIT-GC-FLIPS here from ;;; KERNEL:UNKERNEL; SYS2-LMMAC-GC. ;;; 10-5-86 ab o Moved most DEFVARs here from GC, GC-AREA-SUPPORT, ;;; DAEMONS. ;;; 01-25-87 ab o Minimal TGC integration. ;;; 02-12-87 ab o More TGC integration. ;;; 03-09-87 ab o Moved Idle-Scavenging vars here from ;;; KERNEL;PROCESS-DEFINITIONS. Other misc. ;;; 04-12-87 ab *N 1.9 o Make *GC-CONSOLE-DELAY-INTERVAL* behave as documented. ;;; *N 1.11 o Macros for supporting gc notifications properly. ;;; 05-13-87 ab *P GC 4 o Make *GC-MAX-INCREMENTAL-GENERATION* 2 now. ;;; 07-09-87 ab GC 9 o Additions for TGC training support. ;;; To get rid of compiler warnings: ;;; - Moved SPACE-SIZE DEFSTRUCT here from GC-AREA-SUPPORT. ;;; - Moved %TGC-TRAINING-ENABLED DEFVAR here from AREA-DEFS. ;;; 07-29-87 ab GC 10 o Change default values for *GC-CONSOLE-DELAY-INTERVAL* ;;; and GC-IDLE-SCAVENGE-QUANTUM. ;;; 08-13-87 ab GC 13 o Added yet another alias variable for Adaptive Training. ;;; 08-26-87 ab GC 18 o Back out patch GC 10. ;;; 09-14-87 RJF GC 22 o Added variable GC-INITIAL-OLDSPACE-SIZE which contains ;;; size of old space after flip. ;;; 10-06-87 RJF o Added si:*training-on-at-login?* variable. ;;; 11/17/87 RJF GC 26 O Changed GC-INITIAL-OLDSPACE-SIZES to now be an array of ;;; of info about oldspace. ;;; 02/03/88 JHO o Added EAS defs ;;; 08/03/88 clm o Changed inhibit-gc-flips macro so that the variable inhibit-gc-flips ;;; is maintained correctly. ;;; 08/23/88 clm o moved inhibit-gc-flips defvar and macro to area-defs so that ;;; they are built into the cold band; the kernel uses them now ;;; 04/25/89 RJF/HRC O Added *GC-ACTIVE-SHIFT-COUNT* and *GC-MAX-BUCKET-SIZE* ;;; ;;; 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 50000.) ;Argument to %GC-SCAVENGE used in that case. ;Scavenge for 50000 microseconds (DEFVAR *gc-console-delay-interval* 1. "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)) (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 to copyspace before the current flip.") (DEFVAR gc-initial-copyspace-array (MAKE-ARRAY 4. :initial-element 0)) (DEFVAR *GC-ACTIVE-SHIFT-COUNT* 0.) ;;; ;;; Flip Process parameters (DEFVAR gc-type-of-flip 6 "Type of the last GC flip") (DEFVAR *gc-max-incremental-generation* 2 "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) (DEFVAR *GC-MAX-BUCKET-SIZE* 2500000.) ;;; ;;; Train-A-Band (DEFVAR *training-session-started* nil) ;for training SESSION ;;; ;;; Dynamic Training (DEFVAR %tgc-train-space-exists nil) (DEFVAR %TGC-Training-Enabled nil ;DYNAMIC training. "The creation of train space regions is enabled when this flag is non-NIL.") (DEFVAR *tgc-training-enabled* nil "True when Dynamic Training is enabled.") (FORWARD-VALUE-CELL '*tgc-training-enabled* '%Tgc-training-enabled) ;;AB 8/13/87. Yet another name. (DEFVAR *adaptive-training-enabled* nil "True when Adaptive Training is enabled.") (FORWARD-VALUE-CELL '*adaptive-training-enabled* '%Tgc-training-enabled) (DEFVAR *Adaptive-training-on-at-login?* T "If true, then Adaptive Training will be turned on at login time unless the login-init file load is suppressed. [Note that changing the value to NIL does not turn training off, it just prevents it from being turned on automatically at login.]") (DEFVAR ENTRY-REGION-AREA) (DEFVAR EXIT-REGION-AREA) (DEFVAR WORLD-RECORD-AREA) (DEFVAR REGION-WORLD-RECORD) (DEFVAR REGION-WORLD-LIST-THREAD) (DEFVAR REGION-INTERNAL-EXTERNAL-TRANSLATE-TABLE) ;;; ;;; 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.") ;;CLM 5/24/88 - corrected spelling of var. (DEFVAR full-gc-initialization-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 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-report-stream* t) (FORWARD-VALUE-CELL '*gc-report-stream* 'gc-report-stream) (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.") ;;; ;;; Space Size Calculations (DEFSTRUCT (space-size-info (:conc-name nil)) "Structure containing information about space sizes." new-alloc new-used gen0-alloc gen0-used gen1-alloc gen1-used gen2-alloc gen2-used gen3-alloc gen3-used copy-alloc copy-used static-alloc static-used stat-reg-alloc stat-reg-used stat-area-alloc stat-area-used fixed-alloc fixed-used old-alloc old-used train-alloc train-used areas regions) (DEFVAR *space-size-info* (make-space-size-info)) (DEFVAR *tem-space-size-info* (make-space-size-info)) ;;; Contains the sizes of the various parts of old-space created at flip time. (DEFVAR GC-INITIAL-OLDSPACE-SIZES (MAKE-ARRAY 6. :initial-element 0) "The sizes of the various parts of oldspace after the flip: Used oldspace, Allocated oldspace, Used active gen 0, Used active gen 1, Used active gen 2, Used active gen 3.") ;;; ;;; GC Inlines, Macros ;;; (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))