;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.115
;;; Reason:
;;;  DISK-SAVE now turns off GC after completing before-cold-initializations.
;;;  Also print more meaningful messages, e.g. to let user know "shut-down"
;;;  procedure is running.
;;; Written 28-Jun-88 11:51:00 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 2
;;; with Experimental System 124.114, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From modified file DJ: L.SYS; QMISC.LISP#732 at 28-Jun-88 11:51:26
#8R SYSTEM-INTERNALS#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QMISC  "

(DEFUN DISK-SAVE (PARTITION &OPTIONAL NO-QUERY INCREMENTAL)
  "Save the current Lisp world in partition PARTITION.
PARTITION can be either a string naming a partition, or a number which signifies
 a partition whose name starts with LOD.
NO-QUERY says do not ask for confirmation (or any keyboard input at all).
INCREMENTAL means to write out only those parts of the world which have changed
 since the it was loaded from disk. (The effect of loading a world from a band
 saved incrementally is that the incremental saves /"patch/" the original full save."
  (PROG* ((L (DISK-RESTORE-DECODE PARTITION))
	  (PART-NAME (STRING-APPEND (LDB #o0010 (CADR L)) (LDB #o1010 (CADR L))
				    (LDB #o0010 (CAR L)) (LDB #o1010 (CAR L))))
	  PART-BASE PART-SIZE SYSTEM-VERSION MAX-ADDR
	  (INC-PAGES-SAVED 0)
	  unit)
    (setq unit (unit-for-partition part-name))
    (OR (MULTIPLE-VALUE-SETQ (PART-BASE PART-SIZE)
	  (IF NO-QUERY
	      (FIND-DISK-PARTITION-FOR-READ PART-NAME nil unit)
	    (FIND-DISK-PARTITION-FOR-WRITE PART-NAME nil unit)))
	(RETURN NIL))

    (UNLESS NO-QUERY
      (DOLIST (PATCH-SYSTEM PATCH-SYSTEMS-LIST)
	(WHEN (EQ (PATCH-STATUS PATCH-SYSTEM) :INCONSISTENT)
	  (BEEP)
	  (FORMAT *QUERY-IO* "~&You have loaded patches out of sequence,
 or loaded unreleased patches, in ~A.
As a result, the environment is probably inconsistent with the
current patches and will remain so despite attempts to update it.
Unless you understand these problems well and know how to
be sure whether they are occurring, or how to clean them up,
you should not save this environment."
		  (PATCH-NAME PATCH-SYSTEM))
	  (SEND *QUERY-IO* :CLEAR-INPUT)
	  (UNLESS (YES-OR-NO-P "Dump anyway? ")
	    (RETURN-FROM DISK-SAVE NIL)))))

    ;; This will catch most lossages before the user has waited.
    (UNLESS INCREMENTAL
      (CHECK-PARTITION-SIZE PART-SIZE))

    ;; Prompt now for this rather than waiting through all the initializations.
    (LET ((MAX (OR (MAXIMUM-PARTITION-COMMENT-LENGTH PART-NAME unit) 16.)))
      (SETQ SYSTEM-VERSION
	    (IF NO-QUERY
		(LET ((VERS (SYSTEM-VERSION-INFO T)))
		  (SUBSTRING VERS 0 (MIN (LENGTH VERS) MAX)))
	      (GET-NEW-SYSTEM-VERSION MAX :INCREMENTAL INCREMENTAL))))

    ;; Cause cold boot initializations to happen when rebooted
    ;; and do the BEFORE-COLD initializations now
    (amazing-kludge-order-cold-initialization-list)
    (format t "~%Beginning shut-down initializations...")
    (INITIALIZATIONS 'BEFORE-COLD-INITIALIZATION-LIST T)
    (RESET-INITIALIZATIONS 'COLD-INITIALIZATION-LIST)
    (format t "~%Turning off incremental Garbage-Collector process.")
    (gc:gc-off)
    (gc:maybe-flip-level-2)
    (SETQ WHO-LINE-JUST-COLD-BOOTED-P T)
    (LOGOUT)

    ;; Help stop user from getting worried.
    (WHEN INCREMENTAL
      (FORMAT T "~&NOTE: Comparing current memory contents with the original band
will take a few minutes.")
      (PROCESS-SLEEP 120.))

    ;; This can't be a before-cold initialization, because some other
    ;; initializations sometimes type out
    (when (get 'tv:window 'si:flavor)
      TV:(SHEET-FORCE-ACCESS (INITIAL-LISP-LISTENER)
			     (SEND INITIAL-LISP-LISTENER :REFRESH)
			     (SEND INITIAL-LISP-LISTENER :HOME-CURSOR)))

    ;; :before-cold intialization list deconfigures entire network...
    ;;(CHAOS:RESET)  ;Otherwise, UCODE could lose hacking packets as world dumped.

    ;; Compare all pages with band we booted from,
    ;; record unchanged pages in a bitmap in the band being saved in.
    (WHEN INCREMENTAL
      (SETQ INC-PAGES-SAVED (DISK-SAVE-INCREMENTAL PART-BASE)))

    ;; Check again before updating the partition comment.
    (CHECK-PARTITION-SIZE (+ INC-PAGES-SAVED PART-SIZE))
    (UPDATE-PARTITION-COMMENT PART-NAME SYSTEM-VERSION unit)

    ;; Now shut down the world and check the partition size for real, just
    ;; to make sure that we didn't exceed the size very recently.
    (cond ((get 'tv:window 'si:flavor)
	   (DOLIST (S TV:ALL-THE-SCREENS) (TV:SHEET-GET-LOCK S))
	   (TV:WITH-MOUSE-USURPED
	     (WITHOUT-INTERRUPTS
	       (SETQ TV:MOUSE-SHEET NIL)
	       (DOLIST (S TV:ALL-THE-SCREENS)
		 (SEND S :DEEXPOSE)
		 (TV:SHEET-RELEASE-LOCK S))
	       (disk-save-1 max-addr inc-pages-saved part-size incremental l))))
	  ('else
	   (without-interrupts
	     (disk-save-1 max-addr inc-pages-saved part-size incremental l))))))

))

; From modified file DJ: L.SYS2; GC.LISP#354 at 28-Jun-88 11:51:37
#10R GARBAGE-COLLECTOR#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "GARBAGE-COLLECTOR")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; GC  "

(defun maybe-flip-level-2 ()
  (format *query-io*
	  "~&Flipping level two now will result in better paging and GC behavior after the
   machine boots, by eliminating any garbage in levels two and three.~%")
  (when (yes-or-no-p-with-timeout (* 30 60) t "Flip level two?")
    (flip :volatility 2 :reclaim-mode :batch)))

))