SPL,L,O 
!     NAME:   DL..
!     SOURCE: 92067-18222 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME DL..(8) "92067-16185 REV.1940 790725"
! 
!  MODIFICATION RECORD: 
! 
!      DATE    REASON 
!  1) 780516   TO USE FSTAT TO READ CARTRIDGE DIRECTORY 
!  2) 780516   TO USE KEYWD OFFSET (NOT IDSEG ADDR) FROM OPEN FLAG
!  3) 780518   TO REPORT NEXT TRACK, LAST TRACK AND STARTING TRACK
!              OF FILE AS 5-DIGIT NUMBERS 
!  4) 780518   TO REPORT FILE SIZE IN BLOCKS OR BLK MULTIPLES 
!  5) 781116   TO PRINT ASCII SECURITY CODES AND CRNS AS ASCII
!              TO TREAT 2 ASCII CHARACTERS AS CRN BEFORE TRYING IT
!                   AS A MASK 
!              TO ALLOW SYSTEM MANAGER TO DO :DL,-LU OR DL,CRN
!                   IF LU IN SST, EVEN IF LU NOT IN HIS CL
!              TO CALL LOCK. TO CLEAN INVALID OPEN FLAGS
!  6) 790725   IF LIST DEVICE IS A FMP FILE, IT IS OPENED ONLY ONCE 
!                   (NOT RE-OPENED)   SST #4465 
! 
!     RTE FMGR DIRECTORY LIST MODULE
! 
!     ENTERED ON COMMAND: 
! 
!     DL,CR,MSC 
! 
!     WHERE:
!           CR IF GIVEN RESTRICTS THE LIST TO 
!               THE GIVEN CARTRIDGE 
! 
!           MSC IF GIVEN MUST BE THE MASTER 
!               SECURITY CODE AND CAUSES THE
!               EXPANDED LIST FORMAT. (SEE BELOW) 
! 
!     FORMATS:
! 
!     HEAD: 
! 
!L1   CR=XXXXX
!L2    ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX
!          LAST TR=XXXXX #DR TR=XX
! 
! 
! 
!     WHERE: CR IS FOLLOWED BY THE CARTRIDGE ID NUMBER
!           YYYYYY IS THE CARTRIDGE LABEL 
!           NXTR INDICATES THE NEXT TRACK 
!           NXSEC   THE NEXT SECTOR 
!           #SEC/TR  THE NO. OF SECTORS/TRACK 
!           LAST TR THE LAST TRACK AND
!           #DR TR  THE NUMBER OF DIRECTORY TRACKS
! 
!     STANDARD (MSC NOT SUPPLIED):
!L3   NAME   TYPE   SIZE/LU    OPEN TO
! 
!      FOLLOWED BY THE DIRECTORY ENTRIES
! 
!     EXTENDED FORMAT (MSC SUPPLIED)
!     NAME   TYPE   SIZE/LU    SCODE TRACK SEC OPEN TO
! 
! 
!     IF THE LIST DEVICE IS A TTY (TYPE 00 OR 05) 
!       THE EXTENDED FORMAT MAY FORCE TWO LINES 
!       (IF 6 OR 7 PROGRAMS HAVE THE FILE OPEN) 
!     IF A PROGRAM HAS A FILE OPEN EXCLUSIVELY, 
!     A - (MINUS SIGN) WILL FOLLOW THE PROGRAM'S NAME 
!     IF AN ENTRY IS FOR AN EXTENT A + (PLUS SIGN)
!        WILL BE PRINTED IN THE OPEN TO FIELD 
!        FOLLOWED BY THE EXTENT NUMBER
! 
! 
!     DEFINE EXTERNALS
! 
      LET PK.DR,D.SDR,TMP.,O.BUF,.E.R.,CL.BF,\
      BUF.,N.OPL BE INTEGER,EXTERNAL
      LET HEAD.(4),H1(2),H1.5,H2(5),H3,H4(4),H5,H6(5),H7,H8(6),H9,\ 
          H10(4),H11    BE INTEGER
      LET HEA.1(17),HEA.2(26)  BE INTEGER 
      INITIALIZE HEAD.,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11 TO \ 
       "   ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX LAST TR=XXX"\
          ,"XX #DR TR=XX" 
      INITIALIZE HEA.1 TO "  NAME   TYPE   SIZE/LU    OPEN TO"
      INITIALIZE HEA.2 TO "  NAME   TYPE   SIZE/LU    SCODE TRACK SEC",\
                          "  OPEN TO "
