xtool/precompressor/PrecompZSTD.pas

517 lines
17 KiB
ObjectPascal

unit PrecompZSTD;
interface
uses
ZSTDDLL,
Utils,
PrecompUtils,
System.SysUtils, System.Classes, System.Math;
var
Codec: TPrecompressor;
implementation
const
ZSTDCodecs: array of PChar = ['zstd'];
CODEC_COUNT = 1;
ZSTD_CODEC = 0;
const
Z_MAXSIZE = 16 * 1024 * 1024;
Z_FASTMODE = 0;
Z_WINDOWLOG = 0;
Z_BLOCKSIZE = 0;
var
SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList;
cctx, dctx: array of Pointer;
// cdict, ddict: Pointer;
CodecAvailable, CodecEnabled: TArray<Boolean>;
ZMaxSize: Integer = Z_MAXSIZE;
ZFastMode: Integer = Z_FASTMODE;
ZWindowLog: Integer = Z_WINDOWLOG;
ZBlockSize: Integer = Z_BLOCKSIZE;
function ZSTDInit(Command: PChar; Count: Integer; Funcs: PPrecompFuncs)
: Boolean;
var
I: Integer;
Options: TArray<Integer>;
S: String;
X, Y: Integer;
begin
Result := True;
SetLength(SOList, Count);
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
SOList[X, Y] := TSOList.Create([], TSOMethod.MTF);
for X := Low(CodecAvailable) to High(CodecAvailable) do
begin
CodecAvailable[X] := False;
CodecEnabled[X] := False;
end;
for X := Low(CodecAvailable) to High(CodecAvailable) do
CodecAvailable[X] := ZSTDDLL.DLLLoaded;
X := 0;
while Funcs^.GetCodec(Command, X, False) <> '' do
begin
S := Funcs^.GetCodec(Command, X, False);
if (CompareText(S, ZSTDCodecs[ZSTD_CODEC]) = 0) and ZSTDDLL.DLLLoaded then
begin
CodecEnabled[ZSTD_CODEC] := True;
if Funcs^.GetParam(Command, X, 'l') <> '' then
for I := Low(SOList) to High(SOList) do
SOList[I][ZSTD_CODEC].Update
([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True);
if Funcs^.GetParam(Command, X, 's') <> '' then
ZMaxSize := ConvertToBytes(Funcs^.GetParam(Command, X, 's'));
if Funcs^.GetParam(Command, X, 'f') <> '' then
ZFastMode := ConvertToBytes(Funcs^.GetParam(Command, X, 'f'));
if Funcs^.GetParam(Command, X, 'w') <> '' then
ZWindowLog := ConvertToBytes(Funcs^.GetParam(Command, X, 'w'));
if Funcs^.GetParam(Command, X, 'b') <> '' then
ZBlockSize := StrToInt(Funcs^.GetParam(Command, X, 'b'));
end;
Inc(X);
end;
if CodecAvailable[ZSTD_CODEC] then
begin
SetLength(cctx, Count);
SetLength(dctx, Count);
for X := Low(cctx) to High(cctx) do
begin
cctx[X] := nil;
dctx[X] := nil;
end;
end;
SetLength(Options, 0);
for I := 1 to 22 do
Insert(I, Options, Length(Options));
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
if SOList[X, Y].Count = 0 then
SOList[X, Y].Update(Options);
end;
procedure ZSTDFree(Funcs: PPrecompFuncs);
var
X, Y: Integer;
begin
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
SOList[X, Y].Free;
if CodecAvailable[ZSTD_CODEC] then
begin
for X := Low(cctx) to High(cctx) do
begin
if Assigned(cctx[X]) then
ZSTD_freeCCtx(cctx[X]);
if Assigned(dctx[X]) then
ZSTD_freeDCtx(dctx[X]);
end;
end;
end;
function ZSTDParse(Command: PChar; Option: PInteger;
Funcs: PPrecompFuncs): Boolean;
var
S: String;
I: Integer;
begin
Result := False;
Option^ := 0;
SetBits(Option^, ZFastMode, 8, 1);
SetBits(Option^, ZWindowLog, 9, 5);
SetBits(Option^, ZBlockSize, 14, 13);
I := 0;
while Funcs^.GetCodec(Command, I, False) <> '' do
begin
S := Funcs^.GetCodec(Command, I, False);
if (CompareText(S, ZSTDCodecs[ZSTD_CODEC]) = 0) and ZSTDDLL.DLLLoaded then
begin
SetBits(Option^, ZSTD_CODEC, 0, 3);
if Funcs^.GetParam(Command, I, 'l') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'l')), 3, 5);
if String(Funcs^.GetParam(Command, I, 'f')) = '1' then
SetBits(Option^, 1, 8, 1);
if Funcs^.GetParam(Command, I, 'w') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'w')), 9, 5);
if Funcs^.GetParam(Command, I, 'b') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'b')), 14, 13);
Result := True;
end;
Inc(I);
end;
end;
procedure ZSTDScan1(Instance, Depth: Integer; Input: PByte;
Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd;
Funcs: PPrecompFuncs);
var
Buffer: PByte;
Pos: NativeInt;
X, Y, Z: Integer;
SI: _StrInfo1;
begin
if BoolArray(CodecEnabled, False) then
exit;
Pos := 0;
while Pos < Size do
begin
if PCardinal(Input + Pos)^ = $FD2FB528 then
begin
X := ZSTD_findFrameCompressedSize(Input + Pos, SizeEx - Pos);
if X > 0 then
begin
Z := ZSTD_findDecompressedSize(Input + Pos, X);
if Z <= 0 then
Z := ZMaxSize;
Buffer := Funcs^.Allocator(Instance, Z);
if not Assigned(dctx[Instance]) then
dctx[Instance] := ZSTD_createDCtx;
Y := ZSTD_decompressDCtx(dctx[Instance], Buffer, Z, Input + Pos, X);
// Y := ZSTD_decompress_usingDDict(dctx[Instance], Buffer, Z, Input + Pos, X, ddict);
if (X < Y) then
begin
Output(Instance, Buffer, Y);
SI.Position := Pos;
SI.OldSize := X;
SI.NewSize := Y;
SI.Option := 0;
SetBits(SI.Option, ZFastMode, 8, 1);
SetBits(SI.Option, ZWindowLog, 9, 5);
SetBits(SI.Option, ZBlockSize, 14, 13);
SI.Status := TStreamStatus.None;
Funcs^.LogScan1(ZSTDCodecs[GetBits(SI.Option, 0, 3)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil);
Inc(Pos, SI.OldSize);
continue;
end;
end;
end;
Inc(Pos);
end;
end;
function ZSTDScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt;
StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput;
Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
X: Integer;
Res: Integer;
begin
Result := False;
X := GetBits(StreamInfo^.Option, 0, 3);
if (StreamInfo^.OldSize > 0) and REPROCESSED then
if (Int64Rec(PInt64(PByte(Input) + StreamInfo^.OldSize - Int64.Size)^)
.Lo = StreamInfo^.OldSize) and
(Int64Rec(PInt64(PByte(Input) + StreamInfo^.OldSize - Int64.Size)^).Lo <
Int64Rec(PInt64(PByte(Input) + StreamInfo^.OldSize - Int64.Size)^).Hi)
then
StreamInfo^.OldSize :=
Int64Rec(PInt64(PByte(Input) + StreamInfo^.OldSize - Int64.Size)^).Hi;
if StreamInfo^.OldSize <= 0 then
StreamInfo^.OldSize := ZSTD_findFrameCompressedSize(Input, Size);
if StreamInfo^.OldSize <= 0 then
exit;
if StreamInfo^.NewSize <= 0 then
StreamInfo^.NewSize := ZSTD_findDecompressedSize(Input, Size);
if StreamInfo^.NewSize <= 0 then
StreamInfo^.NewSize := ZMaxSize;
Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize);
case X of
ZSTD_CODEC:
begin
if not Assigned(dctx[Instance]) then
dctx[Instance] := ZSTD_createDCtx;
Res := ZSTD_decompressDCtx(dctx[Instance], Buffer, StreamInfo^.NewSize,
Input, StreamInfo^.OldSize);
end;
end;
if Res > StreamInfo^.OldSize then
begin
Output(Instance, Buffer, Res);
StreamInfo^.NewSize := Res;
Funcs^.LogScan2(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 3)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
function ZSTDProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
A, B: Integer;
I: Integer;
X: Integer;
Res1: NativeInt;
Res2: NativeUInt;
Inp: ZSTD_inBuffer;
Oup: ZSTD_outBuffer;
Progress: NativeInt;
begin
Result := False;
X := GetBits(StreamInfo^.Option, 0, 3);
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize);
SOList[Instance][X].Index := 0;
while SOList[Instance][X].Get(I) >= 0 do
begin
if StreamInfo^.Status >= TStreamStatus.Predicted then
begin
if GetBits(StreamInfo^.Option, 3, 5) <> I then
continue;
if (StreamInfo^.Status = TStreamStatus.Database) and
(GetBits(StreamInfo^.Option, 31, 1) = 0) then
begin
Res1 := StreamInfo^.OldSize;
Result := True;
end;
end;
Params := '';
case X of
ZSTD_CODEC:
begin
Params := 'l' + I.ToString + ':' + 'f' + GetBits(StreamInfo^.Option,
8, 1).ToString + ':' + 'w' + GetBits(StreamInfo^.Option, 9, 5)
.ToString + ':' + 'b' + GetBits(StreamInfo^.Option, 14, 13)
.ToString;
if not Assigned(cctx[Instance]) then
cctx[Instance] := ZSTD_createCCtx;
if not Result then
begin
if GetBits(StreamInfo^.Option, 14, 13) = 0 then
begin
ZSTD_CCtx_setParameter(cctx[Instance], ZSTD_c_compressionLevel,
IfThen(GetBits(StreamInfo^.Option, 8, 1) = 0, I, -I));
ZSTD_CCtx_setParameter(cctx[Instance], ZSTD_c_windowLog,
GetBits(StreamInfo^.Option, 9, 5));
if Assigned(ZSTD_compress2) then
Res1 := ZSTD_compress2(cctx[Instance], Buffer,
StreamInfo^.NewSize, NewInput, StreamInfo^.NewSize)
else if Assigned(ZSTD_compress_generic) then
begin
Oup.dst := Buffer;
Oup.Size := StreamInfo^.NewSize;
Oup.Pos := 0;
Inp.src := PByte(NewInput);
Inp.Size := StreamInfo^.NewSize;
Inp.Pos := 0;
ZSTD_compress_generic(cctx[Instance], @Oup, @Inp, ZSTD_e_end);
Res1 := Oup.Pos;
end
else
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer,
StreamInfo^.NewSize, NewInput, StreamInfo^.NewSize,
IfThen(GetBits(StreamInfo^.Option, 8, 1) = 0, I, -I))
end
else
begin
Progress := 0;
Oup.dst := Buffer;
Oup.Size := StreamInfo^.NewSize;
Oup.Pos := 0;
ZSTD_initCStream(cctx[Instance],
IfThen(GetBits(StreamInfo^.Option, 8, 1) = 0, I, -I));
while Progress < StreamInfo^.NewSize do
begin
Inp.src := PByte(NewInput) + Progress;
Inp.Size := Min(StreamInfo^.NewSize - Progress,
GetBits(StreamInfo^.Option, 14, 13) * 1024);
Inp.Pos := 0;
if ZSTD_compressStream(cctx[Instance], @Oup, @Inp) > 0 then
begin
ZSTD_flushStream(cctx[Instance], @Oup);
Inc(Progress, Inp.Size)
end
else
break;
end;
ZSTD_endStream(cctx[Instance], @Oup);
Res1 := Oup.Pos;
end;
{ Res1 := ZSTD_compress_usingCDict(cctx[Instance], Buffer,
StreamInfo^.NewSize, NewInput, StreamInfo^.NewSize, cdict); }
end;
end;
end;
if not Result then
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 3)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result or (StreamInfo^.Status >= TStreamStatus.Predicted) then
break;
end;
if Result and OPTIMISE_DEC and (StreamInfo^.Status <> TStreamStatus.Database)
and (GetBits(StreamInfo^.Option, 8, 1) = 0) then
begin
A := Pred(I);
for B := A downto 1 do
begin
if not Assigned(cctx[Instance]) then
cctx[Instance] := ZSTD_createCCtx;
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer, StreamInfo^.NewSize,
NewInput, StreamInfo^.NewSize, B);
if (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize) then
I := B
else
break;
end;
end
else if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted)
or (SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin
Res2 := PrecompEncodePatchEx(Instance, OldInput, StreamInfo^.OldSize,
Buffer, Res1, Output);
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2,
Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2));
if Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2) then
begin
SetBits(StreamInfo^.Option, 1, 31, 1);
SOList[Instance][X].Add(I);
Result := True;
end;
end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 3, 5);
SOList[Instance][X].Add(I);
end;
end;
function ZSTDRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
X: Integer;
Res1: NativeInt;
Res2: NativeUInt;
Inp: ZSTD_inBuffer;
Oup: ZSTD_outBuffer;
Progress: NativeInt;
begin
Result := False;
X := GetBits(StreamInfo.Option, 0, 3);
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Buffer := Funcs^.Allocator(Instance, StreamInfo.NewSize);
Params := 'l' + GetBits(StreamInfo.Option, 3, 5).ToString + ':' + 'f' +
GetBits(StreamInfo.Option, 8, 1).ToString + ':' + 'b' +
GetBits(StreamInfo.Option, 14, 13).ToString;
case X of
ZSTD_CODEC:
begin
if not Assigned(cctx[Instance]) then
cctx[Instance] := ZSTD_createCCtx;
if GetBits(StreamInfo.Option, 14, 13) = 0 then
begin
ZSTD_CCtx_setParameter(cctx[Instance], ZSTD_c_compressionLevel,
IfThen(GetBits(StreamInfo.Option, 8, 1) = 0,
GetBits(StreamInfo.Option, 3, 5),
-GetBits(StreamInfo.Option, 3, 5)));
ZSTD_CCtx_setParameter(cctx[Instance], ZSTD_c_windowLog,
GetBits(StreamInfo.Option, 9, 5));
if Assigned(ZSTD_compress2) then
Res1 := ZSTD_compress2(cctx[Instance], Buffer, StreamInfo.NewSize,
Input, StreamInfo.NewSize)
else if Assigned(ZSTD_compress_generic) then
begin
Oup.dst := Buffer;
Oup.Size := StreamInfo.NewSize;
Oup.Pos := 0;
Inp.src := PByte(Input);
Inp.Size := StreamInfo.NewSize;
Inp.Pos := 0;
ZSTD_compress_generic(cctx[Instance], @Oup, @Inp, ZSTD_e_end);
Res1 := Oup.Pos;
end
else
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer,
StreamInfo.NewSize, Input, StreamInfo.NewSize,
IfThen(GetBits(StreamInfo.Option, 8, 1) = 0,
GetBits(StreamInfo.Option, 3, 5),
-GetBits(StreamInfo.Option, 3, 5)));
end
else
begin
Progress := 0;
Oup.dst := Buffer;
Oup.Size := StreamInfo.NewSize;
Oup.Pos := 0;
ZSTD_initCStream(cctx[Instance],
IfThen(GetBits(StreamInfo.Option, 8, 1) = 0,
GetBits(StreamInfo.Option, 3, 5),
-GetBits(StreamInfo.Option, 3, 5)));
while Progress < StreamInfo.NewSize do
begin
Inp.src := PByte(Input) + Progress;
Inp.Size := Min(StreamInfo.NewSize - Progress,
GetBits(StreamInfo.Option, 14, 13) * 1024);
Inp.Pos := 0;
if ZSTD_compressStream(cctx[Instance], @Oup, @Inp) > 0 then
begin
ZSTD_flushStream(cctx[Instance], @Oup);
Inc(Progress, Inp.Size)
end
else
break;
end;
ZSTD_endStream(cctx[Instance], @Oup);
Res1 := Oup.Pos;
end;
{ Res1 := ZSTD_compress_usingCDict(cctx[Instance], Buffer,
StreamInfo.NewSize, Input, StreamInfo.NewSize, cdict); }
end;
end;
Funcs^.LogRestore(ZSTDCodecs[GetBits(StreamInfo.Option, 0, 3)], PChar(Params),
StreamInfo.OldSize, StreamInfo.NewSize, Res1, True);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Res2 := PrecompDecodePatchEx(Instance, InputExt, StreamInfo.ExtSize, Buffer,
Res1, Output);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 = StreamInfo.OldSize then
Result := True;
exit;
end;
if Res1 = StreamInfo.OldSize then
begin
Output(Instance, Buffer, StreamInfo.OldSize);
Result := True;
end;
end;
var
I: Integer;
initialization
Codec.Names := [];
for I := Low(ZSTDCodecs) to High(ZSTDCodecs) do
begin
Codec.Names := Codec.Names + [ZSTDCodecs[I]];
StockMethods.Add(ZSTDCodecs[I]);
end;
Codec.Initialised := False;
Codec.Init := @ZSTDInit;
Codec.Free := @ZSTDFree;
Codec.Parse := @ZSTDParse;
Codec.Scan1 := @ZSTDScan1;
Codec.Scan2 := @ZSTDScan2;
Codec.Process := @ZSTDProcess;
Codec.Restore := @ZSTDRestore;
SetLength(CodecAvailable, Length(Codec.Names));
SetLength(CodecEnabled, Length(Codec.Names));
end.