LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031847. :SYSTEM-TYPE :LOGICAL :VERSION 13. :TYPE "LISP" :NAME "DRIVER" :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 2758741785. :AUTHOR "REL3" :LENGTH-IN-BYTES 9273. :LENGTH-IN-BLOCKS 10. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ;; -*- Mode:COMMON-LISP; Package:FILE-SYSTEM; Base:10.; 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.;;; REVISED:;;;Make SEARCH-AND-HANDLE-SUBDIRECTORIES force upper case to lower case;;;logical directories can still be translated.  12-5-85 MBC;;;-------------     Table Driver for all Pathname Parsing     --------------------(DEFSUBST GET-DELIMITERS ()  (FIRST COMPONENT-DESCRIPTION))  (DEFSUBST GET-EOS-VALID-FLAG ()  (SECOND COMPONENT-DESCRIPTION))  (DEFSUBST GET-PREVIOUS-DELIMITERS ()  (THIRD COMPONENT-DESCRIPTION))  (DEFSUBST GET-PARSING-FUNCTION ()  (FOURTH COMPONENT-DESCRIPTION))  (DEFSUBST GET-REVERSE-SEARCH ()  (FIFTH COMPONENT-DESCRIPTION))  (DEFSUBST GET-RESET-POINTER ()  (SIXTH COMPONENT-DESCRIPTION))  (DEFSUBST GET-NUMBER-OF-RETURN-VALUES ()  (SEVENTH COMPONENT-DESCRIPTION))  (DEFSUBST CALL-AND-PUSH-COMPONENTS (SUBSTRING)  (WHEN (GET-PARSING-FUNCTION)    (DOLIST (ONE-ITEM (MULTIPLE-VALUE-LIST (FUNCALL (GET-PARSING-FUNCTION) SUBSTRING SELF JUNK-ALLOWED)))      (PUSH (SEND SELF :CASE-COMPONENT ONE-ITEM) PARSED-COMPONENTS))))  ;; There is a table for each host that is supported, tables can be shared if appropriate.;; Each table is a list of component descriptions (or lists), where each component description;; represents one or more pathname components between a set of delimiters.;; Each Component description is made up of the following:;;;;      Delimeters   -- list of delimiters (or character set) which delimits this particular component.;;      EOS Flag     -- nil or non-nil, non-nil meaning that End-of-String is a valid delimiter.;;                      If EOS is nil and End-of-String is found then this component is passed.;;      Previous Delimiters  -- list of delimiters, where one must have been the delimiter for the ;;                              component found.  If not then this component is skipped.;;      Parsing Function  -- This is a function to be called if all of the proper conditions are met.;;      Reverse Search    -- If true the string is searched backwards for this component.;;      Reset Pointer     -- If true the the internal pointer as to wre;;  The flow of control is :;;      LOOP thru the table picking up each Component Description.;;         IF previous delimiters is in the list of allowed previous delimiters;;            THEN;;               Search for the next delimiter or EOS.;;               IF a String is found or EOS is Valid;;                  and there is a parsing function.;;                  THEN;;                     CALL the parsing function.;;                     PUSH all returned elements on the return list.;;                  ELSE;;                     PUSH a nil on the return list.;;               Save the delimiter found as the previos delimiter.;;               Save the internal pointer for the string.;;            ELSE;;               PUSH a nil on the return list.;;      END LOOP;;;;      PUSH the ending index on the return list.;;      RETURN the REVERSE of the return list.;; The normal return list looks like the following:;; ( Device Directory Name Type Version Index );;;; NOTE: The return list is host specific.(PROCLAIM '(INLINE FIND-COMPONENT))  (defun Find-Component (self string char-set start end EOS-valid &Optional reverse-search reset-pointer function-p)  (declare (values found-flag sub-string delimiter-found index))    (let ((idx (if reverse-search (find-component-backwards self string char-set end (if function-pstart(if (zerop end) 0 (1- end)))) (find-component-forwards self string char-set start (if function-p end (min (1+ start) (length string)))))))    (if idx(values  t (if (and (= start idx) (not reverse-search))     nil     (string-trim #\space (nsubstring string start      (if reverse-search (1+ idx) idx)))) (aref string idx ) (if reset-pointer     nil     (Skip-past-spaces string (1+ idx)))); Found a delimiter, skip past spaces; so they won't be confused as delimiters.(values  nil (if (< start end)     (string-trim #\space (nsubstring string start end))     nil) nil (if EOS-valid     (if reset-pointer nil end)     nil)))))(defun lm-parse-namestring (string self table &Optional start (end (length string)))  (let (begin(previous-char #\space)parsed-components(junk-allowed parse-pathname-flag)(DEFAULT-CONS-AREA PATHNAME-AREA))        (if start(if (or (minusp start) (> start (length string)))    (FERROR 'PATHNAME-PARSE-ERROR "Invalid start index ~d, in parsing." start )    (setq begin (Skip-Past-Spaces String Start)))(setq begin (Skip-Past-Spaces String 0)))        (if end(when (or (minusp end) (> end (length string)))  (FERROR 'PATHNAME-PARSE-ERROR "Invalid end index ~d, in parsing." end ))(setq end (length string)))        (dolist (Component-Description table)      (if (member previous-char (Get-Previous-Delimiters) :TEST #'EQ); Let's go find a delimiter.  (multiple-value-bind (found-flag sub-string new-previous-char new-begin)      (Find-Component self string (Get-Delimiters) begin end      (Get-EOS-Valid-Flag)      (Get-Reverse-Search)      (Get-Reset-Pointer)      (Get-Parsing-Function))    (if (or found-flag (Get-EOS-Valid-Flag)); String is found -- Call the Parsing function.(Call-and-Push-Components sub-string)(Call-and-Push-Components nil))    (when new-previous-char      (setq previous-char (character new-previous-char)))    (when new-begin      (setq begin new-begin)))  (if (Get-Number-of-Return-Values)      (dotimes (i (Get-Number-of-Return-Values))(push nil parsed-components))      (Call-and-Push-Components nil))))    (push (1+ begin) parsed-components)    (values-list (nreverse parsed-components))))(DEFUN FIND-COMPONENT-BACKWARDS (SELF STRING CHAR-SET START END)  (LOOP WITH IDX WHILE (>= START END) DO     (SETQ IDX (STRING-REVERSE-SEARCH-SET CHAR-SET STRING START END)) UNLESS     (AND IDX (NOT (DELIMITER-IS-NOT-QUOTED SELF STRING IDX))) RETURN IDX DO     (SETQ START (1- IDX)) FINALLY (RETURN IDX)))  (DEFUN FIND-COMPONENT-FORWARDS (SELF STRING CHAR-SET START END)  (LOOP WITH IDX WHILE (<= START END) DO     (SETQ IDX (STRING-SEARCH-SET CHAR-SET STRING START END)) UNLESS     (AND IDX (NOT (DELIMITER-IS-NOT-QUOTED SELF STRING IDX))) RETURN IDX DO     (SETQ START (1+ IDX)) FINALLY (RETURN IDX)))  (DEFUN DELIMITER-IS-NOT-QUOTED (SELF STRING INDEX)  (IF (ZEROP INDEX)    T    (LET ((QUOTE-CHAR (SEND SELF :SEND-IF-HANDLES :QUOTE-CHARACTER)))      (IF QUOTE-CHAR(NOT (CHAR= (AREF STRING (1- INDEX)) QUOTE-CHAR))T))))  (DEFUN SKIP-PAST-SPACES (STRING INDEX)  (IF (< INDEX (LENGTH STRING))    (DO* ((I INDEX (1+ I))  (CHAR (AREF STRING I) (AREF STRING I))) ((OR (NOT (CHAR= CHAR #\SPACE)) (= (1+ I) (LENGTH STRING)))  I))    (LENGTH STRING)))  (DEFUN UNQUOTE-DELIMITERS-OR-ERROR (SELF STRING UNQUOTED-IS-OKAY)  (IF (TYPEP SELF 'INSTANCE)    (LOOP WITH START = 0. AND END = (LENGTH STRING) AND INDEX = 0. AND DELIMITERS =       (SEND SELF :DELIMITERS) WHILE (AND INDEX (< START END)) DO       (SETQ INDEX (STRING-SEARCH-SET DELIMITERS STRING START END)) IF INDEX IF       (DELIMITER-IS-NOT-QUOTED SELF STRING INDEX) DO       (IF UNQUOTED-IS-OKAY (SETQ START (1+ INDEX)) (FERROR 'PATHNAME-PARSE-ERROR "Invalid character in spec ~s" STRING))       ELSE DO       (SETQ STRING (STRING-APPEND (NSUBSTRING STRING 0. (1- INDEX)) (NSUBSTRING STRING INDEX))     START INDEX     END (LENGTH STRING))       FINALLY (RETURN STRING))    STRING))        ;;;-------------     End of Table  Driver Stuff     --------------------;;; ------------   Functions used by the parsing helper functions   ----------------(DEFUN NUMERIC-P (STRING &OPTIONAL PARTIAL-OK SIGN-OK)  "If STRING is a printed representation of a number, return the number, else NIL.PARTIAL-OK non-NIL says, if the number is not the whole of STRING, still return the number that there is (normally, NIL is returned) with a second value which is the index of the character after the number.SIGN-OK non-NIL says a sign at the front is allowed."  (AND (STRINGP STRING)     (DO ((I 0. (1+ I))  (LEN (LENGTH STRING))  (NUM NIL)  (SIGN 1.)  (CH)) ((>= I LEN)  (AND NUM (* NUM SIGN)))       (SETQ CH (AREF STRING I))       (COND ((AND SIGN-OK (ZEROP I) (MEMBER CH '(#\+ #\-) :TEST #'=))  (IF (= CH #\+)    (SETQ SIGN 1.)    (SETQ SIGN -1.))) ((AND (>= #\9 CH) (>= CH #\0)) (SETQ NUM (+ (- CH #\0) (IF NUM  (* NUM 10.)  0.)))) (PARTIAL-OK (RETURN (VALUES (AND NUM (* NUM SIGN)) I))) (T (RETURN ()))))))    er 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                      ;;  .    |   