;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for CDI version 1.2 ;;; Reason: ;;; Add code to set the default load or mcr band. ;;; Written 14-May-86 14:33:38 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 14:33:47 #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 set-local-band-p set-local-microload-p) "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) (setq set-local-microload-p 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))))) )) ; From modified buffer EXP-DLEDIT.LISP#> PTM; DJ: at 14-May-86 14:35:39 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "DJ: PTM; EXP-DLEDIT.#" ;;; Disk label definitions. (DefConst %DL-Base 0.) (DefConst %DL-Version 1.) (DefConst %DL-Storage-Type 4.) (DefConst %DL-Device-Name 5.) (DefConst %DL-Addressing-Info 8.) (DefConst %DL-Volume-Name 12.) (DefConst %DL-Current-Band 16.) (DefConst %DL-Current-Microload 17.) (DefConst %DL-Partition-Table-Name 20.) (DefConst %DL-Partition-Table-Start 21.) (DefConst %DL-Partition-Table-Length 22.) (DefConst %DL-Save-Area-Name 28.) (DefConst %DL-Save-Area-Start 29.) (DefConst %DL-Save-Area-Length 30.) (DefConst %DL-Comment 64.) (DefConst %%DL-Type-Code 0003) (DefConst %TC-Disk 0) (DefConst %TC-Tape 1) (DefConst %%DL-Media 0301) (DefConst %Media-Removable 0) (DefConst %Media-Fixed 1) (DefConst %%DL-Address 0401) (DefConst %Address-Physical 0) (DefConst %Address-Logical 1) (DefConst %Bytes-per 8.) (DefConst %%Bytes-per-Block 0020) (DefConst %%Bytes-per-Sector 2020) (DefConst %Sector-Heads 9.) (DefConst %%Sectors-per-Track 2010) (DefConst %%Number-of-Heads 3010) (DefConst %Cylinders 10.) (DefConst %%Number-of-Cylinders 0020) (DefConst %%Number-of-Sectors-for-Defects 2020) (DefConst %PT-Base 256.) (DefConst %PT-Version 1.) (DefConst %PT-Number-of-Partitions 2.) (DefConst %PT-Size-of-Partition-Entries 3.) (DefConst %PT-Comment-Unknown 4.) (DefConst %PT-Info 5.) (DefConst %PT-Partition-Descriptors 16.) (DefConst %PT-Partition-table-overhead-size 16.) (DefConst %PD-Name 0.) (DefConst %PD-Start 1.) (DefConst %PD-Length 2.) (DefConst %PD-Attributes 3.) (DefConst %%Band-Type-Code 0010) (DefConst %BT-Load-Band 0.) (DefConst %BT-Microload 1.) (DefConst %BT-Page-Band 2.) (DefConst %BT-File-Band 3.) (DefConst %BT-Meter-Band 4.) (DefConst %BT-Test-Zone 5.) (DefConst %BT-Format-Parameter 6.) (DefConst %BT-Volume-label 7.) (DefConst %BT-Save-Area 8.) (DefConst %BT-Partition-Table 9.) (DefConst %BT-Configuration-Band 10.) (DefConst %BT-Log-Band 11.) (DefConst %BT-Empty-Band #xFF) (DefConst %%CPU-type-code 1020) (DefConst %CPU-chaparral #x+0000) (DefConst %CPU-NuMachine-68010 #x+0001) (DefConst %CPU-NuMachine-68020 #x+0002) (DefConst %CPU-TI-Lisp #x+FC00) (DefConst %CPU-Generic-Band #x+FFFF) (DefConst %%Expandable #o3701) (DefConst %%Contractable #o3601) (DefConst %%Delete-protected #o3501) (DefConst %%Logical-partition #o3401) (DefConst %%Copy-protected #o3301) (DefConst %%Default-indicator #o3201) (DefConst %%Diagnostic-indicator #o3101) (DefConst %PD-Comment 4.) (defun set-default-microload-V2 (rqb band) "Sets the default microload partition. This function will search the partition table for the specified band and if it finds it, will set the default bit. It will then go and reset the default bit in other microcode bands that may be set." ;too much work! (PUT-DISK-STRING RQB BAND %DL-CURRENT-MICROLOAD 4) (multiple-value-bind (ignore ignore label-loc ignore) (find-disk-partition band rqb nil t) (when (and label-loc (= (ldb %%band-type-code (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) %BT-Microload) (= (ldb %%CPU-type-code (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) %CPU-chaparral)) (Put-disk-Fixnum rqb (dpb 1. %%default-indicator (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) (+ label-loc %PD-Attributes)) ;; ;; Now, go through the rest of the partitions looking for microload bands that are of this ;; processor type and reset their (possibly) turned on default bit. ;; (loop for index from (+ %pt-base %pt-partition-descriptors) to (+ %pt-base %pt-partition-descriptors (* (get-disk-fixnum rqb (+ %pt-base %pt-number-of-partitions)) (get-disk-fixnum rqb (+ %pt-base %pt-size-of-partition-entries)))) by (get-disk-fixnum rqb (+ %pt-base %pt-size-of-partition-entries)) do (if (and (not (= index label-loc)) (= (ldb %%Band-type-code (get-disk-fixnum rqb (+ index %PD-attributes))) %BT-microload) (= (ldb %%CPU-type-code (get-disk-fixnum rqb (+ index %PD-attributes))) %CPU-chaparral)) (put-disk-fixnum rqb (dpb 0. %%Default-indicator (get-disk-fixnum rqb (+ index %PD-attributes))) (+ index %PD-attributes)))) band) )) (defun set-default-load-band-V2 (rqb band) "Sets the default loadband. This function will search the partition table for the specified band and if it finds it, will set the default bit. It will then go and reset the default bit in other load bands that may be set." (PUT-DISK-STRING RQB BAND %DL-CURRENT-BAND 4) (multiple-value-bind (ignore ignore label-loc ignore) (find-disk-partition band rqb nil t) (when (and label-loc (= (ldb %%band-type-code (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) %BT-load-band) (= (ldb %%CPU-type-code (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) %CPU-chaparral)) (Put-disk-Fixnum rqb (dpb 1. %%default-indicator (get-disk-fixnum rqb (+ label-loc %PD-Attributes))) (+ label-loc %PD-Attributes)) ;; ;; Now, go through the rest of the partitions looking for load bands that are of this ;; processor type and reset their (possibly) turned on default bit. ;; (loop for index from (+ %pt-base %pt-partition-descriptors) to (+ %pt-base %pt-partition-descriptors (* (get-disk-fixnum rqb (+ %pt-base %pt-number-of-partitions)) (get-disk-fixnum rqb (+ %pt-base %pt-size-of-partition-entries)))) by (get-disk-fixnum rqb (+ %pt-base %pt-size-of-partition-entries)) do (if (and (not (= index label-loc)) (= (ldb %%Band-type-code (get-disk-fixnum rqb (+ index %PD-attributes))) %BT-load-band) (= (ldb %%CPU-type-code (get-disk-fixnum rqb (+ index %PD-attributes))) %CPU-chaparral)) (put-disk-fixnum rqb (dpb 0. %%Default-indicator (get-disk-fixnum rqb (+ index %PD-attributes))) (+ index %PD-attributes)))) band) ;return name as successful completion. )) ))