Listing: 1 IMPLEMENTATION MODULE MemCompress; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, Wisconsin 8 * All rights reserved 9 * (414) 468-6040 10 * 11 * $Header: D:/logfiles/mods/memcompr.mov 1.5 10 Mar 1991 15:29:32 coleb $ 12 * 13 * 14 * Written and contributed by Doug Whitfield of Hornby Island, 15 * British Columbia. 16 * 17 *) 18 19 20 IMPORT SYSTEM; 21 IMPORT LowLevel; 22 IMPORT VStorage; 23 24 VAR 25 Initialized : BOOLEAN; 26 27 PROCEDURE Init(); 28 BEGIN 29 IF Initialized THEN 30 RETURN; 31 ELSE 32 Initialized := TRUE; 33 END; 34 LowLevel.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 35 VStorage.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 36 END Init; ***** ^ not supported yet 37 38 39 (* These procedures perform run-length coding compression and 40 decompression of memory blocks. InAddress and InSize are input 41 parameters specifing the starting address and length (in bytes) 42 of the memory block to be compressed or decompressed. If 43 OutAlloc is TRUE, OutAddress and OutSize are taken as input 44 parameters by Compress and the compressed block is put at the 45 specified location. If OutAlloc is FALSE, Compress attempts to 46 allocate memory for the compressed block. If the allocation 47 fails, the compression is abandoned and Compress returns the 48 value FALSE with ErrorFlag set to AllocationFailed. If the 49 allocation is successful, Compress returns the allocated area's 50 address and size. The maximum size of memory block it will 51 allocate is InSize bytes. If, during compression, the compressed 52 block exceeds the specified OutSize (when OutAlloc is TRUE) or 53 InSize (when OutAlloc is FALSE), the compression is abandoned and 54 Compress returns the value FALSE, with ErrorFlag set to 55 CompressedTooLarge. (A compressed block can exceed the size of 56 the uncompressed block from which it is derived if the latter 57 contains characters with ordinal value 254, as this value is used 58 as a designator for the start of a run, and isolated occurences 59 of this character must be translated into two successive 60 characters to avoid ambiguity.) If compression is successfully 61 completed, Compress returns the value TRUE with ErrorFlag set to 62 NoCompressError. 63 64 Decompress performs no error testing, and thus assumes that the 65 size of memory specified to receive the decompressed block is 66 sufficiently large. If Decompress is called with OutSize equal 67 to the value of InSize used during compression, this will be 68 true. 69 70 Compress will yield a useful degree of compression if the input 71 memory block contains runs of successive bytes containing the 72 same value. Such may be the case, for example, in CGA and EGA 73 graphics mode screen images. *) 74 75 76 TYPE 77 Address8086 = 78 RECORD 79 CASE : CARDINAL OF ***** ^ not supported yet ***** ^ 'POINTER' expected 80 1 : 81 a : SYSTEM.ADDRESS; 82 |2 : 83 b : POINTER TO CHAR; 84 END; 85 END; 86 87 VAR 88 NewCharOrd, OldCharOrd, TempOutSize: CARDINAL; 89 InCount, OutCount, RunCount, MaxRunCount, CharOrd, Index: 90 CARDINAL; 91 InAddress, OutAddress: SYSTEM.ADDRESS; 92 InCharPointer, OutCharPointer: Address8086; 93 Char: CHAR; 94 95 PROCEDURE GetChar():CARDINAL; 96 BEGIN 97 Char := InCharPointer.b^; 98 LowLevel.IncAddr( InCharPointer.a, 1 ); 99 INC (InCount); 100 RETURN ORD(Char); 101 END GetChar; 102 103 PROCEDURE PutChar (CharOrd:CARDINAL); 104 BEGIN 105 Char := CHR (CharOrd); 106 OutCharPointer.b^ := Char; 107 LowLevel.IncAddr( OutCharPointer.a, 1 ); 108 INC(OutCount); 109 END PutChar; 110 111 PROCEDURE CompOut (CharOrd:CARDINAL;RunCount:CARDINAL); 112 BEGIN 113 IF CharOrd = 254 THEN 114 IF RunCount > 1 THEN 115 PutChar(254); PutChar(RunCount); PutChar(254) 116 ELSE 117 PutChar(254); PutChar(254) 118 END (*IF*); 119 ELSE 120 IF RunCount = 1 THEN 121 PutChar(CharOrd) 122 ELSIF RunCount = 2 THEN 123 PutChar(CharOrd); PutChar(CharOrd) 124 ELSE 125 PutChar(254); PutChar(RunCount);PutChar(CharOrd) 126 END (*IF*); 127 END (*IF*); 128 END CompOut; 129 130 PROCEDURE Compress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL; 131 VAR OutAddress: SYSTEM.ADDRESS; VAR OutSize:CARDINAL; 132 OutAlloc:BOOLEAN):BOOLEAN; 133 BEGIN 134 ErrorFlag := Corruption; 135 IF NOT OutAlloc THEN 136 IF VStorage.DosAvail (InSize + 5) THEN 137 VStorage.DosAlloc(OutAddress, InSize + 5); 138 TempOutSize := InSize 139 ELSE 140 ErrorFlag := AllocationFailed; 141 RETURN FALSE; 142 END; 143 ELSE 144 TempOutSize := OutSize 145 END; 146 InCharPointer.a := InAddress; OutCharPointer.a := OutAddress; 147 InCount := 0; OutCount :=0; 148 OldCharOrd := GetChar(); 149 LOOP 150 RunCount := 1; 151 MaxRunCount := InSize - InCount + 1; 152 IF MaxRunCount > 253 THEN MaxRunCount := 253 END; 153 LOOP 154 NewCharOrd :=GetChar(); 155 IF NewCharOrd = OldCharOrd THEN 156 INC (RunCount); 157 IF RunCount = MaxRunCount THEN EXIT END 158 ELSE 159 EXIT 160 END (*IF*) 161 END (*LOOP*); 162 CompOut (OldCharOrd,RunCount); 163 IF OutCount >= TempOutSize THEN; 164 IF NOT OutAlloc THEN 165 VStorage.DosDealloc(OutAddress,InSize + 5); 166 END; 167 ErrorFlag := CompressedTooLarge; 168 RETURN FALSE 169 END; 170 OldCharOrd := NewCharOrd; 171 IF InCount = InSize THEN 172 IF RunCount # MaxRunCount THEN CompOut (OldCharOrd,1) END; 173 EXIT 174 END (*IF*) 175 END (*LOOP*); 176 IF NOT OutAlloc THEN 177 OutSize := OutCount; 178 VStorage.DosDealloc(OutCharPointer.a,InSize + 5 - OutSize); 179 END; 180 ErrorFlag := NoCompressError; 181 RETURN TRUE; 182 183 END Compress; 184 185 PROCEDURE Decompress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL; 186 OutAddress: SYSTEM.ADDRESS; OutSize:CARDINAL); 187 BEGIN 188 InCharPointer.a := InAddress; OutCharPointer.a := OutAddress; 189 InCount := 0; OutCount := 0; 190 WHILE InCount < InSize DO 191 CharOrd := GetChar(); 192 IF CharOrd = 254 THEN 193 RunCount := GetChar(); 194 IF RunCount = 254 THEN 195 PutChar (254) 196 ELSE 197 CharOrd := GetChar(); 198 FOR Index := 1 TO RunCount DO 199 PutChar (CharOrd); 200 END (*FOR*) 201 END (*IF*); 202 ELSE 203 PutChar (CharOrd) 204 END (*IF*) 205 END (*WHILE*); 206 OutSize := OutCount; 207 END Decompress; 208 209 BEGIN 210 Initialized := FALSE; 211 Init(); 212 END MemCompress. 9 errors