! 
      LET F.TST,MSC.,.TTY,NAM.. BE FUNCTION,EXTERNAL
! 
      LET F.SET,DR.RD,LOCF,WRITF,OPEN.,CONV.,FSTAT\ 
                         BE SUBROUTINE,EXTERNAL 
      LET SESSN,ISMVE,LOCK.    BE SUBROUTINE,EXTERNAL 
      LET JER.          BE SUBROUTINE,EXTERNAL,DIRECT 
! 
!     DEFINE INTERNALS
! 
      LET SETAD,WRIT,SPACE,CKDID BE SUBROUTINE
! 
!     DEFINE CONSTANTS
! 
      LET BLKS.(3)  BE INTEGER
      INITIALIZE BLKS. TO " BLKS "
      LET KEYWD     BE CONSTANT (1657K) 
      LET XEQT      BE CONSTANT (1717K) 
      LET BLANK     BE CONSTANT (20040K)
      LET C.R       BE CONSTANT (41522K)!CR 
      LET EQ.BL     BE CONSTANT (36440K)!=
      LET MIN.B     BE CONSTANT (26440K)!-
      LET PLS.B     BE CONSTANT (25440K)!+
      LET MIN       BE CONSTANT (   55K)! - 
! 
! 
DL..: SUBROUTINE(N,LIS,ER) GLOBAL 
      ASSEMBLE ["EXT $SMID";"LDA $SMID";"STA SMID"] 
      TFLG,EXEND,FFLAG,IOP,FOUND_0  
      LIS3_[LIS2_[DL_@LIS+1]+1]+1  !SET DISC SPEC 
      DLLU_DL 
      DL_$DL
      CALL SESSN($XEQT)?[GO TO DL0]     !IF IN SESSION, 
      SESWD_.B.                         !GET SCB ADDRESS
      CALL ISMVE(SESWD,SMID,CODE,1)     !GET USER ID FROM SCB 
      IF CODE=7777K THEN IOP_1          !IF SYS MGR, SEARCH ENTIRE CL 
DL0:  LUPT_@CL.BF                       !SET LU/CRN POINTER 
      CALL FSTAT(CL.BF,256,1,IOP)       !READ CARTRIDGE DIRECTORY 
      IF LIS=3 THEN[                    \IF MASK OPTION (IF ASCII)
        IFNOT $(@N.OPL+1) THEN [        \IF CRN SUBPARM, MASK  790424 
         IF $LIS2="  " THEN [           \IF JUST 2 ASCII CHARACTERS 
            IF $LIS3="  " THEN [        \ 
               CALL CKDID? [FFLAG_1;    \IF NOT A CRN 
                  CALL F.SET($DLLU);    \SET UP AS A MASK 
                  DL_$(@N.OPL+1)];      \ 
               GO TO DL1]]];            \ 
         FFLAG_1;                       \SET UP THE MASKS 
         CALL F.SET($DLLU);             \AND THE NEW
         DL_$(@N.OPL+1)]                !CRN
DL1:  DO[T_    @LIS+4   ;IF $T  THEN[IFNOT[\ !CHECK 
          EXEND_MSC.($T)]THEN[ER_51;RETURN]]]!SECURITY
      CALL FSTAT(CL.BF,256,1,IOP)              !READ DISC DIRECTORY 
      CALL CKDID?[ER_54;RETURN]              !DISC IN FSTAT BUFFER? 
AGAIN:DIS_[IF DL THEN DL,ELSE -($LUPT AND 377K)] !GET DISC ID 
      IFNOT DIS THEN RETURN          !END OF DIREC-DONE 
      BLK,INDEX_0 
      T_ @TMP.+3
      IF TFLG THEN GO TO NOPEN          !IF NOT TYPE 0, DON'T RE-OPEN   
      OPEN.(O.BUF,TMP.,$T,0)            !OPEN LIST FILE 
NOPEN:LOCF(O.BUF,.E.R.,T,T,T,T,T2,TFLG) !GET LIST LU
      TTY_[IF .TTY(T2) THEN 1,ELSE 0]   !SET TTY FLAG 
      TB_[BF_@BUF.]+1 
      $BF_BLANK 
      LOCK.(DIS,3,LKER)                 !CLEAR INVALID OPEN FLAGS 
      LOCK.(DIS,5)                      !UNLOCK 
