;;; -*- Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Base:10; Fonts:(COURIER HL12B) -*-
;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 19817*-1989 Texas Instruments Incorporated. All rights reserved.
;1;; * 103/25/87 * 1MRR Made changes to adapt to cpu-type in the band names.*
;1;;  03/18/87  MRR Fixed menu display during default choosing. Get slot number from unit.*
;1;;              CARVE-UP-BOOT now adds PTBL to all online disks.*
;1;;  03/05/87  MRR Made INSTALL-PRIM quit if this is an Explorer II.*
;1;;              Added VERIFY-CFG-BOOT and helper functions.*
;1;;  02/16/87 * 1MRR Made INSTALL-PRIM use a menu to ask for MCR and LOD defaults.*
;1;;  02/04/87  HW  Changed name of mcr file that gets loaded to "sys:io;prim.mcr"*
;1;;  01/30/87  MRR Original*
;;; 04.24.87 DAB Fixed verify-cfg-present-and-valid.
;;; 02-10-89 DAB Added defvar prim-DIRECTORY-name to point to where prim.mcr file is located.

(defvar prim-DIRECTORY-name "SYS:DISK-IO;" ; DAB 02-10-89
  "A string containing the directory name of where the  PRIM.MCR file is located.
  The default is \"SYS:DISK-IO;\".")

