SPL,L,O,M 
!     NAME:   DL..
!     SOURCE: 92070-18017 
!     RELOC:  92070-16017 
!     PGMR:   G.A.A.          MOD. M.L.K. 
! 
!  ***************************************************************
!  * (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..(7) "  92070-1X017  REV.1941  790712"
! 
! 
!     RTE FMGR DIRECTORY LIST MODULE
! 
!     ENTERED ON COMMAND: 
! 
!     DL,CR,MSC 
! 
!     WHERE:
!           CR IF GIVEN RESTRICTS THE LIST TO 
!               THE GIVEN CARTRIDE
! 
!           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=XXXX NXSEC=XXX #SEC/TR=XXX
!          LAST TR= XXXX #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 #BLKS/LU OPEN TO
! 
!      FOLLOWED BY THE DIRECTORY ENTRIES
! 
!     EXTENDED FORMAT (MSC SUPPLIED)
!     NAME   TYPE #BLKS/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 7 PROGRMS HAVE THE FILE OPEN) 
!     IF A PROGRAM HAS A FILE OPEN EXCLUSIVELY
!     A - (MINUS SIGN) WILL FOLLOW THE PROGRAMS 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 D.RIO     BE SUBROUTINE,EXTERNAL
      LET DR.RD     BE SUBROUTINE,EXTERNAL
      LET F.SET     BE SUBROUTINE,EXTERNAL
      LET FTIME     BE SUBROUTINE,EXTERNAL
      LET JER.      BE SUBROUTINE,EXTERNAL,DIRECT 
      LET LOCF      BE SUBROUTINE,EXTERNAL
      LET OPEN.     BE SUBROUTINE,EXTERNAL
      LET WRITF     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET F.TST     BE FUNCTION,EXTERNAL
      LET FID.      BE FUNCTION,EXTERNAL
      LET IFTTY     BE FUNCTION,EXTERNAL
      LET MSC.      BE FUNCTION,EXTERNAL
!  EXTERNAL VARIBLES
      LET .E.R      BE INTEGER,EXTERNAL 
      LET %IDNM     BE INTEGER,EXTERNAL 
      LET %IDA      BE INTEGER,EXTERNAL 
      LET %IDSZ     BE INTEGER,EXTERNAL 
      LET BUF.      BE INTEGER,EXTERNAL 
      LET D.SDR     BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET O.BUF     BE INTEGER,EXTERNAL 
      LET PK.DR     BE INTEGER,EXTERNAL 
      LET TMP.      BE INTEGER,EXTERNAL 
!  INTERNAL SUBROUTINES 
      LET SETAD     BE SUBROUTINE 
      LET SPACE     BE SUBROUTINE 
      LET WRIT      BE SUBROUTINE 
!  INTERNAL VARIBLES
      LET HEAD.(4),H1(2),H1.5,H2(4),H3,H4(4),H5,H6(5),H7,H8(6),H9,\ 
          H10(4),H11    BE INTEGER
      LET HEA.1(15),HEA.2(24)  BE INTEGER 
      INITIALIZE HEAD.,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11 TO \ 
       "   ILAB=YYYYYY NXTR=XXXX NXSEC=XXX #SEC/TR=XXX LAST TR= XX"\
          ,"XX #DR TR=XX" 
      INITIALIZE HEA.1 TO "  NAME   TYPE #BLKS/LU OPEN TO"
      INITIALIZE HEA.2 TO "  NAME   TYPE #BLKS/LU SCODE TRACK SEC  ",\
                          "OPEN TO "
!  INTERNAL CONSTANTS 
      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 
      FFLAG,EXEND_ 0                             !ASSUME NO FILTER, SHORT LIST
      DL_  @LIS+1                                !SET DISC SPEC 
      IF LIS = 3  THEN[                          \IF MASK OPTION
         FFLAG_ 1;                               \SET UP THE MASKS
         F.SET($DL);                             \AND THE NEW 
         DL_ $(@N.OPL+1)],                       \CR REFERENCE
      ELSE                                       \OTHERWISE 
         DL_ $DL                                 !USE AS A CR 
      LUPT_@D.SDR                                !SET LU POINTER
      T_ @LIS+4                                  !CHECK 
      IF $T                                      \SECURITY
         THEN[                                   \CODE
             IFNOT [EXEND_MSC.($T)]              \
                   THEN[                         \
                       ER_ 51;                   \ERROR 51
                       RETURN]]                  !AND RETURN
      D.RIO(1)
      T_ @TMP.+3                                 !POINT TO SECURITY CODE
      OPEN.(O.BUF,TMP.,$T,0)                     !OPEN LIST LU
      LOCF(O.BUF,.E.R,T,T,T,T,T2)                !GET LIST LU 
      TTY_ [IF IFTTY(T2) THEN 1, ELSE 0]         !SET TTY FLAG
AGAIN:DIS_[IF DL THEN DL,ELSE -$LUPT]            !GET DISC ID 
      IFNOT DIS THEN RETURN                      !END OF DIRECTORY, DONE
      BLK,INDEX_0 
      TB_ [BF_ @BUF.]+1                          !
      $BF_ BLANK                                 !
NXBLK:DR.RD(1,DIS,BLK)?[IFNOT BLK THEN[          \READ DIRECTORY BLK
                          ER_-32;                \IF BLK=0 THEN ASSUME
                          RETURN],               \NOT MOUNTED, RETURN 
                      ELSE[                      \OTHERWISE ASSUME AT END 
                          GOTO CLEAN]]           !OF DISC DIRECTORY 
NXFIL:SETAD?[INDEX_0;BLK_BLK+1;GO TO NXBLK]      !SET ADDRESSES TO DIRECT.
      P_TB                                       !
      IF INDEX+BLK-16 THEN GOTO FILEP            !DISC HEADER?
!  WRITE DISC HEADER
      $P_C.R                                     !YES, SET
      $(P+1)_ EQ.BL                              !CR=XXXX 
      CONV.($PK3,$(P+3),5)                       !IN BUFFER 
      FOR I_ 4 TO 14  DO[ $(P+I)_ BLANK]         !CLEAR BUFFER
      FTIME($(P+5))                              !GET DATE AND TIME 
      WRIT($BF,20)                               !WRITE ON LIST UNIT
      CONV.($PK9,H3,4)                           !INSERT NEXT TRACK 
      CONV.($PK5,H5,3)                           !NEXT SECTOR 
      $PK6_$PK6 AND 377K                         !ISOLATE #SECTORS/TRACK
      CONV.($PK6,H7,3)                           !#SECTORS/TRACK
      CONV.($PK7-$PK8-1,H9,4)                    !LAST TRACK
      CONV.(-$PK8,H11,2)                         !#DIRECTORY TRACKS 
      FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\
                                PK_PK+1]
      WRIT(HEAD.,34)
      IF FID.(DIS)  THEN GOTO CLEAN              !CHECK FOR VALID SYS 
      SPACE 
      IF EXEND THEN WRIT(HEA.2,23) ,ELSE WRIT(HEA.1,14)!WRITE NORMAL OR 
                                                 !EXTENDED HEADER 
      SPACE                                      !SPACE 
      T6_[T5_[T4_[T3_TB+2]+3]+3]+2               !SET POINTERS
      GO TO NXFIL                                !START LIST
