SPL,L,O,M,C 
!     NAME:   DL..
!     SOURCE: 92064-18162 
!     RELOC:  92064-16055 
!     PGMR:   G.A.A.
!     MOD:    G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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) " 92064-16055  REV.1805  771025" 
! 
! 
!     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 FOURCE 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
! 
! 
!     DEFINE EXTERNALS
! 
      LET PK.DR,D.SDR,TMP.,IDCB2,.E.R ,\
      BUF.    BE INTEGER,EXTERNAL 
      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 "
! 
      LET MSC.,.TTY BE FUNCTION,EXTERNAL
! 
      LET DR.RD,LOCF,WRITF,OPEN.,CONV.,D.RIO\ 
                         BE SUBROUTINE,EXTERNAL 
      LET JER.          BE SUBROUTINE,EXTERNAL,DIRECT 
! 
!     DEFINE INTERNALS
! 
      LET SETAD, WRIT, SPACE BE SUBROUTINE
! 
!     DEFINE 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 
      EXEND_0 
      DL_$(@LIS+1)      !SET DISC SPEC
      LUPT_@D.SDR   !SET LU POINTER 
      DO[T_    @LIS+4   ;IF $T  THEN[IFNOT[\ !CHECK 
          EXEND_MSC.($T)]THEN[ER_51;RETURN]]]!SECURITY
      D.RIO(1)
AGAIN:DIS_[IF DL THEN DL,ELSE -$LUPT] !GET DISC ID
      IFNOT DIS THEN RETURN          !END OF DIREC-DONE 
      BLK,INDEX_0 
      T_ @TMP.+3
      OPEN.(IDCB2,TMP.,$T,0) !OPEN LIST FILE
      LOCF(IDCB2,.E.R ,T,T,T,T,T2)    !GET LIST LU
      TTY_[IF .TTY(T2) THEN 1, ELSE 0] !SET TTY FLAG  
      TB_[BF_@BUF.]+1 
      $BF_BLANK 
NXBLK:DR.RD(1, DIS,BLK)?[IFNOT BLK THEN [ER_54;RETURN]\ 
                         ,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_C.R              !SET
      $(P+1)   _EQ.BL     !CR=XXXXX 
                          ! 
      CONV.($PK3,$(P+3),5)!IN BUFFER
                          ! 
      WRIT($BF,4)             !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)       !   #DIRICTORY TRACKS
      FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\
                                PK_PK+1]
      WRIT(HEAD.,34)
      SPACE 
      IF EXEND THEN WRIT(HEA.2,23) ,ELSE WRIT(HEA.1,14) 
      SPACE         !SPACE
      T6_[T5_[T4_[T3_TB+2]+3]+3]+2   !SET POINTERS
      GO TO NXFIL                    !START LIST
! 
FILEP:IF $PK<0 THEN GO TO NXFIL !PURGED ENTRY 
      IFNOT $PK THEN GO TO CLEAN ! END OF DIRECTORY 
      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 GO  TO NOT0    !IF TYPE ZERO 
      CONV.($PK4 AND 77K,$T5,2)   !CONVERT LU 
      GO TO EXCK                  !ELSE 
NOT0: CONV.($PK6/2,$T5,5)         !CONVERT BLOCK SIZE 
! 
EXCK: IFNOT EXEND THEN GO TO NAMST !NOT EXTENDED JMP
! 
                                   !SET NAME LIST ORGIN 
! 
      T6_[PK_[PK6_[T2_[P_TB+10]+2]+3]+2]+2
      IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8]
      CONV.($PK8,$T2,5)             !SET SECURITY CODE
      IFNOT $PK3 THEN GO TO 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 THRU NAMSK
NAMSK:                   IF $[PK8_PK8+1]THEN[\
            P_($PK8 AND 77777K)+12;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>34 THEN[WRIT($BF,34);L_L-15;T_TB+14;\
                 FOR T6_T TO TB+33 DO $T6_BLANK]
      WRIT($T,L)  !  WRITE THE LINE 
      GO TO NXFIL 
! 
CLEAN:WRITF(IDCB2,.E.R ,T,-1) !END FILE 
! 
      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 IDCB2 
                        !IF NOT A TTY TWO BLANKS ARE
      WRITF(IDCB2,.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$
                    