LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760030594. :SYSTEM-TYPE :LOGICAL :VERSION 13. :TYPE "LISP" :NAME "VBAT" :DIRECTORY ("REL3-SOURCE" "FILE") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758308024. :AUTHOR "REL3" :LENGTH-IN-BYTES 13007. :LENGTH-IN-BLOCKS 13. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;;; -*- Mode:COMMON-LISP; Package:FILE-SYSTEM; cold-load:t; Base:10. -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(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) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;;  This section contains code to implement the multiple file system partition;;;  capability. The vbat is created here as well as all the code which ;;;  manipulates it. The interface to this code will come through the;;;  fs:lm-disk-read and fs:lm-disk-write as well as boot-file-system and;;;  initialize-file-system code. If you try to boot a version 4 file system,;;;  we create a "fake" vbat to use for version 5 io system.;;;  By the way, vbat stands for virtual block address table.;;;;;; 1-29-84 DAB Select-file-band. Make sure MENU-CHOOSE is loaded before using.(DEFPARAMETER *MAX-PARTITIONS* 32.)  (DEFPARAMETER *VBAT-LEADER-ENTRIES* 0.)  (DEFPARAMETER SINGLE-PARTITION-VERSION 4. "file partition version which has only 1 partition.")  (DEFUN SET-VBAT-ENTRY (ENTRY UNIT START LENGTH PART-NAME VBAT)  "This will add an entry to the vbat table and compute the virtual partition length"  (COND    ((AND (NUMBERP ENTRY) (< ENTRY (ARRAY-TOTAL-SIZE VBAT)))     (SETF (AREF VBAT ENTRY 0.) UNIT)     (SETF (AREF VBAT ENTRY 1.) START)     (SETF (AREF VBAT ENTRY 2.) LENGTH)     (IF (= ENTRY 0.)       (SETF (AREF VBAT ENTRY 3.) LENGTH)       (SETF (AREF VBAT ENTRY 3.) (+ (AREF VBAT (- ENTRY 1.) 3.) LENGTH)))     (SETF (AREF VBAT ENTRY 4.) PART-NAME))    (T NIL)))  (DEFUN VBAT-GET-1-ENTRY (VBAT INDEX)  "Returns the unit, starting address, length of partition, and partition name  for specified index"  (VALUES (AREF VBAT INDEX 0.) (AREF VBAT INDEX 1.) (AREF VBAT INDEX 2.) (AREF VBAT INDEX 4.)))  (DEFUN VBAT-N-ENTRIES (VBAT)  "Returns the number of entries in the vbat"  (ARRAY-LEADER VBAT *VBAT-LEADER-ENTRIES*))  (DEFUN ADD-VBAT-ENTRY (UNIT START LENGTH PART-NAME VBAT)  "Will add next available entry to the vbat table"  (IF (SET-VBAT-ENTRY (ARRAY-LEADER VBAT *VBAT-LEADER-ENTRIES*) UNIT START LENGTH PART-NAME VBAT)    (STORE-ARRAY-LEADER (+ 1. (VBAT-N-ENTRIES VBAT)) VBAT *VBAT-LEADER-ENTRIES*)))  (DEFUN MAKE-VBAT (ENTRIES)  "Makes the vbat and initializes entries to invalid."  (IF (<= ENTRIES *MAX-PARTITIONS*)      (MAKE-ARRAY `(,ENTRIES 5.) :ELEMENT-TYPE T :INITIAL-element 0.:LEADER-LENGTH 2. :LEADER-LIST '(0. 0.))))  (DEFUN RETURN-MAX-SIZE (VBAT)  "This will return the maximum size of the file partition"  (IF (= 0. (VBAT-N-ENTRIES VBAT))    0.    (AREF VBAT (- (VBAT-N-ENTRIES VBAT) 1.) 3.)))  (DEFUN VBAT-READ (STREAM)  "Reads the vbat from the configuration stream. The vbat on disk has the unit number, the   length of the partition and the partition name for each separate partition."  (DECLARE)  (BLOCK ()    (RETURN     (LET ((N-ENTRIES (GET-BYTES STREAM 2.)))       (IF (= N-ENTRIES 1.) (PROGN   (SETF (DC-VERSION) SINGLE-PARTITION-VERSION)   (RETURN (FAKE-VBAT `(,LM-UNIT ,LM-PARTITION)))) (LET ((VBAT (MAKE-VBAT N-ENTRIES)))   (DOTIMES (I N-ENTRIES)     (LET* ((UNIT (GET-BYTES STREAM 3.))    (LENGTH (GET-BYTES STREAM 3.))    (PART-NAME (GET-STRING STREAM))    (STARTING (FIND-DISK-PARTITION PART-NAME () UNIT)))       (WHEN (NULL STARTING) (NOTIFY  (FORMAT () "Could not find partition ~s on unit ~d. Aborting." PART-NAME UNIT)) (THROW 'BOOT-FILE-SYSTEM()))       (ADD-VBAT-ENTRY UNIT STARTING LENGTH PART-NAME VBAT)))   (RETURN VBAT)))))))      (DEFUN VBAT-WRITE (STREAM VBAT)  "Write the vbat to the configuration stream. This vbat differs from the in memory vbat   in that it will not have the starting address of the partitions, only their names."  (LET ((N-ENTRIES (VBAT-N-ENTRIES VBAT)))    (PUT-BYTES STREAM 2. N-ENTRIES)    (DOTIMES (I N-ENTRIES)      (MULTIPLE-VALUE-BIND (UNIT IGNORE LENGTH PART-NAME)(VBAT-GET-1-ENTRY VBAT I)(PUT-BYTES STREAM 3. UNIT);save unit number(PUT-BYTES STREAM 3. LENGTH);save partition length(PUT-STRING PART-NAME STREAM))));save partition name  VBAT)  (DEFUN DECODE-ADDRESS (ADDR VBAT)  "Returns the device unit and block address from addr"  (DO ((I 0. (+ I 1.)))      ((>= I (ARRAY-LEADER VBAT *VBAT-LEADER-ENTRIES*))       (FERROR :RETRY-DISK-OPERATION () 'DISK-ERROR "Fatal error on vbat lookup - address ~0."       ADDR))    (IF (> (AREF VBAT I 3.) ADDR)      (RETURN       (VALUES (AREF VBAT I 0.)       (+ (AREF VBAT I 1.) (- ADDR (- (AREF VBAT I 3.) (AREF VBAT I 2.))))       (- (AREF VBAT I 3.) ADDR))))))  (DEFUN SELECT-FILE-BAND ()  (LET ((FILE-BAND  (when (find-symbol "MENU-CHOOSE"  'W)    (funcall (symbol-function       (find-symbol "MENU-CHOOSE" 'W))     (SI::GENERATE-PARTITION-MENU-LIST %BT-FILE-BAND "Select file partition \"~a\"")     :label '(:STRING "Select the file band:" :FONT FONTS:METSI)))))    (VALUES FILE-BAND)))  (DEFUN QUERY-USER-FOR-PARTITIONS (&OPTIONAL (P-LIST (QUOTE NIL)))  "Get a list of partitions from the user that represent the partitions of the file band."  (LET ((PART-LIST (REVERSE P-LIST)))    (SEND *TERMINAL-IO* :CLEAR-SCREEN)    (FORMAT *TERMINAL-IO* "~% Please choose one or more of the possible file partitions")    (FORMAT *TERMINAL-IO* "~% Partition list: ~A" (REVERSE PART-LIST))    (LOOP     (LET* ((USER-CHOSEN-PARTITION (SELECT-FILE-BAND))    (UNIT (FIRST USER-CHOSEN-PARTITION))    (PARTITION (SECOND USER-CHOSEN-PARTITION)))       (SEND *TERMINAL-IO* :CLEAR-SCREEN)       (WHEN USER-CHOSEN-PARTITION (IF (MEMBER (LIST UNIT PARTITION) PART-LIST :TEST #'EQUALP)   (FORMAT *TERMINAL-IO* "~% Partition ~A already in list." PARTITION)   (SETQ PART-LIST (CONS (LIST UNIT PARTITION) PART-LIST)))))     (FORMAT *TERMINAL-IO* "~% Partition list: ~A" (REVERSE PART-LIST))     (IF (NOT (Y-OR-N-P "~% Would you like to add another partition? "))       (RETURN (REVERSE PART-LIST)))     (SEND *TERMINAL-IO* :CLEAR-SCREEN)     (FORMAT *TERMINAL-IO* "~% Partition list: ~A" (REVERSE PART-LIST)))    (REVERSE PART-LIST)))  (DEFUN MAKE-VBAT-FROM-LIST (PART-LIST)  "Used during the boot and initialize sequence to create the dc-vbat"  (LET ((VBAT (MAKE-VBAT *MAX-PARTITIONS*)))    (DOLIST (POSS PART-LIST)  ;part-list format is ((unit partition-name) (unit partition-name) ...)      (LET ((UNIT (FIRST POSS)) ;this will handle logical file bands    (PARTITION-NAME (SECOND POSS)))(MULTIPLE-VALUE-BIND (STARTING-BLOCK LENGTH)  (FIND-DISK-PARTITION PARTITION-NAME () UNIT)  ;find the file partition on disk  (ADD-VBAT-ENTRY UNIT STARTING-BLOCK LENGTH PARTITION-NAME VBAT))))    VBAT))  (DEFUN MAKE-LIST-FROM-VBAT (VBAT)  "Creates a list of unit and partition name pairs from unit id and start address in vbat"  (LET ((PART-LIST (QUOTE NIL)))    (DOTIMES (INDEX (VBAT-N-ENTRIES VBAT) PART-LIST)      (MULTIPLE-VALUE-BIND (UNIT IGNORE IGNORE PART-NAME)(VBAT-GET-1-ENTRY VBAT INDEX)(SETQ PART-LIST (CONS (LIST UNIT PART-NAME) PART-LIST))))    (REVERSE PART-LIST)))  ;; Following should go into dledit(DEFUN PARTITION-NAME-FROM-BASE (UNIT BASE-ADR)  "Returns the name of a partition given unit id and base address. Returns nil if not found"  (LET ((PART-LIST (SI::PARTITION-LIST () UNIT ())))    (DOLIST (ENTRY PART-LIST NIL)      (IF (= BASE-ADR (SECOND ENTRY))(RETURN (FIRST ENTRY))))))   (DEFUN PSIZE-FROM-PARTITION-LIST (PART-LIST &AUX STARTING-BLOCK LENGTH (TOTAL-SIZE 0.))  "To determine the actual size of the file partition using all entries on the partition-list"  (DOLIST (POSS PART-LIST)    (LET ((UNIT (FIRST POSS))  (PARTITION-NAME (SECOND POSS)))      (MULTIPLE-VALUE-SETQ (STARTING-BLOCK LENGTH)(FIND-DISK-PARTITION PARTITION-NAME () UNIT))      (SETQ TOTAL-SIZE (+ TOTAL-SIZE LENGTH))))  TOTAL-SIZE)  (DEFUN VALIDATE-VBAT (VBAT)  "Validate total length for file partition from info in disk label.   Returns t if they are equal, nil if they are not equal."  (EQ (PSIZE-FROM-PARTITION-LIST (MAKE-LIST-FROM-VBAT VBAT)) (RETURN-MAX-SIZE VBAT)))  (DEFUN CHECK-LAST-ENTRY (VBAT)  "Check if the last entry in the vbat has been expanded. If so, update the vbat."  (LET* ((ENTRY (CAR (LAST (MAKE-LIST-FROM-VBAT VBAT))));get length of final partition (UNIT (FIRST ENTRY)) (PARTITION-NAME (SECOND ENTRY)) (LAST-ENTRY (- (VBAT-N-ENTRIES VBAT) 1.)))    (MULTIPLE-VALUE-BIND (STARTING-BLOCK LENGTH)      (FIND-DISK-PARTITION PARTITION-NAME () UNIT)      (MULTIPLE-VALUE-BIND (UNIT IGNORE OLD-LENGTH)(VBAT-GET-1-ENTRY VBAT LAST-ENTRY)(IF (> LENGTH OLD-LENGTH);if length has increased, modify vbat  (SET-VBAT-ENTRY LAST-ENTRY UNIT STARTING-BLOCK LENGTH PARTITION-NAME VBAT)  ())))))             ;; if length not changed, return nil.(DEFUN COMMENT-FILE-PARTITIONS (PART-LIST)  "Updates the names for each partition in the partition list."  (LET ((REST (CDR PART-LIST))(PARTITION-NUMBER 0.))    (UPDATE-PARTITION-COMMENT (SECOND (CAR PART-LIST)) "LM File System" (FIRST (CAR PART-LIST)))    (SI::SET-PARTITION-ATTRIBUTE (SECOND (CAR PART-LIST)) (FIRST (CAR PART-LIST)) :FILE-BAND)    (SI::SET-PARTITION-PROPERTY (SECOND (CAR PART-LIST)) (FIRST (CAR PART-LIST)) :DEFAULT)    (DOLIST (POSS REST)      (LET ((UNIT (FIRST POSS))    (PARTITION-NAME (SECOND POSS)))(SETQ PARTITION-NUMBER (+ 1. PARTITION-NUMBER))(SI::SET-PARTITION-ATTRIBUTE PARTITION-NAME UNIT :FILE-BAND)(SI::SET-PARTITION-PROPERTY PARTITION-NAME UNIT :LOGICAL-PARTITION)(UPDATE-PARTITION-COMMENT PARTITION-NAME (FORMAT () "File Ext. ~D" PARTITION-NUMBER)  UNIT)))))  (DEFUN FAKE-VBAT (UNIT-PART-LIST)  "makes a bogus vbat which allows us to read the configuration area in the file partition"  (SETF (DC-VBAT) (MAKE-VBAT 1.))  (LET ((UNIT (FIRST UNIT-PART-LIST))(PART (SECOND UNIT-PART-LIST)))    (MULTIPLE-VALUE-BIND (STARTING-BLOCK LENGTH)      (FIND-DISK-PARTITION PART () UNIT)      (ADD-VBAT-ENTRY UNIT STARTING-BLOCK LENGTH PART (DC-VBAT))))  (DC-VBAT))  (DEFUN PRINT-BOOT-SEQUENCE (VBAT)  "print vbat information during boot"  (LET ((PAR-LIST (MAKE-LIST-FROM-VBAT VBAT)))    (FORMAT T "~&File system boot sequence: unit: ~d, partition: ~a" (CAAR PAR-LIST)    (CADAR PAR-LIST))    (IF (> (VBAT-N-ENTRIES VBAT) 1.)      (DOLIST (I (CDR PAR-LIST) NIL)(FORMAT T "~% ~26t unit: ~d, partition: ~a" (CAR I) (CADR I))))))  (DEFUN PRINT-VBAT (VBAT &OPTIONAL (START 0.))  "lists the vbat entries in the file system partition vbat"  (FORMAT T "~% number of entries: ~d" (VBAT-N-ENTRIES VBAT))  (DO ((I START (+ 1. I)))      ((>= I (ARRAY-LEADER VBAT *VBAT-LEADER-ENTRIES*)))    (FORMAT T "~% unit: ~o, start address: ~d, length: ~d, total length: ~d partition-name: ~a"    (AREF VBAT I 0.) (AREF VBAT I 1.) (AREF VBAT I 2.) (AREF VBAT I 3.) (AREF VBAT I 4.))))  ;; These are the only interface to the disk in the file system, with the exception;; of FIND-DISK-PARTITION and UPDATE-PARTITION-COMMENT.;; The unit and block offset are provided by the Virtual Block Address table.(DEFUN LM-DISK-READ (RQB ADDR &OPTIONAL (NPAGES (RQB-NPAGES RQB)) &AUX UNIT FINAL-ADDRESS BLOCKS-TILL-END)  "Interface to the IO system for file system reads. Multiple partition maps   are handled by the vbat initialized at file system boot-time.    Beware of requests that will span two (or more) partitions on old style disks."  (COND    ((< ADDR (RETURN-MAX-SIZE (DC-VBAT)))     (DO ((BLOCKS-LEFT NPAGES (- BLOCKS-LEFT LENGTH))  (LENGTH 0.)  (OFFSET 0. (+ OFFSET LENGTH))) ((<= BLOCKS-LEFT 0.))       (MULTIPLE-VALUE-SETQ (UNIT FINAL-ADDRESS BLOCKS-TILL-END) (DECODE-ADDRESS (+ ADDR OFFSET) (DC-VBAT)))       (SETQ LENGTH (IF (< BLOCKS-LEFT BLOCKS-TILL-END)      BLOCKS-LEFT      BLOCKS-TILL-END))       (DISK-READ RQB UNIT FINAL-ADDRESS LENGTH T OFFSET)))    (T (FERROR () "Disk Read out of range."))))    (DEFUN LM-DISK-WRITE (RQB ADDR &OPTIONAL (NPAGES (RQB-NPAGES RQB)) &AUX UNIT FINAL-ADDRESS BLOCKS-TILL-END)  "Interface to the IO system for file system writes. DC-VBAT contains the mappinng   information for multiple partition file system."  (COND    ((< ADDR (RETURN-MAX-SIZE (DC-VBAT)))     (DO ((BLOCKS-LEFT NPAGES (- BLOCKS-LEFT LENGTH))  (LENGTH 0.)  (OFFSET 0. (+ OFFSET LENGTH))) ((<= BLOCKS-LEFT 0.))       (MULTIPLE-VALUE-SETQ (UNIT FINAL-ADDRESS BLOCKS-TILL-END) (DECODE-ADDRESS (+ ADDR OFFSET) (DC-VBAT)))       (SETQ LENGTH (IF (< BLOCKS-LEFT BLOCKS-TILL-END)      BLOCKS-LEFT      BLOCKS-TILL-END))       (DISK-WRITE RQB UNIT FINAL-ADDRESS LENGTH T OFFSET)))    (T (FERROR () "Disk Write out of range."))))   (send self :open medium pathname `(:error ,error-p :direction nil)))    (if (errorp stream)stream(send stream :truename)))) (compile-flavor-methods local-file)W-SPACE NIL)(loc NIL)(ALLOCATED-NEW-PAGES NIL)(initial-map-block-length (map-nblocks map)))    (loop      (if (setq pointer