xtool/precompressor/PrecompMain - Copy.pas

992 lines
28 KiB
ObjectPascal

unit PrecompMain;
interface
uses
Main, Threading, Utils, ParseClass, ParseExpr,
PrecompUtils, PrecompZLib,
WinAPI.Windows,
System.SysUtils, System.Classes, System.SyncObjs, System.Math, System.Types,
System.StrUtils, System.RTLConsts,
System.Generics.Defaults, System.Generics.Collections;
const
XTOOL_PRECOMP = $304C5458;
type
TEncodeOptions = record
Method: AnsiString;
ChunkSize, Threads: Integer;
Depth: Integer;
LowMem: Boolean;
HistorySize: Boolean;
HistoryFile: String;
end;
TDecodeOptions = record
Method: AnsiString;
Threads: Integer;
end;
procedure PrintHelp;
procedure Parse(ParamArg: TArray<string>; out Options: TEncodeOptions);
overload;
procedure Parse(ParamArg: TArray<string>; out Options: TDecodeOptions);
overload;
// reuse resources when going in-depth
// make an array of all common resources for depth
// depth will be hard af to add
// check if at least one of the functions exists in a dll before using it
// number of chunks to process when decoding
procedure Encode(Input, Output: TStream; Options: TEncodeOptions);
procedure Decode(Input, Output: TStream; Options: TDecodeOptions);
function PrecompGetCodec(Cmd: PAnsiChar; Index: Integer; WithParams: Boolean)
: PAnsiChar stdcall;
function PrecompGetParam(Cmd: PAnsiChar; Index: Integer; Param: PAnsiChar)
: PAnsiChar stdcall;
function PrecompAllocator(Instance: Integer; Size: Integer): Pointer stdcall;
procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer)stdcall;
procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer;
Size: Integer)stdcall;
procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer;
Size: Integer)stdcall;
procedure PrecompAddStream1(Instance: Integer; Info: PStrInfo1;
Codec: PAnsiChar)stdcall;
implementation
var
Codecs: array of TPrecompressor;
PrecompFunctions: _PrecompFuncs;
procedure PrintHelp;
var
I, J: Integer;
S: string;
begin
Console.Write('precomp - data precompressor');
Console.Write('');
Console.Write('Usage:');
Console.Write
(' xtool precomp:method1,method2,methodN...:param1,param2,paramN... input output');
Console.Write('');
(* Console.Write('Methods:');
for I := Low(Codecs) to High(Codecs) do
begin
S := '';
for J := Low(Codecs[I]) to High(Codecs[I]) do
begin
if (IndexText(Codecs[I][J], Codecs[I]) = J) then
S := S + Codecs[I][J] + ', ';
end;
Delete(S, Length(S) - 1, 2);
Console.Write(' ' + S);
end; *)
Console.Write('');
Console.Write('Parameters:');
Console.Write(' c# - scanning range of precompressor [16mb]');
Console.Write(' t# - number of working threads [Threads/2]');
Console.Write(' lm - low memory mode');
Console.Write(' hs - enable history database');
Console.Write(' hf# - history database file');
Console.Write('');
end;
procedure Parse(ParamArg: TArray<string>; out Options: TEncodeOptions);
var
ArgParse: TArgParser;
ExpParse: TExpressionParser;
S: String;
begin
ArgParse := TArgParser.Create(ParamArg);
ExpParse := TExpressionParser.Create;
try
Options.Method := AnsiString(ArgParse.AsString('-m'));
S := ArgParse.AsString('-c', '16mb');
S := ReplaceText(S, 'KB', '* 1024^1');
S := ReplaceText(S, 'MB', '* 1024^2');
S := ReplaceText(S, 'GB', '* 1024^3');
Options.ChunkSize := Max(4194304, Round(ExpParse.Evaluate(S)));
S := ArgParse.AsString('-t', '50p');
S := ReplaceText(S, 'p', '%');
S := ReplaceText(S, '%', '%*' + CPUCount.ToString);
Options.Threads := Max(1, Round(ExpParse.Evaluate(S)));
Options.Depth := Succ(ArgParse.AsInteger('-d'));
Options.LowMem := ArgParse.AsBoolean('-lm');
finally
ArgParse.Free;
ExpParse.Free;
end;
end;
procedure Parse(ParamArg: TArray<string>; out Options: TDecodeOptions);
var
ArgParse: TArgParser;
ExpParse: TExpressionParser;
S: String;
begin
ArgParse := TArgParser.Create(ParamArg);
ExpParse := TExpressionParser.Create;
try
Options.Method := AnsiString(ArgParse.AsString('-m'));
S := ArgParse.AsString('-t', '50p');
S := ReplaceText(S, 'p', '%');
S := ReplaceText(S, '%', '%*' + CPUCount.ToString);
Options.Threads := Max(1, Round(ExpParse.Evaluate(S)));
finally
ArgParse.Free;
ExpParse.Free;
end;
end;
function GetIndex(Scanned, Processed: TArray<Boolean>): Integer;
var
I: Integer;
begin
if BoolArray(Processed, True) then
begin
Result := -2;
exit;
end
else
Result := -1;
for I := Low(Scanned) to High(Scanned) do
begin
if (Scanned[I] = True) and (Processed[I] = False) then
begin
Result := I;
break;
end;
end;
end;
type
TCommonVars = record
MemStream: TMemoryStream;
DataStore: TDataStore;
MemOutput: TArray<TMemoryStream>;
InfoStore1: TArray<TListEx<TEncodeSI>>;
InfoStore2: TList<TFutureSI>;
Scanned1, Scanned2, Processed: TArray<Boolean>;
CurPos: TArray<Int64>;
CurCodec: TArray<Byte>;
StrIdx: TArray<Integer>;
ThrIdx: TArray<Integer>;
end;
var
ComVars: TArray<TCommonVars>;
DepIdx: TArray<Integer>;
Sync: TCriticalSection;
Tasks: TArray<TTask>;
WorkStream: TArray<TMemoryStream>;
History: TDictionary<Int64, THistory>;
Duplicates: TDictionary<Int64, TDuplicate>;
// history should not depend on the streams about to be processed, check before doing this
procedure CodecInit(Count: Integer; Method: AnsiString);
var
I, X, Y: Integer;
S: AnsiString;
List: TStringDynArray;
begin
PrecompFunctions.GetCodec := @PrecompGetCodec;
PrecompFunctions.GetParam := @PrecompGetParam;
PrecompFunctions.Allocator := @PrecompAllocator;
if Method = '' then
exit;
Insert(PrecompZLib.Codec, Codecs, Length(Codecs));
for X := High(Codecs) downto Low(Codecs) do
for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do
Insert(String(Codecs[X].Names[Y]), List, Length(List));
I := 0;
while Assigned(PrecompGetCodec(PAnsiChar(Method), I, False)) do
begin
if IndexText(String(PrecompGetCodec(PAnsiChar(Method), I, False)), List) < 0
then
raise Exception.CreateFmt(SPrecompError1,
[String(PrecompGetCodec(PAnsiChar(Method), I, False))]);
Inc(I);
end;
for X := High(Codecs) downto Low(Codecs) do
begin
S := '';
for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do
begin
I := 0;
while Assigned(PrecompGetCodec(PAnsiChar(Method), I, False)) do
begin
if SameText(String(PrecompGetCodec(PAnsiChar(Method), I, False)),
String(Codecs[X].Names[Y])) then
S := S + AnsiString(PrecompGetCodec(PAnsiChar(Method), I,
True)) + '+';
Inc(I);
end;
end;
if S <> '' then
begin
SetLength(S, Length(S) - 1);
Codecs[X].Initialized := Codecs[X].Init(PAnsiChar(S), Count,
@PrecompFunctions);
end
else
Delete(Codecs, X, 1);
end;
end;
procedure CodecFree(Count: Integer);
var
I: Integer;
begin
for I := Low(Codecs) to High(Codecs) do
if Codecs[I].Initialized then
Codecs[I].Free(@PrecompFunctions);
end;
function PrecompGetCodec(Cmd: PAnsiChar; Index: Integer; WithParams: Boolean)
: PAnsiChar;
var
List: TStringDynArray;
begin
Result := nil;
if Assigned(Cmd) then
begin
List := DecodeStr(String(Cmd), '+');
if InRange(Index, Low(List), High(List)) then
if WithParams then
Result := PAnsiChar(AnsiString(List[Index]))
else
Result := PAnsiChar(AnsiString(DecodeStr(List[Index], ':')[0]));
end;
end;
function PrecompGetParam(Cmd: PAnsiChar; Index: Integer; Param: PAnsiChar)
: PAnsiChar;
var
List1, List2: TStringDynArray;
I: Integer;
begin
Result := nil;
if Assigned(Cmd) then
begin
List1 := DecodeStr(String(Cmd), '+');
if InRange(Index, Low(List1), High(List1)) then
begin
List2 := DecodeStr(List1[Index], ':');
if Length(List2) > 1 then
begin
if not Assigned(Param) then
Result := PAnsiChar(AnsiString(List2[1]))
else
begin
List1 := DecodeStr(List2[1], ',');
for I := Low(List1) to High(List1) do
if List1[I].StartsWith(String(Param), True) then
Result := PAnsiChar
(AnsiString(List1[I].Substring(Length(String(Param)))));
end;
end;
end;
end;
end;
function PrecompAllocator(Instance: Integer; Size: Integer): Pointer;
begin
with ComVars[DepIdx[Instance]] do
begin
if WorkStream[Instance].Size < Size then
WorkStream[Instance].Size := Size;
Result := WorkStream[Instance].Memory;
end;
end;
procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer);
begin
with ComVars[DepIdx[Instance]] do
begin
case Size of
- 1:
MemOutput[Instance].Position := CurPos[Instance];
else
MemOutput[Instance].WriteBuffer(Buffer^, Size);
end;
end;
end;
// TMemoryMap
procedure PrecompAddStream1(Instance: Integer; Info: PStrInfo1;
Codec: PAnsiChar);
var
SI1: TEncodeSI;
SI2: TFutureSI;
LValid: Boolean;
LCodec: Byte;
LOption: Integer;
I, X, Y: Integer;
S: String;
begin
// add overhead function
with ComVars[DepIdx[Instance]] do
begin
if (Info^.Position < 0) or (MemOutput[Instance].Position - CurPos[Instance]
<> Info^.NewSize) then
begin
MemOutput[Instance].Position := CurPos[Instance];
exit;
end;
if Assigned(Codec) then
begin
LValid := False;
I := 0;
while Assigned(PrecompGetCodec(Codec, I, False)) do
begin
for X := Low(Codecs) to High(Codecs) do
begin
for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do
if SameText(String(PrecompGetCodec(Codec, I, False)),
String(Codecs[X].Names[Y])) then
begin
LCodec := X;
if Codecs[X].Initialized then
if Codecs[X].Parse(PrecompGetCodec(Codec, I, True), @LOption,
@PrecompFunctions) then
begin
LValid := True;
break;
end;
end;
if LValid then
break;
end;
Inc(I);
end;
if not LValid then
begin
MemOutput[Instance].Position := CurPos[Instance];
exit;
end;
end
else
begin
LCodec := CurCodec[Instance];
LOption := Info^.Option;
end;
if Info^.Position < Min(DataStore.Size, DataStore.Slot[Instance].Size) then
begin
FillChar(SI1, SizeOf(TEncodeSI), 0);
SI1.ActualPosition := Info^.Position;
SI1.StorePosition := CurPos[Instance];
SI1.OriginalSize := Info^.OldSize;
SI1.UnpackedSize := Info^.NewSize;
SI1.Codec := LCodec;
SI1.Option := LOption;
SI1.Status := Info^.Status;
InfoStore1[Instance].Add(SI1);
end
else
begin
FillChar(SI2, SizeOf(TFutureSI), 0);
SI2.Position := DataStore.Position[Instance] + Info^.Position;
SI2.OriginalSize := Info^.OldSize;
SI2.UnpackedSize := Info^.NewSize;
SI2.Codec := LCodec;
SI2.Option := LOption;
SI2.Status := Info^.Status;
Sync.Acquire;
InfoStore2.Add(SI2);
Sync.Release;
end;
CurPos[Instance] := MemOutput[Instance].Position;
end;
end;
// endian(CSize,4)
procedure Scan1(Index: Integer);
var
I: Integer;
begin
with ComVars[DepIdx[Index]] do
for I := Low(Codecs) to High(Codecs) do
begin
try
CurPos[Index] := MemOutput[Index].Position;
CurCodec[Index] := I;
Codecs[I].Scan1(Index, DataStore.Slot[Index].Memory,
Min(DataStore.Size, DataStore.Slot[Index].Size),
DataStore.Slot[Index].Size, @PrecompOutput1, @PrecompAddStream1,
@PrecompFunctions);
except
end;
end;
end;
procedure Scan2(Index: Integer);
var
I: Integer;
begin
(* while StrIdx2[Index] < InfoStore2.Count do
begin
// if InfoStore2[StrIdx2[Index]].Position then
// there is a problem here with the count when multi threading...
Inc(StrIdx2[Index]);
end;
for I := Low(Codecs) to High(Codecs) do
begin
try
CurPos[Index] := MemOutput[Index].Position;
CurCodec[Index] := I;
Codecs[Index][I].Scan2(Index, DataStore.Slot[Index].Memory,
Min(DataStore.Size, DataStore.Slot[Index].Size),
DataStore.Slot[Index].Size, @PrecompAllocator, @PrecompCompress,
@PrecompOutput1, @PrecompAddStream1);
except
end;
end; *)
end;
// use TDictionary for history and deduplication
procedure Process(Index, ThreadIndex, StreamIndex: Integer);
var
SI1: _StrInfo2;
SI2: TEncodeSI;
Res: Boolean;
begin
with ComVars[DepIdx[Index]] do
begin
SI2 := InfoStore1[ThreadIndex][StreamIndex];
SI1.OldSize := SI2.OriginalSize;
SI1.NewSize := SI2.UnpackedSize;
SI1.Option := SI2.Option;
SI1.Status := SI2.Status;
CurPos[Index] := MemOutput[Index].Position;
CurCodec[Index] := SI2.Codec;
try
Res := Codecs[SI2.Codec].Process(Index,
PByte(DataStore.Slot[ThreadIndex].Memory) + SI2.ActualPosition,
PByte(MemOutput[ThreadIndex].Memory) + SI2.StorePosition, @SI1,
@PrecompOutput1, @PrecompFunctions);
except
Res := False;
end;
if Res then
begin
SI2.OriginalSize := SI1.OldSize;
SI2.UnpackedSize := SI1.NewSize;
SI2.Option := SI1.Option;
SI2.Status := TStreamStatus(SuccessStatus);
SI2.ExtPosition := CurPos[Index];
SI2.ExtSize := MemOutput[Index].Position - CurPos[Index];
SI2.ExtThread := Index;
InfoStore1[ThreadIndex][StreamIndex] := SI2;
CurPos[Index] := MemOutput[Index].Position;
end;
end;
end;
procedure EncThread(Y: Integer);
var
X, Z: Integer;
History: Boolean;
begin
with ComVars[DepIdx[Y]] do
begin
if InRange(Y, Low(InfoStore1), High(InfoStore1)) then
begin
Scan1(Y);
Scanned1[Y] := True;
// try to process even before scan finishes
(* if ExternalInUse(EOptions.Method) then
while BoolArray(Scanned1, False) do
Sleep(10); *)
// Scan2(Y);
InfoStore1[Y].Sort;
Scanned2[Y] := True;
end;
// if index < count give the thread index, check this for all threads
// should give more speed
while True do
begin
Z := GetIndex(Scanned2, Processed);
while Z = -1 do
begin
Sleep(10);
Z := GetIndex(Scanned2, Processed);
end;
ThrIdx[Y] := Z;
if Z < -1 then
break;
X := AtomicIncrement(StrIdx[Z]);
while X < InfoStore1[Z].Count do
begin
History := False;
Process(Y, Z, X);
if History = False then
begin
// Int64Rec(HD.Tag).Lo := SI.Checksum;
// Int64Rec(HD.Tag).Hi := SI.UnpackedSize;
end;
Z := GetIndex(Scanned2, Processed);
while Z = -1 do
begin
Sleep(10);
Z := GetIndex(Scanned2, Processed);
end;
ThrIdx[Y] := Z;
if Z < -1 then
break;
X := AtomicIncrement(StrIdx[Z]);
end;
if Z < -1 then
break;
if X >= InfoStore1[Z].Count then
Processed[Z] := True;
end;
end;
end;
procedure InternalEncode(Input, Output: TStream; Options: TEncodeOptions;
Index, Depth: Integer);
var
GUID: TGUID;
StreamInfo: TEncodeSI;
StreamHeader: TStreamHeader;
StreamCount: Int32;
BlockSize: Int64;
UI32: UInt32;
I, J: Integer;
LastStream, LastPos: Int64;
begin
I := XTOOL_PRECOMP;
Output.WriteBuffer(I, I.Size);
CreateGUID(GUID);
Output.WriteBuffer(GUID, SizeOf(GUID));
LongRec(I).Bytes[0] := Length(Options.Method);
Output.WriteBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size);
Output.WriteBuffer(Options.Method[1], LongRec(I).Bytes[0]);
Sync := TCriticalSection.Create;
if Index = 0 then
begin
SetLength(DepIdx, Options.Threads);
SetLength(ComVars, Options.Depth);
for J := Low(ComVars) to High(ComVars) do
with ComVars[J] do
begin
MemStream := TMemoryStream.Create;
SetLength(MemOutput, Options.Threads);
SetLength(ThrIdx, Options.Threads);
if Options.LowMem then
I := 1
else
I := Options.Threads;
SetLength(InfoStore1, I);
SetLength(StrIdx, I);
SetLength(Scanned1, I);
SetLength(Scanned2, I);
SetLength(Processed, I);
SetLength(CurPos, I);
SetLength(CurCodec, I);
end;
end;
SetLength(Tasks, Options.Threads);
SetLength(WorkStream, Options.Threads);
for I := Low(Tasks) to High(Tasks) do
begin
if Length(Tasks) > 1 then
Tasks[I] := TTask.Create(I);
MemOutput[I] := TMemoryStream.Create;
WorkStream[I] := TMemoryStream.Create;
end;
for I := Low(InfoStore1) to High(InfoStore1) do
InfoStore1[I] := TListEx<TEncodeSI>.Create(EncodeSICmp);
InfoStore2 := TList<TFutureSI>.Create(FutureSICmp);
// if FileExists(Options.HistoryFile) then
// LoadHistory(HistoryList, Options.HistoryFile);
DataStore := TDataStore.Create(Input, True, Length(InfoStore1),
Options.ChunkSize);
CodecInit(Options.Threads, Options.Method);
LastStream := 0;
DataStore.Load;
while not DataStore.Done do
begin
if Length(Tasks) > 1 then
if IsErrored(Tasks) then
for I := Low(Tasks) to High(Tasks) do
Tasks[I].RaiseLastError;
for I := Low(InfoStore1) to High(InfoStore1) do
begin
InfoStore1[I].Count := 0;
StrIdx[I] := -1;
Scanned1[I] := False;
Scanned2[I] := False;
Processed[I] := False;
CurPos[I] := 0;
end;
for I := Low(Tasks) to High(Tasks) do
begin
ThrIdx[I] := 0;
MemOutput[I].Position := 0;
if Length(Tasks) > 1 then
begin
Tasks[I].Perform(EncThread);
Tasks[I].Start;
end
else
EncThread(0);
end;
for I := Low(InfoStore1) to High(InfoStore1) do
begin
while Processed[I] = False do
Sleep(10);
for J := Low(ThrIdx) to High(ThrIdx) do
while ThrIdx[J] = I do
Sleep(10);
// DEC MEM LIMIT HERE
LastPos := LastStream;
MemStream.Position := 0;
StreamCount := 0;
BlockSize := 0;
MemStream.WriteBuffer(StreamCount, StreamCount.Size);
MemStream.WriteBuffer(BlockSize, BlockSize.Size);
if InfoStore1[I].Count > 0 then
begin
InfoStore1[I].Index := 0;
J := InfoStore1[I].Get(StreamInfo);
while J >= 0 do
begin
if (Integer(StreamInfo.Status) <> SuccessStatus) or
(LastStream > StreamInfo.ActualPosition) or
(StreamInfo.ActualPosition >= Options.ChunkSize) then
InfoStore1[I].Delete(J)
else
begin
Inc(StreamCount);
StreamHeader.Kind := DEFAULT_STREAM;
if StreamInfo.ExtSize > 0 then
StreamHeader.Kind := StreamHeader.Kind or EXTENDED_STREAM;
StreamHeader.OldSize := StreamInfo.OriginalSize;
StreamHeader.NewSize := StreamInfo.UnpackedSize;
if StreamInfo.ExtSize > 0 then
begin
Inc(StreamHeader.NewSize, StreamInfo.ExtSize);
Inc(StreamHeader.NewSize, StreamInfo.ExtSize.Size);
end;
StreamHeader.Codec := StreamInfo.Codec;
StreamHeader.Option := StreamInfo.Option;
Inc(BlockSize, StreamHeader.NewSize);
MemStream.WriteBuffer(StreamHeader, SizeOf(TStreamHeader));
LastStream := Int64(StreamInfo.ActualPosition) +
StreamInfo.OriginalSize;
end;
J := InfoStore1[I].Get(StreamInfo);
end;
MemStream.Position := 0;
MemStream.WriteBuffer(StreamCount, StreamCount.Size);
MemStream.WriteBuffer(BlockSize, BlockSize.Size);
Output.WriteBuffer(MemStream.Memory^, MemStream.Position + StreamCount *
SizeOf(TStreamHeader));
InfoStore1[I].Index := 0;
J := InfoStore1[I].Get(StreamInfo);
while J >= 0 do
begin
Output.WriteBuffer
((PByte(MemOutput[I].Memory) + StreamInfo.StorePosition)^,
StreamInfo.UnpackedSize);
if StreamInfo.ExtSize > 0 then
begin
Output.WriteBuffer((PByte(MemOutput[StreamInfo.ExtThread].Memory) +
StreamInfo.ExtPosition)^, StreamInfo.ExtSize);
Output.WriteBuffer(StreamInfo.ExtSize, StreamInfo.ExtSize.Size);
end;
J := InfoStore1[I].Get(StreamInfo);
end;
InfoStore1[I].Index := 0;
J := InfoStore1[I].Get(StreamInfo);
while J >= 0 do
begin
UI32 := StreamInfo.ActualPosition - LastPos;
Output.WriteBuffer(UI32, UI32.Size);
if UI32 > 0 then
Output.WriteBuffer((PByte(DataStore.Slot[I].Memory) +
LastPos)^, UI32);
LastPos := StreamInfo.ActualPosition + StreamInfo.OriginalSize;
J := InfoStore1[I].Get(StreamInfo);
end;
end
else
Output.WriteBuffer(StreamCount, StreamCount.Size);
UI32 := Max(Min(Options.ChunkSize, DataStore.Slot[I].Size) - LastPos, 0);
Output.WriteBuffer(UI32, UI32.Size);
if UI32 > 0 then
Output.WriteBuffer((PByte(DataStore.Slot[I].Memory) + LastPos)^, UI32);
LastStream := Max(LastStream - Options.ChunkSize, 0);
if I > 0 then
DataStore.LoadEx;
end;
DataStore.LoadEx;
if Length(Tasks) > 1 then
WaitForAll(Tasks);
end;
StreamCount := StreamCount.MinValue;
Output.WriteBuffer(StreamCount, StreamCount.Size);
CodecFree(Options.Threads);
for I := Low(Tasks) to High(Tasks) do
begin
if Length(Tasks) > 1 then
Tasks[I].Free;
MemOutput[I].Free;
WorkStream[I].Free;
end;
for I := Low(InfoStore1) to High(InfoStore1) do
InfoStore1[I].Free;
InfoStore2.Free;
DataStore.Free;
// if Options.HistoryFile <> '' then
// SaveHistory(HistoryList, Options.HistoryFile);
// SetLength(HistoryList, 0);
MemStream.Free;
Sync.Free;
end;
var
DecInput, DecOutput: TStream;
Idx: Integer;
StreamPos: TArray<Int64>;
Completed: TArray<Boolean>;
StreamCount: Int32;
BlockPos: Int64;
MemInput: TMemoryStream;
procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer;
Size: Integer);
begin
DecOutput.WriteBuffer(Buffer^, Size);
end;
procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer;
Size: Integer);
begin
MemOutput[Instance].WriteBuffer(Buffer^, Size);
end;
procedure Restore(MT: Boolean; ThreadIndex: Integer);
var
X: Integer;
Pos: Int64;
X64: Int64;
SI: _StrInfo3;
SH: PStreamHeader;
UI32: UInt32;
Ptr1, Ptr2: PByte;
LOutput: _PrecompOutput;
begin
Pos := 0;
X := AtomicIncrement(Idx);
while X < StreamCount do
begin
SH := PStreamHeader((PByte(MemStream.Memory) + X * SizeOf(TStreamHeader)));
if MT then
begin
LOutput := @PrecompOutput3;
Pos := StreamPos[X];
X64 := Pos + SH^.NewSize;
while (BlockPos < X64) do
begin
if IsErrored(Tasks) or (BlockPos < 0) then
exit;
Sleep(1);
end;
MemOutput[ThreadIndex].Position := 0;
end
else
begin
LOutput := @PrecompOutput2;
DecInput.ReadBuffer(UI32, UI32.Size);
if UI32 > 0 then
DecOutput.CopyFrom(DecInput, UI32);
end;
SI.OldSize := SH^.OldSize;
SI.NewSize := SH^.NewSize;
SI.Option := SH^.Option;
Ptr1 := PByte(MemInput.Memory) + Pos;
if SH^.Kind and EXTENDED_STREAM = EXTENDED_STREAM then
begin
SI.ExtSize := PInteger(Ptr1 + SI.NewSize - SI.NewSize.Size)^;
SI.NewSize := SI.NewSize - SI.ExtSize - SI.ExtSize.Size;
Ptr2 := PByte(MemInput.Memory) + Pos + SI.NewSize;
end
else
Ptr2 := nil;
if (Codecs[SH^.Codec].Restore(ThreadIndex, Ptr1, Ptr2, SI, LOutput,
@PrecompFunctions) = False) then
raise Exception.CreateFmt(SPrecompError3,
[String(Codecs[SH^.Codec].Names[0])]);
if MT then
begin
Move(MemOutput[ThreadIndex].Memory^, Ptr1^, SI.OldSize);
Completed[X] := True;
end
else
begin
Inc(Pos, SH^.NewSize);
end;
X := AtomicIncrement(Idx);;
end;
end;
procedure DecThread(Y: Integer);
begin
Restore(True, Y);
end;
procedure ReadCallback(Pos: Int64);
begin
BlockPos := Pos;
end;
// restore stuff by chunk
procedure InternalDecode(Input, Output: TStream; Options: TDecodeOptions;
Index, Depth: Integer);
var
GUID: TGUID;
StreamHeader: PStreamHeader;
BlockSize: Int64;
CurrPos: Int64;
UI32: UInt32;
I, J: Integer;
begin
DecInput := Input;
DecOutput := Output;
Input.ReadBuffer(GUID, SizeOf(GUID));
Input.ReadBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size);
SetLength(Options.Method, LongRec(I).Bytes[0]);
Input.ReadBuffer(Options.Method[1], LongRec(I).Bytes[0]);
MemStream := TMemoryStream.Create;
SetLength(Tasks, Options.Threads);
SetLength(MemOutput, Options.Threads);
SetLength(WorkStream, Options.Threads);
for I := Low(Tasks) to High(Tasks) do
begin
if Length(Tasks) > 1 then
Tasks[I] := TTask.Create(I);
MemOutput[I] := TMemoryStream.Create;
WorkStream[I] := TMemoryStream.Create;
end;
MemInput := TMemoryStream.Create;
CodecInit(Options.Threads, Options.Method);
Input.ReadBuffer(StreamCount, StreamCount.Size);
while StreamCount >= 0 do
begin
if Length(Tasks) > 1 then
if IsErrored(Tasks) then
for I := Low(Tasks) to High(Tasks) do
Tasks[I].RaiseLastError;
if StreamCount > 0 then
begin
BlockPos := 0;
Input.ReadBuffer(BlockSize, BlockSize.Size);
MemStream.Position := 0;
MemStream.CopyFrom(Input, StreamCount * SizeOf(TStreamHeader));
CurrPos := 0;
if (Options.Threads > 1) and (StreamCount > 1) then
begin
if StreamCount > Length(StreamPos) then
SetLength(StreamPos, StreamCount);
SetLength(Completed, Length(StreamPos));
for J := 0 to StreamCount - 1 do
begin
StreamPos[J] := CurrPos;
Completed[J] := False;
StreamHeader :=
PStreamHeader((PByte(MemStream.Memory) + J *
SizeOf(TStreamHeader)));
Inc(CurrPos, Max(StreamHeader^.OldSize, StreamHeader^.NewSize));
end;
end;
if MemInput.Size < BlockSize then
MemInput.Size := BlockSize;
MemInput.Position := 0;
Idx := -1;
if (Options.Threads > 1) and (StreamCount > 1) then
begin
for I := Low(Tasks) to High(Tasks) do
begin
Tasks[I].Perform(DecThread);
Tasks[I].Start;
end;
for J := 0 to StreamCount - 1 do
begin
StreamHeader :=
PStreamHeader((PByte(MemStream.Memory) + J *
SizeOf(TStreamHeader)));
MemInput.Size := Max(MemInput.Size, MemInput.Position +
Max(StreamHeader^.OldSize, StreamHeader^.NewSize));
if CopyStream(Input, MemInput, StreamHeader^.NewSize) <>
StreamHeader^.NewSize then
begin
BlockPos := -1;
raise EReadError.CreateRes(@SReadError);
end;
Inc(BlockPos, Max(StreamHeader^.OldSize, StreamHeader^.NewSize));
end;
end
else
MemInput.CopyFrom(Input, BlockSize);
if (Options.Threads > 1) and (StreamCount > 1) then
begin
for J := 0 to StreamCount - 1 do
begin
Input.ReadBuffer(UI32, UI32.Size);
if UI32 > 0 then
Output.CopyFrom(Input, UI32);
while (Completed[J] = False) and (IsErrored(Tasks) = False) do
Sleep(1);
if IsErrored(Tasks) then
for I := Low(Tasks) to High(Tasks) do
Tasks[I].RaiseLastError;
Output.WriteBuffer((PByte(MemInput.Memory) + StreamPos[J])^,
PStreamHeader((PByte(MemStream.Memory) + J * SizeOf(TStreamHeader)))
^.OldSize);
end;
WaitForAll(Tasks);
end
else
Restore(False, 0);
end;
Input.ReadBuffer(UI32, UI32.Size);
if UI32 > 0 then
Output.CopyFrom(Input, UI32);
Input.ReadBuffer(StreamCount, StreamCount.Size);
end;
CodecFree(Options.Threads);
MemInput.Free;
for I := Low(Tasks) to High(Tasks) do
begin
if Length(Tasks) > 1 then
Tasks[I].Free;
MemOutput[I].Free;
WorkStream[I].Free;
end;
MemStream.Free;
end;
procedure Encode(Input, Output: TStream; Options: TEncodeOptions);
begin
InternalEncode(Input, Output, Options, 0, 0);
end;
procedure Decode(Input, Output: TStream; Options: TDecodeOptions);
begin
InternalDecode(Input, Output, Options, 0, 0);
end;
end.