;;; -*- Mode: Common-Lisp; Package: User; Base: 8.; Patch-File: T -*-

;;; Reason: Changed si:disk-save-caller to allow disk saves with
;;; MMON system loaded.

;;;                           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, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 05/19/89 17:00:47 by MARKY,
;;; while running on LIBRA from band LODA
;;; With SYSTEM 6.0, VIRTUAL-MEMORY 6.0, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.0, TV 6.3, DATALINK 6.0, CHAOSNET 6.0, GC 6.0, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.0, SERIAL 6.0, PRINTER 6.0, MAC-PRINTER-TYPES 6.0, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.0, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.0, VISIDOC 6.0, TI-CLOS 6.0, CLEH 6.0, IP 3.45,
;;;  Experimental BUG 11.5, Experimental CLX 6.0, Experimental CLUE 21.0, Experimental X11M 4.0,
;;;   microcode 428, Band Name: Rel 6.0 + SLE 5/15

;;; Enable disk save when MMON system is loaded.

#!C
; From file DISK-SAVE-RESTORE.LISP#> MEMORY-MANAGEMENT; SYS:
#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; DISK-SAVE-RESTORE.#"



(DEFUN disk-save-caller (unit save-part-name-hi-16-bits save-part-name-lo-16-bits
			 save-part-base save-part-size saving-over-self part-name &aux max-addr)
  (DECLARE (SPECIAL tv:*screens-exposed-at-disk-save*))
  ;; This function runs in the Disk-Save process.
  (SEND current-process :set-quantum (* 60. 60. 30.)) ; 30 minutes to finish.
  ;;
  ;; Clear Initial Lisp Listener's screen.
  ;; This can't be a before-cold initialization, because some initializations type out.
  (tv:sheet-force-access (tv:initial-lisp-listener)
    (SEND tv:initial-lisp-listener :refresh))
  ;;
  ;; Shut down the world and check the partition size again, just
  ;; to make sure that we didn't exceed the size very recently.
  ;; First make sure all screen images are saved away properly.
  (DOLIST (screen tv:all-the-screens)
    (tv:sheet-get-lock screen))
  (tv:with-mouse-usurped
    (LET-GLOBALLY ((inhibit-scheduling-flag t))
      (SETQ tv:mouse-sheet nil)
      ;; Remember which screens were exposed, so we can reexpose them on reboot if we want to.  CJJ 04/13/88.
      (SETF tv:*screens-exposed-at-disk-save* nil)
      ;; Deexposing a screen can cause others to be deexposed, so capture all the exposed screens before deexposing any...
      ;; CJJ 06/08/88.
      (DOLIST (screen tv:all-the-screens)
	(WHEN (SEND screen :exposed-p)
	  (PUSH screen tv:*screens-exposed-at-disk-save*)))
      ;; Don't allow screens to be autoexposed to take the place of those deexposed.  CJJ 06/08/88.
      ;; Added by KJF [may] on 01/27/89 for CJJ during addition of Multiple Monitor (MMON) support.
      ;; may 05/19/89 Used to try to call a macro if fdefinedp  - this would never work
      (LET ((tv:*autoexpose-screens* nil)) ;; may 05/19/89 ;; in line version of TV:WITHOUT-AUTOEXPOSING-SCREENS macro
	(DOLIST (screen tv:all-the-screens)
	  (SEND screen :deexpose)
	  (tv:sheet-release-lock screen)))

      (WHEN (AND (addin-p) (FBOUNDP 'before-disk-save))
	(before-disk-save t t))			;; Zap all MAC-resident windows.
      ;;
      ;; Remove all traces of Disk-Save process from system, so it will never try
      ;; to run again with its state destroyed.  We'd like to :RESET it but can't
      ;; because we're running in it.  Setting Current-Process to nil will suppress
      ;; the warm boot message, so this doesn't look like a warm-booted process.
      ;; Disabling removes from si:Active-Processes.
      ;;
      (PROCESS-DISABLE current-process)
      (SETQ all-processes (DELETE current-process all-processes))
      (SETQ current-process nil)
      ;;
      ;; Must use Cold-Load-Stream since scheduling inhibited.
      (SETQ *terminal-io* cold-load-stream
	    *standard-output* cold-load-stream
	    si:cold-load-stream-owns-keyboard t)
      (SEND *terminal-io* :home-cursor)
      (SEND *terminal-io* :clear-screen)
      ;;
      ;; Once more with feeling, and bomb out badly if losing.
      (SETQ max-addr (find-max-addr))
      (check-partition-size save-part-size t)
      ;; Store the size in words rather than pages.  But don't get a bignum!
      (SETF (system-communication-area %sys-com-highest-virtual-address)
	    (LSH max-addr
		 (BYTE-SIZE %%va-offset-into-page)))
      (internal-disk-save (get-real-unit unit)
			  save-part-name-hi-16-bits save-part-name-lo-16-bits
			  save-part-base save-part-size saving-over-self part-name)))) ;pass name along, ab 8/29/88

))