SPL,L,O,M 
!     NAME:   CL..
!     SOURCE: 92067-18238 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (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..(8) "92067-16185 REV.1940 790725"
! 
!  MODIFICATION RECORD: 
! 
!      DATE     REASON
!  1) 780427    TO USE 256-WORD BUFFER FOR DISC DIRECTORY 
!  2) 780427    TO USE EXPANDED FSTAT CALL
!  3) 780427    TO ADD ALL OPTION 
!  4) 780512    TO USE NEW CL FORMAT
!  5) 790116    TO HANDLE WRITE OF LOCK FLAGS FOR EMPTY ID SEGS.
!  6) 790222    TO CHECK FOR BREAK
!  7) 790725    TO USE $ACFL FOR ACCOUNT FILE DISC LU 
! 
!     DISC  DIRECTORY LIST
! 
!     ENTERED BY
! 
!     CL     COMMAND
! 
!     DEFINE   EXTERNALS
! 
      LET OPEN.,IER.,WRITF,FSTAT,CONV.\ 
              BE SUBROUTINE,EXTERNAL
      LET OPEN,                       \FMP OPEN ROUTINE 
          CLOSE,                      \FMP CLOSE ROUTINE
          GTSCB,                      \RETRIEVE SESSION CONTROL BLOCK 
          MSS.,                       \FMGR ERROR MESSAGE ROUTINE 
          PGS.,                       \IDENTIFY SESSION DISC TYPE 
          ACNAM                       \RETRIEVE ACCOUNT NAME
              BE SUBROUTINE,EXTERNAL
! 
      LET IFBRK                       \CHECK BREAK FLAG 
              BE FUNCTION,EXTERNAL
! 
      LET .DFER         BE SUBROUTINE,EXTERNAL,DIRECT 
      LET NAM..         BE INTEGER,FUNCTION,EXTERNAL
      LET .E.R.,                      \   
          CL.BF,                      \BUFFER FOR CARTRIDGE DIRECTORY 
          O.BUF,                      \ 
          OVRD.,                      \CARTRIDGE SEARCH OVERRIDE
          SM.BF,                      \GENERAL BUFFER 
          SCR.,                       \2ND 2 COMMAND CHARACTERS 
          S.CAP,                      \SESSION CAPABILITY LEVEL 
          TMP.                        \ 
              BE INTEGER,EXTERNAL 
      ASSEMBLE ["EXT $SMGP";"EXT $SMID";"EXT $SMLK";"EXT $SMST"]
      ASSEMBLE ["EXT $ACFL"]
      LET ACTFL(3) BE INTEGER 
      LET BLANK(3) BE INTEGER 
      LET LINE(29) BE INTEGER 
      INITIALIZE ACTFL TO "+@CCT!"
      INITIALIZE BLANK TO "      "
      INITIALIZE LINE TO \
      "  LU  LAST TRACK   CR   LOCK  P/G/S  USER/GROUP "
      LET KEYWD BE CONSTANT (1657K) 
! 
! 
CL..: SUBROUTINE GLOBAL 
      T_@TMP.+3 
      ASSEMBLE ["LDA $SMGP";"STA SMGP";"LDA $SMID";"STA SMID"]
      ASSEMBLE ["LDA $SMLK";"STA SMLK";"LDA $SMST";"STA SMST"]
      ASSEMBLE ["LDA $ACFL";"STA ACFL"] 
      OPEN.(O.BUF,TMP.,$T,0)          !OPEN LIST FILE 
      TB_@LINE+1
      IF SCR. = "AL" THEN [N_24;IOP_1], \SET LENGTH OF HEADER TO PRINT
         ELSE [N_18;IOP_0]
      WRITF(O.BUF,.E.R.,LINE,N)       !WRITE THE HEAD 
      IER.
      WRITF(O.BUF,.E.R.,LINE,1)       !SPACE A LINE 
      IER.
      CALL FSTAT(CL.BF,256,1,IOP)     !READ DIRECTORY OF DISCS
      ACN_[PGS_[PN_[PCR_[PTR_TB+5]+4]+2]+4]+2  !SET COLUMN PTRS.
      I_0                             !INITIALIZE DIRECTORY ENTRY PTR 
      IF S.CAP THEN [                 \IF IN SESSION, THEN
         CALL GTSCB(SM.BF,144,IERR);  \GET SCB CONTENTS 
         GRID_@SM.BF-(SMLK+SMST);     \ 
         PRID_$(GRID+SMID);           \GET PRIVATE ID 
         GRID_$(GRID+SMGP)],          \GET GROUP ID 
      ELSE PRID,GRID_ -1              ! 
      IF SCR. = "AL" OR S.CAP > 0 THEN \IF ALL OPTION OR IF SESSION 
         [TEMP_OVRD.;                  \CARTRIDGE SEARCH OVERRIDE 
          OVRD._OVRD. OR 100000K;      \SET TO SEARCH ALL DISCS 
          CALL OPEN(SM.BF,OER,ACTFL,1,-31178,ACFL); \OPEN ACCT FILE 
          OVRD._TEMP] 
