SPL,L,O,M ! NAME: PK.. ! SOURCE: 92067-18204 ! 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 PK..(8) "92067-16185 REV.1903 790424" ! ! MODIFICATION RECORD: ! ! 1) 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT THE ! DESTINATION AND TO CORRECTLY HANDLE FILES TO 32K SECTORS ! 2) 780516 TO HANDLE LOCK. ERROR RETURN PARAMETER ! 3) 780516 TO CHECK FOR SESSION CARTRIDGE ACCESS ERRORS ! 4) 780516 TO CORRECTLY REPORT DISC CRN OF LOCKED DISCS ! 5) 780721 TO USE NEW D.RTR CALLING SEQUENCE ! 6) 790113 TO MASK OFF LOCK IN LU WORD FROM DS.LU ! 7) 790123 TO REMOVE EXCEPTION FOR TYPE 4 PGMS FROM TRAK. ! 8) 790127 TO HANDLE PACK OF LARGE FILES (>32K SECTORS) ! ! PK.. IS THE PACKING ROUTINE FOR THE ! RTE FMGR PROGRAM. ! ! IT PACKS RTE FILES AS FOLLOWS: ! ! 1. IF DISC IS LU2 OR 3 A CHECK IS ! MADE TO INSURE NO CURRENT ID SEGMENTS ! POINT TO FILE TRACKS. ! ! 2. EACH FILE IS MOVED DOWN (IF NECESSARY). ! AFTER EACH FILE IS MOVED, ITS DIRECTORY ! ENTRY IS UPDATED. ! (THUS NO MORE THAN ONE FILE IS ! LOST BY A CRASH.) ! ! 3. AFTER ALL FILES ARE MOVED, A NEW DIRECTORY ! IS CREATED PACKING OUT ALL THE PURGED ! ENTRIES AND THIS IS WRITTEN ON THE DISC VIA D.RTR. ! ! THIS ROUTINE IS ENTERED BY THE COMMAND: ! ! PK,CR ! ! WHERE CR IS OPTIONAL AND RESTRICTS ! THE PACK TO DISC CR. ! ! DECLARE EXTERNALS ! LET CONV., \INTEGER TO ASCII CONVERSION D.RIO, \CARTRIDGE DIRECTORY READ DR.RD, \FILE DIRECTORY READ ROUTINE EXEC, \RTE EXEC ROUTINE FM.ER, \FMGR ERROR MESSAGE WRITE IER., \FMGR ERROR HANDLING ROUTINE LOCK., \CARTRIDGE LOCKING ROUTINE MSS., \FMGR ERROR MESSAGE ROUTINE READF, \FMP FILE READ ROUTINE RWNDF, \FMP FILE REWIND ROUTINE WRITF \FMP FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! LET .DAD, \DOUBLE INTEGER ADD .DSB, \DOUBLE INTEGER SUBTRACT .DMP, \DOUBLE INTEGER MULTIPLY JER. \FMGR ERROR HANDLING ROUTINE BE SUBROUTINE,EXTERNAL,DIRECT ! LET NAM.. \NAME CHECKING ROUTINE BE FUNCTION,EXTERNAL ! LET COR.A \ BE PSEUDO,EXTERNAL,DIRECT ! LET .E.R., \FMGR ERROR WORD .IDAD, \ .R.E., \FMGR INTERNAL ERROR WORD CUSE., \CURRENT SEGMENT D., \ASCII "D.RTR" D.SDR, \CARTRIDGE DIRECTORY BUFFER DS.LU, \DISC LOCK-LU WORD FROM CL I.BUF, \FMGR INTERNAL BUFFER O.BUF, \FMGR INTERNAL BUFFER OVRD., \SESSION CARTRIDGE OVERRIDE FLAG PK.DR \FILE DIRECTORY BUFFER BE INTEGER,EXTERNAL ! ! DECLARE INTERNAL SUBROUTINES ! LET BADTR, \ SETAD, \ TRAK. \CHECK ID'S POINTING TO TYPE 6'S BE SUBROUTINE ! ! DECLARE ARRAYS ! LET DW64(2),BLKMP(2),SECSZ(2),SIZ(2), \ SIZ2(2),TRK.A(2),XFER(2) \ BE INTEGER LET BTL(6) BE INTEGER LET MS(3),MS2,MS3,MS4 BE INTEGER ! INITIALIZE MS TO "DISC =" INITIALIZE BLKMP TO 0,256 INITIALIZE DW64 TO 0,64 ! ! DECLARE CONSTANTS ! LET READI BE CONSTANT( 1) LET WRIT BE CONSTANT( 2) LET BKLWA BE CONSTANT(1777K) LET XEQT BE CONSTANT(1717K) LET KEYWD BE CONSTANT(1657K) LET SECT2 BE CONSTANT(1757K) LET SECT3 BE CONSTANT(1756K) LET A BE CONSTANT( 3 ) LET B BE CONSTANT( 1 ) ! ! PK..: SUBROUTINE(N,LIS,ER) GLOBAL !ENTRY POINT PACK_$(@LIS+1) !GET THE PACK LUPT_@D.SDR !SET CL BUFFER ADDRESS PAKAD_@PK.DR !SET FILE DIRECTORY ADDRESS PK1: D.RIO(READI) !READ CL TO D.SDR ! AGAIN:DIS_[IF PACK THEN PACK,ELSE -($LUPT AND 377K)] IFNOT DIS THEN RETURN !END OF DISC DIRECTORY CALL JER. !CHECK FOR BREAK LOCK.(DIS,3,LKER)?[IF LKER = -32 THEN \IF ACCESS ERROR [IF PACK THEN [MSS.(LKER); \AND CRN GIVEN, WRITE ERROR GO TO NXDIS],\CONTINUE TO NEXT DISC ELSE GO TO NXDIS]; \ELSE SKIP TO NEXT DISC MSS.(LKER); \PRINT ERR OTHER THAN -32 MS2_DIS;MS3,MS4_" "; \BLANKS TO PAD ASCII NAME IF NAM..(MS2) THEN \IFNOT VALID NAMR, CONVERT DIGITS [IF DIS<0 THEN [ \IF LU NEGATIVE, DNO_-DIS;MS2_"- "], \MAKE POSITIVE, PREPARE FOR WRITE ELSE [DNO_DIS;MS2_" "]; \POSITIVE ALREADY CONV.(DNO,MS4,5)]; \CONVERT DISC NUMBER TO ASCII FM.ER(2,MS,6); \WRITE NUMBER OF LOCKED DISC GO TO NXDIS] !CONTINUE TO NEXT DISC ! DR.RD(READI,DIS,0)?[ER_54;RETURN] !READ SPECIFICATION ENTRY ! FILCO_0 SETAD LU_$$@DS.LU AND 377K !SET LU, MASKING OFF LOCK FLAG ! ! SET UP DCBS FOR PACKING ! DCB5_[NXSEC_[NXTR_[DCB2_[\ DCB_@O.BUF]+2]+1]+1]+1 DCB21_[DCB20_[DCB19_[OBUF_[DCB9_[DCB8_[DCB7_[DCB6_ \ DCB5+1]+1]+1]+1]+7]+3]+1]+1 FOR T_DCB TO [TBUF_DCB+32] DO $T_0 !CLEAR THE DCB $DCB_LU $DCB2_1 $DCB6_128 !SET RECORD SIZE $DCB7_100200K !SECURITY FLAG $DCB8_$PKD6 !SECTORS PER TRACK $DCB9_$XEQT !OPEN FLAG FOR T_DCB TO DCB9 DO[T1_T+16;$T1_$T] IF LU<4 THEN TRAK.(LU)?[GO TO PK26] !IF 2 OR 3, CHECK TYPE 6'S ! ! THE DISC IS LOCKED AND WE MAY START ! PACKING - WE MUST HAVE A BUFFER ! AND ITS SIZE. IF WE ARE IN THE ! BACKGROUND USE ALL THE REST OF ! CORE; ELSE USE 0.BUF+32 (256 WDS) ! IF ($($XEQT+14)AND 7)#3 THEN GOTO PK3 PK2: IF[LN_($BKLWA-[COR.A,BUFAD_.IDAD]+1)\BUFAD GETS VALUE FROM COR.A AND 77600K]>256 THEN GO TO PK5 ! PK3: DO[LN_256;BUFAD_TBUF] PK5: SECSZ(1)_0 SECSZ(2)_LN-<10 !NBR. OF SECTORS AVAILABLE TO USE ! ! BUFFER AND LENGTH ARE SET NOW ! START TO PACK ! ! DO[$NXTR_$PKD4; FOR\ T_@BTL TO @BTL+5 DO[\ PKD9_PKD9+1; $T_$PKD9]] $NXSEC,BLK_0 NXBLK:DR.RD(READI,DIS,BLK)?[GO TO CLEAN] ! FILCO_0 ! NXFIL:SETAD?[GO TO WRBLK] ! ! IFNOT $PKD THEN GOTO CLEAN !END ! IF $PKD<0 THEN GOTO NXFIL !PURGED IFNOT $PKD3 THEN GOTO NXFIL !TYPE0 ! ! IF THE FILE CONTAINS A BAD TRACK ! PURGE IT AND CONTINUE ! BADTR($PKD4,[$DCB20_$PKD5 AND 377K],$PKD6)?[WRFL,$PKD_ -1;\ GO TO WRBLK] ! ! ! COMPUTE NEW LOCATION ! NEWLO:BADTR($NXTR,$NXSEC,$PKD6)?[\ $NXTR_$BT+1;$NXSEC_0;GO TO NEWLO] ! ! IF NEW LOCATION SAME AS OLD THEN ! GO TO NEXT FILE ! IF $NXTR=$PKD4 THEN [IF $NXSEC=$DCB20 THEN\ GO TO PK11] ! ! FAKE OPEN THE FILES ! WRFL,CO,$DCB5,$DCB21_$PKD6 !# OF SECTORS IF CO<0 THEN \IF SIZE NEGATIVE, [.B._-CO;.A._0; \ CALL .DMP(BLKMP); \MPY BY BLOCK MULTIPLIER * 2 SIZ(1)_.A.;SIZ(2)_.B.], \AND SAVE ELSE [SIZ(1)_0;SIZ(2)_CO] !ELSE JUST MAKE IT DOUBLE WORD $DCB19_$PKD4 !START TRACK RWNDF(O.BUF,.E.R.) !SET REST OF DCB IER. RWNDF($OBUF,.E.R.) !FOR IN AND OUT IER. PK10: .B._SIZ(2);.A._SIZ(1) !IF FILE SIZE(SECTORS) IS CALL .DSB(SECSZ) !GREATER THAN NUMBER OF IF .A. >= 0 THEN [ \AVAILABLE SECTORS TO USE, IF (.A. OR .B.) # 0 THEN [ \THEN USE 256 WORDS, ELSE XFER(1)_0;XFER(2)_LN; \USE FILE SIZE IN WORDS GOTO PK10A]] ! .B._SIZ(2);.A._SIZ(1) !GET FILE SIZE CALL .DMP(DW64) !CONVERT TO WORDS XFER(1)_.A.;XFER(2)_.B. !NUMBER OF WORDS TO TRANSFER PK10A:READF($OBUF,.E.R.,$BUFAD,XFER(2)) IER. WRITF(O.BUF,.E.R.,$BUFAD,XFER(2)) IER. XFER(2)_XFER(2) -< 10 !IF MORE WORDS, CONTINUE XFER .B._SIZ(2);.A._SIZ(1) !GET CURRENT SIZE CALL .DSB(XFER) !SUBTRACT WORDS MOVED SIZ(1)_.A.;SIZ(2)_.B.;.A._SIZ(1) !UPDATE WORDS LEFT TO MOVE IF (.A. OR .B.) THEN GOTO PK10 !CONTINUE IF NON-ZERO DO[$PKD4_$NXTR;$PKD5_$NXSEC+($PKD5 AND 177400K)] PK11: DO[$NXTR_NTR;$NXSEC_NSEC]!UPDATE FOR NEXT FILE ! ! POINTERS ARE UPDATED ! ! FILE IS MOVED - UPDATE DIRECTORY ! THEN GO DO NEXT FILE. ! WRBLK:IF WRFL THEN[DR.RD(WRIT,DIS,BLK);WRFL_0] IF FILCO=128 THEN[BLK_BLK+1;GOTO NXBLK],ELSE\ GO TO NXFIL CLEAN:BLK,CO_0 PK12: DR.RD(READI,DIS,BLK)?[GO TO PK25] DO[FILCO_0;SETAD] IF BLK THEN GO TO PK16 DO[$PKD5_$NXSEC;$PKD9_$NXTR;$NXSEC_0] !SET NEXT SEC,TRK NSEC_$SECT2 IF $SECT3 THEN [IF $SECT3<$SECT2 THEN NSEC_$SECT3] $DCB5_-$PKD8*$PKD6+2 !TRKS IN DIR * SECTORS PER TRK NTR_$DCB5/NSEC IF $B THEN NTR_NTR+1 EXEC(4,NTR,$NXTR,$DCB,$DCB8) !GET TRACK(S) $DCB6_16 $DCB2_2 RWNDF(O.BUF,.E.R.) IER. PK16: IFNOT $PKD THEN GOTO PK25 IF $PKD+1 THEN[WRITF(O.BUF,.E.R.,$PKD);\ IER.;CO_CO+1] SETAD?[BLK_BLK+1;GOTO PK12] GOTO PK16 ! PK25: FOR T_PKD TO PKD+15 DO $T_0 FOR T_CO TO($DCB5-2)*4 DO[\ WRITF(O.BUF,.E.R.,$PKD);IER.] ! PK15: TRK.A(1)_$DCB TRK.A(2)_$NXTR RQST_OVRD. OR 7 EXEC(23,D.,$XEQT,RQST,DIS,$DCB8,0,TRK.A,2) DO[AREG_$0;BREG_$1;IF AREG THEN GOTO PK15] DO[.E.R._$BREG;IER.] !CHECK ERRORS PK26: LOCK.(DIS,5) !UNLOCK DISC EXEC(5,-1) !RETURN TRACKS NXDIS:I.BUF_0 !CLEAR I.BUF IN CASE WE EXIT IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] RETURN END ! ! SETAD SETS THE ADDRESSES FOR THE NEXT FILES ENTRY ! IN PK.DR - IF NONE THEN AN FRETURN IS MADE. ! SETAD:SUBROUTINE FEXIT ! IF FILCO=128 THEN FRETURN PKD9_[PKD8_[PKD6_[PKD5_[PKD4_[PKD3_[PKD_\ PAKAD+FILCO]+3]+1]+1]+1]\ +2]+1 FILCO_FILCO+16 RETURN END ! ! BADTR RETURNS FALSE IF THE CURRENT FILE ! AREA CONTAINS A BAD TRACK. ! BADTR:SUBROUTINE(TRAK,SECT,NOSEC)FEXIT SIZ3_$DCB8 -> 1 IF NOSEC<0 THEN \COMPUTE NEXT TRACK AND SECTOR, [.B._-NOSEC;.A._0; \AVOID 32K SECTORS SIGN PROBLEM CALL .DMP(BLKMP); \IF NEGATIVE SIZE, USE MULTIPLIER SIZ2(1)_.A.;SIZ2(2)_.B.], \SAVE ELSE [SIZ2(1)_0;SIZ2(2)_NOSEC]!ELSE JUST MAKE IT DOUBLE WORD .B._SECT;.A._0 CALL .DAD(SIZ2) ASSEMBLE ["CLE,SLA"; \DIVIDE DOUBLE WORD BY 2 "CCE"; \ "ARS"; \ "ERB"; \ "SWP"; \DIVIDE BY BLOCKS "JSB .DIV"; \ "DEF SIZ3"] NTR_.A.+TRAK NSEC_$B+$B !NEXT TRACK & SECTOR (32K SECTORS SIGN PROB.) ! CHECK EACH TRACK AGAINST THE BAD LIST. FOR T_TRAK TO[IF NSEC THEN 0,ELSE -1]\ + NTR DO[\ FOR BT_@BTL TO @BTL+5 DO[ \ IF $BT THEN[IF T=$BT THEN FRETURN]]] RETURN END ! ! TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE ! FILE MANAGEMENT TRACKS. IF ANY ARE FOUND, THE ! NAME OF THE PROGRAM IS PRINTED, ! AND AN FEXIT IS TAKEN. ! TRAK.:SUBROUTINE(LOGUN) FEXIT LU3_LOGUN AND 1 !SET LU 3 FLAG DO[NSEC,FILCO_0;NTR_($PKD4-<7)] !GET NEXT TRACK SETAD T_$KEYWD !SET INDEX TO KEYWD LIST NEXT: DMAN_[NAM3_[NAM2_[NAM1_$T+12]+1]+1]+12 IF $NAM3 AND 20K THEN DMAN_NAM3+5 !ADJUST FOR SHORT ID SEGS IF [T2_$NAM3 AND 7]=1 THEN GOTO OK !NO CHECK NEEDED FOR TYPE 1 IF (($DMAN-<1)AND 1)#LU3 THEN GOTO OK !COMPARE DISC LU IF ($DMAN AND 77600K)