! 
!     PROCESS FILES 
! 
FILEP:IF $PK<0 THEN GO TO NXFIL                  !PURGED ENTRY
      IFNOT $PK THEN GOTO CLEAN                  !END OF DIRECTORY
      IF FFLAG THEN[                             \IF MASK OPTION
         IFNOT F.TST(PK) THEN GOTO NXFIL]        !REJECT IF NOT SET 
      FOR T_TB TO TB+80 DO[$T_BLANK]             !BLANK BUFFER
      FOR T_TB TO T3 DO [$T_$PK;PK_PK+1]         !SET NAME
      CONV.($PK3,$T4,5)                          !SET TYPE
      IF $PK3 THEN GOTO NOT0                     !IF TYPE ZERO
      CONV.($PK4 AND 77K,$T5,2)                  !CONVERT LU
      GOTO EXCK                                  !ELSE
NOT0: CONV.($PK6/2,$T5,5)                        !CONVERT BLOCK SIZE
! 
EXCK: IFNOT EXEND THEN GO TO NAMST               !NOT EXTENDED JUMP 
! 
                                                 !SET NAME LIST ORIGIN
! 
      T6_[PK_[PK6_[T2_[P_TB+10]+2]+3]+2]+2
      IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8]     !IF SEC CODE NEG SET POS 
      CONV.($PK8,$T2,5)                          !SET SECURITY CODE 
      IFNOT $PK3 THEN GOTO NAMST                 !IF TYPE ZERO
      CONV.($PK4,$PK6,4)                         !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[                         \CHECK ALL OPEN FLAGS
         IF $[PK8_ PK8+1]  THEN[                 \OPEN FLAG PRESENT?
            P_ ($PK8 AND 377K)-1;                \YES, SO ISOLATE ID# 
            IF P< $%IDNM  THEN[                  \LEGAL ID# SO PROCESS IT 
               P_ $%IDA + (P*$%IDSZ) +12;        \CALCULATE ID NAME ADRS
               FOR T_ P TO P+2  DO[              \MOVE ID NAME INTO 
                   $T2_ $T;                      \OUTPUT BUFFER 
                   T2_ T2+1];                    \INCREMENT OUTPUT BUF PT 
               T_ T2-1;                          \POINT TO LAST CHARACTER 
               $T_($T AND 177400K)+[IF $PK8<0 THEN MIN, ELSE 40K]]]]!SET LAST 
                                                 !CHARACTER TO "-" IF 
                                                 !EXCLUSIVE OPEN, ELSE BLANK
PRT:  P_TB+81                                    !SET LINE LENGTH 
LNCK: IF $[P_P-1]=BLANK THEN GOTO LNCK           !BACK UP OVER BLANKS 
      L_P-TB+1
      T_BF                                       !SET BUFFER ADDRESS
      IF L>34 THEN[WRIT($BF,34);L_L-15;T_TB+14;  \IF LINE > 68 CHAR.
                 FOR T6_T TO TB+33 DO $T6_BLANK] !WRITE IT ON 2 LINES 
      WRIT($T,L)                                 !WRITE THE LINE
      GOTO NXFIL
! 
CLEAN:IF $(@O.BUF+2)  THEN[                      \IF OUTPUT TYPE > 0
         SPACE;                                  \THEN WRITE 2 SPACES 
         SPACE],                                 \TO OUTPUT FILE
      ELSE[                                      \IF TYPE 0, THEN 
          WRITF(O.BUF,.E.R,T,-1);                \WRITE END OF FILE 
          JER.]                                  !AND CHECK FOR ERROR 
! 
      IFNOT DL THEN[LUPT_LUPT+4;GOTO AGAIN] 
! 
      RETURN
      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 BLOCKS ARE 
      WRITF(O.BUF,.E.R ,$(@BAD+TTY),NWORD+1-TTY) !ADDED 
      JER.                                       !AT THE
      RETURN                                     !FRONT 
      END 
! 
SPACE:SUBROUTINE
      $TB_BLANK                                  !SET A ONE WORD BLANK
      WRIT($BF,1)                                !WRITE IT
      RETURN                                     !RETURN
      END 
! 
      END 
      END$
                                                                                                                                            