SPL,L,O,M 
!     NAME:   DL..
!     SOURCE: 92071-18017 
!     RELOC:  92071-16017 
!     PGMR:   G.A.A.
!     MOD:    M.L.K., E.D.B.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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..(7) "92071-1X017 REV.2041 800709"
! 
!     RTE FMGR DIRECTORY LIST MODULE
! 
!     ENTERED ON COMMAND: 
! 
!     DL[,CRN[,MSC]]
! 
!       OR
! 
!     DL,NAMR[,MSC] 
! 
!     WHERE:
! 
!     CRN   IF SUPPLIED, RESTRICTS THE LIST TO SPECIFIED CARTRIDGE
! 
!     NAMR  IS A FILE NAMR, WITH OPTIONAL SECURITY CODE, CARTRIDGE
!           IDENTIFIER AND ADDITIONAL SUBPARAMETERS.
! 
!     MSC   IF SUPPLIED, MUST BE THE MASTER SECURITY CODE,
!           AND CAUSES THE EXPANDED LIST FORMAT. (SEE BELOW)
! 
!     DIRECTORY LIST FORMAT:
! 
!L1   CR=CCCCC                       (TIME) 
!L2   ILAB =LLLLLL NXTR=TTTT NXSEC=SSS #SEC/TR=XXX
!          LAST TR= YYYY #DR TR=ZZ
! 
!     WHERE:
! 
!     CCCCC  IS FOLLOWED BY THE CARTRIDGE ID NUMBER 
!     YYYYYY IS THE CARTRIDGE LABEL 
!     TTTT   IS THE NEXT AVAILABLE TRACK
!     SSS    IS THE NEXT AVAILABLE SECTOR 
!     XXX    IS THE NUMBER OF SECTORS/TRACK 
!     YYYY   IS THE LAST AVAILABLE TRACK
!     ZZ     IS THE NUMBER OF DIRECTORY TRACKS
! 
!     STANDARD (MSC NOT SUPPLIED):
!L3   NAME   TYPE #BLKS/LU OPEN TO
! 
!     EXTENDED FORMAT (MSC SUPPLIED)
!L3   NAME   TYPE #BLKS/LU SCODE TRACK SEC OPEN TO
! 
!     FOLLOWED BY THE DIRECTORY ENTRIES:
! 
!     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
! 
!  EXTERNAL SUBROUTINES 
      LET CONV.     BE SUBROUTINE,EXTERNAL
      LET FSTAT     BE SUBROUTINE,EXTERNAL
      LET L.OPN     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET L.HED     BE SUBROUTINE,EXTERNAL
      LET L.WRT     BE SUBROUTINE,EXTERNAL
      LET L.SPC     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET L.WEF     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET CONV.     BE SUBROUTINE,EXTERNAL
      LET MSS.      BE SUBROUTINE,EXTERNAL
      LET FM.ER     BE SUBROUTINE,EXTERNAL
! 
!  EXTERNAL FUNCTIONS 
      LET CR.LU     BE FUNCTION,EXTERNAL
      LET F.SET     BE FUNCTION,EXTERNAL
      LET F.GET     BE FUNCTION,EXTERNAL
      LET FID.      BE FUNCTION,EXTERNAL
      LET MSC.      BE FUNCTION,EXTERNAL
      LET P.NAM     BE FUNCTION,EXTERNAL
! 
!  EXTERNAL VARIABLES 
      LET BUF.      BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
! 
!  INTERNAL SUBROUTINES 
      LET WHEAD     BE SUBROUTINE,DIRECT
! 
!  INTERNAL FUNCTIONS 
      LET DL        BE FUNCTION 
! 
!  INTERNAL VARIABLES 
      LET D.SDR(128)BE INTEGER
      LET FNAME, FN2, FN3, FTYPE, FTRAK, FSECT,  \
          FSIZE, FRECL, FSECU, FFLAG(7) BE INTEGER
      LET DFALT(3)  BE INTEGER
      LET MS(3),MS2,MS3,MS4 BE INTEGER
      LET HEAD1(4),H1(2),H1.5,H2(4),H3,H4(4),    \
          H5,H6(5),H7,H8(6),H9,H10(4),H11,H12    \
                    BE INTEGER
      LET HEAD2(15),HEAD3(24) BE INTEGER
