;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.60
;;; Reason:
;;;  The PATCH-VERSION structure now stores and prints the universal time
;;;  at which the patch was started.  The change is upward compatible.
;;;  The intention is to aid correlating a patch with file changes and
;;;  unexpected lossages.
;;; Written 22-Aug-88 13:48:28 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.59, ZWEI 125.19, 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.12, SDU ROM 102, kold 4aug88.



; From modified file DJ: L.SYS2; PATCH.LISP#187 at 22-Aug-88 13:49:04
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(DEFSTRUCT (PATCH-VERSION (:TYPE LIST) (:CONC-NAME VERSION-)
			  (:ALTERANT NIL) (:CALLABLE-CONSTRUCTORS NIL))
  (NUMBER NIL :DOCUMENTATION "Minor number of the patch")
  (EXPLANATION NIL :DOCUMENTATION "String explaining the contents of the patch")
  (AUTHOR USER-ID :DOCUMENTATION "Who dun it")
  (UNRELEASED NIL :DOCUMENTATION
    "T means that this patch is not released,
and will not normally be loaded by LOAD-PATCHES unless explicitly requested.")
  (time-stamp (get-universal-time) :documentation
    "The universal-time when this patch was started")
  )

;;; List of systems that are legal to patch, i.e. list of PATCH-SYSTEM's

))

; From modified file DJ: L.SYS2; PATCH.LISP#187 at 22-Aug-88 13:49:07
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(DEFUN PRINT-PATCH (MAJOR-VERSION-NUMBER PATCH-VERSION-DESC)
  (FORMAT T "~&~D.~D ~8T~A~@[ (~\\time\\)~]:~:[~; (unreleased)~]~&~10T~~A~~%"
	  MAJOR-VERSION-NUMBER
	  (VERSION-NUMBER PATCH-VERSION-DESC)
	  (VERSION-AUTHOR PATCH-VERSION-DESC)
	  (VERSION-time-stamp PATCH-VERSION-DESC)
	  (VERSION-UNRELEASED PATCH-VERSION-DESC)
	  (VERSION-EXPLANATION PATCH-VERSION-DESC)))

))

; From modified file DJ: L.SYS2; PATCH.LISP#187 at 22-Aug-88 13:49:07
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(DEFUN INCREMENT-PATCH-SYSTEM-MAJOR-VERSION (NAME STATUS &AUX VERSION PATCH-MAJOR)
  "Increment the major version of the patchable system NAME, and set status to STATUS.
This modifies the patch directory files of the system."
  (SETQ VERSION (GET-PATCH-SYSTEM-MAJOR-VERSION NAME T))
  (WHEN (NULL VERSION)
    (FORMAT T "~&No master directory for system ~A, creating one." NAME)
    (SETQ VERSION 0))
  (INCF VERSION)
  (SETQ PATCH-MAJOR (MAKE-PATCH-MAJOR :NAME NAME :VERSION VERSION))
  (WITH-OPEN-FILE (FILE (PATCH-SYSTEM-PATHNAME NAME :SYSTEM-DIRECTORY) :DIRECTION :OUTPUT)
    (FORMAT FILE
	    ";;; -*- Mode:LISP; Package:USER; Base:10; Readtable:Common-Lisp; Patch-File:T -*-~%")
    (LET ((*PRINT-BASE* 10.)
	  (*PACKAGE* PKG-USER-PACKAGE)
	  (*READTABLE* INITIAL-COMMON-LISP-READTABLE))
      (WRITE-RESPONSIBILITY-COMMENT FILE)
      (PRINT PATCH-MAJOR FILE)))
  (LET ((FIRST-VERS (MAKE-PATCH-VERSION :NUMBER 0
					:EXPLANATION (FORMAT NIL "~A Loaded" NAME))))
    (WRITE-PATCH-DIRECTORY PATCH-MAJOR (MAKE-PATCH-DIR :STATUS STATUS
						       :VERSION-LIST (NCONS FIRST-VERS))
			   T))
  VERSION)

(DEFUN RESERVE-PATCH (PATCH-SYSTEM &OPTIONAL (WARNING-STREAM *STANDARD-OUTPUT*))
  "Allocate a minor system number for patchable system PATCH.
Mark it in the directory with a NIL.
PATCH should be an object of type PATCH-SYSTEM.
Returns the allocated minor version number."
  (IF (MEMQ PATCH-SYSTEM FROZEN-PATCH-SYSTEMS-LIST)
      (cerror "Do it anyway.  ** Be sure you know what you're doing! **"
	      "System ~S is frozen and should not be patched." (PATCH-NAME PATCH-SYSTEM)))
  (LET* ((PATCH-DIR (READ-PATCH-DIRECTORY PATCH-SYSTEM))
	 (PATCHES (PATCH-DIR-VERSION-LIST PATCH-DIR))
	 (LAST-PATCH (LAST PATCHES))
	 (NEW-VERSION (1+ (VERSION-NUMBER (FIRST LAST-PATCH)))))
    (DOLIST (P PATCHES)
      (WHEN (VERSION-EXPLANATION P)
	(UNLESS (ASSQ (VERSION-NUMBER P)
		      (PATCH-VERSION-LIST PATCH-SYSTEM))
	  (FORMAT WARNING-STREAM "~&Note: Patch ~D.~D is not loaded yet."
		  (PATCH-VERSION PATCH-SYSTEM)
		  (VERSION-NUMBER P))
	  (RETURN))))				;Only mention the first one.
    (DOLIST (P PATCHES)
      (OR (VERSION-EXPLANATION P)
	  (RETURN (FORMAT WARNING-STREAM "~&Note: Patch ~D.~D is not finished yet."
			  (PATCH-VERSION PATCH-SYSTEM)
			  (VERSION-NUMBER P)))))
    (SETF (CDR LAST-PATCH)
	  (NCONS (MAKE-PATCH-VERSION :NUMBER NEW-VERSION :EXPLANATION NIL)))
    (WRITE-PATCH-DIRECTORY PATCH-SYSTEM PATCH-DIR)
    NEW-VERSION))

))