Permalink
Browse files

PasZip FPC/Linux compatibility and x86-64 performance fix

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Jan 11, 2019
1 parent 3648678 commit e49cf64cf9f64e0f8381f3fc01efda995aa3355c
Showing with 65 additions and 60 deletions.
  1. +64 −59 PasZip.pas
  2. +1 −1 SynopseCommit.inc
@@ -33,14 +33,15 @@
- CRC32 table can be generated by code (save 1KB in executable)
- Inflate made 50% faster than MadLib's original by tuned Move() usage
and some critical part rewrite
- included .zip archive reading from file, resource or direct memory
- included .zip archive write into a file (new .zip creation, not update)
- .zip reading from file, resource or direct memory - Windows only
- .zip write into a file (new .zip creation, not update) - Windows only
Version 1.18
- enhanced compatibility with new targets and compilers (Win32, Win64,
Delphi 2009+, FPC)
- even more refactoring, and fixes
- .zip supported for Windows only
}

@@ -57,7 +58,6 @@ interface
{$ifdef MSWINDOWS}
Windows,
{$else}
LibC,
Types,
{$endif}
SysUtils;
@@ -80,10 +80,10 @@ function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;
/// uncompress memory using the ZLib INFLATE algorithm
function UnCompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;

/// compress memory using the ZLib DEFLATE algorithm
/// compress memory using the ZLib DEFLATE algorithm with a crc32 checksum
function CompressString(const data: RawByteZip; failIfGrow: boolean = false): RawByteZip;

/// uncompress memory using the ZLib INFLATE algorithm
/// uncompress memory using the ZLib INFLATE algorithm, checking crc32 checksum
function UncompressString(const data: RawByteZip): RawByteZip;


@@ -112,12 +112,12 @@ function IsCompressedFileEqual(const uncomprFile, comprFile: TFileName): boolean
// is set to TRUE.
function Zip(const zip: TFileName; const files, zipAs: array of TFileName;
NoSubDirectories: boolean = false): boolean;
{$endif}


/// create a void .zip file
procedure CreateVoidZip(const aFileName: TFileName);

{$endif MSWINDOWS}

/// create a compatible .gz file (returns file size)
function GzCompress(src: pointer; srcLen: integer; const fName: TFileName): cardinal;

@@ -128,14 +128,17 @@ function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal
{$DEFINE DYNAMIC_CRC_TABLE}
{ if defined, the crc32Tab[] is created on staturp: save 1KB of code size }

type
TCRC32Tab = array[0..255] of cardinal;

/// the static buffer used for fast CRC32 hashing
{$ifdef DYNAMIC_CRC_TABLE}
var
crc32Tab: array[0..255] of cardinal;
crc32Tab: TCRC32Tab;
{$else}

