;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for CDI version 1.3 ;;; Reason: ;;; More changes to the disk interface. ;;; Written 14-May-86 15:03:49 by PTM at site LMI Cambridge ;;; while running on Larry from band 3 ;;; 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.18, Experimental CDI 1.0, microcode 1512, SDU ROM 103. ; From modified file DJ: L.IO; DLEDIT.LISP#89 at 14-May-86 15:04:03 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DLEDIT  " (DEFUN LE-COM-CONTROL-E-v2 () (SETQ LE-SOMETHING-CHANGED T) ;something probably will... (IF (< LE-ITEM-NUMBER (LENGTH LE-STRUCTURE)) (LET ((ITEM (NTH LE-ITEM-NUMBER LE-STRUCTURE))) (LET ((NAME (FIRST ITEM)) (VALUE (SECOND ITEM)) (*READ-BASE* 10.)) (WITH-INPUT-EDITING (T `((:INITIAL-INPUT ,(FORMAT NIL "~D" VALUE)))) (SETQ VALUE (PROMPT-AND-READ (IF (NUMBERP VALUE) ':INTEGER ':STRING) "Change the ~A from to:" NAME))) ;; Avoid lossage in lowercase partition names. (COND ((MEMQ NAME '(PARTITION-NAME CURRENT-BAND CURRENT-MICROLOAD)) (SETQ VALUE (STRING-UPCASE VALUE)))) (CASE NAME (PACK-NAME (PUT-DISK-STRING LE-RQB VALUE 12. 16.)) (DRIVE-NAME (PUT-DISK-STRING LE-RQB VALUE 5 12.)) (COMMENT (PUT-DISK-STRING LE-RQB VALUE 64. 96.)) (N-CYLINDERS (put-disk-fixnum le-rqb (dpb value (byte 16. 0) (get-disk-fixnum le-rqb 10.)) 10.)) (N-HEADS (put-disk-fixnum le-rqb (dpb value (byte 8 16.) (get-disk-fixnum le-rqb 9)) 9)) (N-sectors-PER-TRACK (put-disk-fixnum le-rqb (dpb value (byte 8 24.) (get-disk-fixnum le-rqb 9)) 9)) (N-PARTITIONS (put-disk-fixnum le-rqb value (+ 256. 2))) (WORDS-PER-PART (put-disk-fixnum le-rqb value (+ 256. 3))) ;; These occur in multiple instances; hair is required ((PARTITION-NAME PARTITION-START PARTITION-SIZE PARTITION-COMMENT partition-type) (LET ((PLOC (LE-CURRENT-PARTITION))) (CASE NAME (PARTITION-NAME (PUT-DISK-STRING LE-RQB VALUE PLOC 4)) (PARTITION-START (PUT-DISK-FIXNUM LE-RQB VALUE (1+ PLOC))) (PARTITION-SIZE (PUT-DISK-FIXNUM LE-RQB VALUE (+ PLOC 2))) (partition-type (put-disk-fixnum le-rqb (dpb value (byte 8 0) (get-disk-fixnum le-rqb (+ ploc 3))) (+ ploc 3))) (PARTITION-COMMENT (PUT-DISK-STRING LE-RQB VALUE (+ PLOC 4) (* 4 (- (GET-DISK-FIXNUM LE-RQB (+ 256. 3)) 4))))))) (current-microload (set-default-microload-V2 le-rqb value)) (current-band (set-default-load-band-V2 le-rqb value)) (OTHERWISE (FERROR "No editor for ~S" NAME))))) (BEEP)) (LE-DISPLAY-LABEL LE-RQB LE-UNIT)) ;;; Returns the word number of the start of the descriptor for the partition ;;; containing the current item. )) ; From modified file DJ: L.IO; DLEDIT.LISP#89 at 14-May-86 15:04:29 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: IO; DLEDIT  " (DEFUN SET-CURRENT-BAND (BAND &OPTIONAL UNIT MICRO-P &AUX LABEL-INDEX) "Specify the LOD band to be used for loading the Lisp system at boot time. If the LOD band you specify goes with a different microcode, you will be given the option of selecting that microcode as well. Usually, do so. Do PRINT-DISK-LABEL to see what bands are available and what they contain. UNIT can be a string containing a machine's name, or /"CC/"; then the specified or debugged machine's current band is set. The last works even if the debugged machine is down. UNIT can also be a disk drive number; however, it is the disk on drive zero which is used for booting. Returns T if the band was set as specified, NIL if not (probably because user said no to a query)." (when (null unit) (select-processor ((:cadr :lambda) (setq unit 0)) (:explorer (setq unit (explorer-lod-band-logical-unit))))) (with-decoded-disk-unit (unit unit (FORMAT NIL "(SET-CURRENT-~:[BAND~;MICROLOAD~] ~D)" MICRO-P BAND)) (with-disk-rqb (rqb disk-label-rqb-pages) (PROG ((UCODE-NAME (SELECT-PROCESSOR (:CADR "MCR") (:LAMBDA "LMC") (:explorer "MCR") ))) (SETQ BAND (COND ((OR (SYMBOLP BAND) (STRINGP BAND)) (STRING-UPCASE (STRING BAND))) (T (FORMAT NIL "~A~D" (COND (MICRO-P UCODE-NAME) (T "LOD")) BAND)))) (OR (STRING-EQUAL (SUBSTRING BAND 0 3) (IF MICRO-P UCODE-NAME "LOD")) (FQUERY NIL "The specified band is not a ~A band. Select it anyway? " (IF MICRO-P UCODE-NAME "LOD")) (RETURN NIL)) (MULTIPLE-VALUE (NIL NIL LABEL-INDEX) (FIND-DISK-PARTITION-FOR-READ BAND RQB UNIT)) ;Does a READ-DISK-LABEL (ecase (get-disk-fixnum rqb 1) (1 (PUT-DISK-STRING RQB BAND (COND (MICRO-P 6) (T 7)) 4)) (2 (if (numberp unit) (if micro-p (set-default-microload-V2 rqb band) (set-default-load-band-V2 rqb band)) (ferror "can't set the default band remotely for V2 labels"))) ) (IF (NOT MICRO-P) (MULTIPLE-VALUE-BIND (NIL MEMORY-SIZE-OF-BAND UCODE-VERSION-OF-BAND) (MEASURED-SIZE-OF-PARTITION BAND UNIT) (LET ((CURRENT-UCODE-VERSION (current-microload-version unit)) (MACHINE-MEMORY-SIZE (cond ((and (numberp unit) (= (get-disk-fixnum rqb 1) 2)) (page-partition-size-for-local-machine)) (t (MEASURED-SIZE-OF-PARTITION "PAGE" UNIT))))) (AND (> MEMORY-SIZE-OF-BAND MACHINE-MEMORY-SIZE) (NOT (FQUERY NIL "~A requires a ~D block PAGE partition, but there is only ~D. Select ~A anyway? " BAND MEMORY-SIZE-OF-BAND MACHINE-MEMORY-SIZE BAND)) (RETURN NIL)) (MULTIPLE-VALUE-BIND (BASE-BAND-NAME BASE-BAND-VALID) (INC-BAND-BASE-BAND BAND UNIT) (WHEN BASE-BAND-NAME (FORMAT T "~%Band ~A is an incremental save with base band ~A." BAND BASE-BAND-NAME) (UNLESS BASE-BAND-VALID (FORMAT T "~2%It appears that ~A's contents have been changed since ~A was dumped. Therefore, booting ~A may fail to work!" BASE-BAND-NAME BAND BAND) (UNLESS (FQUERY FORMAT:YES-OR-NO-P-OPTIONS "~%Select ~A anyway? " BAND) (RETURN NIL))))) (IF UCODE-VERSION-OF-BAND (IF (EQ CURRENT-UCODE-VERSION UCODE-VERSION-OF-BAND) (FORMAT T "~%The new current band ~A should work properly with the ucode version that is already current." BAND) (LET ((BAND-UCODE-PARTITION (FIND-MICROCODE-PARTITION RQB UCODE-VERSION-OF-BAND))) (IF BAND-UCODE-PARTITION (IF (FQUERY NIL "~A goes with ucode ~D, which is not selected. Partition ~A claims to contain ucode ~D. Select it? " BAND UCODE-VERSION-OF-BAND BAND-UCODE-PARTITION UCODE-VERSION-OF-BAND) (ecase (get-disk-fixnum rqb 1) (1 (PUT-DISK-STRING RQB BAND-UCODE-PARTITION 6 4)) (2 (cond ((numberp unit) (set-default-microload-V2 rqb band-ucode-partition)) (t (ferror "can't set remote V2 labels"))))) (UNLESS (FQUERY FORMAT:YES-OR-NO-P-OPTIONS "~2%The machine may fail to boot if ~A is selected with the wrong microcode version. It wants ucode ~D. Currently ucode version ~D is selected. Do you know that ~A will run with this ucode? " BAND UCODE-VERSION-OF-BAND CURRENT-UCODE-VERSION BAND) (RETURN NIL))) ;; Band's desired microcode doesn't seem present. (FORMAT T "~%~A claims to go with ucode ~D, which does not appear to be present on this machine. It may or may not run with other ucode versions. Currently ucode ~D is selected." BAND UCODE-VERSION-OF-BAND CURRENT-UCODE-VERSION) (UNLESS (FQUERY FORMAT:YES-OR-NO-P-OPTIONS "~%Should I really select ~A? " BAND) (RETURN NIL)))))))) ;; Here to validate a MCR partition. (WHEN (and (= (get-disk-fixnum rqb 1) 1) (> LABEL-INDEX (- #o400 3))) (FORMAT T "~%Band ~A may not be selected since it is past the first page of the label. The bootstrap prom only looks at the first page. Sorry.") (RETURN NIL))) (WRITE-DISK-LABEL RQB UNIT) (RETURN T))))) ))