SPL,L,O ! NAME: DL.. ! SOURCE: 92067-18222 ! 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 DL..(8) "92067-16185 REV.1940 790725" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780516 TO USE FSTAT TO READ CARTRIDGE DIRECTORY ! 2) 780516 TO USE KEYWD OFFSET (NOT IDSEG ADDR) FROM OPEN FLAG ! 3) 780518 TO REPORT NEXT TRACK, LAST TRACK AND STARTING TRACK ! OF FILE AS 5-DIGIT NUMBERS ! 4) 780518 TO REPORT FILE SIZE IN BLOCKS OR BLK MULTIPLES ! 5) 781116 TO PRINT ASCII SECURITY CODES AND CRNS AS ASCII ! TO TREAT 2 ASCII CHARACTERS AS CRN BEFORE TRYING IT ! AS A MASK ! TO ALLOW SYSTEM MANAGER TO DO :DL,-LU OR DL,CRN ! IF LU IN SST, EVEN IF LU NOT IN HIS CL ! TO CALL LOCK. TO CLEAN INVALID OPEN FLAGS ! 6) 790725 IF LIST DEVICE IS A FMP FILE, IT IS OPENED ONLY ONCE ! (NOT RE-OPENED) SST #4465 ! ! RTE FMGR DIRECTORY LIST MODULE ! ! ENTERED ON COMMAND: ! ! DL,CR,MSC ! ! WHERE: ! CR IF GIVEN RESTRICTS THE LIST TO ! THE GIVEN CARTRIDGE ! ! MSC IF GIVEN MUST BE THE MASTER ! SECURITY CODE AND CAUSES THE ! EXPANDED LIST FORMAT. (SEE BELOW) ! ! FORMATS: ! ! HEAD: ! !L1 CR=XXXXX !L2 ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX ! LAST TR=XXXXX #DR TR=XX ! ! ! ! WHERE: CR IS FOLLOWED BY THE CARTRIDGE ID NUMBER ! YYYYYY IS THE CARTRIDGE LABEL ! NXTR INDICATES THE NEXT TRACK ! NXSEC THE NEXT SECTOR ! #SEC/TR THE NO. OF SECTORS/TRACK ! LAST TR THE LAST TRACK AND ! #DR TR THE NUMBER OF DIRECTORY TRACKS ! ! STANDARD (MSC NOT SUPPLIED): !L3 NAME TYPE SIZE/LU OPEN TO ! ! FOLLOWED BY THE DIRECTORY ENTRIES ! ! EXTENDED FORMAT (MSC SUPPLIED) ! NAME TYPE SIZE/LU SCODE TRACK SEC OPEN TO ! ! ! IF THE LIST DEVICE IS A TTY (TYPE 00 OR 05) ! THE EXTENDED FORMAT MAY FORCE TWO LINES ! (IF 6 OR 7 PROGRAMS HAVE THE FILE OPEN) ! IF A PROGRAM HAS A FILE OPEN EXCLUSIVELY, ! A - (MINUS SIGN) WILL FOLLOW THE PROGRAM'S NAME ! IF AN ENTRY IS FOR AN EXTENT A + (PLUS SIGN) ! WILL BE PRINTED IN THE OPEN TO FIELD ! FOLLOWED BY THE EXTENT NUMBER ! ! ! DEFINE EXTERNALS ! LET PK.DR,D.SDR,TMP.,O.BUF,.E.R.,CL.BF,\ BUF.,N.OPL BE INTEGER,EXTERNAL LET HEAD.(4),H1(2),H1.5,H2(5),H3,H4(4),H5,H6(5),H7,H8(6),H9,\ H10(4),H11 BE INTEGER LET HEA.1(17),HEA.2(26) BE INTEGER INITIALIZE HEAD.,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11 TO \ " ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX LAST TR=XXX"\ ,"XX #DR TR=XX" INITIALIZE HEA.1 TO " NAME TYPE SIZE/LU OPEN TO" INITIALIZE HEA.2 TO " NAME TYPE SIZE/LU SCODE TRACK SEC",\ " OPEN TO " ! LET F.TST,MSC.,.TTY,NAM.. BE FUNCTION,EXTERNAL ! LET F.SET,DR.RD,LOCF,WRITF,OPEN.,CONV.,FSTAT\ BE SUBROUTINE,EXTERNAL LET SESSN,ISMVE,LOCK. BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! ! DEFINE INTERNALS ! LET SETAD,WRIT,SPACE,CKDID BE SUBROUTINE ! ! DEFINE CONSTANTS ! LET BLKS.(3) BE INTEGER INITIALIZE BLKS. TO " BLKS " LET KEYWD BE CONSTANT (1657K) LET XEQT BE CONSTANT (1717K) LET BLANK BE CONSTANT (20040K) LET C.R BE CONSTANT (41522K)!CR LET EQ.BL BE CONSTANT (36440K)!= LET MIN.B BE CONSTANT (26440K)!- LET PLS.B BE CONSTANT (25440K)!+ LET MIN BE CONSTANT ( 55K)! - ! ! DL..: SUBROUTINE(N,LIS,ER) GLOBAL ASSEMBLE ["EXT $SMID";"LDA $SMID";"STA SMID"] TFLG,EXEND,FFLAG,IOP,FOUND_0 LIS3_[LIS2_[DL_@LIS+1]+1]+1 !SET DISC SPEC DLLU_DL DL_$DL CALL SESSN($XEQT)?[GO TO DL0] !IF IN SESSION, SESWD_.B. !GET SCB ADDRESS CALL ISMVE(SESWD,SMID,CODE,1) !GET USER ID FROM SCB IF CODE=7777K THEN IOP_1 !IF SYS MGR, SEARCH ENTIRE CL DL0: LUPT_@CL.BF !SET LU/CRN POINTER CALL FSTAT(CL.BF,256,1,IOP) !READ CARTRIDGE DIRECTORY IF LIS=3 THEN[ \IF MASK OPTION (IF ASCII) IFNOT $(@N.OPL+1) THEN [ \IF CRN SUBPARM, MASK 790424 IF $LIS2=" " THEN [ \IF JUST 2 ASCII CHARACTERS IF $LIS3=" " THEN [ \ CALL CKDID? [FFLAG_1; \IF NOT A CRN CALL F.SET($DLLU); \SET UP AS A MASK DL_$(@N.OPL+1)]; \ GO TO DL1]]]; \ FFLAG_1; \SET UP THE MASKS CALL F.SET($DLLU); \AND THE NEW DL_$(@N.OPL+1)] !CRN DL1: DO[T_ @LIS+4 ;IF $T THEN[IFNOT[\ !CHECK EXEND_MSC.($T)]THEN[ER_51;RETURN]]]!SECURITY CALL FSTAT(CL.BF,256,1,IOP) !READ DISC DIRECTORY CALL CKDID?[ER_54;RETURN] !DISC IN FSTAT BUFFER? AGAIN:DIS_[IF DL THEN DL,ELSE -($LUPT AND 377K)] !GET DISC ID IFNOT DIS THEN RETURN !END OF DIREC-DONE BLK,INDEX_0 T_ @TMP.+3 IF TFLG THEN GO TO NOPEN !IF NOT TYPE 0, DON'T RE-OPEN OPEN.(O.BUF,TMP.,$T,0) !OPEN LIST FILE NOPEN:LOCF(O.BUF,.E.R.,T,T,T,T,T2,TFLG) !GET LIST LU TTY_[IF .TTY(T2) THEN 1,ELSE 0] !SET TTY FLAG TB_[BF_@BUF.]+1 $BF_BLANK LOCK.(DIS,3,LKER) !CLEAR INVALID OPEN FLAGS LOCK.(DIS,5) !UNLOCK NXBLK:DR.RD(1, DIS,BLK)?[IFNOT BLK THEN \ [IF .A. THEN [ER_54;RETURN], \ ELSE GO TO DL4], \ ELSE GO TO CLEAN] !READ BLOCK NXFIL:SETAD?[INDEX_0;BLK_BLK+1;GO TO NXBLK] !SET ADDRESSES P_TB IF INDEX+BLK-16 THEN GO TO FILEP !NOT FIRST JUMP $P,FOUND_C.R !SET $(P+1) _EQ.BL !CR= $(P+3),$(P+4)_BLANK !BLANKS TO FILL OUT ASCII NAME $(P+2)_$PK3 IF NAM..($(P+2))#0 THEN \IF NOT VALID NAMR, THEN CONV.($PK3,$(P+3),5) !MAKE CRN 5 ASCII DIGITS DL2: WRIT($BF,4) !WRITE ON LIST UNIT CONV.($PK9,H3,5) !INSERT NEXT TRACK CONV.($PK5,H5,3) ! NEXT SECTOR CONV.($PK6,H7,3) ! #SECTORS/TRACK CONV.($PK7-$PK8-1,H9,5) ! LAST TRACK CONV.(-$PK8,H11,2) ! #DIRECTORY TRACKS FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\ PK_PK+1] WRIT(HEAD.,35) SPACE IF EXEND THEN WRIT(HEA.2,25) ,ELSE WRIT(HEA.1,17) SPACE !SPACE T6_[T5C_[T5B_[T5A_[T5_[T4_[T3_TB+2]+3]+3]+1]+1]+1]+1 GO TO NXFIL !START LIST ! FILEP:IF $PK<0 THEN GO TO NXFIL !PURGED ENTRY IFNOT $PK THEN GO TO CLEAN ! END OF DIRECTORY IF FFLAG THEN[ \IF MASK OPTION IFNOT F.TST(PK) THEN GO TO NXFIL] !REJECT IF NOT IN SET. FOR T_TB TO TB+8 DO[$T_BLANK] !BLANK BUFFER BLKA_@BLKS. FOR T_TB+9 TO TB+11 DO \WRITE "BLKS" [$T_$BLKA; \ BLKA_BLKA+1] FOR T_TB+12 TO TB+80 DO [$T_BLANK] !BLANK REST OF LINE FOR T_TB TO T3 DO [$T_$PK;PK_PK+1] !SET NAME CONV.($PK3,$T4,5) !SET TYPE IF $PK3 THEN GO TO NOT0 !IF TYPE ZERO CONV.($PK4 AND 77K,$T5,2) !CONVERT LU $T5A_" (" !WRITE "(LU)" $T5B_"LU" $T5C_") " GO TO EXCK !ELSE NOT0: IF $PK6<0 THEN [ \IF SIZE IS NEGATIVE CONV.(-$PK6,$T5,5); \CONVERT SIZE (BLK MULTIPLES) $T5A_"*B"], \WRITE "*BLKS" ELSE CONV.($PK6/2,$T5,5) !ELSE, CONVERT SIZE (BLOCKS) ! EXCK: IFNOT EXEND THEN GO TO NAMST !NOT EXTENDED JMP ! !SET NAME LIST ORGIN ! T6_[PK_[PK6_[T2_[P_TB+12]+2]+3]+2]+2 IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8] $T2_$PK8 !CHECK SECURITY CODE IF NAM..($T2)=0 THEN GO TO DL3 !IF NOT VALID ASCII, THEN CONV.($PK8,$T2,5) !CONVERT AS NUMERIC DL3: IFNOT $PK3 THEN GO TO NAMST !IF TYPE ZERO CONV.($PK4,$PK6,5) !SKIP TRACK CONV.($PK5 AND 377K,$PK,3) !AND SECTOR NAMST:T2_T6 !SET WORKING ADDRESS ! IF $PK3 THEN [IF [T_($PK5 -<8)AND 377K] THEN[\ $T6_PLS.B ;CONV.(T,$(T6+1),3);GO TO PRT] ] ! REPEAT 7 TIMES DO THRU NAMSK NAMSK: IF $[PK8_PK8+1] THEN [ \IF OPEN FLAG, THEN P_($PK8 AND 377K)-1; \KEYWD TABLE OFFSET OF IDSEG KINDX_0; \COUNT TO CHECK FOR VALID OFFSET IDSG_$KEYWD; \GET KEYWD TABLE ADDRESS NXID: IF $IDSG THEN [ \IF NOT END OF TABLE, THEN IF KINDX # P THEN [ \IF NOT TO OFFSET YET, THEN KINDX_KINDX+1; \BUMP INDEX TO KEYWD TABLE IDSG_IDSG+1; \NEXT ENTRY IN KEYWD TABLE GO TO NXID], \CONTINUE KEYWD TABLE SEARCH ELSE [P_$IDSG+12; \GET PROGRAM NAME IF $P THEN [FOR T_P TO P+2 \ DO[ $T2_$T ;T2_T2+1];T_T2-1; \ $T_($T AND 177400K)+[IF $PK8<0 THEN \ MIN,ELSE 40K]]]]] PRT: P_TB+81 LNCK: IF $[P_P-1]=BLANK THEN GO TO LNCK L_P-TB+1 T_BF !SET BUFFER ADDRESS IF L>36 THEN[WRIT($BF,36);L_L-13;T_TB+14;\ FOR T6_T TO TB+35 DO $T6_BLANK] WRIT($T,L) ! WRITE THE LINE GO TO NXFIL ! CLEAN:WRITF(O.BUF,.E.R.,T,-1) !END FILE DL4: IFNOT DL THEN[LUPT_LUPT+4;GOTO AGAIN] IFNOT FOUND THEN ER_43 !ERR (NOT IN SST) RETURN END ! CKDID:SUBROUTINE FEXIT !VERIFY DISC IS IN FSTAT BUFFER IFNOT DL THEN RETURN !IF NOT GIVEN, NEEDN'T CHECK CLEND_LUPT !SET POINTER TO LU WORD OF CL IF DL < 0 THEN \IF NEGATIVE LU GIVEN, [LDIS_ -DL;CRN_0], \MAKE POSITIVE, CLEAR CRN FLAG ELSE \OTHERWISE [LDIS_DL;LUPT_LUPT+2;CRN_1] !SET PTR TO CRN WORD IN CL WHILE $CLEND DO \COMPARE UNTIL END OF CL OR FND [IFNOT CRN THEN \IF NEGATIVE LU WAS GIVEN, $LUPT_$LUPT AND 377K; \THEN MASK OFF LOCK FLAG IF LDIS=$LUPT THEN \IF FOUND A MATCH, [LUPT_@CL.BF;RETURN], \THEN RESET PTR TO CL, RETURN ELSE \OTHERWISE [LUPT_LUPT+4;CLEND_CLEND+4]] !BUMP TO NEXT CL ENTRY LUPT_@CL.BF !RESET PTR TO CL FRETURN END ! SETAD:SUBROUTINE FEXIT ! SET PACK DIRECTORY ENTRY ! ADDRESSES IF INDEX=128 THEN FRETURN !END BLOCK EXIT PK9_[PK8_[PK7_[PK6_[PK5_[PK4_[PK3_[PK_INDEX+@PK.DR]+\ 3]+1]+1]+1]+1]+1]+1 !SET THE ADDRESSES INDEX_INDEX+16 !STEP INDEX RETURN END ! WRIT: SUBROUTINE(BAD,NWORD) !WRITE N WORDS ON O.BUF !IF NOT A TTY TWO BLANKS ARE WRITF(O.BUF,.E.R.,$(@BAD+TTY),NWORD+1-TTY)!ADDED JER. !AT THE RETURN !FRONT END ! SPACE:SUBROUTINE $TB_BLANK !SET A 1 WORD BLANK WRIT($BF,1) !WRITE IT RETURN !RETURN END ! END END$