LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031660. :SYSTEM-TYPE :LOGICAL :VERSION 12. :TYPE "LISP" :NAME "DISK-SAVE-RESTORE" :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 2758727799. :AUTHOR "REL3" :LENGTH-IN-BYTES 21914. :LENGTH-IN-BLOCKS 22. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ;;; -*- Mode:Common-Lisp; Package:SI; Base:8.; Cold-Load:t; -*-;;;                           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) 1985,1987 Texas Instruments Incorporated. All rights reserved.;** (c) Copyright 1980 Massachusetts Institute of Technology **;;; Edit History;;;                   Patch;;;   Date    Author  Number   Description;;;------------------------------------------------------------------------------;;; 02-12-86    ab      --     Common Lisp conversion for VM2.;;;                            This file used to be part of SYS;QMISC;;;                            Re-wrote Disk-Restore-Decode to return;;;                              partition string name as well as 2 other values.;;;                            Cleaned up other Disk-Save help functions.;;;                            Cleaned up Disk-Save and changed it to call;;;                              new Internal-Disk-Save routine (in Lisp).;;;                            Added user-interface support to Disk-Save for;;;                              "save over self" option.;;;                            Modified Mini-Disk-Save to use Lisp disk-save,;;;                              and to run in minimal kernel environment.;;;                            Cleaned up Disk-Restore a bit.;;; 03-10-86    ab      --     Fixed Estimate-Dump-Size to take wired pages;;;                              into account.;;; 04-20-86    ab      --     Added DISPLAY-MODE argument to disk-save.  Removed;;;                              what used to be the INCREMENTAL argument entirely.;;;                            Fixed Disk-Restore to re-boot current band when;;;                              called with no arguments.  [SPR 1929];;; 05-07-86  ab/rjf    --     Changed Disk-Save to run in its own process, which;;;                              will not be known to the scheduler on re-boot.;;;                              This ensures that the process we do the disk-save;;;                              from will have a consistent state in the saved band.;;;                              [SPR 1605];;;                            Fix to make sure Disk-Save only asks you once if;;;                              you're SURE you want to save an inconsistent band.;;;                              Also added small extra fudge to Estimate-Dump-Size.;;; 05-09-86    ab      --     Change Check-Partition-Size not to :EXPOSE tv:main-screen;;;                              when erroring.  Set up *Terminal-IO* to be Cold-Load-Stream;;;                              as early as possible.  That will be the disk-save;;;                              process' error stream.;;; 05-12-86    ab      --     Fix disk-save NO-QUERY mode so that whatever you supply;;;                              as the PRT-COMMENT argument will be displayed as;;;                              system-additional-info (in the herald) on re-boot.;;;                              [SPR 2180];;; 05-14-86    ab      --     Fix small bug that cursor was sometimes left on;;;                              initial-lisp-listener's screen.;;; 05-15-86    ab      --     Fix save-over-yourself mode to check if sufficient swap;;;                              space is available to migrate all clean load band pages.;;;                              If there's not enough swap space, the system would;;;                              later crash during Make-All-Pages-Dirty with an "out of;;;                              swap space" crash.;;; 06-23-86    ab      --     Integrate into VM2.  This effectively integrates part of Rel 2.1;;;                              Ucode-Dependent patch 2-4 into VM2.  Derived from;;;                              SYS:MEMORY-MANAGEMENT; DISK-SAVE-RESTORE#2. ;;;                            All changes needed for integration are in DISK-SAVE-INTEGRATION-HACKS;;; 07-22-86    ab      --     Integrate Rel 2.1 Ucode-Dependent patch 2-18.;;; 07-25-86    ab      --     Change Disk-Save so that it will run both in minimum VM2 kernel;;;                              environment and with window system loaded.  Remove Mini-Disk-Save;;;                              entirely since there will no longer be a special "minimal";;;                              version.  Also added Cold-Disk-Save-Caller which will run without;;;                              the window system loaded. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Help functions;;;;;;; Returns string containing name of PARTITION & its integer representation.(Defun Disk-Restore-Decode (partition &aux low-16-bits hi-16-bits name)  ;; Returns three values:  name of partition as a string, high 16 bits of  ;; string name considered as an integer, low 16 bits of string name  ;; considered as an integer.  (cond ((or (null partition) (eq partition t)) ;; NIL or T signals to use currently booted partition. (setq name *Loaded-Band*))((integerp partition) ;; Appends LOD to integer. (if (>= partition 10.)     (ferror nil "~d. is not a valid LOD partition number (too large)" partition)) (setq name (string-append "LOD" (string (digit-char partition 10.)))))((or (symbolp partition) (stringp partition)) ;; Make sure string or symbol is made into upper case string exactly ;; 4 characters long. (if (= (length (string partition)) 1)     (setq name (string-append "LOD" partition))     (setq name (subseq (string (string-append (string-upcase partition) "    "))0 4))))(t (ferror nil "~S is not a valid partition designator." partition)))  ;; Now construct integer representation.  (setq low-16-bits (+ (int-char (aref name 0))       (lsh (int-char (aref name 1)) 8.))hi-16-bits (+ (int-char (aref name 2))      (lsh (int-char (aref name 3)) 8.)))   (values name hi-16-bits low-16-bits)) ;; Fixed this to take wired pages into account.  These must all be saved,;; whether they look like they have any address space allocated to them;; or not.  Without change, this function would underestimate dump size.;; Also added another small fudge factor.(Defun Estimate-Dump-Size ()  "Returns estimate of how many disk blocks will be required for this save."  (do ((region(area-region-list (symbol-value First-Non-Fixed-Wired-Area-Name))(1+ region))       (size 0))      ((= region Size-Of-Region-Arrays)       ;; Add in wired pages & 64. pages extra fudge.       (* disk-blocks-per-page  (+ size (truncate (system-communication-area %Sys-Com-Wired-Size)    Page-Size) 64.)))    ;; Check each region.  If it is free, ignore it.  Otherwise,    ;; add how many pages it will take to dump it.    (cond ((not (region-free-p region))      (setq size (+ size (* (ceiling (region-free-pointer region)     Cluster-Size-In-Words)    Cluster-Size)))))  ))(Defun Check-Partition-Size (part-size &optional abort-p)  (let ((dump-size (estimate-dump-size)))    (when (> dump-size part-size)      ;; This test is not necessarily accurate, since we have not      ;; yet shut off the world.  However, it should catch most cases,      ;; so that this error will be detected before the partition comment      ;; gets clobbered usually.      (ferror nil "Cannot save, partition too small.  Need at least ~D. pages.~@[~@                      Warm Boot please.~]" dump-size abort-p))    dump-size));;; Find the highest address in the virtual memory.;;; If you call this function without;;; inhibiting interrupts, the result is not strictly correct since some;;; other process could invalidate it at any time by CONSing.  However,;;; it gives you a good idea and a lower bound.  The answer is in number;;; of pages (which will always fit in a fixnum).(Defun Find-Max-Addr ()  (do ((region 0 (1+ region))       (max-addr 0))      ((= region Size-Of-Region-Arrays)       (truncate max-addr Page-Size))    ;; Check each region.  If it is free, ignore it.  Otherwise,    ;; find the highest address of that region, and get the    ;; highest such address.    (cond ((not (region-free-p region))      (setq max-addr (max max-addr      ;; Make sure numbers we are adding are positive, even      ;; if that means making a bignum.      (+ (convert-to-unsigned (region-origin region)) (region-length region))))))    ));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Disk Save and Disk Restore User-Callable Functions;;;;(Defvar *Save-Over-Self-Warning*" ~%                      *** WARNING *** ~         ~2%You are attempting to Disk-Save over the currently running band, ~          ~%partition ~a on unit ~d.  While this is possible it is dangerous, ~          ~%since if Disk-Save encounters an error your current band may not ~          ~%be usable.  It also takes much longer than a regular Disk-Save. ~         ~2%Save anyway?")(Defvar *Save-Over-Self-Swap-Space-Error-Msg*       "~2%It is not possible to Disk-Save on top of the current partition ~         ~%(~a on unit ~d) because the currently available swap space ~         ~%(~:d. pages) is insufficient to hold the current number of clean~         ~%load band pages (~:d.) that would need to be moved to the swap bands ~         ~%in save-over-yourself mode. ~        ~2%Disk-Saving to a partition other than the one you're booted from ~         ~%will still work.")(Defvar *Patch-Level-Inconsistent-Warning*"~&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 verify and ~         ~%be sure whether they are occurring, or how to clean them up, ~         ~%you should not save this environment.")(DEFVAR  *Dont-Warn-About-Disk-Save-Over-Current-Band* nil  "When non-nil, Disk-Save will not warn you about saving over the currently running band.");; Set to T upon cold boot for who-line's benefit(Defvar Who-Line-Just-Cold-Booted-P nil)(Defun Disk-Save (partition &optional (unit *Default-Disk-Unit*)            &key (no-query nil) (partition-comment nil)         (display-mode :normal))  "Save the current Lisp world in partition PARTITION on disk UNIT.  The optional PARTITION argument can be either a string naming a partitionor a number which signifies a partition whose name starts with LOD.  The NO-QUERY keyword says do not ask for confirmation (or any keyboard input at all).  The default is to ask the user.  The PARTITION-COMMENT keyword is a string describing the new Lisp world to be put in the disk label.  This is normally prompted for, so is of use mainly onlyin NO-QUERY mode.  The DISPLAY-MODE keyword controls the type of disk-save's status display.  Values are :NORMAL (the default screen display) and NIL (for no display)."  (block Disk-Save    (let (save-part-name save-part-name-hi-16-bits save-part-name-lo-16-bits  save-part-base save-part-size system-version saving-over-self)            ;; Decode partition argument.      (multiple-value-setq (save-part-name save-part-name-hi-16-bits   save-part-name-lo-16-bits)   (disk-restore-decode partition))            ;; First check if saving over currently running band.      (when (and (eq unit *Default-Disk-Unit*) (string-equal save-part-name *Loaded-Band*));; Check if we've got enough swap space to migrate all the;; clean load band pages.  Return NIL (with explanation) if not.(let ((swap-space-needed (count-unmodified-load-band-pages))      swap-space-available)  (multiple-value-setq (nil swap-space-available)       (swap-space-info))  ;; Add a bit of fudge for dirty pages still in core, etc.  (setq swap-space-needed(+ swap-space-needed (estimate-modified-core-pages) 100.))  (if (> swap-space-needed swap-space-available)      (progn(format *Standard-Output* *Save-Over-Self-Swap-Space-Error-Msg**Loaded-Band* *Default-Disk-Unit*swap-space-available swap-space-needed)(return-from Disk-Save nil))      ;; We've got enough space, but warn user of hazards.      (if (OR *Dont-Warn-About-Disk-Save-Over-Current-Band*      (yes-or-no-p *Save-Over-Self-Warning*   *Loaded-Band* *Default-Disk-Unit*))  ;; Note fact that we're saving over current band.  (setq saving-over-self t)  ;; Exit returning nil if user doesn't confirm.  (return-from Disk-Save nil)))))            ;; Get base & start for partition to save into.      ;; If querying on, double check with user.      (unless (multiple-value-setq (save-part-base save-part-size)   (if (or no-query saving-over-self)       ;; If saving over self, call -FOR-READ version, since it       ;; doesn't ask user any more questions about the band.       (find-disk-partition-for-read save-part-name nil unit)       (find-disk-partition-for-write save-part-name nil unit)))(return-from Disk-Save nil))      ;; This will catch most lossages before the user has waited.      (check-partition-size save-part-size)            ;; Check patch consistency.      (unless no-query(when (boundp 'Patch-Systems-List)  (dolist (patch-system Patch-Systems-List)    (when (eq (patch-status patch-system) :INCONSISTENT)      (beep)      (format *Query-IO* *Patch-Level-Inconsistent-Warning*      (patch-name patch-system))      (send *Query-IO* :CLEAR-INPUT)      (if (yes-or-no-p "Save anyway? ")  (return);; break out of Dolist  (return-from Disk-Save nil))))))      (if (variable-boundp System-Additional-Info)  ;; Prompt user for herald and disk label strings  (setq system-version(if no-query    (let ((vers (or partition-comment System-Additional-Info)))      (setq system-additional-info vers)      (SUBSEQ (STRING vers) 0 (MIN (LENGTH vers) 16.)))    (get-new-system-version unit)))  ;; Else (cold band)  (unless (and partition-comment (stringp partition-comment))    (setq partition-comment  (string-append (string-capitalize user-id) "'s Kernel"))))      (check-partition-size save-part-size)      ;; Set up display mode & get the time now, before we shut down system.      (setq DS-Display-Mode    (case display-mode  (:normal :normal)  (:debug :debug);; undocumented  (otherwise nil)))      (setq DS-Start-Clock-Time           ;; Keep track of when we started,    (if (and (fboundp 'time:print-current-time)   ;; if we can determine that.     (fboundp 'time:get-time)     (time:get-time))(time:print-current-time nil)nil))      (if (fboundp 'system-shutdown)  ;; Quiet the system.  This does a LOGOUT.  (system-shutdown :TYPE :DISK-SAVE :REASON-STRING "Shutdown by DISK SAVE" :RETURN t)  (progn    (setq Cold-Booting t)    (setq user-id "")));; pseudo-logout            ;; Cause cold boot initializations to happen when rebooted.      ;; Do the BEFORE-COLD initializations now.      (initializations 'Before-Cold-Initialization-List t)      ;; Reset the Cold inits so they will get run on reboot!      (reset-initializations 'Cold-Initialization-List)      ;; Some randomness ... may or may not be strictly necessary.      (setq Who-Line-Just-Cold-Booted-P t)            ;; Check again before updating the partition comment.      (check-partition-size save-part-size)      (if partition-comment  (update-partition-comment save-part-name partition-comment unit)  (update-partition-comment save-part-name system-version unit))      ;; Spawn off new process to run the Disk-Save in.  This ensures that the      ;; state of the process wer'e currently running in will be consistent in      ;; the saved band.      (process-run-function'(:name "Disk-Save" :restart-after-boot nil)(if (variable-boundp tv:window-owning-mouse)    #'disk-save-caller    #'cold-disk-save-caller)unit save-part-name-hi-16-bits save-part-name-lo-16-bitssave-part-base save-part-size saving-over-self)      ;; Make this process sleep for 10 seconds so the prompt is not      ;; redisplayed before interrupts shut down completely.      (process-sleep 600.))    ))(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 &aux max-addr)  ;; This function runs in the Disk-Save process.  ;;  ;; 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)      (dolist (screen tv:All-The-Screens)(send screen :DEEXPOSE)(tv:sheet-release-lock screen))      ;;      ;; 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    tv: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)))  )(Defun Cold-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 &aux max-addr)  (let-globally ((Inhibit-Scheduling-Flag t))    ;; Remove all traces of Disk-Save process from system, 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  tv:Cold-Load-Stream-Owns-Keyboard t)    (send *Terminal-IO* :home-cursor)    (send *Terminal-IO* :clear-screen)        (setq max-addr (find-max-addr))    ;; 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-bitssave-part-base save-part-size saving-over-self))  );; Fix to use current band as default if called with no args.(Defun Disk-Restore (&optional (partition *Loaded-Band*) (unit *Default-Disk-Unit*))  "Reboot partition PARTITION on unit UNIT as a saved Lisp world.  PARTITION can be either a string naming a partition, or a numberwhich signifies a partition whose name starts with LOD.  The default isto reboot the current Lisp world.  NIL means boot the default load partition for UNIT.  Note that this does not change the running microcode.  You cannot successfully DISK-RESTORE a world that will not work with the microcode that is currently running."  (let (rqb block name name-hi-16-bits name-lo-16-bits comment desired-ucode)    ;; Decode partition argument    (multiple-value-setq (name name-hi-16-bits name-lo-16-bits) (disk-restore-decode partition))    ;; Verify valid partition & get its desired Ucode.    (unwind-protect       (setq rqb (read-disk-label unit)     name (if partition      name      (current-band unit))         block (find-disk-partition-for-read name rqb unit t)     comment (partition-comment name unit)     desired-ucode (get-ucode-version-of-band name unit))      (return-disk-rqb rqb))    ;; Verify Ucode level.    (and (/= desired-ucode %Microcode-Version-Number) (not (zerop desired-ucode));; Not stored yet (format *Query-IO* "~&That band prefers microcode ~D but the running microcode is ~D.~%" desired-ucode %Microcode-Version-Number))       ;; Verify with user.    (cond ((fquery format:Yes-Or-No-Quietly-P-Options   "Do you really want to restore ~A (~A)?  " name comment)   (and (fboundp 'tv:close-all-servers)(tv:close-all-servers "Disk-Restoring"))   (%disk-restore name-hi-16-bits name-lo-16-bits (get-real-unit unit))))    ))transfer-length))    (setf (aref rqb %IO-RQ-TRANSFER-LENGTH-HIGH) (ldb %%Q-HIGH-HALF transfer-length))    ;; Set up disk block to read    (setf (aref rqb %IO-RQ-DEVICE-ADDRESS) (ldb %%Q-LOW-HALF address))    (setf (aref rqb %IO-RQ-DEVICE-ADDRESS-HIGH) (ldb %%Q-HIGH-HALF address))       ;; Initiate the i/o.    (%io rqb #+elroy (AREF disk-type-table (get-logical-unit unit) 7.); device descriptor #-elroy *Nupi*)  ))(Defun DS-Disk-Read (rqb unit address npages offset)  (ds-disk-io rqb unit address npages offset %NUPI-COMMAND-READ))(Defun DS-Disk-Write (rqb unit address npages offset)  (ds-di