;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for CDI version 1.4 ;;; Reason: ;;; Update print-disk-label-from-rqb-v2 to use the rqb for the default microload and band. ;;; Written 14-May-86 15:28:41 by Gibson at site LMI Cambridge ;;; while running on Explorer One from band 1 ;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Window-Maker 1.1, Gateway 4.8, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.26, Experimental CDI 1.3, microcode 1514. ; From modified file DJ: L.IO; DLEDIT.LISP#90 at 14-May-86 15:28:44 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DLEDIT  " (defun print-disk-label-from-rqb-v2 (stream unit rqb cons-up-le-structure-p &AUX CURRENT-MICROLOAD CURRENT-BAND) (terpri stream) (LE-OUT 'pack-name (get-disk-string rqb 12. 16.) stream cons-up-le-structure-p) (Princ ": " stream) (LE-OUT 'DRIVE-NAME (Get-disk-String rqb 5 12.) stream cons-up-le-structure-p) (Princ ", " stream) (LE-OUT 'COMMENT (Get-disk-String rqb 64. 96.) stream cons-up-le-structure-p) (Format stream "~%~a version ~d, " ; You can't edit these (Get-disk-String rqb 0 4) (Get-disk-Fixnum rqb 1)) (let ((type-word (get-disk-fixnum rqb 4))) (select (ldb (byte 3 0) type-word) (0 ; disk (le-OUT 'DEVICE-TYPE "DISK" stream cons-up-le-structure-p) (let ((temp (Get-disk-Fixnum rqb 8))) ;"bytes-per" (Terpri stream) (LE-OUT 'N-Bytes-per-Block (ldb (byte 16. 0) temp) stream cons-up-le-structure-p) (Princ " bytes per block, " stream) (LE-OUT 'N-Bytes-per-Sector (ldb (byte 16. 16.) temp) stream cons-up-le-structure-p) (Princ " bytes per sector, " stream) (Terpri stream) (setq temp (Get-disk-Fixnum rqb 9)) (LE-OUT 'N-Sectors-per-Track (ldb (byte 8 24.) temp) stream cons-up-le-structure-p) (Princ " sectors per track, " stream) (LE-OUT 'N-Heads (ldb (byte 8 16.) temp) stream cons-up-le-structure-p) (Princ " heads, " stream) (Terpri stream) (setq temp (Get-disk-Fixnum rqb 10.)) (LE-OUT 'N-Cylinders (ldb (byte 16. 0) temp) stream cons-up-le-structure-p) (Princ " cylinders, " stream) (LE-OUT 'N-Sectors-for-Defects (ldb (byte 16. 16.) temp) stream cons-up-le-structure-p) (Princ " sectors for defects, " stream)) ) (1 ;"tape" (LE-OUT 'DEVICE-TYPE "TAPE" stream cons-up-le-structure-p)) (Otherwise (LE-OUT 'DEVICE-TYPE (Format nil "UNKNOWN (~d)" (Ldb (byte 3 0) type-word)) stream cons-up-le-structure-p)) )) (Terpri stream) (Princ "Current microload = " stream) (LE-OUT 'CURRENT-MICROLOAD (Setq current-microload (get-disk-string rqb %dl-current-microload 4)) stream cons-up-le-structure-p) (Princ ", current virtual memory load (band) = " stream) (LE-OUT 'CURRENT-BAND (Setq current-band (get-disk-string rqb %dl-current-band 4)) stream cons-up-le-structure-p) (Terpri stream) (Princ "Partition table " STREAM) (LE-OUT 'PARTITION-TABLE-NAME (Get-disk-String rqb 20. 4.) stream cons-up-le-structure-p) (Princ ", starting block " STREAM) (LE-OUT 'PARTITION-TABLE-START (Get-disk-Fixnum rqb 21.) stream cons-up-le-structure-p) (Princ ", length " STREAM) (LE-OUT 'PARTITION-TABLE-LENGTH (Get-disk-Fixnum rqb 22.) stream cons-up-le-structure-p) (Terpri stream) (Princ "Save area " STREAM) (LE-OUT 'SAVE-AREA-NAME (Get-disk-String rqb 28. 4.) stream cons-up-le-structure-p) (Princ ", starting block " STREAM) (LE-OUT 'SAVE-AREA-START (Get-disk-Fixnum rqb 29.) stream cons-up-le-structure-p) (Princ ", length " STREAM) (LE-OUT 'SAVE-AREA-LENGTH (Get-disk-Fixnum rqb 30.) stream cons-up-le-structure-p) (Terpri stream) ;; The partition table resides in the disk label buffer starting ;; at page 1. (Let ((pt-start 256.) n-partitions words-per-part) ;;; (Princ "Partition Table Revision: " stream) ;;; (LE-OUT 'P-TABLE-REVISION (Get-disk-Fixnum rqb (+ pt-start 1)) ;;; stream cons-up-le-structure-p) (LE-OUT 'N-PARTITIONS (Setq n-partitions (Get-disk-fixnum rqb (+ pt-start 2))) stream cons-up-le-structure-p) (Princ " partitions, " stream) (LE-OUT 'WORDS-PER-PART (Setq words-per-part (Get-disk-Fixnum rqb (+ pt-start 3))) stream cons-up-le-structure-p) (Princ "-word descriptors:" stream) ;; print out partition descriptors (DO ((i 0 (1+ i)) (loc (+ pt-start 16.) (+ loc words-per-part))) ((= i n-partitions)) (Let ((partition-name (Get-disk-String rqb loc 4))) (If (Or (String-Equal partition-name current-microload) (String-Equal partition-name current-band)) (Format stream "~%* ") (Format stream "~% ")) (LE-OUT 'PARTITION-NAME partition-name stream cons-up-le-structure-p)) (Princ " " stream) (princ "Part-type ") (LE-OUT 'PARTITION-TYPE (LDB (byte 8 0) (Get-disk-Fixnum rqb (+ loc 3))) ;"***attributes***" stream cons-up-le-structure-p) (Princ " at block " stream) (LE-OUT 'PARTITION-START (Get-disk-Fixnum rqb (+ loc 1)) stream cons-up-le-structure-p) (Princ ", " stream) (LE-OUT 'PARTITION-SIZE (Get-disk-Fixnum rqb (+ loc 2)) stream cons-up-le-structure-p) (Princ " blocks long" stream) (When (> words-per-part 4) ; Partition comment (Princ ", /"" stream) (LE-OUT 'PARTITION-COMMENT (Get-disk-String rqb (+ loc 4) (* 4 (- words-per-part 4))) stream cons-up-le-structure-p) (Tyo #/" stream)) (Let ((this-end (+ (Get-disk-Fixnum rqb (+ loc 1)) (Get-disk-Fixnum rqb (+ loc 2)))) (next-base (If (= (1+ i) n-partitions) ; last partition ;; +++ figure this out, should be total number of blocks +++ ;; +++ cheat for now +++ (+ (Get-disk-Fixnum rqb (+ loc 1)) (Get-disk-Fixnum rqb (+ loc 2))) ;; Starting block number of next partition (Get-disk-Fixnum rqb (+ loc 1 words-per-part))))) (Cond ((> (- next-base this-end) 0) (Format stream ", ~D blocks free at ~D" (- next-base this-end) this-end)) ((< (- next-base this-end) 0) (Format stream ", ~D blocks overlap" (- this-end next-base))))) ) ) ) ))