NEXT: CL4_[CL3_[CL2_[CL1_@CL.BF+I]+1]+1]+1
      IF IFBRK() THEN [MSS.(0);GO TO DONE] !CHECK FOR BREAK 
      IFNOT $CL1 THEN [                   \IF END OF DIRECTORY
DONE:    IF SCR. = "AL" OR S.CAP > 0 THEN \IF ALL OR IF SESSION 
            CALL CLOSE(SM.BF);            \CLOSE ACCOUNT FILE 
         WRITF(O.BUF,.E.R.,T,-1);IER.;    \ 
         RETURN]
! 
      I_I+4                              !BUMP TO NEXT ENTRY
      FOR T_ TB TO ACN+10 DO[$T_LINE(1)] !BLANK OUT THE LINE
      CONV.($CL1 AND 377K,$TB,2)      !CONVERT LU TO ASCII
      CONV.($CL2,$PTR,5)              !CONVERT LAST TRACK TO ASCII
      $PCR_$CL3 
      IF NAM..($PCR)#0 THEN           \IF NOT VALID NAMR, THEN
         CONV.($CL3,$PCR,5)           !MAKE CRN 5 ASCII DIGITS
      IFNOT [T_$CL1 AND 177400K] THEN \IF NOT LOCKED, 
         [N_11;GO TO WD4]             !SKIP LOCK FLAG CONVERSION
      T_$($KEYWD+((T->8)-1))+12       !WORD 13 OF LOCKING IDSEG 
      T2_[T1_PN+1]+1                  !ADDRS OF WORDS 2,3 OF PGM NAME 
      IFNOT $T THEN                   \IF ZERO IN NAME WORD, THEN 
         CALL .DFER($PN,BLANK), ELSE  \PUT BLANKS FOR LOCKING PGM 
         [$PN_$T;                     \FIRST 2 CHARS OF PGM NAME
          $T1_$(T+1);                 \SECOND 2 CHARS OF PGM NAME 
      $T2_($(T+2) AND 177400K) +40K]  !LAST CHARACTER OF PGM NAME 
      N_15                            !SET LENGTH OF LINE TO PRINT
! 
WD4:  ID_$CL4 AND 7777K               !GET SESSION DISC ID
      IFNOT ID THEN GO TO WRT         !IF NON-SESSION DISC, SKIP PGS
      IF ID=7777K THEN [C_3;          \IF SYSTEM ID 
         $PGS_"S ";GO TO GTNAM]       ! 
      IFNOT S.CAP THEN                \IF NON-SESSION AND 
        [IF SCR. # "AL" THEN GO TO WRT] !IFNOT "ALL", SKIP PGS WRITE
      IF ID=PRID THEN [C_1;           \IF USER'S PRIVATE ID 
         $PGS_"P ";GO TO GTNAM]       ! 
      IF ID=GRID THEN [C_2;           \IF USER'S GROUP ID 
         $PGS_"G ";GO TO GTNAM]       ! 
      IF OER < 0 THEN GO TO WRT, ELSE \IF OPEN ERROR, SKIP PGS WRITE
         CALL PGS.(SM.BF,ID,C)        !PRIVATE,GROUP OR SYSTEM? 
      IF C=1 THEN [$PGS_"P ";GO TO GTNAM]   !IF PRIVATE, WRITE "P"
      IF C=2 THEN [$PGS_"G ";GO TO GTNAM]   !IF GROUP, WRITE "G"
      IF C=3 THEN $PGS_"S "                 !IF SYSTEM, WRITE "S" 
GTNAM:IFNOT C THEN GO TO WRT          !IFNOT P,G OR S, SKIP REST
      N_17
      IF SCR. # "AL" THEN GO TO WRT   !IF NOT ALL, SKIP ACCT NAME WRITE 
      IREC_1                          !SET UP FOR 1ST CALL TO ACNAM 
MORE: CALL ACNAM(SM.BF,ID,C,IREC,$ACN,N) !GET ACCOUNT NAME
      IF IREC<0 THEN [N_17;GO TO WRT] !IF ERROR, SKIP ACCT NAME WRITE 
      N_N/2+19                        !SET LINE LENGTH FOR FULL LINE
      IFNOT IREC THEN GO TO WRT       !IF LAST NAME, JUST WRITE IT
      WRITF(O.BUF,.E.R.,LINE,N)       !WRITE FULL LINE AND
      IER.                            !IF NO ERROR, THEN
      FOR T_TB TO ACN+10 DO [$T_LINE(1)]  !BLANK OUT THE LINE 
      GO TO MORE                      !GET NEXT NAME W/ SAME ID 
! 
WRT:  WRITF(O.BUF,.E.R.,LINE,N) 
      IER.
      TL_TL+1 
      GO TO NEXT
! 
      END 
      END 
      END$
                                                                                                                                                                                                            