;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.113
;;; Reason:
;;;  1. Clean up processor-specific stuff in PATCH.LISP (mostly for PRINT-HERALD).
;;;  
;;;  2. When printing SYSTEM-ADDITIONAL-INFO string in
;;;  WRITE-RESPONSIBILITY-COMMENT, make sure resulting string is contained
;;;  within one line by transforming newlines (stripping from ends, turning
;;;  into spaces within).  Fixes bad screw when your system comment has
;;;  embedded returns; can't load a patch file made under such conditions!
;;; Written 18-Oct-88 16:27:16 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Tonic from band 1
;;; with Experimental System 126.112, Experimental ZWEI 126.21, Experimental ZMail 74.9, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, ) This space for rent (.



; From modified file DJ: L.SYS2; PATCH.LISP#188 at 18-Oct-88 16:28:44
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(DEFUN SYSTEM-VERSION-INFO (&OPTIONAL (BRIEF-P NIL) &AUX (FIRST T) TEM)
  "Return a one-line string giving the versions of all patchable systems.
Also gives the microcode version, and the loaded band's disk label comment.
With BRIEF-P, return stuff suitable for disk label comment."
  (WITH-OUTPUT-TO-STRING (S)
    (UNLESS (AND BRIEF-P (EQ (PATCH-STATUS (GET-PATCH-SYSTEM-NAMED "System")) :INCONSISTENT))
      ;; If some system is inconsistent but System is not,
      ;; make sure "Bad" appears at the front.
      (DOLIST (SYS PATCH-SYSTEMS-LIST)
	(WHEN (EQ (PATCH-STATUS SYS) ':INCONSISTENT)
	  (FORMAT S (IF BRIEF-P "Bad " "Don't-dump-a-band! "))
	  (RETURN))))
    (DOLIST (SYS PATCH-SYSTEMS-LIST)
      (COND ((NOT (AND BRIEF-P (OR (SYSTEM-SHOULD-NOT-APPEAR-IN-DISK-LABEL (PATCH-NAME SYS))
				   (MEMQ SYS FROZEN-PATCH-SYSTEMS-LIST))))
	     (IF (NOT FIRST)
		 (SEND S :STRING-OUT (IF BRIEF-P " " ", ")))
	     (SETQ FIRST NIL)
	     (COND ((NULL (SETQ TEM (ASSQ (PATCH-STATUS SYS) SYSTEM-STATUS-ALIST)))
		    (SETQ TEM (STRING (PATCH-STATUS SYS))))
		   (BRIEF-P
		    (SETQ TEM (THIRD TEM)))
		   (T
		    (SETQ TEM (SECOND TEM))))
	     (UNLESS (EQUAL TEM "")
	       (SEND S :STRING-OUT TEM)
	       (WRITE-CHAR #\SPACE S))
	     (IF (NOT (AND BRIEF-P (EQUALP (PATCH-NAME SYS) "System")))
		 (FORMAT S "~A " (IF (NOT BRIEF-P) (PATCH-NAME SYS)
				     (SYSTEM-SHORT-NAME (PATCH-NAME SYS)))))
	     (FORMAT S "~D.~D"
		     (PATCH-VERSION SYS) (VERSION-NUMBER (FIRST (PATCH-VERSION-LIST SYS)))))))
    (unless brief-p
      #+(target lambda cadr explorer)
      (format s ", Microcode ~D" %MICROCODE-VERSION-NUMBER)
      (describe-external-system s))
    ;;;Always print SYSTEM-ADDITIONAL-INFO, but:
    ;;; 1) Newlines, spaces on ends get trimmed,
    ;;; 2) Newlines inside become spaces.
    (let ((sys-info
	    (substitute #\space #\return
			(string-trim '(#\return #\space) system-additional-info))))
      (AND (PLUSP (STRING-LENGTH sys-info))
	   (FORMAT S ", ~A" sys-info)))))

))

; From modified file DJ: L.SYS2; PATCH.LISP#188 at 18-Oct-88 16:28:46
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(DEFUN DESCRIBE-SYSTEM-VERSIONS (&OPTIONAL (S *STANDARD-OUTPUT*) IGNORE-FROZEN
				 &AUX (MAX 9) NAME-LIST STATUS UL)
  "Print the version numbers of all patchable systems, one per line, on stream S.
The microcode version number and some other suitable information is also included."
  (SETQ UL (IF IGNORE-FROZEN
	      (SUBSET #'(LAMBDA (X) (NOT (MEMQ X FROZEN-PATCH-SYSTEMS-LIST)))
		      PATCH-SYSTEMS-LIST)
	     PATCH-SYSTEMS-LIST))
  (SETQ NAME-LIST (MAKE-LIST (LENGTH UL)))
  (DO ((SYS UL (CDR SYS))
       (NAM NAME-LIST (CDR NAM)))
      ((NULL SYS))
    (SETQ STATUS (SECOND (ASSQ (PATCH-STATUS (CAR SYS)) SYSTEM-STATUS-ALIST)))
    (SETF (CAR NAM)
	  (WITH-OUTPUT-TO-STRING (STREAM)
	    (WHEN (PLUSP (LENGTH STATUS))
	      (SEND STREAM :STRING-OUT STATUS)
	      (WRITE-CHAR #\SPACE STREAM))
	    (SEND STREAM :STRING-OUT (PATCH-NAME (CAR SYS)))))
    (SETQ MAX (MAX (LENGTH (CAR NAM)) MAX)))
  (DO ((SYS UL (CDR SYS))
       (NAM NAME-LIST (CDR NAM)))
      ((NULL SYS))
    (FORMAT S "~& ~A" (CAR NAM))
    (DOTIMES (I (- MAX (LENGTH (CAR NAM))))
      (WRITE-CHAR #\SPACE S))
    (FORMAT S " ~3D.~D"
	    (PATCH-VERSION (CAR SYS))
	    (VERSION-NUMBER (FIRST (PATCH-VERSION-LIST (CAR SYS))))))
  #+(target lambda cadr explorer)
  (progn
    (FORMAT S "~& Microcode")
    (DOTIMES (I (- MAX 9. 1))
      (WRITE-CHAR #\SPACE S))
    (FORMAT S " ~4D" %MICROCODE-VERSION-NUMBER))
  #+(target lambda)
  ;print SDU boot tape version if set up
  (let ((boot-tape-version (get-boot-tape-version-number)))
    (when boot-tape-version
      (format s "~& SDU")
      (dotimes (i (- max 3.))
	(write-char #\space s))
      (format s " ~3D.~D" 
	      (ldb (BYTE 16. 16.) boot-tape-version)
	      (ldb (BYTE 16. 0.) boot-tape-version))))
  )

; Moved to SYS: IO; DISK on 10/9/86  (which is loaded before this file; avoid problem
; with Site initializations while building cold load).

;(defun get-boot-tape-version-number ()
;  "return boot tape version number, or nil if not available
;   version is 32-bits, major.minor"
;  (select-processor
;    (:lambda
;      (when (and (> (%system-configuration-size *sys-conf*)
;		    %system-configuration-newboot-version-number)
;		 (neq 0 (ldb #o2020 (%system-configuration-newboot-version-number *sys-conf*))))
;	(%system-configuration-newboot-version-number *sys-conf*)))
;    ((:explorer :cadr))))

))

; From modified file DJ: L.SYS2; PATCH.LISP#188 at 18-Oct-88 16:28:48
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(defun get-sdu-rom-version-number ()
  "return sdu rom version number, or nil if not available"
  (select-processor
    (:lambda
      (when (and (> (%system-configuration-size *sys-conf*)
		    %system-configuration-sdu-rom-version-number)
		 (neq 0 (%system-configuration-sdu-rom-version-number *sys-conf*)))
	(%system-configuration-sdu-rom-version-number *sys-conf*)))
    ;;N/A:
    ((:explorer :cadr :falcon))))

))

; From modified file DJ: L.SYS2; PATCH.LISP#188 at 18-Oct-88 16:28:52
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(defun describe-external-system (&optional (s *standard-output*))
  #+(target lambda)
  ;;Include SDU Boot Tape and ROM version numbers if set up
  (let ((boot-tape-version (get-boot-tape-version-number))
	(rom-version (get-sdu-rom-version-number)))
    (when boot-tape-version
      (format s ", SDU Boot Tape ~D.~D"
	      (ldb (BYTE 16. 16.) boot-tape-version)
	      (ldb (BYTE 16. 0.)  boot-tape-version)))
    (when rom-version
      (format s ", SDU ROM ~D" rom-version)))
  ;;;|||KMC: Hold this thought. 10/18/88
  #+(target falcon)
  (format s ",K/Mac Interface ??"))

))