(defun INSTALL-PRIM (&optional unit)
  "2Converts a disk unit to the new boot method that uses PRIM, the download primitive.
Installs the PRIM, BOOT, and CFG1 to the default disk.*
The variable PRIM-DIRECTORY-NAME must be set to the directory containing the PRIM.MCR file. The 
default is \"SYS:DISK-IO;\"."
 (prog ()
;1; If unit is unspecified, use the default unit that is in NVRAM.*
  (unless unit
    (setq unit (nvram-default-unit)))
;1; If this is an Explorer II, tell the user and quit.*
  (When (= %cpu-ti-explorer-II (cpu-type))
    (return-from install-prim
      (format *standard-output*
	      "~%This is an Explorer II environment.  The PRIM partition is not needed."))) 
;1; If PRIM already exists, tell the user and quit.*
  (when (prim-p unit)    
      (format *standard-output*
	      "~%The PRIM partition already exists on unit ~a." unit)
      (if (y-or-n-p "~&Would you like to reinstall PRIM on unit ~a ?" unit)
	  (go copy-prim)
	  (return-from install-prim)))
  
;1; If no BOOT exists on unit then tell user and quit.*
  (unless (boot-p unit)
    (return-from install-prim
      (format *standard-output*
	      "~%We expected a BOOT partition to exist on unit ~a.
You will have to install BOOT, PRIM, and CFG1 by editing the disk label manually." unit)))
  
;1; If BOOT is too small then tell user and quit.*  
  (let ((boot
	  (car (member "BOOT"
		       (get-partition-list-of-unit unit %BT-microload %cpu-explorer)
		       :test #'string-equal
		       :key #'second))))
    (unless (and boot (<= 145  (fifth boot)))
      (return-from install-prim
	(format *standard-output*
		"~%The BOOT partition on unit ~a is too small to divide up automatically.
You will have to install BOOT, PRIM, and CFG1 by editing the disk label manually." unit)))) 
    
;1; Carve up the BOOT partition.*
  (unless (carve-up-boot unit)
    (return-from install-prim
      (format *standard-output*
	      "~%For some reason the automatic editing of the disk label on unit ~a
was unsuccessful.  You will have to install BOOT, PRIM, and CFG1 by editing
the disk label manually." unit)))

 copy-prim
  (format *standard-output*
	  "~%Installing the boot primitive partition, PRIM, on unit ~a." unit)
  
;1; Copy the primitive microcode into PRIM and BOOT.*
  (let (part-base part-size rqb
	(filename (fs:merge-pathname-defaults "prim.mcr#>" prim-DIRECTORY-name))  ; DAB 02-10-89
	partition-name-string) ;03.26.87 DAB	
    ;1this code is from the load-mcr-file definition, modified to squash the query..*
    (dolist (part '("BOOT.exp" "PRIM.exp")) ;1mrr 03.25.87*
      (unwind-protect
	(progn
	  (setq rqb (get-disk-rqb))
	  (multiple-value-setq (part-base part-size nil part nil partition-name-string)
	    (find-disk-partition part () unit () ))   ;1mrr 3.18.87 No query!* 
	  (unless (null part-base)
	    (let ((explorer-1-mode (zerop (mcr-file-cpu-type filename))))
	      (with-open-file (file filename :direction :input
				    :characters nil :byte-size 16.)
		(block done
		  (do ((buf16 (array-leader rqb %io-rq-leader-buffer))
		       (block part-base
			 (1+ block))
		       (n part-size (1- n)))
		      ((zerop n)
		       (ferror () "Failed to fit in partition"))
		    (do ((lh)
			 (rh)
			 (i 0. (+ i 2.)))
			((= i 512.)
			 (disk-write rqb unit block))
		      (if explorer-1-mode  ;Do correct byte swap
			  (setq lh (funcall file :tyi)
				rh (funcall file :tyi))
			  (setq rh (funcall file :tyi)
				lh (funcall file :tyi)))
		      (cond
			((or (null lh) (null rh))
			 (unless (zerop i)
			   (disk-write rqb unit block))	   ;Force last block if neccessary
			 (update-partition-comment partition-name-string  ;03.26.87 DAB
						   (microcode-name filename) unit)
			 (return-from done ())))
		      (setf (aref buf16 i) rh)
		      (setf (aref buf16 (1+ i)) lh))))))))
      (dispose-of-unit unit)
      (return-disk-rqb rqb))))
  
  ;1;rename BOOT comment field *
  (let* ((old-comment (partition-comment "BOOT.exp" unit)) ;03.26.87 DAB
	 (version (subseq old-comment (string-search-set " " old-comment)))
	 (comment (string-append "MENUBOOT" version)))
    (update-partition-comment "BOOT.exp" comment unit)) ;03.26.87 DAB

  (let ((cfg-name (find-cfg-band unit)))  ;returns partition-name-string
    (unless cfg-name
      (return-from install-prim
	(format *standard-output*
		"~&There is no valid configuration partition found on unit ~a. " unit)))
    (initialize-cfg-partition cfg-name unit t)
    (set-partition-property cfg-name unit :default)
    
;1; Setup the default ucode.*
    (let (mcr-choice lod-choice)
      (if (setq mcr-choice
	       (W:Menu-Choose (Generate-Partition-Menu-List
				 %BT-Microload
				 "Select the Microcode band \"~a\"" (cpu-type))
			       :label
			       '(:string "Select a MICROCODE band to be set as the system default for boot:"
					 :font fonts:hl12b)))
	  (set-cfg-boot-data cfg-name unit
			     :boot-name (Parse-partition-name (second mcr-choice)) ;1mrr 03.25.87*
			     :boot-unit (first mcr-choice)
			     :boot-slot (get-device-slot-number (first mcr-choice)))
	  (format *standard-output* "~&The setup of the configuration band was aborted.
You will have to specify a microload band in the configuration band to make it 
valid for booting.  Use SET-CURRENT-MICROLOAD."))
      
      
;1;Setup the default load environment*
      (if (setq lod-choice
		(W:Menu-Choose (Generate-Partition-Menu-List
				 %BT-load-band
				 "Select the Load band \"~a\"" (cpu-type))
			       :label
			       '(:string "Select a LOAD band to be set as the system default for boot:"
					 :font fonts:hl12b)))
	  (set-cfg-load-data cfg-name unit
			     :load-name (Parse-partition-name (second lod-choice)) ;1mrr 03.25.87* 
			     :load-unit (first lod-choice)
			     :load-slot (get-device-slot-number (first lod-choice)))
	  (format *standard-output* "~&The setup of the configuration band was aborted.
You will have to specify a load band in the configuration band to make it 
valid for booting.  Use SET-CURRENT-BAND."))))

  ;1set PRIM as default microcode in label*
  (with-rqb (rqb (read-disk-label unit))
    (set-default-microload rqb "PRIM.exp") ;1mrr 03.25.87*
    (write-disk-label rqb unit))

  (format *standard-output* "~&The boot primitive installation is completed.")
  ) ;1prog* 
  T
  )

;1-------------------------------------------------*

(defun carve-up-boot (unit)
  "1Carves up the Boot partition into three parts, BOOT, PRIM, and CFG1
You better check whether you need to do this before calling it.*"
  
  (unless (expand-and-add-ptbls-to-disks) ;1mrr 3.18.87*
    (return-from carve-up-boot nil))
  
  (with-rqb
    (rqb (read-disk-label unit))
    (let
      ((nwords    ;1words per partition*
	 (Get-disk-Fixnum rqb (+ %pt-base %PT-Size-of-Partition-Entries)))
       (nparts    ;1number of partitions*
	 (get-disk-fixnum rqb (+ %pt-base %PT-Number-of-Partitions)))
       (buf (rqb-buffer rqb))
       bstart blength ploc pname pattr)
    
      (multiple-value-setq (bstart blength ploc pname pattr)
			          (find-disk-partition "BOOT.exp" rqb unit t)) ;1mrr 03.25.87*
      ;1change length of BOOT partition*
      (Put-disk-Fixnum RQB 64 (+ ploc %PD-Length))
      
;;1add two partitions - PRIM and CFG1*
      (setq nparts (+ 2 nparts))   ;1add two partitions, see if they fit.*
      (When (> (+ (* nwords nparts) %PT-Partition-Descriptors)
	       (* (Get-disk-Fixnum rqb %DL-Partition-Table-Length) page-size))

	  (Format *standard-output* "~&The partition table is full.  You will need to 
expand the partition table or delete excess partitions.")
	  (if (and (<= (Get-disk-Fixnum rqb %DL-Partition-Table-Length) 1)
		   (y-or-n-p "~&Would you like me to expand the partition table for you ?"))
	      (unless (expand-partition-table rqb unit)
		(format *standard-output* "~&Couldn't find room to expand the partition table.")
		(return-from carve-up-boot nil))
	      (return-from carve-up-boot)))
      
      ;1move partition locator past BOOT partition so that we add the partitions after BOOT.*
      (setq ploc (+ ploc nwords))
      
      (Put-disk-Fixnum rqb nparts
		       (+ %pt-base %PT-Number-of-Partitions))
      (Let ((foo (Make-Array #o12000 ':Type 'Art-16b)))	  ;used to be 400 for 1 block partition table
        (Copy-Array-Portion buf (* ploc 2) (Array-Length buf)	;with 3 blocks lengths 12000 seems to work
                            foo (* nwords 2 2) #o12000)  ;1add room for two partitions*
        (Copy-Array-Portion foo 0 #o12000
                            buf (* ploc 2) (Array-Length buf))
        ;1; Initialize new partitions.*
        (Put-disk-String RQB "PRIM" (+ ploc %PD-Name) 4)
	(Put-disk-String RQB "CFG1" (+ ploc %PD-Name nwords) 4)
        (Put-disk-Fixnum RQB 64 (+ ploc %PD-Length))
	(Put-disk-Fixnum RQB 17 (+ ploc %PD-Length nwords))
        (Put-disk-Fixnum RQB (dpb %BT-Microload %%Band-Type-Code   ;1PRIM is ucode, Explorer-cpu*
				  (dpb %cpu-explorer %%cpu-type-code 0))
				  (+ ploc %PD-Attributes))
	(Put-disk-Fixnum RQB (dpb %BT-Configuration-Band %%Band-Type-Code  ;1CFG1 is config-band, generic.*
				  (dpb %cpu-generic-band %%cpu-type-code 0))
			 (+ ploc %PD-Attributes nwords))
        (Put-disk-Fixnum RQB (+ bstart 64) (+ ploc %PD-Start))
	(Put-disk-Fixnum RQB (+ bstart 64 64) (+ ploc %PD-Start nwords))

        (Return-Array foo))

      (write-disk-label rqb unit)
      ;1; for debugging*
      ;(print-disk-label-from-rqb *standard-output* rqb nil)
      )
   )
  T)

(defun expand-and-add-ptbls-to-disks ()
  (dolist (unit (all-disk-units))
    (with-rqb
      (rqb (read-disk-label unit))
      ;1if the partition table is only 1 block then expand it.*
      (when (<= (get-disk-fixnum rqb %DL-Partition-Table-Length) 1)
	(Format *standard-output*
		"~&The partition table on unit ~a is only 1 block.  It needs to be expanded." unit)
	(format *standard-output* "~&We will try to expand the partition table to 3 blocks for you.")
	(unless (expand-partition-table rqb unit)
	  (format *standard-output* "~&Couldn't find room to expand the partition table.")
	  (return-from expand-and-add-ptbls-to-disks  nil)))  ;12-03-87 DAB

1        *;1check for PTBL and LABL in the partition label. Add them if needed. Abort if you can't put them in.*  
      (unless (and (add-if-needed rqb "PTBL" unit) (add-if-needed rqb "LABL" unit))
	(format *standard-output* "~&PTBL or LABL not in disk label and can't be added.")
	(return-from expand-and-add-ptbls-to-disks  nil))
      (write-disk-label rqb unit)))
  t)
 
(defun add-if-needed (rqb partition-name unit)
;1For adding a PTBL or LABL if needed.*
  (multiple-value-bind (start ignore word name attributes)
      (find-disk-partition partition-name rqb unit t)
    (if start
	;1Partition was found so check the attributes, correcting if needed.*
	(selector name string-equal
	  ("PTBL" (unless (= (ldb %%band-type-code attributes) %bt-partition-table)
		    (setq attributes (dpb %bt-partition-table %%Band-Type-Code attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  (unless (= (ldb %%cpu-type-code attributes) %CPU-Generic-Band)
		    (setq attributes (dpb %CPU-Generic-Band %%cpu-type-code attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  (unless (ldb-test %%default-indicator attributes)
		    (setq attributes (dpb 1 %%default-indicator attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  )
		   
	  ("LABL" (unless (= (ldb %%band-type-code attributes) %bt-volume-label)
		    (setq attributes (dpb %bt-volume-label %%Band-Type-Code attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  (unless (= (ldb %%cpu-type-code attributes) %CPU-Generic-Band)
		    (setq attributes (dpb %CPU-Generic-Band %%cpu-type-code attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  (unless (ldb-test %%default-indicator attributes)
		    (setq attributes (dpb 1 %%default-indicator attributes))
		    (Put-disk-Fixnum rqb attributes (+ word %PD-Attributes)))
		  ))

	;1Partition not found, so add it to the partition table.*
	(let
	  ((nwords    ;1words per partition*
	     (Get-disk-Fixnum rqb (+ %pt-base %PT-Size-of-Partition-Entries)))
	   (nparts    ;1number of partitions*
	     (get-disk-fixnum rqb (+ %pt-base %PT-Number-of-Partitions)))
	   (buf (rqb-buffer rqb))
	   bstart blen btype ploc pname)
	  
	  ;1check if there is room to add a partition entry.*
	  (setq nparts (+ 1 nparts))   
	  (When (> (+ (* nwords nparts) %PT-Partition-Descriptors)
		   (* (Get-disk-Fixnum rqb %DL-Partition-Table-Length) page-size))

	    (Format *standard-output*
  "~&The partition table is full.  You will need to expand the partition table or delete excess partitions.")
	    (if (and (<= (Get-disk-Fixnum rqb %DL-Partition-Table-Length) 1)
		     (y-or-n-p "~&Would you like me to expand the partition table for you ?"))
		(unless (expand-partition-table rqb unit)
		  (format *standard-output* "~&Couldn't find room to expand the partition table.")
		  (return-from add-if-needed nil))
		(return-from add-if-needed nil)))
	  
	  ;1update the partition count*
	  (Put-disk-fixnum rqb nparts (+ %pt-base %PT-Number-of-Partitions))

	  ;1set pointer to first entry.*
	  (setq ploc (+ %pt-base %PT-Partition-Descriptors))

	  ;1get the partition specific info*
	  (selector partition-name string-equal
	    ("PTBL"
	     (setq bstart (get-disk-fixnum rqb %DL-Partition-Table-Start))
	     (setq blen (get-disk-fixnum rqb %DL-Partition-Table-Length))
	     (setq pname "PTBL")
	     (setq btype %BT-Partition-Table)
	     )
	    
	    ("LABL"
	     (setq bstart 0)
	     (setq blen 2) ;1might depend on version # or we could use *(get-disk-fixnum rqb %DL-Partition-Table-Start)1.*
	     (setq pname "LABL")
	     (setq btype %BT-Volume-label)
	     )
	    )

	  ;1make room in the rqb*
	  (Let ((foo (Make-Array #o12000 ':Type 'Art-16b)))	;1used to be #o400 for 1 block partition table*
	    (Copy-Array-Portion buf (* ploc 2) (Array-Length buf)  ;1with 3 blocks lengths 12000 seems to to work*
				foo (* nwords 2) #o12000)
	    (Copy-Array-Portion foo 0 #o12000
				buf (* ploc 2) (Array-Length buf))
	  ;1merge the new data into the rqb*
	    (add-partition-entry rqb pname :loc ploc :start bstart :length blen
				 :cpu-type %CPU-Generic-band :band-type btype
				 :properties (dpb 1 %%Delete-protected 
						  (dpb 1 %%default-indicator 0)))
	    (Return-Array foo))
	)))
  T)
  
(defun add-partition-entry (rqb name &key loc start length band-type cpu-type properties)
  "2Add an entry to the partition table in a rqb. Space for the entry must have already been made
available.  LOC is the word offset pointing into the partition table entry. Doesn't update partition count!*"
  (let (attributes)
    (Put-disk-String rqb name (+ loc %PD-Name) 4)
    (Put-disk-Fixnum rqb start (+ loc %PD-Start))
    (Put-disk-Fixnum rqb length (+ loc %PD-Length))
    (setq attributes (dpb cpu-type  %%cpu-type-code
			  (dpb band-type %%Band-Type-Code properties))) 
    (Put-disk-Fixnum rqb attributes (+ loc %PD-Attributes))
    ))


(defun expand-partition-table (rqb unit)
  "1Looks for 2an *open spot2 in the disk RQB to add expand the partition table to 3 blocks. 
Then copy the partition table to the new PTBL on UNIT. If no openings are found, return nil.**"
  (let ((gaps (find-disk-openings rqb))
	(new-size 3)
	(bstart nil)
	ploc)
    (if (and gaps
	   ;1If the first gap starts at 0, then we won't use the first 2 blocks*
	   ;1because it would be overlaping the LABL.*
	     (if (= 0 (caar gaps))
		 (if (>= (cadar gaps) (+ new-size 2))
		     (setf (caar gaps)  2  ;1set the starting pt. at 2 for safety.*
			   (cadar gaps) (- (cadar gaps) 2))	 ;1and adjust the length*
		     (setq gaps (rest gaps))	   ;1discard the first gap - it's too small*
		     gaps)
		 t)
	     gaps   ;1check again in case the only gap was the first one and it was too small.*
	     ;1find the starting block of the first gap that is > 3 blocks long.*
	     (or (dolist (gap gaps bstart)   ;prefer 3 
		   (when (and  (not (< (first gap) %DL-Partition-Table-Start (+ (first gap) (third gap))))
			       (>= (second gap) new-size))
		     (return (setq bstart (first gap)
				   ploc (third gap)))))
		 (dolist (gap gaps bstart)   ;settle for 2?  12-03-87 DAB
		   (when (and (not (< (first gap) %DL-Partition-Table-Start (+ (first gap) (third gap))))
			      (>= (second gap) (1- new-size)))
		     (return (setq bstart (first gap)
				   ploc (third gap)
				   new-size 2))))

		 )
	     )
	;1found a gap and a starting point.*	
	(Let ((foo (Make-Array #o12000 ':Type 'Art-16b))
	      (buf (rqb-buffer rqb))
	      (nwords (Get-disk-Fixnum rqb (+ %pt-base %PT-Size-of-Partition-Entries)))
	      (nparts (get-disk-fixnum rqb (+ %pt-base %PT-Number-of-Partitions))))
	   ;1delete old PTBL if it existed.*
	  (multiple-value-bind (part-base ignore ptbl-loc ignore ignore)
	      (find-disk-partition "PTBL.gen" rqb unit t)  ;1mrr 03.25.87*
	    (when part-base
	      (Put-disk-Fixnum rqb (setq nparts (Max (1- nparts) 0))
			       (+ %pt-base %PT-Number-of-Partitions))
	      (Copy-Array-Portion buf (* (+ ptbl-loc nwords) 2) (Array-Length buf) 
				  buf (* ptbl-loc 2) (Array-Length buf))
	      (when (> ploc ptbl-loc)
		(setq ploc (- ploc nwords)))
	      ))
	   ;1add new PTBL*
	  (Copy-Array-Portion buf (* ploc 2) (Array-Length buf) 
			      foo (* nwords 2) #o12000)
	  (Copy-Array-Portion foo 0 #o12000
			      buf (* ploc 2) (Array-Length buf))	      
	  (add-partition-entry rqb "PTBL" :loc ploc :start bstart :length new-size 
			       :cpu-type %cpu-generic-band :band-type %bt-partition-table
			       :properties (dpb 1 %%Delete-protected (dpb 1 %%default-indicator 0)))
	  
	   ;1update the pointer to the PTBL in the label*
	  (put-disk-fixnum rqb bstart %DL-Partition-Table-Start)
	   ;1update the partition table length*
	  (put-disk-fixnum rqb new-size %DL-Partition-Table-Length)
	1   *;1update the partition count*
	  (put-disk-fixnum rqb (1+ nparts) (+ %pt-base %PT-Number-of-Partitions))
	  ;1copy the partition info into the new ptbl.*
	  (write-disk-label rqb unit)	  
	  (Return-Array foo)
	  ;1for debugging*
	  ;(print-disk-label-from-rqb *standard-output* rqb nil)
	 
	  T) ;1signal completion*
	;1couldn't find a gap.*
 	nil)
    ))

(defun find-disk-openings (rqb)
  "1Looks for open areas on 2the *disk2 rqb*. Returns a list of lists. The inner lists contain
the start and length of the gap2s and the descriptor location in the rqb of the next partition*.*"
  (let ((parts (partition-list-from-rqb rqb))
	start (prev-end 0) gaps)
    
    (dolist (part parts (nreverse gaps))
      (setq start (second part))
      (when (> start prev-end)
	(setq gaps (cons (list prev-end (- start prev-end) (fifth part)) gaps)))
      (setq prev-end (+ start (third part)))
	    )))
      

(defun verify-cfg-boot ( )
  "2Checks the default disk label to verify that a configuration-style boot can occur.
Checks for:
  1. the presence of PRIM (for Explorer I systems) as the default microcode.
  2. a default PTBL on the default drive.
  3. a CFG partition and verifies its validity.
 Prints messages and queries to *terminal-io*.  Returns t if successful, nil if not. *"

  (let ((stream *terminal-io*))
          ;1If this is an LX*
    (cond ((= 2  si:microcode-type-code)
	   (format stream "~%This is an LX environment."))
	1   *;1If this is an Explorer I ...*
	  ((= %cpu-explorer (cpu-type))
	   (format stream "~%This is an Explorer I environment.")
	   (unless
	     (verify-prim-present-and-default stream)
	     (return-from verify-cfg-boot)))
	  ;1 Must be an Explorer II*
	  ((= %cpu-ti-explorer-II (cpu-type))
	   (format stream "~%This is an Explorer II environment."))
	  ;1 Unrecognized CPU type or error.*
	  (T  ;1otherwise*
	   (ferror nil
	     "Unrecognized CPU type code, ~a.  Can't continue the verification process." (cpu-type))))

    ;1Check for a default PTBL on the default drive.*
    (unless
      (verify-ptbl-present-and-default stream)
      (return-from verify-cfg-boot))

    ;1Check for the presence of a CFG partition.*
    (unless
      (verify-cfg-present-and-valid stream)
      (return-from verify-cfg-boot))
    ;1Success*
    (format stream
  "~%The verification was successful.  It appears that the system is prepared for a configuration style boot.")
    )
  T);1;verify-cfg-boot*


;1;Helper function*
(defun verify-prim-present-and-default (stream)
  (let ((unit (nvram-default-unit)))
    (cond
      ;1 PRIM is on the default drive.*
      ((prim-p unit)
       (format stream
   "~%The boot primitive partition, PRIM, is present on unit ~a, the default unit according to NVRAM. -- OK"
	       unit)
       )
      ;1 PRIM is not on the default drive.*
      (T ;1otherwise*
       (cond
	 ;1 Is PRIM anywhere in the system?*
	 ((prim-p)
	  (let ((prim-unit (find-prim)))
	    (cond 
	      ((y-or-n-p
     "~&The boot primitive partition, PRIM, was not found on the default unit ~a, but it was found on unit ~a.
  Should I make unit ~a the default unit in NVRAM ? " unit prim-unit prim-unit)
	       (sys:change-nvram :load-unit prim-unit)
	       (setq unit prim-unit))
	      (T ;1otherwise*
	       (return-from verify-prim-present-and-default nil
		 (format stream
   "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The boot primitive is not on the default unit as set in NVRAM."))))))
	 
	 ;1 PRIM not found anywhere.*
	 (T ;1otherwise*
	  (cond 
	    ((and 
	       (y-or-n-p
     "~&The boot primitive partition, PRIM, was not found on any disks in the system.
  Should I try to install PRIM for you ?") 
	       (install-prim unit)))
	    (T ;1otherwise*
	     (return-from verify-prim-present-and-default nil
			  (format stream 
  "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The boot primitive partition, PRIM, was not found on any disks in the system.")))))
       ))) ;1cond*
    
    ;1Ensure that PRIM is the default microcode partition*
    (if (string-equal "PRIM" (current-band-in-ptbl unit t))
	(format stream
	   "~%The boot primitive partition, PRIM, is marked as the default microcode on unit ~a. -- OK"
	      unit)
	(if
	  (y-or-n-p
    "~&The boot primitive partition, PRIM, was not marked as the default microcode partition on unit ~a.  
  Should I make PRIM the default microcode on unit ~a ? " unit unit)
	    ;1set PRIM as default microcode in label*
	  (with-rqb (rqb (read-disk-label unit))
	    (set-default-microload rqb "PRIM")
	    (write-disk-label rqb unit))
	  (return-from verify-prim-present-and-default nil
		       (format stream 
  "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The boot primitive is not set as the default microcode partition on unit ~a." unit))))
    )  ;1let*
  T)  ;1verify-prim-present-and-default* 

;;1Helper function*
(defun verify-ptbl-present-and-default (stream)
  (let ((unit (nvram-default-unit))
	start len addr name attributes)
    (multiple-value-setq (start len addr name attributes)
      (find-disk-partition "PTBL.gen" nil unit nil nil ))  ;1mrr 03.25.87*
    
    ;1PTBL not found *
    (unless start
      (cond ((y-or-n-p
	       "~&No PTBL entry was found on unit ~a.  Should I try to add one for you ?" unit)
	     (with-rqb (rqb (read-disk-label unit))
	             ;1Note: This adds PTBL as the first entry in the partition table.*
	       (cond ((add-if-needed rqb "PTBL.gen" unit) ;1mrr 03.25.87*
		      (add-if-needed rqb "LABL.gen" unit) ;1mrr 03.25.87*
		      (write-disk-label rqb unit)
		      (format stream "~%A PTBL entry was added to the disk label of unit ~a." unit)
		      (multiple-value-setq (start len addr name attributes) ;1reread PTBL to get attributes.*
			(find-disk-partition "PTBL.exp" nil unit nil nil )))	   ;1mrr 03.25.87*
		     (T
		      (return-from verify-ptbl-present-and-default nil
			(format stream
  "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: Could not add a PTBL entry to the disk label on unit ~a." unit))))))
	    (T
	     (return-from verify-ptbl-present-and-default nil
		   (format stream
    "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: There is no PTBL entry on the disk label on unit ~a." unit)))))

    (unless (and (= (ldb %%band-type-code attributes) %bt-partition-table)
		 (= (ldb %%cpu-type-code attributes) %CPU-Generic-Band)
		 (ldb-test %%default-indicator attributes))
      (return-from verify-ptbl-present-and-default nil
		   (format stream
			   "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The PTBL attributes are incorrect on the disk label on unit ~a.
  The PTBL should be set as a Generic CPU/OS type, Partition table type, with the default bit on." unit)))

    (format stream
	    "~%The partition table entry, PTBL, on unit ~a is present and marked as the default -- OK." unit)
    T))

;1;Helper function*

(defun verify-cfg-present-and-valid (stream)
  (let* ((unit (nvram-default-unit))
	 (cfg-name (default-cfg-in-ptbl unit))
	 mcr mcr-unit lod lod-unit)
    
    (unless cfg-name
      (return-from verify-cfg-present-and-valid nil
		   (format stream
			   "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: Couldn't find a valid configuration partition on unit ~a.
  The CFG partition should be set as a Generic CPU/OS type, Configuration band type, with the default bit on." unit)))
    
    (format stream
	    "~%The configuration partition, ~a, on unit ~a is present and marked as the default -- OK."
	    (parse-partition-name cfg-name) unit)  ;mrr 03.25.87
    
    (ignore-errors
      (multiple-value-setq (mcr mcr-unit)  ;04.23.87 DAB Handle module not present for (cpu-type)
	(current-microload unit :cfg-unit unit :cfg-band cfg-name)))
    (ignore-errors
      (multiple-value-setq (lod lod-unit)  ;04.23.87 DAB Handle module not present for (cpu-type)
	(current-band unit nil :cfg-unit unit :cfg-band cfg-name)))
    
    (when (and (stringp mcr-unit)
	       (string-equal #\* mcr-unit))
      (setq mcr-unit unit))
    (when (and (stringp lod-unit)
	       (string-equal #\* lod-unit))
      (setq lod-unit unit))
    
    (when (string-equal #\* lod)
      (unless (setq lod (current-band-in-ptbl lod-unit))
	(return-from verify-cfg-present-and-valid nil
		     (format stream
			     "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The Load name entry in the configuration band is set as wild, but there is no Load band 
  with a default bit set in the label on unit ~a.  You should either use SYS:SET-CURRENT-BAND to change the
  Load name entry in the CFG band ~a, or turn on the default bit on a load band in the label on unit ~a."

			     unit (Parse-partition-name cfg-name) unit)))) ;mrr 03.25.87
    
					   ;Check whether the mcr and lod bands exist.
    (unless
      (and mcr ;04.24.87 DAB Make sure mcr is not nil
	   (find-disk-partition mcr nil mcr-unit nil nil)) ;04.24.87 DAB 
      (return-from verify-cfg-present-and-valid nil
		   (format stream
			   "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The microcode partition, ~a, on unit ~a referenced by the configuration partition,
  ~a on unit ~a was not found.  You should use SYS:SET-CURRENT-MICROLOAD to set a new default microload."
			   mcr mcr-unit (Parse-partition-name cfg-name) unit)))	   ;mrr 03.25.87
    (format stream
	    "~%The MCR band, ~a, on unit ~a, described in configuration partition, ~a, on unit ~a is present. -- OK."
	    mcr mcr-unit (Parse-partition-name cfg-name) unit)	   ;mrr 03.25.87
    
    (unless
      (and lod      ;04.24.87 DAB Make sure lod is not nil
	   (find-disk-partition lod nil lod-unit nil nil))
      (return-from verify-cfg-present-and-valid nil
		   (format stream
			   "~%The verification failed.  The system is not ready to boot using the configuration partition. 
Reason for failure: The load partition, ~a, on unit ~a referenced by the configuration partition, ~a 
  on unit ~a was not found.  You should use SYS:SET-CURRENT-BAND to set a new default load band."
			   lod lod-unit (Parse-partition-name cfg-name) unit)))	   ;mrr 03.25.87
    (format stream
	    "~%The LOD band, ~a, on unit ~a, described in configuration partition, ~a, on unit ~a is present. -- OK."
	    lod lod-unit (Parse-partition-name cfg-name) unit)	   ;mrr 03.25.87
    
    T))