SPL,L,O,M 
!     NAME:   CL..
!     SOURCE: 92071-18014 
!     RELOC:  92071-16014 
!     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 CL..(7) "92071-1X014 REV.2041 800718"
! 
!     CARTRIDGE DIRECTORY LIST ROUTINE
! 
!     ENTERED BY: 
! 
!     CL,CRN1,CRN2,...,CRNX 
! 
!     WHERE:
! 
!     CRNX   IF SUPPLIED RESTRICTS THE LIST TO THE
!            THE REQUESTED CARTRIDGES 
! 
!     CARTRIDGE LIST FORMAT:
! 
!L1   LU  LAST TRACK   CRN   LOCK          (TIME) 
!L2 
!     FOLLOWED BY A LINE FOR EACH REQUESTED CARTRIDGE:
! 
!LN   WW    XXX       YYYYY  ZZZZZ
! 
!     WHERE:
! 
!     WW      IS THE CARTRIDGE LU NUMBER
!     XXX     IS THE LAST TRACK ON THE CARTRIDGE
!     YYYYY   IS THE CARTRIDGE REFERENCE NUMBER 
!     ZZZZZ   IS THE NAME OF PROGRAM TO WHICH CARTRIDGE IS LOCKED 
! 
!  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 P.NAM     BE SUBROUTINE,EXTERNAL
!  EXTERNAL VARIABLES 
      LET BUF.      BE INTEGER,EXTERNAL 
!  INTERNAL VARIABLES 
      LET D.SDR(128)BE INTEGER
      LET HEAD1(40) BE INTEGER                   !FIRST HEADER LINE 
      LET HEAD2(40) BE INTEGER                   !SECOND HEADER LINE
! 
      INITIALIZE HEAD1 TO                        \INITIALIZE HEADER 1 
          "  CARTRIDGE LIST                ",    \
          "                                "     !
      INITIALIZE HEAD2 TO                        \INITIALIZE HEADER 2 
          "  LU  LAST TRACK   CR   LOCK    ",    \HEADING 
          "                                "     !
! 
!     INTERNAL CONSTANTS
      LET BL.BL     BE CONSTANT (20040K)         !"  "
! 
CL..: SUBROUTINE GLOBAL                          !NO PRAMETERS NEEDED 
      L.OPN                                      ! OPEN LIST FILE 
      L.HED(HEAD2)                               !WRITE FIRST HEADER LINE 
!     L.WRT(HEAD2,32)                            !WRITE SECOND HEADER LINE
      L.SPC                                      !SPACE A LINE
! 
      FSTAT(D.SDR,128)                           !READ THE CARTRIDGE DIR
      TL_ @D.SDR                                 !SET UP POINTER
      PN_[PCR_[PTR_[TB_@BUF.+1]+4]+5]+2          !SET UP BUFFER POINTERS
      BUF._ BL.BL 
! 
NEXT: IFNOT $TL THEN [L.WEF; RETURN]             !FINISHED? 
      FOR T_ TB TO TB+40 DO $T_ BL.BL            !CLEAR OUTPUT BUFFER 
      CONV.($TL,$TB,2)                           !SET LU INTO BUFFER
      CONV.($[TL_TL+1],$PTR,4)                   !SET LAST TRACK IN BUFFER
      CONV.($[TL_TL+1],$PCR,5)                   !SET CRN INTO BUFFER 
! 
      IF $[TL_TL+1] THEN [                       \IF LOCK WORD EXISTS 
          P.NAM($PN,$TL AND 377K);               \FIND PROGRAM NAME 
          N_ 15],                                \SET LINE LENGTH 
      ELSE N_ 11                                 !OTHERWISE SET LINE LENGTH 
! 
      TL_ TL+1                                   !POINT TO NEXT ENTRY 
      L.WRT(BUF.,N)                              !WRITE OUT OUTPUT BUF
      GOTO NEXT                                  !GO LIST NEXT ENTRY
! 
      END 
      END 
! 
      END$
                                                                                                                                                                                                                                