;;; -*- Mode: Common-Lisp; Package: SI; Base: 8.; Patch-File: T -*-
;;; Written 12/07/88 13:56:16 by ab,
;;; Reason: Don't automatically lock up regions of NR-SYM as static or the TREE-SHAKER will
;;; no longer work.  12/7/88.
;;; while running on MX6 from band NB22
;;; With SYSTEM 5.19, GC 5.3, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.6, BASIC-FILE 5.3, RPC 5.4, NFS 5.12, EH 5.3, MAKE-SYSTEM 5.2,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.26, COMPILER 5.1, TV 5.22, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.9, DEBUG-TOOLS 5.1, WINDOW-MX 5.30, PRINTER 5.11, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.33, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.4, TELNET 5.1,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.45, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 96, Band Name: microExplorer Network (11/22)

#!C
; From file GC.LISP#> MEMORY-MANAGEMENT; MR-X:
#8R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "sys: MEMORY-MANAGEMENT; GC.É#É"


(DEFUN gc-reclaim-oldspace ()
  "This function finishes a collection.  It scavengs any un-scavenged oldspace
then frees all oldspace for later use.  Does nothing if there is no oldspace."
  (WITH-LOCK (Gc-Flip-Lock)
    (WHEN GC-Oldspace-Exists
      ;; Make sure all regions are clean (no pointers to oldspace)
      (DO ()
	  (%Gc-Flip-Ready)			;stop when scavenger says all is clean
	(%gc-scavenge #o10000))
      ;; Report oldspace statistics,etc
      (process-gc-done-stats)
      (WHEN (AND EXTENDED-ADDRESS-SPACE
		 (> GC-TYPE-OF-FLIP 5.))
	(EXTENDED-ADDRESS-SPACE-AFTER-COLLECTION-PROCESSING))
      (IF %gc-flip-ready
	  (WITHOUT-INTERRUPTS
	    ;; Return oldspace regions to free region pool.
	    (DOLIST (area Area-List)
	      (LET ((area-number (SYMBOL-VALUE area)))
		(WHEN (OR (MINUSP area-number) (>= area-number Size-Of-Area-Arrays))
		  (FERROR nil "Area-symbol ~S clobbered" area))
		(gc-reclaim-oldspace-area area-number)))
	    (SETQ Gc-Oldspace-Exists nil
		  GC-Initial-Copyspace-Size 0))	;for gc-status
	  (FERROR nil "Semaphore error in GC-Reclaim-Oldspace"))
      (WHEN (AND EXTENDED-ADDRESS-SPACE		       ;ab 12/7/88.  Don't automatically lock up NR-SYM static or tree-shaker won't work.
		 (= 5 GC-TYPE-OF-FLIP))
	;; DON'T LET ANY NON-STATIC SYMBOL REGIONS CREEP INTO GENERATION 3.
	(make-area-regions-static NR-SYM))
      ;; Wake up daemon process
      (WHEN (FBOUNDP 'check-all-gc-daemons)
	(check-all-gc-daemons)))))

(UNLESS extended-address-space
  (gc-off-temporarily)
  (make-area-regions-dynamic nr-sym)
  (gc-off-temporarily-back-on))

))