const
crc32Tab: array[0..255] of cardinal = ($00000000, $77073096, $ee0e612c,
crc32Tab: TCRC32Tab = ($00000000, $77073096, $ee0e612c,
$990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
$e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064,
$6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
@@ -175,6 +178,8 @@ function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal
$2d02ef8d);
{$endif}

{$ifdef MSWINDOWS}

type
/// generic file information structure, as used in .zip file format
// - used in any header, contains info about following block
@@ -225,7 +230,6 @@ function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal
commentLen: word; // 0
end;

{$ifdef MSWINDOWS}
type
/// stores an entry of a file inside a .zip archive
TZipEntry = packed record
@@ -281,7 +285,6 @@ TZipRead = class
// - can be used to copy the initial .exe file
property ZipStartOffset: cardinal read fZipStartOffset;
end;
{$endif}

/// write-only access for creating a .zip archive file
// - not to be used to update a .zip file, but to create a new one
@@ -320,31 +323,36 @@ TZipWrite = class
// - by default, the 1st of January, 2010 is used if not date is supplied
procedure AddStored(const aZipName: TZipName; Buf: pointer; Size: integer;
FileAge: integer = 1 + 1 shl 5 + 30 shl 9);
{$ifdef MSWINDOWS}
/// add a file from an already compressed zip entry
procedure AddFromZip(const ZipEntry: TZipEntry);
{$endif}
/// append a file content into the destination file
// - useful to add the initial Setup.exe file, e.g.
procedure Append(const Content: RawByteZip);
/// release associated memory, and close destination file
destructor Destroy; override;
end;

{$endif MSWINDOWS}


implementation

{$ifndef FPC}
type
PtrUInt = {$ifdef CPU64}NativeUInt{$else}cardinal{$endif};
{$endif FPC}

// special tuned Move() routine, including data overlap bug correction
{$ifdef PUREPASCAL}
procedure MoveWithOverlap(Src: PByte; Dst: PByte; Count: Integer);
var
i: integer;
begin // should be fast enough in practice
for i := 1 to Count do begin
Dst^ := Src^;
procedure MoveWithOverlap(Src: PByte; Dst: PByte; Count: PtrUInt);
{$ifdef HASINLINE}inline;{$endif}
begin // should be fast enough in practice, especially inlined
dec(PtrUInt(Src), PtrUInt(Dst));
inc(Count, PtrUInt(Dst));
repeat
Dst^ := PByteArray(Src)[PtrUInt(Dst)];
inc(Dst);
inc(Src);
end;
until PtrUInt(Dst)=Count;
end;
{$else}
procedure MoveWithOverlap(Src: PByte; Dst: PByte; Count: Integer);
@@ -916,11 +924,6 @@ TDeflateState = record

//----------------- Inflate support

{$ifndef FPC}
type
PtrUInt = {$ifdef CPU64}NativeUInt{$else}cardinal{$endif};
{$endif FPC}

const
InflateMask: array[0..16] of Cardinal = ($0000, $0001, $0003, $0007, $000F,
$001F, $003F, $007F, $00FF, $01FF, $03FF, $07FF, $0FFF, $1FFF, $3FFF, $7FFF, $FFFF);
@@ -2559,7 +2562,7 @@ function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;
// and PreviousLength >= 1.
// The match length will not be greater than S.Lookahead.

function ScanFast(Scan, Match, StrEnd: pByte): integer;
function ScanFast(Scan, Match, StrEnd: PByte): integer;
// faster routine by AB
begin
inc(Scan, 2);
@@ -3077,7 +3080,7 @@ function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;

// The elements Heap[HeapLength / 2 + 1 .. HeapLength] are leaves of the Tree,
// establish sub-heaps of increasing lengths.
for N := S.HeapLength div 2 downto 1 do
for N := S.HeapLength shr 1 downto 1 do
RestoreHeap(S, Tree^, N);

// construct the Huffman tree by repeatedly combining the least two frequent nodes
@@ -3568,7 +3571,7 @@ function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;
GetMem(Overlay, S.LiteralBufferSize * (SizeOf(Word) + 2));
S.PendingBuffer := TPAByte(Overlay);
S.PendingBufferSize := S.LiteralBufferSize * (SizeOf(Word) + 2);
S.DistanceBuffer := @Overlay[S.LiteralBufferSize div SizeOf(Word)];
S.DistanceBuffer := @Overlay[S.LiteralBufferSize shr 1];
S.LiteralBuffer := @S.PendingBuffer[(1 + SizeOf(Word)) * S.LiteralBufferSize];
S.PendingOutput := PByte(S.PendingBuffer);
S.LiteralDescriptor.DynamicTree := @S.LiteralTree;
@@ -3689,31 +3692,32 @@ function ToByte(value: cardinal): cardinal; inline;
end;
{$else}
type ToByte = byte;
{$endif}
{$endif CPUARM}

function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal;
var
i: integer;
table: {$ifdef CPUX86}TCRC32Tab absolute crc32Tab{$else}^TCRC32Tab{$endif};
begin
result := aCRC32;
{$ifndef CPUX86}table := @crc32Tab;{$endif}
for i := 0 to (inLen shr 2) - 1 do begin
result := crc32Tab[ToByte(result xor pByte(inBuf)^)] xor (result shr 8);
inc(pByte(inBuf));
result := crc32Tab[ToByte(result xor pByte(inBuf)^)] xor (result shr 8);
inc(pByte(inBuf));
result := crc32Tab[ToByte(result xor pByte(inBuf)^)] xor (result shr 8);
inc(pByte(inBuf));
result := crc32Tab[ToByte(result xor pByte(inBuf)^)] xor (result shr 8);
inc(pByte(inBuf));
result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
inc(PByte(inBuf));
result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
inc(PByte(inBuf));
result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
inc(PByte(inBuf));
result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
inc(PByte(inBuf));
end;
for i := 0 to (inLen and 3) - 1 do begin
result := crc32Tab[ToByte(result xor pByte(inBuf)^)] xor (result shr 8);
inc(pByte(inBuf));
result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
inc(PByte(inBuf));
end;
end;

function CompressString(const data: RawByteZip; failIfGrow: boolean = false):
RawByteZip;
function CompressString(const data: RawByteZip; failIfGrow: boolean = false): RawByteZip;
var
i1: integer;
begin
@@ -3744,13 +3748,13 @@ function UncompressString(const data: RawByteZip): RawByteZip;


{$ifdef MSWINDOWS}

type
splitInt64 = record
splitInt64 = packed record
loCard, hiCard: cardinal
end;

function CompressFile(const srcFile, dstFile: TFileName; failIfGrow: boolean =
false): boolean;
function CompressFile(const srcFile, dstFile: TFileName; failIfGrow: boolean): boolean;
var
sf, df: dword;
sm, dm: dword;
@@ -3824,8 +3828,8 @@ function CompressFile(const srcFile, dstFile: TFileName; failIfGrow: boolean =
SetLastError(err);
end;

function UncompressFile(const srcFile, dstFile: TFileName; lastWriteTime: int64
= 0; attr: dword = 0): boolean;
function UncompressFile(const srcFile, dstFile: TFileName; lastWriteTime: int64;
attr: dword): boolean;
var
sf, df: dword;
sm, dm: dword;
@@ -3874,8 +3878,7 @@ function UncompressFile(const srcFile, dstFile: TFileName; lastWriteTime: int64
else
err := GetLastError;
if result then begin
SetFilePointer(df, integer(splitInt64(dl).loCard), @splitInt64(dl).hiCard,
FILE_BEGIN);
SetFilePointer(df, integer(splitInt64(dl).loCard), @splitInt64(dl).hiCard, FILE_BEGIN);
SetEndOfFile(df);
end;
if result and (lastWriteTime <> 0) then
@@ -3909,12 +3912,12 @@ function IsCompressedFileEqual(const uncomprFile, comprFile: TFileName): boolean
crc1, crc2: dword;
begin
result := GetCompressedFileInfo(comprFile, size1, crc1) and
GetUncompressedFileInfo(uncomprFile, size2, crc2) and (size1 = size2) and (crc1
= crc2);
GetUncompressedFileInfo(uncomprFile, size2, crc2) and (size1 = size2) and
(crc1 = crc2);
end;

function GetCompressedFileInfo(const comprFile: TFileName; var size: int64; var
crc32: dword): boolean;
function GetCompressedFileInfo(const comprFile: TFileName; var size: int64;
var crc32: dword): boolean;
var
file_: dword;
c1: dword;
@@ -3954,7 +3957,8 @@ function GetUncompressedFileInfo(const uncomprFile: TFileName; var size: int64;
CloseHandle(file_);
end;
end;
{$endif}

{$endif MSWINDOWS}

function GzCompress(src: pointer; srcLen: integer; const fName: TFileName): cardinal;
const
@@ -3987,7 +3991,8 @@ function GzCompress(src: pointer; srcLen: integer; const fName: TFileName): card
finally
close(f);
end;
{$I+} if ioresult <> 0 then
{$I+}
if ioresult <> 0 then
exit;
result := destLen + 18;
end;
@@ -4114,7 +4119,6 @@ function Zip(const zip: TFileName; const files, zipAs: array of TFileName;
Windows.DeleteFile(pointer(zip));
end;
end;
{$endif}

procedure CreateVoidZip(const aFileName: TFileName);
var
@@ -4131,6 +4135,8 @@ procedure CreateVoidZip(const aFileName: TFileName);
FileClose(H);
end;

{$endif MSWINDOWS}

{$ifdef DYNAMIC_CRC_TABLE}
{
Generate a table for a byte-wise 32-bit CRC calculation on the polynomial:
@@ -4505,7 +4511,6 @@ function TZipRead.GetInitialExeContent: RawByteZip;
SetString(result, PAnsiChar(Buf), ZipStartOffset);
end;

{$endif}

{ TZipWrite }

@@ -4573,7 +4578,6 @@ procedure TZipWrite.AddDeflated(const aFileName: TFileName; RemovePath: boolean;
FileClose(H);
end;

{$ifdef MSWINDOWS}
procedure TZipWrite.AddFromZip(const ZipEntry: TZipEntry);
begin
if (self = nil) or (Handle = 0) or (Handle = integer(INVALID_HANDLE_VALUE)) then
@@ -4597,7 +4601,6 @@ procedure TZipWrite.AddFromZip(const ZipEntry: TZipEntry);
end;
inc(Count);
end;
{$endif}

procedure TZipWrite.AddStored(const aZipName: TZipName; Buf: pointer; Size,
FileAge: integer);
@@ -4677,6 +4680,8 @@ destructor TZipWrite.Destroy;
inherited;
end;

{$endif MSWINDOWS}

initialization
{$ifdef DYNAMIC_CRC_TABLE}
InitCrc32Tab;
@@ -1 +1 @@
'1.18.4952'
'1.18.4953'

0 comments on commit e49cf64

Please sign in to comment.