NXBLK:DR.RD(1, DIS,BLK)?[IFNOT BLK THEN \ 
         [IF .A. THEN [ER_54;RETURN],   \ 
             ELSE GO TO DL4],           \ 
             ELSE GO TO CLEAN]         !READ BLOCK
NXFIL:SETAD?[INDEX_0;BLK_BLK+1;GO TO NXBLK] !SET ADDRESSES
      P_TB
      IF INDEX+BLK-16 THEN GO TO FILEP !NOT FIRST JUMP
      $P,FOUND_C.R                           !SET 
      $(P+1)   _EQ.BL                  !CR= 
      $(P+3),$(P+4)_BLANK              !BLANKS TO FILL OUT ASCII NAME 
      $(P+2)_$PK3 
      IF NAM..($(P+2))#0 THEN          \IF NOT VALID NAMR, THEN 
         CONV.($PK3,$(P+3),5)          !MAKE CRN 5 ASCII DIGITS 
DL2:  WRIT($BF,4)                      !WRITE ON LIST UNIT
      CONV.($PK9,H3,5)        !INSERT NEXT TRACK
      CONV.($PK5,H5,3)        !   NEXT SECTOR 
      CONV.($PK6,H7,3)        !   #SECTORS/TRACK
      CONV.($PK7-$PK8-1,H9,5) !   LAST TRACK
      CONV.(-$PK8,H11,2)       !   #DIRECTORY TRACKS
      FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\
                                PK_PK+1]
      WRIT(HEAD.,35)
      SPACE 
      IF EXEND THEN WRIT(HEA.2,25) ,ELSE WRIT(HEA.1,17) 
      SPACE         !SPACE
      T6_[T5C_[T5B_[T5A_[T5_[T4_[T3_TB+2]+3]+3]+1]+1]+1]+1
      GO TO NXFIL                    !START LIST
! 
FILEP:IF $PK<0 THEN GO TO NXFIL !PURGED ENTRY 
      IFNOT $PK THEN GO TO CLEAN ! END OF DIRECTORY 
      IF FFLAG THEN[                        \IF MASK OPTION 
         IFNOT F.TST(PK) THEN GO TO NXFIL]  !REJECT IF NOT IN SET.
      FOR T_TB TO TB+8 DO[$T_BLANK] !BLANK BUFFER 
      BLKA_@BLKS. 
      FOR T_TB+9 TO TB+11 DO            \WRITE "BLKS" 
         [$T_$BLKA;                     \ 
          BLKA_BLKA+1]
      FOR T_TB+12 TO TB+80 DO [$T_BLANK] !BLANK REST OF LINE
      FOR T_TB TO T3 DO [$T_$PK;PK_PK+1] !SET NAME
      CONV.($PK3,$T4,5)                  !SET TYPE
      IF $PK3 THEN GO  TO NOT0           !IF TYPE ZERO
      CONV.($PK4 AND 77K,$T5,2)          !CONVERT LU
      $T5A_" ("                          !WRITE "(LU)"
      $T5B_"LU" 
      $T5C_") " 
      GO TO EXCK                         !ELSE
NOT0: IF $PK6<0 THEN [            \IF SIZE IS NEGATIVE
         CONV.(-$PK6,$T5,5);      \CONVERT SIZE (BLK MULTIPLES) 
         $T5A_"*B"],              \WRITE "*BLKS"
      ELSE  CONV.($PK6/2,$T5,5)   !ELSE, CONVERT SIZE (BLOCKS)
! 
EXCK: IFNOT EXEND THEN GO TO NAMST !NOT EXTENDED JMP
! 
                                   !SET NAME LIST ORGIN 
! 
      T6_[PK_[PK6_[T2_[P_TB+12]+2]+3]+2]+2
      IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8]
      $T2_$PK8                      !CHECK SECURITY CODE
      IF NAM..($T2)=0 THEN GO TO DL3 !IF NOT VALID ASCII, THEN
      CONV.($PK8,$T2,5)             !CONVERT AS NUMERIC 
DL3:  IFNOT $PK3 THEN GO TO NAMST !IF TYPE ZERO 
      CONV.($PK4,$PK6,5)             !SKIP TRACK
      CONV.($PK5 AND 377K,$PK,3)     !AND SECTOR
NAMST:T2_T6         !SET WORKING ADDRESS
! 
      IF $PK3 THEN [IF [T_($PK5 -<8)AND 377K] THEN[\
          $T6_PLS.B ;CONV.(T,$(T6+1),3);GO TO PRT] ]
! 
      REPEAT 7 TIMES DO THRU NAMSK
