SPL,L,O,M,C 
!     NAME:   CL..  
!     SOURCE: 92064-18163 
!     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 CL..(7) " 92064-16055  REV.1650  760923" 
! 
!     DIBC  DIRECTORY LIST
! 
!     ENTERED BY
! 
!     CL     COMMAND
! 
! 
! 
!     DEFINE   EXTERNALS
! 
! 
      LET OPEN.,WRITF,D.RIO,CONV.\
                         BE SUBROUTINE,EXTERNAL 
      LET IER.           BE SUBROUTINE,EXTERNAL,DIRECT
! 
      LET D.SDR,IDCB2   BE INTEGER,EXTERNAL 
      LET TMP.,.E.R ,BUF. BE INTEGER,EXTERNAL 
!     DEFINE CONSTANTS
      LET BLANK(14) BE INTEGER
      INITIALIZE BLANK TO "  LU  LAST TRACK   CR   LOCK"
! 
! 
CL..: SUBROUTINE GLOBAL  !NO PRAMETERS NEEDED 
      T_@TMP.+3 
      OPEN.(IDCB2,TMP.,$T,0)! OPEN LIST FILE
      TB_@BUF.+1
      BUF._BLANK(1) 
      WRITF(IDCB2,.E.R ,BLANK,14) !WRITE THE HEAD 
      IER.
      WRITF(IDCB2,.E.R ,BUF.,1) !SPACE A LINE 
      IER.
      CALL D.RIO         !READ THE DIRECTORY OF DISCS 
      PN_[PCR_[PTR_     TB+   4]+5]+2 
      TL_@D.SDR    !SET ITS ADDRESS 
NEXT: IFNOT $TL THEN [WRITF(IDCB2,.E.R ,T,-1);IER.;\
                           RETURN]
! 
      FOR T_ TB TO PN DO[$T_BLANK(1)] 
      CONV.($TL,$TB ,2) 
      CONV.($[TL_TL+1],$PTR,4)
      CONV.($[TL_TL+1],$PCR,5)
      IFNOT $[TL_TL+1] THEN [N_11;GO TO WRT]
      T_$TL +12 
      T2_[T1_PN+1]+1
      $PN_$T
      $T1_$(T+1)
      $T2_($(T+2) AND 177400K) +40K 
      N_15
! 
WRT:  WRITF(IDCB2,.E.R ,BUF.,N) 
      IER.
      TL_TL+1 
      GO TO NEXT
! 
      END 
      END 
      END$
                        