! 
      INITIALIZE DFALT TO "------"
      INITIALIZE MS TO "DISC =" 
      INITIALIZE HEAD1,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11,H12 TO \ 
          "   ILAB=XXXXXX NXTR=XXXX NXSEC=XXX",  \
          " #SEC/TR=XXX LAST TR= XXXX #DR TR=XX  "
      INITIALIZE HEAD2 TO                        \
          "  NAME   TYPE #BLKS/LU OPEN TO"
      INITIALIZE HEAD3 TO                        \
          "  NAME   TYPE #BLKS/LU SCODE TRACK SEC  OPEN TO" 
! 
!  INTERNAL CONSTANTS 
      LET EXCL      BE CONSTANT (   15K)         !" -" - "  " 
! 
DL..: SUBROUTINE(N,LIS,ER) GLOBAL 
      IF LIS=0 THEN [MASK_ @DFALT; DISC_ @N.OPL+1]
      IF LIS=1 THEN [MASK_ @DFALT; DISC_ @LIS+1]
      IF LIS=3 THEN [MASK_ @LIS+1; DISC_ @N.OPL+1]
! 
      MSKFL_ F.SET($MASK,N.OPL)                  !SET UP FILE MASK
      DISC_ $DISC                                !AND DISC ID 
! 
      IF $[T_ @LIS+4] THEN [                     \IF MSC GIVEN, 
          IFNOT [EXEND_ MSC.($T)] THEN [         \CHECK IF CORRECT, 
              ER_ 51; RETURN]],                  \TAKE ERROR EXIT 
      ELSE EXEND_ 0                              !OTHERWISE NORMAL LIST 
! 
      PTR18_[PTR16_[PTR13_[PTR11_[PTR9_[         \SET POINTERS
          PTR6_[PTR4_[PTR3_[PTR2_[TB_            \
          @BUF.+1]+1]+1]+1]+2]+3]+2]+2]+3]+2     !
      BUF. _ "  " 
! 
      L.OPN                                      !OPEN LIST FILE
! 
      IF DISC THEN [                             \DO SINGLE DISC
          IFNOT CR.LU(DISC) THEN [ER_ -32; RETURN]; \ 
          IF FID.(DISC) THEN [ER_ -103; RETURN]; \
          FOUND_ DL(DISC,-1)],                   \
      ELSE [                                     \OTHERWISE MULTI DISCS 
          FSTAT(D.SDR,124);                      \GET CARTRIDGE LIST
          LUPT_ @D.SDR;                          \SET POINTER 
          FOUND_ 0;                              \CLEAR FOUND FLAG
          UNTIL [DISC_ -$LUPT]=0 DO [            \DO FOR EVERY DISC 
              IFNOT FID.(DISC) THEN              \IF GOOD DISC, 
                  FOUND_ FOUND OR DL(DISC,0),    \ THEN WRITE DIR LIST
              ELSE [                             \OTHERWISE,
                  MS2_ "- ";                     \
                  CONV.(-DISC,MS4,5);            \CONVERT LU TO ASCII 
                  MSS.(-103);                    \PRINT ERROR MESSAGE 
                  FM.ER(2,MS,6)];                \PRINT DISC ID 
              LUPT_ LUPT+4]]                     !DO NEXT DISC
! 
      IF FOUND THEN RETURN                       !IF A FILE FOUND, RETURN 
! 
      ER_ [IF MSKFL THEN -50, ELSE -6]           !RETURN PROPER ERROR 
      RETURN
      END 
! 
DL:   FUNCTION(DIS,XXX) 
! 
!     WRITE DIRECTORY LIST FOR A SINGLE DISC
! 
      LET ENTRY(2) BE INTEGER 
! 
      ENTRY(1)_ DIS; ENTRY(2)_ 0                 !SET UP FOR SEARCH 
      PRNTD_ 0                                   !CLEAR PRINTED FLAG
! 
!     CREATE CARTRIDGE HEADER LINE
! 
      IF F.GET(FNAME,ENTRY) THEN RETURN 0        !GET CARTRIDGE HEADER
