SPL,L,O,M 
!     NAME:   CL..
!     SOURCE: 92070-18014 
!     RELOC:  92070-16014 
!     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 CL..(7) " 92070-1X014  REV.1941  790712" 
! 
!     DISC  DIRECTORY LIST
! 
!     ENTERED BY
! 
!     CL     COMMAND
! 
! 
! 
!  EXTERNAL SUBROUTINES 
      LET CONV.     BE SUBROUTINE,EXTERNAL
      LET D.RIO     BE SUBROUTINE,EXTERNAL
      LET FTIME     BE SUBROUTINE,EXTERNAL
      LET IER.      BE SUBROUTINE,EXTERNAL,DIRECT 
      LET OPEN.     BE SUBROUTINE,EXTERNAL
      LET WRITF     BE SUBROUTINE,EXTERNAL
!  EXTERNAL VARIBLES
      LET .E.R      BE INTEGER,EXTERNAL 
      LET %IDA      BE INTEGER,EXTERNAL     !SYSTEM ENTRY $IDA
      LET %IDSZ     BE INTEGER,EXTERNAL     !SYSTEM ENTRY $IDSZ 
      LET BUF.(129) BE INTEGER,EXTERNAL 
      LET D.SDR     BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET TMP.      BE INTEGER,EXTERNAL 
!  INTERNAL VARIBLES
      LET BLANK(14) BE INTEGER                             !THESE TWO 
        INITIALIZE BLANK TO "  LU  LAST TRACK   CR   LOCK" !BUFFERS 
      LET TIME(19)  BE INTEGER                             !MUST BE 
        INITIALIZE TIME TO 19(20040K)                      !IN ORDER
! 
! 
CL..: SUBROUTINE GLOBAL                     !NO PRAMETERS NEEDED
      T_@TMP.+3                             !POINT TO SEC CODE AND CRN
      OPEN.(I.BUF,TMP.,$T,0)                ! OPEN LIST FILE
      TB_@BUF.+1
      BUF.(1) _BLANK(1) 
      FTIME(TIME(3))                        !GET DATE AND TIME
      WRITF(I.BUF,.E.R,BLANK,32)            !WRITE THE HEAD 
      IER.                                  !CHECK FOR ERROR
      WRITF(I.BUF,.E.R,BUF.,1)              !SPACE A LINE 
      IER.                                  !CHECK FOR ERROR
      CALL D.RIO                            !READ THE DIRECTORY OF DISCS
      PN_ [PCR_ [PTR_  TB+  4]+ 5]+ 2       !SET UP POINTERS TO OUTPUT BUF
      TL_@D.SDR                             !BEGINNING OF DIRECTORY 
! 
NEXT: IFNOT $TL                             \IF END OF CART LIST, 
          THEN[                             \THEN 
DONE:         WRITF(I.BUF,.E.R,T,-1);       \WRITE END OF FILE
              IER.;                         \CHECK FOR ERROR
              RETURN]                       !AND EXIT 
! 
      FOR T_ TB TO PN DO[$T_BLANK(1)]       !CLEAR THE OUTPUT BUF 
      CONV.($TL,$TB ,2)                     !CONVERT LU AND STORE AT TB 
      CONV.($[TL_TL+1],$PTR,4)              !CONVERT LAST TRACK 
      CONV.($[TL_TL+1],$PCR,5)              !CONVERT CRN
      IFNOT $[TL_TL+1]                      \IF LOCK WRD IS 0 
          THEN[                             \ 
              N_11;                         \SET LINE LENGTH TO 11
              GOTO WRT]                     !AND WRITE THE LINE 
      T _ $%IDA +((($TL AND 377K)-1)*$%IDSZ)+11 !POINT TO ID NAME 
      FOR T2 _ PN TO PN+2  DO[              \MOVE ID NAME TO
          $T2 _ $[T_T+1]]                   !OUTPUT BUFFER
      T2 _ T2-1                             !BACK UP ONE
      $T2 _ ($T2 AND 177400K) + 40K         !CLEAR LAST BYTE OF NAME
      N _ 15                                !SET LINE LENGTH
! 
WRT:  WRITF(I.BUF,.E.R,BUF.,N)              !WRITE OUT OUTPUT BUF 
      IER.                                  !CHECK FOR ERRORS 
      TL_TL+1                               !POINT TO NEXT CART ENTRY 
      GOTO NEXT                             !LIST NEXT ENTRY
! 
      END 
      END 
      END$
                                                                                                                                              