NAMSK:      IF $[PK8_PK8+1] THEN [    \IF OPEN FLAG, THEN 
              P_($PK8 AND 377K)-1;    \KEYWD TABLE OFFSET OF IDSEG
              KINDX_0;                \COUNT TO CHECK FOR VALID OFFSET
              IDSG_$KEYWD;            \GET KEYWD TABLE ADDRESS
NXID:         IF $IDSG THEN [         \IF NOT END OF TABLE, THEN
                 IF KINDX # P THEN [  \IF NOT TO OFFSET YET, THEN 
                    KINDX_KINDX+1;    \BUMP INDEX TO KEYWD TABLE
                    IDSG_IDSG+1;      \NEXT ENTRY IN KEYWD TABLE
                    GO TO NXID],      \CONTINUE KEYWD TABLE SEARCH
                 ELSE [P_$IDSG+12;    \GET PROGRAM NAME 
                IF $P THEN [FOR T_P TO P+2  \ 
                DO[ $T2_$T ;T2_T2+1];T_T2-1; \
                $T_($T AND 177400K)+[IF $PK8<0 THEN \ 
                     MIN,ELSE 40K]]]]]
PRT:  P_TB+81 
LNCK: IF $[P_P-1]=BLANK THEN GO TO LNCK 
      L_P-TB+1
      T_BF  !SET BUFFER ADDRESS 
      IF L>36 THEN[WRIT($BF,36);L_L-13;T_TB+14;\
                 FOR T6_T TO TB+35 DO $T6_BLANK]
      WRIT($T,L)  !  WRITE THE LINE 
      GO TO NXFIL 
! 
CLEAN:WRITF(O.BUF,.E.R.,T,-1)          !END FILE
DL4:  IFNOT DL THEN[LUPT_LUPT+4;GOTO AGAIN] 
      IFNOT FOUND THEN ER_43  !ERR (NOT IN SST) 
      RETURN
      END 
! 
CKDID:SUBROUTINE FEXIT                 !VERIFY DISC IS IN FSTAT BUFFER
      IFNOT DL THEN RETURN             !IF NOT GIVEN, NEEDN'T CHECK 
      CLEND_LUPT                       !SET POINTER TO LU WORD OF CL
      IF DL < 0 THEN                   \IF NEGATIVE LU GIVEN, 
         [LDIS_ -DL;CRN_0],            \MAKE POSITIVE, CLEAR CRN FLAG 
      ELSE                             \OTHERWISE 
         [LDIS_DL;LUPT_LUPT+2;CRN_1]   !SET PTR TO CRN WORD IN CL 
      WHILE $CLEND DO                  \COMPARE UNTIL END OF CL OR FND
         [IFNOT CRN THEN               \IF NEGATIVE LU WAS GIVEN, 
          $LUPT_$LUPT AND 377K;        \THEN MASK OFF LOCK FLAG 
          IF LDIS=$LUPT THEN           \IF FOUND A MATCH, 
             [LUPT_@CL.BF;RETURN],     \THEN RESET PTR TO CL, RETURN
          ELSE                         \OTHERWISE 
             [LUPT_LUPT+4;CLEND_CLEND+4]] !BUMP TO NEXT CL ENTRY
      LUPT_@CL.BF                      !RESET PTR TO CL 
      FRETURN 
      END 
! 
SETAD:SUBROUTINE FEXIT ! SET PACK DIRECTORY ENTRY 
                       ! ADDRESSES
      IF INDEX=128 THEN FRETURN !END BLOCK EXIT 
      PK9_[PK8_[PK7_[PK6_[PK5_[PK4_[PK3_[PK_INDEX+@PK.DR]+\ 
            3]+1]+1]+1]+1]+1]+1 !SET THE ADDRESSES
      INDEX_INDEX+16   !STEP INDEX
      RETURN
      END 
! 
WRIT: SUBROUTINE(BAD,NWORD) !WRITE N WORDS ON O.BUF 
                        !IF NOT A TTY TWO BLANKS ARE
      WRITF(O.BUF,.E.R.,$(@BAD+TTY),NWORD+1-TTY)!ADDED
      JER.                                  !AT THE 
      RETURN                                !FRONT
      END 
! 
SPACE:SUBROUTINE
      $TB_BLANK     !SET A 1 WORD BLANK 
      WRIT($BF,1)   !WRITE IT 
      RETURN        !RETURN 
      END 
! 
      END 
      END$
                                                                