;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 126.22 ;;; Reason: ;;; Improve interface to DISK-SAVE. ;;; ;;; SI:GET-NEW-SYSTEM-VERSION now takes :QUERY keyword (which DISK-SAVE ;;; uses). If non-NIL, offers user chance to edit the system label string. ;;; ;;; This solves a problem whereby DISK-SAVE no longer gave an opportunity to ;;; specify your own partition comment. That happened when we changed all ;;; the loaded standard systems (except SYSTEM) s.t. they do not appear in ;;; the disk label comment by default. ;;; ;;; Other presentability improvements thanks to SAZ. -Keith ;;; Written 9-Aug-88 14:29:26 by keith (Keith Corbett) at site Gigamos Cambridge ;;; while running on Breaking Glass from band 2 ;;; with Experimental System 126.21, ZWEI 125.14, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103. ; From modified file DJ: L.SYS2; PATCH.LISP#185 at 9-Aug-88 14:29:48 #10R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  " (DEFUN GET-NEW-SYSTEM-VERSION (&OPTIONAL (MAXIMUM-LENGTH 16.) &KEY INCREMENTAL query) (setq maximum-length (or maximum-length 16.)) (when (not (plusp maximum-length)) (warn "No characters allowed for new system version label \(maximum-length = ~D\)" maximum-length) (return-from get-new-system-version "")) (FORMAT T "~&This is now:") (DESCRIBE-SYSTEM-VERSIONS) (FRESH-LINE) (SETQ SYSTEM-ADDITIONAL-INFO (READLINE-TRIM *QUERY-IO* "" `((:PROMPT "Additional comment for herald: ") (:INITIAL-INPUT ,SYSTEM-ADDITIONAL-INFO) (:INITIAL-INPUT-POINTER ,(LENGTH SYSTEM-ADDITIONAL-INFO))))) (LET ((VERS (SYSTEM-VERSION-INFO T))) (IF INCREMENTAL (SETQ VERS (STRING-APPEND "Inc " VERS))) ;; Offer user chance to change it (when query (setq vers (string-trim #\return (readline-trim *query-io* "" `((:prompt ,(if (stringp query) (format nil query vers maximum-length) (format nil "~%Edit the system version label \(as shown\); ~ up to ~D character~:P allowed.~&Press RETURN when done.~2%> " maximum-length))) (:initial-input ,vers) (:initial-output-pointer ,(string-length vers)) (:initial-input-pointer 0.)))))) ;; If short version doesn't fit, allow user to edit it (e.g. abbreviate system names) (DO (SHORT) (( (LENGTH VERS) MAXIMUM-LENGTH)) (SETQ SHORT (SUBSTRING VERS 0 MAXIMUM-LENGTH)) (beep) (SETQ VERS (READLINE-TRIM *QUERY-IO* "" `((:PROMPT ,(FORMAT NIL "~%~S will not fit in disk label.~@ ~%Please abbreviate the label to ~D character~:P: " VERS MAXIMUM-LENGTH)) (:INITIAL-INPUT ,VERS) (:INITIAL-INPUT-POINTER ,MAXIMUM-LENGTH))))) VERS)) )) ; From modified file DJ: L.SYS; QMISC.LISP#737 at 9-Aug-88 14:32:50 #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 :query T)))) ;; 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) (let ((gc-status gc:*gc-process-control*)) (when (eq gc-status :active) (gc:gc-off)) ;Wait for current reclamation (if any) to complete (gc:maybe-flip-level-2) ;Flip level 2 in batch mode (when (eq gc-status :active) (gc:gc-on))) ;Reenable the GC Process (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)))))) ))