SPL,L,O,M ! NAME: PK.. ! SOURCE: 92071-18027 ! RELOC: 92071-16027 ! PGMR: G.A.A. ! MOD: G.L.M., 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 PK..(7) "92071-1X027 REV.2041 800629" ! ! MODIFIED 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT ! THE DESTINATION AND ALSO TO CORRECTLY HANDLE FILES TO 32K SECTORS ! ! MODIFIED 800627 FOR THE RTE-L/20 FMGR ! ! PK.. IS THE PACKING ROUTINE FOR THE RTE FMGR PROGRAM. ! ! IT PACKS RTE FILES AS FOLLOWS: ! ! 1. 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 OR "OF".) ! ! 2. AFTER ALL FILES ARE MOVED, A NEW DIRECTORY ! IS CREATED REMOVING ALL THE PURGED ENTRIES. ! THIS IS WRITTEN ON THE DISC DIRECTLY AFTER ! REQUESTING A LOCK VIA D.RTR ! ! THIS ROUTINE IS ENTERED BY THE COMMAND: ! ! PK,CR ! ! WHERE CR IS OPTIONAL AND RESTRICTS ! THE PACK TO DISC CR. ! ! EXTERNAL SUBROUTINES LET EXEC BE SUBROUTINE,EXTERNAL LET LIMEM BE SUBROUTINE,EXTERNAL ! LET CONV. BE SUBROUTINE,EXTERNAL LET DR.RD BE SUBROUTINE,EXTERNAL LET FM.ER BE SUBROUTINE,EXTERNAL LET IER. BE SUBROUTINE,EXTERNAL,DIRECT LET JER. BE SUBROUTINE,EXTERNAL,DIRECT LET MSS. BE SUBROUTINE,EXTERNAL LET MVW BE SUBROUTINE,EXTERNAL LET SY.TR BE SUBROUTINE,EXTERNAL ! LET FSTAT BE SUBROUTINE,EXTERNAL LET READF BE SUBROUTINE,EXTERNAL LET RWNDF BE SUBROUTINE,EXTERNAL LET WRITF BE SUBROUTINE,EXTERNAL ! ! EXTERNAL FUNCTIONS LET CRLK BE FUNCTION,EXTERNAL LET CRULK BE FUNCTION,EXTERNAL LET GTOPN BE FUNCTION,EXTERNAL ! ! EXTERNAL VARIABLES LET .E.R BE INTEGER,EXTERNAL LET DS.LU BE INTEGER,EXTERNAL LET I.BUF BE INTEGER,EXTERNAL LET O.BUF BE INTEGER,EXTERNAL LET PK.DR BE INTEGER,EXTERNAL ! ! INTERNAL SUBROUTINES LET BADTR BE SUBROUTINE LET SETAD BE SUBROUTINE ! ! INTERNAL VARIABLES LET D.SDR(128)BE INTEGER LET BTL(6) BE INTEGER LET MS(3) BE INTEGER LET MS2 BE INTEGER LET MS3 BE INTEGER LET MS4 BE INTEGER INITIALIZE MS TO "DISC =" ! ! INTERNAL CONSTANTS LET READI BE CONSTANT( 1) LET WRIT BE CONSTANT( 2) ! ! PK..: SUBROUTINE(N,LIS,ER) GLOBAL !ENTRY POINT PACK_$(@LIS+1) !GET THE PACK LUPT_@D.SDR !GET ADRS OF CART DIR PAKAD_@PK.DR !SET DIREC. BUFFER ADRS CALL LIMEM(1,FWAM,WRDS) !SEE IF MEMORY AVAIL. WRDS_WRDS AND 77600K !FULL SECTOR BOUNDS ! PK1: FSTAT(D.SDR,128) !READ CART DIR TO D.SDR ! AGAIN:DIS_[IF PACK THEN PACK,ELSE -$LUPT] !PACK PARM OR CART LIST IFNOT DIS THEN [CALL LIMEM(-1); \END OF DISC DIRECTORY RETURN] !RETURN MEMORY AND EXIT CALL JER. !CHECK FOR BREAK IF [T_CRLK(DIS)] THEN [ \ MSS.(T); \LOCK DISC/PRINT THE ERROR IF DIS<0 THEN [ \IF LU NEGATIVE DNO_ -DIS; \MAKE POSITIVE MS2_ "- "], \ ELSE [ \POSITIVE ALREADY DNO_ DIS; \ MS2_ " "]; \ CONV.(DNO,MS4,5); \CONVERT NUMBER TO ASCII FM.ER(2,MS,6); \WRITE CRN GOTO NXDIS] !GOTO NEXT ! DR.RD(READI,DIS,0)?[ER_-32;RETURN] !READ 1ST DIR BLK ! SY.TR(DIS,T,1,HITRK,HISEC) !GET HI DISC ADDR IN USE FILCO_0 !CLEAR FILE COUNT SETAD !SET PTRS TO NXT ENTRY ! ! 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 ! ! TBUF_ DCB+32 ! O.BUF_ 0 ! MVW(DCB,DCB+1,31) !CLEAR FIRST 31 ENTRIES $DCB_DS.LU !SET LU INTO DCB $DCB2_1 !SET TYPE 1 (FORCE TO 1) $DCB6_128 !SET RECORD SIZE $DCB7_100200K !SECURITY FLAG $DCB8_$PKD6 AND 377K !SET #SECT TRACK $DCB9_GTOPN !AND OPEN FLAG MVW(DCB,OBUF,16) !COPY TO 2ND DCB ! ! THE DISC IS LOCKED AND WE MAY START ! PACKING - WE MUST HAVE A BUFFER ! AND ITS SIZE. IF LIMEM GOT MORE ! THAN 256 WORDS USE THAT MEMORY; ! ELSE USE O.BUF+32 (256 WDS) ! ! ! WRDS AND FWAM WERE SET UP BY CALL TO LIMEM UPON ENTRY ! IF WRDS>256 THEN[ \ BUFAD_ FWAM; \SET POINTER TO PACK BUF LN_ WRDS; \SET LENGTH OF BUFFER GOTO PK5] !USE LARGER BUF FOR SPEED ! PK3: LN_ 256 !USE INTERNAL BUFFER BUFAD_ TBUF !OF O.BUF/I.BUF PK5: SECSZ_ LN-<10 !SET SECTOR COUNT ! ! BUFFER AND LENGTH ARE SET NOW ! START TO PACK ! $NXTR_ $PKD4 !SET TO 1ST FMP TRACK FOR T_ @BTL TO @BTL+5 DO[ \SET UP BAD PKD9_PKD9+1; \TRACK LIST $T_ $PKD9] ! $NXSEC_ 0 !INIT SECTOR BLK_ 0 !INIT BLOCK COUNTER GOTO NXFIL !SKIP HEADR BLOCK ! NXBLK:DR.RD(READI,DIS,BLK)?[GO TO CLEAN] !READ DIRECTORY BLOCK FILCO_0 !RESET DIRECTORY PTR ! NXFIL:SETAD?[GO TO WRBLK] !SET PKD PTRS TO NX FILE ! IFNOT $PKD THEN GOTO CLEAN !TEST FOR 0 AT END OF DIRECT IFNOT $PKD3 THEN GOTO NXFIL !SKIP TYPE 0 ! SEK_ $PKD5 AND 377K !GET SECTOR FROM DIRECTORY IF $PKD4 < HITRK THEN GOTO SKIP !SKIP UNTIL HI TRACK IF $PKD4 = HITRK THEN[ \IF BELOW HIGHEST BOUNDRY IF SEK <= HISEC THEN[ \CALCULATE NEW SKIP: $NXTR_ ((SEK+$PKD6)->1)/($DCB8->1)+$PKD4;\NEXT TRACK $NXSEC_ .B.+.B.; \AND SECTOR GOTO NXFIL]] !AND GO WORK ON NEXT FILE ! IF $PKD<0 THEN GOTO NXFIL !PURGED ! IF [T_ ($PKD >-8)] >= 60K THEN [ \IF 1ST CHAR IS NUMERIC IF T <= 71K THEN [ \THEN FILE IS A SCR FILE WRFL,$PKD_ -1; \PURGE SCRATCH FILES GOTO WRBLK]] !AND UPDATE DIRECTORY ! ! IF THE FILE CONTAINS A BAD TRACK ! PURGE IT AND CONTINUE ! BADTR($PKD4,[$DCB20_$PKD5 AND 377K],$PKD6)?[WRFL,$PKD_ -1;\IF 'FROM' GO TO WRBLK] !HAS BAD TRK, PURGE IT ! ! ! COMPUTE NEW LOCATION ! NEWLO:BADTR($NXTR,$NXSEC,$PKD6)?[ \IF 'TO' FILE HAS BAD $NXTR_$BT+1;$NXSEC_0;GO TO NEWLO] !TRK, SKIP TRK ! ! IF NEW LOCATION SAME AS OLD THEN ! GO TO NEXT FILE ! IF $NXTR=$PKD4 THEN[ \IF TO & FROM TRKS IF $NXSEC=$DCB20 THEN \AND SECTORS MATCH GOTO PK11] !SKIP COPY ! ! FAKE OPEN THE FILES ! WRFL_ -1 !SET 'WRITTEN-ON' FLAG CO,$DCB5,$DCB21_ $PKD6 !SET # OF SECTORS $DCB19_ $PKD4 !START TRACK RWNDF(O.BUF,.E.R) !SET REST OF FROM DCB IER. !CHECK FOR ERRORS RWNDF($OBUF,.E.R) !SET REST OF TO DCB IER. !CHECK FOR ERRORS PK10: XFER_[IF CO>SECSZ THEN LN,ELSE CO-<6] !SET # OF WRDS TO XFER READF($OBUF,.E.R,$BUFAD,XFER) !READ FROM FILE IER. !CHECK FOR ERRORS WRITF(O.BUF,.E.R ,$BUFAD,XFER) !WRITE 'TO' FILE IER. !CHECK FOR ERRORS IF [CO_CO-(XFER-<10)] THEN GOTO PK10 !SET REMAINING SIZE $PKD4_ $NXTR !SET IN NEW DIRECT ADRS $PKD5_ $NXSEC+($PKD5 AND 177400K) !FOR COPIED FILE PK11: $NXTR_NTR !UPDATE PTRS FOR $NXSEC_ NSEC !NEXT FILE ! ! PONTERS ARE UPDATED ! ! FILE IS MOVED - UPDATE DIRECTORY ! THEN GO DO NEXT FILE. ! WRBLK:IF WRFL THEN[ \IF 'WRITTEN-ON' FLAG DR.RD(WRIT,DIS,BLK); \SET WRITE OUT UPDATED WRFL_ 0] !DIRECTORY INFO IF FILCO=128 THEN[ \IF DIR PTR AT BLK_ BLK+1; \END OF DIR BLK GOTO NXBLK], \SET UP FOR NEXT ELSE GOTO NXFIL !ELSE UPDATE PTRS ! ! ! --- THIS SECTION PACKS THE DIRECTORY ---------------------------------- ! ! CLEAN:TCNT,FCNT,FBLK,TBLK_ 0 !INITIALIZE POINTERS FBF_ @PK.DR !SET ADDRESS OF DIR BUF TBF_ @O.BUF !SET ADRS OF OUTPUT BUF ! TOP: DR.RD(READI,DIS,FBLK)?[GO TO EED] !READ DIR BLOCK !GOTO END IF LAST + 1 IF FBLK THEN GOTO PCK !IF NOT 1ST, CONTINUE ! FILCO_0 !CLEAR FILE COUNT FOR SETAD SETAD !THIS IS THE DIR ID $PKD9_$NXTR !SET NEXT TRACK $PKD5_$NXSEC !SET THE NEXT SECTOR GO TO MOK !MOVE THIS ENTRY ! ! PCK: IFNOT [T_$(FBF+FCNT)] THEN GOTO EED !GET OUT IF END OF DIR IF [NXTR_ $(FBF+FCNT+4)] < HITRK THEN GOTO MOK !BELOW, MOVE IT IF NXTR = HITRK THEN[ \BELOW PACK BOUNDRY IF ($(FBF+FCNT+5) AND 377K) <= HISEC THEN \OR ON IT, MOVE GOTO MOK] !ENTRY IF T<0 THEN GOTO NEX !IF PURGED-TRY NEXT ONE ! MOK: MVW(FBF+FCNT,TBF+TCNT,16) !MOVE DIR ENTRY TO SAVE BUF IF [TCNT_TCNT+16]=128 THEN[ \BUMP OUT COUNT-IF FULL TCNT_0; \RESET OUT COUNT DR.RD(-2,DIS,TBLK); \WRITE THE BLOCK TBLK_TBLK+1] !BUMP THE BLOCK CONUT ! NEX : IF [FCNT_FCNT+16]=128 THEN[ \BUMP IN COUNT-IF EMPTY FCNT_0; \RESET IN COUNT FBLK_ FBLK+1; \BUMP BLOCK COUNT GOTO TOP], \GO READ NEXT BLOCK ELSE GOTO PCK !ELSE DO NEXT ENTRY ! ! --- CLEAR REMAINDER OF DIRECTORY --- ! EED: $(TBF+TCNT)_ 0 !CLEAR "CURRENT" FW OF BUF T_(128-TCNT)-1 !CALCULATE # WORDS TO MOVE !TO CLEAR REST OF BUFFER MVW(TBF+TCNT,TBF+TCNT+1,T) !CLEAR REST OF BUFFER WIPE: DR.RD(-2,DIS,TBLK) !WRITE IT OUT TBLK_TBLK+1 !BUMP BLOCK COUNT ! ! IFNOT FBLK < TBLK THEN[ \CLEAR REST OF DIRECTORY IFNOT TCNT THEN GOTO WIPE, \CONT AT WIPE IF ELSE[ \ELSE CLEAR FULL BUFFER TCNT_0; \ GOTO EED]] ! ! PK26: CRULK(DIS) !UNLOCK DISC NXDIS:I.BUF_ 0; O.BUF_ 0 !CLEAR FW SO CLOSE WON'T !GET SCREWED UP IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] CALL LIMEM(-1) 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 ! ! COMPUTE NEXT TRACK AND SECTOR ! NTR_((SECT+NOSEC)->1)/($DCB8->1)+TRAK !(ROTATE TO AVOID) NSEC_ .B.+.B. !(32K SIGN PROBLEM) ! ! 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 END END$ !