COMPRESS864
(George Source)
Macros used: ABANDCOM, ALTLENG, BC, BS, BXE, BXL, BXU, CHAIN, CLOSETHROW, CLOSETOP, DELETE, DOWN, ENDCOM, FILEAUTW, FILETRAN, FINDCORE, FREECORE, FSHCODE, FSHSKIP, GETCORE, GETDIR, GETFNAME, HUNT2J, INFORM, JBC, JBS, JMBS, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, OPEN, OPENMAS, OPENRELN, OPENSYS, OUTINCS, OUTPACK, OUTPARAM, PSTAC, READAGAIN, REWIND, SEGENTRY, SETNCORE, SFUB, STEP, STEPAGAIN, TESTREP, TESTRPN2, TOPFCA2, TOPFCB, TOPFCB2, TRACE, TRANSFIN, UNNORM, VFREEW
- COMPRESS864.txt
22FL #OPT K0COMPRESS=K0FILESTORE>K0ALLGEO 22^= #LIS K0COMPRESS 23DW #SEG COMPRESS40 [JUDY BIDGOOD 23YG #OPT K6COMPRESS=K6FILESTORE>K6ALLGEO 24D6 8HCOMPRESS 24XQ SEGENTRY K2COMPRESS,ZCOMPRESS 25CB # THIS SEGMENT IMPLEMENTS THE INCDUMP COMPRESS COMMAND TO COMPRESS VITAL 25X2 # SYSTEM FILES. THIS COMMAND CAN ONLY BE ISSUED UNDER :DUMPER. 266S ...SPACE #20202020 269C ... FSHSKIP B 26#2 ...( 26BL XMAS #4 26W= 4HMAST 27*W 4HER 27TG 4H 28SQ XFIL 4HSYST 29#B 4HEM F 29S2 4HILES 2=?L ...) 2=R= ZCOMPRESS 2=T8 ... FSHCODE B,XFSHBCOMP 2=X6 ...( 2=^4 ... BRN (GEOERR) 2?32 ...XFSHBCOMP 2?4Y ...) 2?6W ... FSHSKIP B 2?8S ...( 2?=W MONOUT COMPHEAD 2?QG STOZ AWORK1(2) [OLD SIZE OF FILE. 2#=6 STOZ AWORK2(2) [NEW SIZE OF FILE 2#PQ STOZ AWORK3(2) [OLD SIZE OF FILESTORE. 2*9B STOZ AWORK4(2) [NEW SIZE OF FILESTORE. 2*P2 SETNCORE 10,1,ADATA,CREADL 2B8L STOZ A1(1) 2B#H ... SETNCORE 16,1,FLIB,FLINC 2BDD ... LDN 0 1 2BJ* ... STO 0 A1(1) [REC HEADER 2BN= SETNCORE 6,1,FILE,FLOCNB 2C7W SETNCORE 4,2,FILE,FABSNB [SET UP FABSNB CONTAINING MASTER 2CMG LDN 1 XMAS(1) 2D76 ADN 2 A1 2DLQ MOVE 1 4 2DP5 ... OPENSYS XEND1,INCINDEX,GENERAL 2DRD ... GETFNAME [FABSNB FOR INCINDEX 2DTR ... BRN NEXTDIR 2DY6 ...XSTEPUP 2F9G ... LDN 0 1 2FGW ... ADS 0 AWORK3(2) 2FS= ... ADS 0 AWORK4(2) 2G5L XSTEP STEP 2GK= XSTEP1 2H4W BZE 3 XEND 2HJG LDX 0 ERES-A1(3) 2J46 BNZ 0 XSTEP [J IF NOT NAME RECORD. 2JHQ ... JBC XSTEP,3,BNINDEX 2JJS ... JMBS XSTEP,3,BNERASE,BNTEMP[NOT WORTH COMPRESSING 2JKW ... LDX 0 ECOPSN(3) 2JLY ... SRL 0 15 2JN2 ... SBN 0 1 2JP4 ... BNG 0 XSTEP [DON'T COMPRESS OR SEARCH IF EMPTY 2JQ6 ... ORX 0 EUSE1N(3) [X0=0 IF 1 BLOCK TERMINAL FILE 2JR8 ... BZE 0 XSTEPUP [CAN'T BE COMPRESSED 2JS= ... TESTBRKI XFIN 2JT# ... MHUNT 2,FILE,FLOCNB 2JWB ... LDX 0 EUSE1N(3) 2JXD ... BNZ 0 XDIR [J IF DIRECTORY 2JYG ... LDX 0 ELANN(3) 2J^J ... STO 0 A1+5(2) [UPDATE FLOCNB WITH LOCAL NAME 2K2L ... ADN 3 ELOC1N 2K3N ... LDN 4 A1(2) 2K4Q ... MOVE 3 5 2K5S ... BRN XBOTH 2K6W ...XDIR 2K7Y ... LDX 0 HCOLUSER [VVV: 2K92 ... STO 0 A1(2) [UPDATE FLOCNB WITH USERNAME 2K=4 ... STOZ A1+4(2) [UNUSED WORD 2K?6 ... LDN 1 ELOC1N(3) 2K#8 ... SUM 0 3 2K*= ... STO 0 A1+5(2) [STORE KEY 2KB# ... ADN 3 EUSE1N 2KCB ... LDN 4 A1+1(2) 2KDD ... MOVE 3 3 2KFG ...XBOTH 2KH2 CALL 6 TESTALT [ALTLEN FABSNB AND UPDATE R.H. SET X2 2L2L ADX 2 A1(2) [ADD IN NEW LENGTH OF FABSNB 2LG= ... ADN 2 A1-6 2L^W ... MHUNT 1,FILE,FLOCNB 2MFG ... ADN 1 A1 2M^6 ... MOVE 1 6 [UPDATE FABSNB FROM FLOCNB 2R8L ... READAGAIN 2R*G ... MHUNTW 1,FILE,FRB 2RGB ... NAME 1,FILE,ENT 2SJG ... OPENRELN XEND1,GENERAL,QUERY 2SPB ... TESTRPN2 OK,NOTOPEN 2SW= ... TOPFCB2 3 2T36 ... JBS XSTEP,3,BFDIR 2T82 ... BRN NEXTDIR 2T*2 XEND 2TSL MHUNT 1,FILE,FABSNB 2W#= LDX 0 A1(1) 2WRW SBN 0 4 2X?G BZE 0 XFIN [J IF END OF :MASTER 384Q NEXTDIR 38JB TOPFCB2 3 [X3 FCB OF FILE TO BE COMPRESSED 3942 #SKI K6COMPRESS>99-99 39HL TRACE FLOC1(3),LOCNAM 3=3= LDX 0 FBLMOD(3) 3=GW SBN 0 FBLKS-A1 3?2G SBN 0 1 3?G6 BNZ 0 XMORE [J IF MORE THAN 1 BLOCK IN FILE 3?^Q LDN 0 1 3#FB ADS 0 AWORK3(2) 3#^2 ADS 0 AWORK4(2) 3*#P ...NOOP CLOSETHROW 3*ND ... BRN NOTOPEN 3*Y= XMORE 3BCW ADN 0 1 3BXG STO 0 AWORK1(2) [OLD SIZE OF FILE 3CC6 ADS 0 AWORK3(2) [OLD SIZE OF FILESTORE 3CCH ... LDX 7 BSPRE(3) 3CCY ... LDX 4 7 3CD* ... SBN 7 48 [<48? 3CDQ ... BNG 7 XCONT 3CF7 ... LDX 3 BMISC [I.E.SPECIAL RES. 3CFJ ... LDX 5 BSAB [TYPE 3CF^ ...STEP LDX 3 FPTR(3) 3CGB ... BXE 3 CXMI,(GEOERR) [LAST? 3CGR ... BXU 5 ATYPE(3),STEP [BSLIST BLOCK? 3CH8 ... LDX 6 BACK1(3) 3CHK ... SBX 6 4 3CJ2 ... BNZ 6 STEP [NOT THIS RES.,CONT SCAN 3CJC ... LDX 7 BSFREE(3) 3CJS ... SBX 7 0 [ - NO BLOCKS IN FILE 3CK9 ... BPZ 7 XCONT 3CKL ... ADS 0 AWORK4(2) 3CL3 ... OUTPACK BACK1(3),1,NUMA [OUTPUT RESNO AS 1ST PARAM 3CLD ... CALL 7 OUTNAME [ FILENAME AS 2ND 3CLT ... MONOUT FNCOMPRESS 3CM= ... MHUNT 1,ADATA,CREADL 3CMM ... STOZ A1(1) 3CN4 ... MHUNT 2,FLIB,FLINC [SET RESNO IN FLINC 3CNF ... LDX 1 2 3CNW ... LDX 0 A1(2) 3CP? ... SBN 0 1 3CPN ... BZE 0 STORE 3CQ5 ...SCAN BXE 4 A1+2(2),NOOPA 3CQG ... ADN 2 1 3CQX ... BCT 0 SCAN 3CR# ...STORE STO 4 A1+2(2) 3CRP ... LDX 2 1 3CS6 ... LDN 1 1 3CSH ... ADS 1 A1(2) 3CSY ...NOOPA LDX 2 FX2 3CT* ... BRN NOOP 3CTQ ...XCONT 3CW= ... TOPFCB2 3 3CWQ LDN 7 0 3DBB ... BS 3,BFCORE [SET 'LEAVE BLOCKS IN CORE' BIT. 3F*L #SKI K6COMPRESS>99-99 3FT= TRACE FBLMOD(3),BEFORE 3G#W REWIND 3GSG PRESS 3H#6 STEP 3HRQ BZE 3 XPRESS [JIF END OF FILE 3J?B LDEX 3 FRH(3) 3JR2 SBX 7 3 [SUBTRACT R.H. FROM SPACE IN PREV. 3K=L TOPFCA2 2 [ BLOCK (IF ANY) 3KQ= LDX 0 FREADWORD(2) 3L9W SBN 0 A1 3LPG BNZ 0 PRESS [IGNORE IF NOT 1ST REC IN BLOCK 3M96 BNG 7 WONTFIT [JIF REC WON'T FIT IN PREV BLOCK 3MNQ READAGAIN 3N8B DELETE 3NN2 MHUNTW 1,FILE,FRB 3P7L NAME 1,FILE,FWB 3PM= DOWN INSERT,10 [INSERT REC @ END OF PREV BLOCK 3Q6W MFREEW FILE,FWB 3QLG BRN PRESS 3R66 WONTFIT 3RKQ LDN 7 GSBS-1 3S5B SBX 7 3 [START TO CALC AMOUNT OF SPACE IN 3SK2 CALL 6 SFUBFREE [DISPOSE OF USAGE BLOCK FOR 3T4L [PREVIOUS BLOCK OF FILE. 3TJ= BRN PRESS [ THIS BLOCK 3W3W XPRESS 3WHG TOPFCB2 3 3X36 LDX 0 FBLMOD(3) 3XGQ SBN 0 FBLKS-A1 3Y2B STO 0 AWORK2(2) [NEW SIZE OF FILE 3YG2 ADS 0 AWORK4(2) [NEW SIZE OF FILESTORE 3Y^L #SKI K6COMPRESS>99-99 3^F= TRACE FBLMOD(3),AFTER 3^P4 ... BC 3,BFCORE 3^S^ ... CLOSETHROW 3^YW LDX 0 AWORK2(2) 42DG SBX 0 AWORK1(2) 42Y6 BZE 0 ONEBLK 43CQ ... CALL 7 OUTNAME 4=Q6 OUTPACK AWORK1(2),1,NUMA [SET UP OLD SIZE AND NEW SIZE OF FILE 4?9Q OUTPACK AWORK2(2),1,NUMB [IN GMON/ASET BLOCK AS 2ND AND 3RD 4?PB MONOUT ECOMPRESS [PARAMETERS FOR OUTPUT. OUTPUT MESSAG 4#92 MHUNT 1,ADATA,CREADL 4#NL STOZ A1(1) 4*8= ONEBLK 4*9H ...NOTOPEN 4*=S ... CALL 1 XPOINT 4*N= ... HUNT2J 1,FILE,FABSNB,2,NOTSTART [J TO NOTSTART IF ONLY 1 FABSNB 4B5N ... FREECORE 2 [EXTRA FABSNB FOR INCINDEX 4BH6 ... OPENMAS XEND1,READ 4BPL ... BRN XSTEP 4BY6 ...NOTSTART 4C6Q MHUNT 1,FILE,FLOCNB 4CLB LDN 0 6 4D62 SBS 0 A1(2) [DECREMENT R.H. OF FABSNB 4DKL LDX 5 A1(2) 4F5= ADN 5 A1(2) 4FJW LDN 6 A1(1) 4G4G MOVE 5 6 [MOVE NAME FROM FABSNB TO FLOCNB 4GJ6 ... TESTBRKI XEND1 4H3Q ... OPEN XEND1,GENERAL,QUERY 4LF6 TESTREPN OK,NOTOPEN 4LYQ XOPEN 4MDB GETDIR 2 [NOTICE ERASEES,POSITION ON INDEX REC 4MY2 [TRAPS RECORD IF FOUND 4NCL ... VFREEW FILE,ENT 4NX= TESTREP OK,XSTEP 4PWG STEPAGAIN 4QB6 BRN XSTEP1 4QTQ XFIN 4R*B CLOSETOP [CLOSE MASTER 4RT2 XEND1 4S#L MHUNT 2,ADATA,CREADL [SET UP NAME :- FILESTORE IN CREADL 4SS= LDN 1 XFIL(1) [THEN MOVE TO GMON/ASET AS FIRST 4T?W [PARAMETER FOR OUTPUT 4TRG LDN 0 12 4W?6 STO 0 A1(2) 4WQQ ADN 2 CPDATA 4X=B MOVE 1 3 4XQ2 SBN 2 CPDATA 4Y9L OUTPARAM A1(2),CPDATA,ADATA,CREADL 4YP= LDX 2 FX2 4^8W OUTPACK AWORK3(2),1,NUMA 4^NG OUTPACK AWORK4(2),1,NUMB 5286 MONOUT FCOMPRESS [OUTPUT MESSAGE 528? ... MHUNT 2,FLIB,FLINC 528D ... LDX 5 A1(2) 528K ... SBN 5 1 528Q ... BZE 5 XEND2 [ NO MESSAGE 528X ... OUTINCS 5294 ... INFORM 0,BSSPECRES,1 5299 ... INFORM 0,FCCAOINF,1 529B ...XEND2 MFREE FLIB,FLINC 529H ... FSHCODE A,XFSHAABAND 52=Y ...( 52#* ... TESTBRKI XABAND [J IF BREAKIN BIT SET ELSE ENDCOM 52*Q ... TRANSFIN ,,ALIEN [RETURN IF CAME FROM MACHINE B 52C7 ... ENDCOM 52DJ ...XABAND 52F^ ... LDN 4 1 [OFFSET OF 1 - ABANDCOM 52HB ... TRANSFIN ,,ALIEN [RETURN IF CAME FROM MACHINE B 52JR ...XFSHAABAND 52L8 ...) 52MQ ... ABANDCOM 555W # SUBROUTINES 556D ...OUTNAME 5572 ... SBX 7 FX1 557J ... MHUNT 1,FILE,FABSNB 5586 ... LDX 3 A1(1) 558N ... GETCORE 3,1 559= ... MHUNT 1,FILE,FABSNB 559S ... FINDCORE 2 55=B ... NAME 2,FILE,FABSNB 55=Y ... LDN 1 A1(1) 55?G ... LDN 2 A1(2) 55#4 ... MOVE 1 0(3) 55#L ... MHUNT 1,ADATA,CREADL 55*8 ... SMO FX1 55*Q ... LDX 0 SPACE 55B# ... STO 0 A1+1(1) 55BW ... LDN 5 A1+1(1) 55CD ... LDN 6 A1+2(1) 55D2 ... MOVE 5 9 55DJ ... UNNORM FULL [SET NAME OF FILE UP IN CREADL BLOCK 55F6 ... MFREE FILE,FABSNB 55FN ... MHUNT 1,ADATA,CREADL [AND MOVE INTO GMON/ASET AS 55G= ... LDN 0 26 55GS ... STO 0 A1(1) 55HB ... OUTPARAM A1(1),CPDATA,ADATA,CREADL [FIRST PARAMETER FOR OUTPUT 55HY ... ADX 7 FX1 55JG ... EXIT 7 0 55KG XPOINT 5656 MHUNT 2,FILE,FABSNB 56JQ EXIT 1 0 574B TESTALT 57J2 CALL 1 XPOINT 583L LDX 5 A1(2) 58H= LDX 4 A1(2) 592W ADN 5 6 59GG BXL 4 ALOGLEN(2),RHEAD 5=26 SBX 6 FX1 5=FQ ALTLENG 2,5,XPOINT 5?F2 ADX 6 FX1 5?YL CALL 1 XPOINT 5#D= RHEAD 5#XW STO 5 A1(2) 5*CG EXIT 6 0 5*X6 # 5BBQ SFUBFREE 5BWB TOPFCB 1 [X1->FCB,X2->FCA. 5CB2 LDN 0 FBLKS 5CTL BXE 0 FREADBLOCK(2),(6) [J IF FIRST BLOCK OF FILE. 5D*= LDX 5 FREADBLOCK(2) 5DSW SBN 5 1 5F#G SMO 5 5FS6 LDX 4 0(1) [PICK UP BLK NO OF PREVIOUS BLOCK. 5G?Q PSTAC 2,2 5GRB SFUB 2,4,1,(6) [J IF NO USAGE BLOCK PRESENT. 5H?2 LDEX 0 ARINGNO(2) 5HQL SBN 0 1 5J== BZE 0 ONEFCA 5JPW ADN 0 1 5K9G ADN 2 A1 5KP6 STACKLOOK 5L8Q BXE 5 FREADBLOCK(2),(6) [J IF SOMEONE ELSE USING BLOCK. 5LNB ADN 2 FELLEN 5M82 BCT 0 STACKLOOK 5MML ONEFCA 5N7= LDX 0 ATYPE(1) 5NLW SRL 0 12 5P6G SBN 0 FILE+FUWB 5PL6 BZE 0 UWRITE 5Q5Q FREECORE 1 [FREE BLOCK IF IT'S A FURB. 5QKB EXIT 6 0 5R52 UWRITE 5RJL SBX 6 FX1 5S4= CHAIN 1,FX2 5SHW LDN 4 0 5T3G FILEAUTW 4,FAIL+FREE,,5 [WRITE AWAY BLOCK. 5TH6 ADX 6 FX1 5W2Q EXIT 6 0 5WGB FILETRAN 5WQ8 ...) 5X22 MENDAREA 50,K99COMPRESS 5XFL #END ^^^^ ...535033400003