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$