{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COMPRESS864)}}
====== COMPRESS864 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETHROW|CLOSETHROW]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DELETE|DELETE]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GETCORE|GETCORE]], [[george:macro:GETDIR|GETDIR]], [[george:macro:GETFNAME|GETFNAME]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:INFORM|INFORM]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENMAS|OPENMAS]], [[george:macro:OPENRELN|OPENRELN]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTINCS|OUTINCS]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PSTAC|PSTAC]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SFUB|SFUB]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSFIN|TRANSFIN]], [[george:macro:UNNORM|UNNORM]], [[george:macro:VFREEW|VFREEW]]
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