;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.67
;;; Reason:
;;;  Accept a host object as valid disk unit specification (e.g. for
;;;  PRINT-DISK-LABEL).
;;;  
;;;  Also, give PRINT-DISK-LABEL a useful documentation string, with examples.
;;; Written 30-Aug-88 13:03:01 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.66, Experimental ZWEI 126.2, Experimental ZMail 74.0, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Unix-Interface 14.0, Experimental Tape 25.1, Experimental Lambda-Diag 18.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, Lambda/Falcon Development System.



; From modified file DJ: L.IO; DISK.LISP#422 at 30-Aug-88 13:03:17
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DISK  "

(DEFUN DECODE-UNIT-ARGUMENT (UNIT USE &OPTIONAL (DISK-INIT-P NIL) (WRITE-P NIL)
			     &AUX TEM)
  "First value is decoded unit. If second value is NIL the caller should call
DISPOSE-OF-UNIT eventually. If T then the UNIT must have already been decoded."
  (when (typep unit 'host)
    (setq unit (send unit :name)))
  (COND ((AND (STRINGP UNIT)
	      (STRING-EQUAL UNIT "MT" :END1 2))
	 (SETQ TEM (STRING-SEARCH-CHAR #/SP UNIT))
	 (LET ((CC-DISK-UNIT (IF (NULL TEM) 0 (READ-FROM-STRING UNIT NIL (1+ TEM)))))
	   (COND ((NOT (ZEROP CC-DISK-UNIT))
		  (FERROR "MT can only talk to unit zero")))
	   (values (FS:MAKE-BAND-MAGTAPE-HANDLER WRITE-P) NIL)))
	((AND (STRINGP UNIT)
	      (FBOUNDP 'SI:MAKE-LAM-DISK-UNIT)
	      (MEM #'STRING-EQUAL UNIT '("EXP" "LAM")))
	 (VALUES (SI:MAKE-LAM-DISK-UNIT UNIT USE DISK-INIT-P WRITE-P) NIL))
	((STRINGP UNIT)
	 (LET ((HOST (SI:PARSE-HOST (SUBSTRING UNIT 0 (SETQ TEM (STRING-SEARCH-CHAR #/SP UNIT)))))
	       (DISK-UNIT (IF (NULL TEM) 0 (READ-FROM-STRING UNIT NIL (1+ TEM)))))
	   (VALUES (NET:GET-REMOTE-DISK-UNIT HOST DISK-UNIT USE DISK-INIT-P WRITE-P) NIL)))
	((numberp unit)
	 (values (require-online-numeric-unit unit) t))
	('ELSE
	 (VALUES UNIT T))))

; Copied by hand from SYS: SYS2; PATCH on 10/9/86: Avoid site inititialization lossage while
; building cold load.  -rpp

))

; From modified file DJ: L.IO; DLEDIT.LISP#100 at 30-Aug-88 13:08:19
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DLEDIT  "


(DEFUN PRINT-DISK-LABEL (&OPTIONAL UNIT (STREAM STANDARD-OUTPUT))
  "Print the contents of disk UNIT's label on STREAM.
UNIT can be:
  1) A disk drive number; or
  2) A host object or the name of a host; or
  3) A string containing the name of a machine 
     and a disk drive number.
/
  For example:
/
  /(print-disk-label/)             ;unit 0 of this system
  /(print-disk-label 1/)           ;unit 1 of this system
  /(print-disk-label /"LAM-A/"/)     ;unit 0 on remote host LAM-A
  /(print-disk-label /"LAM-A 1/"/)   ;unit 1 on remote host LAM-A
"
  (setq unit (default-disk-unit unit))
  (WITH-DECODED-DISK-UNIT (DECODED-UNIT UNIT "reading label")
    (using-resource (rqb si:rqb disk-label-rqb-pages 4)
      (read-disk-label rqb decoded-unit)
      (print-disk-label-from-rqb stream decoded-unit rqb nil))))

))