! 
      H1(1)_ FNAME AND 77777K                    !CARTRIDGE LABEL 
      H1(2)_ FN2; H1.5_ FN3 
      CRN_ FTYPE                                 !SAVE CRN
      CONV.(FFLAG,H3,4)                          !INSERT NEXT TRACK 
      CONV.(FSECT,H5,3)                          !NEXT SECTOR 
      CONV.(FSIZE AND 377K,H7,3)                 !#SECTORS/TRACK
      CONV.(FRECL-FSECU-1,H9,4)                  !LAST TRACK
      CONV.(-FSECU,H11,2)                        !#DIRECTORY TRACKS 
      IF XXX THEN WHEAD                          !WRITE OUT HEADER
! 
!     LOOK FOR FILES TO LIST
! 
NXFIL:IF F.GET(FNAME,ENTRY) THEN [               \GET FILE ENTRY
          IF PRNTD THEN L.WEF;                   \
          RETURN PRNTD]                          !
      IF FNAME<0 THEN GOTO NXFIL                 !CHECK FOR FILE ENTRY
! 
      IFNOT PRNTD THEN WHEAD                     !WRITE OUT HEADER
      FOR T_ TB TO TB+80 DO $T_ "  "             !BLANK BUFFER
      $TB_ FNAME; $PTR2_ FN2; $PTR3_ FN3         !SET NAME
      CONV.(FTYPE,$PTR6,5)                       !SET TYPE
      IF FTYPE THEN CONV.(FSIZE/2,$PTR9,5),      \CONVERT BLOCK SIZE
               ELSE CONV.(FTRAK AND 77K,$PTR9,5) !OR LU NUMBER
! 
      IF EXEND THEN [                            \DO EXTENDED LINE
          IF FSECU<0 THEN [                      \IF SECU NEGATIVE
              $PTR11_ "- ";                      \SET "- " IN BUFFER
              FSECU_ -FSECU];                    \SET POSITIVE
          CONV.(FSECU,$PTR13,5);                 \SET SECURITY CODE 
          IF FTYPE THEN [                        \IF TYPE ZERO
              CONV.(FTRAK,$PTR16,4);             \CONVERT TRACK 
              CONV.(FSECT AND 377K,$PTR18,3)];   \AND SECTOR
          T2_ TB+19],                            \SET WORKING ADDRESS 
      ELSE T2_ TB+10                             !SET WORKING ADDRESS 
! 
      IF FTYPE THEN [                            \IF NOT TYPE ZERO, 
          IF [T_(FSECT-<8) AND 377K] THEN [      \AND NOT MAIN EXTENT 
              $T2_ "+ ";                         \SET "+ " IN BUFFER
              CONV.(T,$(T2+1),3);                \SET EXTENT NUMBER 
              GOTO PRT]]                         !AND CONTINUE
! 
      FOR FLG_ 1 TO 7 DO [                       \CHECK ALL OPEN FLAGS
          IF [T_ FFLAG(FLG)] THEN [              \IF OPEN FLAG PRESENT, 
              IFNOT P.NAM($T2,T AND 377K) THEN   \THEN GET PROGRAM NAME 
                  T2_T2+3;                       \ AND BUMP POINTER 
              IF T < 0 THEN                      \IF EXCLUSIVE OPEN,
                  $(T2-1)_ $(T2-1)+EXCL]]        !CHANGE LAST CHARACTER 
! 
PRT:  T_ TB+81                                   !SET LINE LENGTH 
! 
LNCK: IF $[T_T-1]="  " THEN GOTO LNCK            !BACK UP OVER BLANKS 
      L.WRT(BUF.,T-TB+2)                         !WRITE THE LINE
      GOTO NXFIL
      END 
! 
WHEAD:SUBROUTINE
! 
!     WRITE OUT CARTRIDGE DESCRIPTIVE HEADER
! 
      FOR T_ TB TO TB+80 DO $T_ "  "             !CLEAR BUFFER
      $TB_"CR"; $PTR2_ "= "                      !SET "CR= " IN BUFFER
      CONV.(CRN,$PTR4,5)                         !SET CRN IN BUFFER 
      L.HED(BUF.)                                !WRITE FIRST HEADER
      L.WRT(HEAD1,36)                            !WRITE SECOND HEADER 
      L.SPC                                      !
      IF EXEND THEN L.WRT(HEAD3,24),             \WRITE NORMAL
               ELSE L.WRT(HEAD2,15)              ! OR EXTENDED HEADER 
      L.SPC                                      !
! 
      PRNTD_ -1                                  !SET PRINTED FLAG
      RETURN                                     ! AND RETURN 
      END 
! 
      END 
      END$