LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031845. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "DISK-RQB-RESOURCE" :DIRECTORY ("REL3-SOURCE" "PATHNAME") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758741751. :AUTHOR "REL3" :LENGTH-IN-BYTES 16912. :LENGTH-IN-BLOCKS 17. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;;; -*- Mode:Common-Lisp; Package:SI; Base:8.; Cold-Load: T -*-;;;                           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) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;; Edit History;;;                   Patch;;;   Date    Author  Number   Description;;;------------------------------------------------------------------------------;;; 01-31-86   ab       --     Common Lisp conversion for VM2.;;; 10-15-86   ab       --     Changes for 2K page-size. (DEFVAR *IN-USE-RQBS-LIST* ()) ;busy rqbs stored here temporarily ;;; Area containing wirable buffers and RQBs(DEFVAR DISK-BUFFER-AREA (MAKE-AREA :NAME 'DISK-BUFFER-AREA :GC :STATIC :REGION-SIZE 524288.)   "Area containing disk RQBs.") ;; Internally, RQBs are resources.(DEFRESOURCE RQB (N-BLOCKS LEADER-LENGTH) :CONSTRUCTOR MAKE-DISK-RQB :FREE-LIST-SIZE 50.) (DEFUN GET-DISK-RQB (&OPTIONAL (N-BLOCKS 1.) (LEADER-LENGTH (LENGTH DISK-RQ-LEADER-QS)))  "Return an RQB of data length N-BLOCKS and leader length LEADER-LENGTH.The leader length is specified only for weird hacks.Use RETURN-DISK-RQB to release the RQB for re-use."  (DOLIST (AN-RQB *IN-USE-RQBS-LIST*)    (WHEN (%IO-DONE AN-RQB)      (RETURN-DISK-RQB AN-RQB);rqb can be returned to resource      (SETF *IN-USE-RQBS-LIST*    (DELETE AN-RQB (THE LIST *IN-USE-RQBS-LIST*) :TEST #'EQ :COUNT 1.))))  (LET* ((DEFAULT-CONS-AREA WORKING-STORAGE-AREA) (RQB (ALLOCATE-RESOURCE 'RQB N-BLOCKS LEADER-LENGTH)))    (SETF (AREF RQB %IO-RQ-INFORMATION)  (DPB 1. %%IO-RQ-DONE (AREF RQB %IO-RQ-INFORMATION)))    RQB));; Return a buffer to the free list(DEFUN RETURN-DISK-RQB (RQB)  "Release RQB for reuse.  Returns NIL."  (WHEN (NOT (NULL RQB));allow NIL's to be handed to the function just in case    (IF (%IO-DONE RQB);it is safe to return the rqb to the resource      (PROGN(UNWIRE-DISK-RQB RQB)(clear-rqb-command-block rqb)(DEALLOCATE-RESOURCE 'RQB RQB))      (PUSH RQB *IN-USE-RQBS-LIST*)));rqb still in use, queue it for later return  ())(DEFUN COUNT-FREE-RQBS (N-BLOCKS)  "Return the number of free RQBs there are whose data length is N-BLOCKS."  (WITHOUT-INTERRUPTS   (LOOP WITH RESOURCE = (GET 'RQB 'DEFRESOURCE) WITH N-OBJECTS = (RESOURCE-N-OBJECTS RESOURCE) FOR I FROM 0. BELOW N-OBJECTS COUNT (= (CAR (RESOURCE-PARAMETERS RESOURCE I)) N-BLOCKS))))(DEFUN rqb-scatter-table-size (rqb)  "Returns the number of 2-word entries in RQB's scatter table."  (FLOOR     (%POINTER-DIFFERENCE      (%POINTER-PLUS (LOGAND (%POINTER rqb) (- page-size)) Page-Size)      (%POINTER-PLUS rqb (+ 1 (%P-LDB-OFFSET %%Array-Long-Length-Flag rqb 0)    %IO-Rq-Parameter-List-Word)))    2))(DEFUN clear-rqb-command-block (rqb)  "Clears the RQB command block, including the scatter list."  (SETF (rq-link rqb) 0)  (SETF (rq-information rqb) 0)  (SETF (rq-command rqb) 0)  (SETF (rq-status rqb) 0)  (SETF (rq-buffer rqb) 0)  (SETF (rq-transfer-length rqb) 0)  (SETF (rq-device-address rqb) 0)  (SETF (rq-event-address rqb) 0)  (DOTIMES (entry (rqb-scatter-table-size rqb))    (SETF (rq-scatter-entry-address rqb entry) 0)    (SETF (rq-scatter-entry-bytes rqb entry) 0))  )(DEFUN print-rqb (rqb &optional (print-base 16.) (stream *standard-output*))  "Prints information about RQB's contents."  (LET ((*read-base* print-base)(*print-base* print-base))    (FORMAT stream "~2%RQB ~a at #x+~16r~                    ~2%Leader N Half Words:   ~25t~a~                     ~%Leader N Blocks:       ~25t~a~                     ~%Leader Buffer:         ~25t~a~                     ~%Leader 8-Bit-Buffer:   ~25t~a~                     ~%Leader N Blocks Wired: ~25t~a~                    ~2%Link:                  ~25t~a~                     ~%Information:           ~25t~a~                     ~%Command:               ~25t~a~                     ~%Status:                ~25t~a~                     ~%Buffer:                ~25t~a~                     ~%Transfer Length:       ~25t~a~                     ~%Device Address:        ~25t~a~                     ~%Event Address:         ~25t~a"    rqb (%physical-address rqb)    (rqb-n-half-words rqb) (rqb-n-blocks rqb) (rqb-buffer rqb)    (IF (STRINGP (rqb-8-bit-buffer rqb)) "a string" "not a string")    (rqb-n-blocks-wired rqb)    (rq-link rqb) (rq-information rqb) (rq-command rqb)    (rq-status rqb) (rq-buffer rqb) (rq-transfer-length rqb)    (rq-device-address rqb) (rq-event-address rqb))    (FORMAT stream "~%Parameter List:")    (IF (ZEROP (rq-scatter-entry-bytes rqb 0))(FORMAT stream "~25tEmpty")(DOTIMES (entry (rqb-scatter-table-size rqb))  (IF (ZEROP (rq-scatter-entry-bytes rqb entry))      (RETURN)      (FORMAT stream "~%  Entry ~3,,:d ~25tAddress: ~11,,a  Length: ~11,,a"      entry      (rq-scatter-entry-address rqb entry)      (rq-scatter-entry-bytes rqb entry)))  ))    (VALUES)  ))(DEFUN print-all-rqbs ()  (MAP-RESOURCE #'(lambda (rqb in-use ignore)    (FORMAT t "~%--------------------------~%")    (FORMAT t "~%RQB in use: ~a" in-use)    (print-rqb rqb))'rqb)  ) ;;;;;; the constructor function for the RQB resource;;;;;              RQB Data Structures;;             ---------------------;;Page 0 of "Extended RQB" (all parts that are wired down during disk i/o);;Word #;;       +----------------------------------------------+  ----;;  0    |      RQB Buffer array Header                 |;;       +----------------------------------------------+   RQB Buffer array overhead ;;  1    |           (Ptr to start of data array)       |     (RQB Buffer is 16-b ;;       +----------------------------------------------+      displaced-index-offset array;;  2    |           (Data buffer length in Qs)         |      overlaying actual data;;       +----------------------------------------------+      area of RQB);;  3    |           (Indirect offset)                  |;;       +----------------------------------------------+  ----;;  4    |      RQB 8-bit Buffer array Header           |;;       +----------------------------------------------+   RQB 8-bit Buffer array overhead;;  5    |           (Ptr to start of data array)       |     (RQB 8-bit Buffer is STRING;;       +----------------------------------------------+      displaced-index-offset array;;  6    |           (Data buffer length in Qs)         |      overlaying actual data;;       +----------------------------------------------+      area of RQB);;  7    |           (Indirect offset)                  |      ;;       +----------------------------------------------+  ----;;  8    |      Array-Leader Header                     |  Actual RQB array leader;;       +----------------------------------------------+;;  9    |        %IO-RQ-Leader-N-Pages-Wired           |  Leader-4  Number of wired data pages;;       +----------------------------------------------+;; 10    |        %IO-RQ-Leader-8-Bit-Buffer            |  Leader-3  Array pointer (to RQB 8-bit buffer header);;       +----------------------------------------------+;; 11    |        %IO-RQ-Leader-Buffer                  |  Leader-2  Array pointer (to RQB Buffer header)    ;;       +----------------------------------------------+;; 12    |        %IO-RQ-Leader-N-Blocks                |  Leader-1  Length of data area in disk blocks + 2 (cmd area)        ;;       +----------------------------------------------+;; 13    |        %IO-RQ-Leader-N-Half-Words            |  Leader-0  Number of half-word elements of actual RQB array        ;;       +----------------------------------------------+;; 14    |           (Leader length = 5)                |        ;;       +----------------------------------------------+  ----;; 15    |      RQB Array Header                        |  Actual RQB array header & overhead;;       +----------------------------------------------+;; 16    |           (Array index length)               |  (This exists only if number data pages > 1)         ;;       +----------------------------------------------+  ----;; 17    |        %IO-RQ-Link                           |  Array elements 0, 1   ;; These 2 words used by          ;;       +----------------------------------------------+                        ;; Ucode device queueing.;; 18    |        %IO-RQ-Information                    |  Array elements 2, 3   ;;       +----------------------------------------------+;; 19    |        %IO-RQ-Command                        |  4, 5                  ;; NUPI cmd block proper;;       +----------------------------------------------+                        ;; starts here;; 20    |        %IO-RQ-Status                         |  6, 7           ;;       +----------------------------------------------+;; 21    |        %IO-RQ-Buffer                         |  8, 9      Data buffer phys addr if no scatter list.  Else ptr;;       +----------------------------------------------+                to %IO-RQ-Parameter list word.;; 22    |        %IO-RQ-Transfer-Length                |  10, 11    Total i/o transfer length, in bytes       ;;       +----------------------------------------------+;; 23    |        %IO-RQ-Device-Address                 |  12, 13           ;;       +----------------------------------------------+;; 24    |        %IO-RQ-Event-Address                  |  14, 15           ;;       +----------------------------------------------+;; 25    |        Spare                                 |  16, 17           ;;       +----------------------------------------------+;; 26    |        Spare                                 |  18, 19           ;;       +----------------------------------------------+;; 27    |        %IO-RQ-Parameter-List                 |  20 through 477                      ;;  .    |                                              |  CCW or Scatter List.  ;;  .    |                                              |  Pairs of words consisting of physical address;;  .    |                                              |  and number of words for each scatter entry;;511    |                                              |  NOTE: 485 words available = Max of 242 scatter list entries!;;       +----------------------------------------------+       (used to be 229 words and 114 entries w/256-word page);;Page 1 and following of "Extended RQB" contain actual data.  ;;Note RQB data starts at RQB element number 478 (decimal).;;Miscellaneous notes:;;--------------------;; * In the diagram above, slot descriptions in parentheses indicate;;   array-header overhead words associated with indirect, displaced, and;;   long arrays.  These words are not generally accessible by ordinary;;   array reference functions.;; * The "Extended RQB" includes overhead associated with actual RQB leader,;;   and the indirect arrays that overlay the RQB data.  This overhead;;   plus the command block and scatter table comprise one page.  The actual;;   RQB array does not start at the beginning of this page.  The "Extended;;   RQB" thus includes all Q's involved in the I/O transfer.  Note that;;   the Ucode doesn't care about anything before the %IO-RQ-Link word.;;   Slots above that are used for Lisp disk i/o housekeeping.;; * The total length of the "Extended RQB" is the number of data blocks;;   (as specified in the get-disk-rqb call) plus one page of overhead.;;   The "Extended RQB" always start on a page boundary.   ;; * RQBs are guaranteed to be contiguous in virtual memory because of the;;   way they are allocated.  The NUPI, however, must have physical addresses;;   for its transfers, and the virtual pages may not be physically;;   contiguous (hence the scatter list).;; * For more information, see Wire-NUPI-RQB and Make-Disk-RQB (IO;DISK);;   and UR-Device if you're really interested in what the Ucode does.(DEFUN make-disk-rqb (ignore n-blocks leader-length &aux n-blocks-rounded)  ;; Figure out how many blocks N-BLOCKS is modulo page-size.  ;; N-blocks-rounded and N-blocks may be slighly different, since we must  ;; create RQBs that are exactly multiples of page size.  The N-BLOCKS in the  ;; RQB leader, though, will be what user specified.  Its just the data length  ;; of the arrays that may be longer.  (SETQ n-blocks-rounded (* (CEILING n-blocks disk-blocks-per-page)    disk-blocks-per-page))  (PROG (overhead array-length rqb-buffer rqb-8-bit-buffer rqb) ;; Compute how much overhead there is in the RQB-BUFFER, ;; RQB-8-BIT-BUFFER, and in the RQB's leader and header.  4 for the ;; RQB-BUFFER indirect-offset array, 4 for the RQB-8-BIT-BUFFER ;; indirect-offset array, 3 for the RQB's header, plus the RQB's leader. ;; Then set the length (in halfwords) of the array to be sufficient so ;; that it plus the overhead is a multiple of the page size, making it ;; possible to wire down RQB's.    (SETQ overhead (+ 4. 4. 3. leader-length)  array-length (* (- (+ (* n-blocks-rounded   disk-block-word-size)        ;data size in wordsPage-Size)                        ;command block size in words     overhead)                                  ;minus overhead (which isn't array elements)  2.))                        ;=> gives number of 16-b array elements    (COND      ((> array-length %Array-Max-Short-Index-Length)       (SETQ overhead (1+ overhead)     array-length (- array-length 2.))       (OR (> array-length %Array-Max-Short-Index-Length)  (FERROR nil "Impossible to make this RQB array fit"))))    ;; See if the CCW (scatter) list (in the worst case) will run off the end of the first page,    ;; and hence not be stored in consecutive physical addresses.  NUPI requires that    ;; the scatter list be physically contiguous.    (IF (> (+ overhead;Misc array overhead Q's      (FLOOR %Io-Rq-Parameter-List 2.);CMD block Q's before CCW list      (* n-blocks 2.));Max num of Q's needed for this CCW list   page-size)      (FERROR 'rqb-too-large      "CCW list doesn't fit on first RQB page, ~D pages (decimal) is too many" n-blocks))    L    (WITHOUT-INTERRUPTS       (SETQ rqb-buffer    ;; Allocate array header for displaced RQB-Buffer array.    ;; This header must start on a page boundary.    ;; The RQB-Buffer and RQB-8-Bit-Buffer arrays are displaced to the first DATA block.    (MAKE-ARRAY (* disk-block-word-size n-blocks 2.):type art-16b  :area disk-buffer-area:displaced-to "":displaced-index-offset (- array-length   (* disk-block-word-size n-blocks-rounded 2.)))     ;; Allocate array header for 8-b displaced.    rqb-8-bit-buffer    (MAKE-ARRAY (* disk-block-word-size n-blocks 4.):type art-string  :area disk-buffer-area:displaced-to "":displaced-index-offset (* (- array-length      (* disk-block-word-size n-blocks-rounded 2.))   2.))    ;; Actual data portion    rqb    (MAKE-ARRAY array-length:area disk-buffer-area  :type art-16b:leader-length leader-length)))    (COND      ((NOT (= (%region-number rqb-buffer);make sure a new region       (%region-number rqb)));didn't screw us completely       ;; Screwwed! Try again.  Make sure don't lose same way again by       ;; using up region that didnt hold it.       (SAFE-RETURN-ARRAY rqb)       (LET ((rn (%REGION-NUMBER rqb-buffer))) (SAFE-RETURN-ARRAY rqb-buffer) (%use-up-region rn))       (GO L)))    (make-sure-free-pointer-of-region-is-at-page-boundary 'disk-buffer-area (%REGION-NUMBER rqb))    (%P-STORE-CONTENTS-OFFSET rqb rqb-buffer 1.);Displace RQB-BUFFER to RQB    (%P-STORE-CONTENTS-OFFSET rqb rqb-8-bit-buffer 1.)    (SETF (rqb-n-half-words rqb) (+ %Io-Rq-Parameter-List (* 2. n-blocks)))    (SETF (rqb-n-blocks rqb) n-blocks)    (SETF (rqb-buffer rqb) rqb-buffer)    (SETF (rqb-8-bit-buffer rqb) rqb-8-bit-buffer)    (RETURN rqb))) ;;; Use this to recover if the free pointer is off a page boundary.;;; Set free pointer to show the region is full.(DEFUN %use-up-region (region-number)  (SETF (AREF #'region-free-pointer region-number)(aref #'region-length region-number))) (DEFUN make-sure-free-pointer-of-region-is-at-page-boundary (area region-number)  (WHEN (NOT (ZEROP (LOGAND (1- page-size)    (region-free-pointer region-number))))     (FERROR nil "~%Area ~A(#~O), region ~O has free pointer ~O, which is not on a page boundary"     area (SYMBOL-VALUE area) region-number (region-free-pointer region-number)))) -TYPE (SEND HOST :SYSTEM-TYPE))    TEM))  (DEFMETHOD (PATHNAME :OPEN-CANONICAL-DEFAULT-TYPE) (CANONICAL-TYPE &REST ARGS)  (IF TYPE    (LEXPR-SEND SELF :OPEN SELF ARGS)    (LEXPR-SEND SELF :OPEN-CANONICAL-TYPE CANONICAL-TYPE SELF ARGS)))  (DEFMETHOD (PATHNAME :OPEN-CANONICAL-TYPE) (CANONICAL-TYPE PRETRANSLATED-PATHNAME &REST ARGS &KEY &OPTIONAL (ERROR T) &ALLOW-OTHER-KEYS)  (LET ((SURFACE-TYPES (SEND SELF :TYPES-FOR-CANONICAL-TYPE CANONICAL-TYPE)))    (DO ((TYPES SURFACE-TYPES (CDR 