* Fixed a potential bug where a value would not change if a contition wasn't met

* Made TITSFReader friendlier for inherited classes
* Small fix for threaded lzx compressor


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15547 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 65 insertions, 46 deletions

diff --git a/packages/chm/src/chmbase.pas b/packages/chm/src/chmbase.pas
index 558f048bd9..bc26d3fe9c 100644
--- a/packages/chm/src/chmbase.pas
+++ b/packages/chm/src/chmbase.pas
@@ -36,8 +36,6 @@ type
     Unknown_1: LongWord;
     TimeStamp: LongWord; //bigendian
     LanguageID: LongWord;
-    Guid1: TGuid;
-    Guid2: TGuid;
   end;
   TITSFHeaderEntry = record
     PosFromZero: QWord;
@@ -78,7 +76,7 @@ type
     Unknown5: LongInt; // = -1
   end;
   
-  TPMGchunktype = (ctPMGL, ctPMGI, ctUnknown);
+  TDirChunkType = (ctPMGL, ctPMGI, ctAOLL, ctAOLI, ctUnknown);
   
   TPMGListChunk = record
     PMGLsig: array [0..3] of char;
diff --git a/packages/chm/src/chmreader.pas b/packages/chm/src/chmreader.pas
index 0f37820364..dc55d628be 100644
--- a/packages/chm/src/chmreader.pas
+++ b/packages/chm/src/chmreader.pas
@@ -54,25 +54,26 @@ type
   protected
     fStream: TStream;
     fFreeStreamOnDestroy: Boolean;
-    fChmHeader: TITSFHeader;
+    fITSFHeader: TITSFHeader;
     fHeaderSuffix: TITSFHeaderSuffix;
     fDirectoryHeader: TITSPHeader;
     fDirectoryHeaderPos: QWord;
     fDirectoryHeaderLength: QWord;
     fDirectoryEntriesStartPos: QWord;
-    fDirectoryEntries: array of TPMGListChunkEntry;
     fCachedEntry: TPMGListChunkEntry; //contains the last entry found by ObjectExists
     fDirectoryEntriesCount: LongWord;
+    procedure ReadHeader; virtual;
+    procedure ReadHeaderEntries; virtual;
+    function  GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
+    procedure GetSections(out Sections: TStringList);
   private
-    procedure ReadHeader;
-    function  GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
     function  GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
     function  ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
     function  ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
     procedure LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
     procedure LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
 
-    procedure GetSections(out Sections: TStringList);
+
     function  GetBlockFromSection(SectionPrefix: String; StartPos: QWord; BlockLength: QWord): TMemoryStream;
     function  FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
        out CompressedSize: QWord; out UnCompressedSize: QWord; out LZXResetTable: TLZXResetTableArr): QWord;  // Returns the blocksize
@@ -82,10 +83,10 @@ type
   public
     ChmLastError: LongInt;
     function IsValidFile: Boolean;
-    procedure GetCompleteFileList(ForEach: TFileEntryForEach);
-    function ObjectExists(Name: String): QWord; // zero if no. otherwise it is the size of the object
+    procedure GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True); virtual;
+    function ObjectExists(Name: String): QWord; virtual; // zero if no. otherwise it is the size of the object
                                                 // NOTE directories will return zero size even if they exist
-    function GetObject(Name: String): TMemoryStream; // YOU must Free the stream
+    function GetObject(Name: String): TMemoryStream; virtual; // YOU must Free the stream
     property CachedEntry: TPMGListChunkEntry read fCachedEntry;
   end;
   
@@ -181,7 +182,7 @@ begin
   end;
 end;
 
-function ChunkType(Stream: TMemoryStream): TPMGchunktype;
+function ChunkType(Stream: TMemoryStream): TDirChunkType;
 var
   ChunkID: array[0..3] of char;
 begin
@@ -189,39 +190,46 @@ begin
   if Stream.Size< 4 then exit;
   Move(Stream.Memory^, ChunkId[0], 4);
   if ChunkID = 'PMGL' then Result := ctPMGL
-  else if ChunkID = 'PMGI' then Result := ctPMGI;
+  else if ChunkID = 'PMGI' then Result := ctPMGI
+  else if ChunkID = 'AOLL' then Result := ctAOLL
+  else if ChunkID = 'AOLI' then Result := ctAOLI;
 end;
 
 { TITSFReader }
 
 procedure TITSFReader.ReadHeader;
-var
-fHeaderEntries: array [0..1] of TITSFHeaderEntry;
 begin
-  fStream.Position := 0;
-  fStream.Read(fChmHeader,SizeOf(fChmHeader));
+  fStream.Read(fITSFHeader,SizeOf(fITSFHeader));
 
   // Fix endian issues
   {$IFDEF ENDIAN_BIG}
-  fChmHeader.Version := LEtoN(fChmHeader.Version);
-  fChmHeader.HeaderLength := LEtoN(fChmHeader.HeaderLength);
+  fITSFHeader.Version := LEtoN(fITSFHeader.Version);
+  fITSFHeader.HeaderLength := LEtoN(fITSFHeader.HeaderLength);
   //Unknown_1
-  fChmHeader.TimeStamp := BEtoN(fChmHeader.TimeStamp);//bigendian
-  fChmHeader.LanguageID := LEtoN(fChmHeader.LanguageID);
-  //Guid1
-  //Guid2
+  fITSFHeader.TimeStamp := BEtoN(fITSFHeader.TimeStamp);//bigendian
+  fITSFHeader.LanguageID := LEtoN(fITSFHeader.LanguageID);
   {$ENDIF}
+
+  if fITSFHeader.Version < 4 then
+   fStream.Seek(SizeOf(TGuid)*2, soCurrent);
   
   if not IsValidFile then Exit;
   
+  ReadHeaderEntries;
+end;
+
+procedure TITSFReader.ReadHeaderEntries;
+var
+fHeaderEntries: array [0..1] of TITSFHeaderEntry;
+begin
   // Copy EntryData into memory
   fStream.Read(fHeaderEntries[0], SizeOf(fHeaderEntries));
 
-  if fChmHeader.Version > 2 then
+  if fITSFHeader.Version = 3 then
     fStream.Read(fHeaderSuffix.Offset, SizeOf(QWord));
   fHeaderSuffix.Offset := LEtoN(fHeaderSuffix.Offset);
   // otherwise this is set in fill directory entries
-  
+
   fStream.Position := LEtoN(fHeaderEntries[1].PosFromZero);
   fDirectoryHeaderPos := LEtoN(fHeaderEntries[1].PosFromZero);
   fStream.Read(fDirectoryHeader, SizeOf(fDirectoryHeader));
@@ -509,7 +517,7 @@ begin
   inherited Destroy;
 end;
 
-function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
+function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
 var
   Sig: array[0..3] of char;
 begin
@@ -518,7 +526,9 @@ begin
 
   Stream.Read(Sig, 4);
   if Sig = 'PMGL' then Result := ctPMGL
-  else if Sig = 'PMGI' then Result := ctPMGI;
+  else if Sig = 'PMGI' then Result := ctPMGI
+  else if Sig = 'AOLL' then Result := ctAOLL
+  else if Sig = 'AOLI' then Result := ctAOLI;
 end;
 
 function TITSFReader.GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
@@ -599,6 +609,7 @@ end;
 constructor TITSFReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
   fStream := AStream;
+  fStream.Position := 0;
   fFreeStreamOnDestroy := FreeStreamOnDestroy;
   ReadHeader;
   if not IsValidFile then Exit;
@@ -606,7 +617,6 @@ end;
 
 destructor TITSFReader.Destroy;
 begin
-  SetLength(fDirectoryEntries, 0);
   if fFreeStreamOnDestroy then FreeAndNil(fStream);
 
   inherited Destroy;
@@ -615,13 +625,15 @@ end;
 function TITSFReader.IsValidFile: Boolean;
 begin
   if (fStream = nil) then ChmLastError := ERR_STREAM_NOT_ASSIGNED
-  else if (fChmHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
-  else if (fChmHeader.Version <> 2) and (fChmHeader.Version <> 3) then
+  else if (fITSFHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
+  //else if (fITSFHeader.Version <> 2) and (fITSFHeader.Version <> 3)
+  else if not (fITSFHeader.Version in [2..4])
+  then
     ChmLastError := ERR_NOT_SUPPORTED_VERSION;
   Result := ChmLastError = ERR_NO_ERR;
 end;
 
-procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach);
+procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True);
 var
   ChunkStream: TMemoryStream;
   I : Integer;
@@ -662,7 +674,12 @@ begin
          Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
          if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
          fCachedEntry := Entry; // if the caller trys to get this data we already know where it is :)
-         ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
+         if  (Length(Entry.Name) = 1)
+         or (AIncludeInternalFiles
+              or
+             ((Length(Entry.Name) > 1) and (not(Entry.Name[2] in ['#','$',':']))))
+         then
+          ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
        end;
      end;
     {$IFDEF CHM_DEBUG_CHUNKS}
@@ -841,7 +858,7 @@ begin
   end
   else begin // we have to get it from ::DataSpace/Storage/[MSCompressed,Uncompressed]/ControlData
     GetSections(SectionNames);
-    FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection-1]]);
+    FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection]]);
     Result := GetBlockFromSection(SectionName, Entry.ContentOffset, Entry.DecompressedLength);
     SectionNames.Free;
   end;
@@ -1235,8 +1252,6 @@ begin
     {$ENDIF}
     Sections.Add(WString);
   end;
-  // the sections are sorted alphabetically, this way section indexes will jive
-  Sections.Sort;
   Stream.Free;
 end;
 
diff --git a/packages/chm/src/chmwriter.pas b/packages/chm/src/chmwriter.pas
index bbd67072ac..96f13aeffa 100644
--- a/packages/chm/src/chmwriter.pas
+++ b/packages/chm/src/chmwriter.pas
@@ -241,8 +241,6 @@ begin
     Unknown_1 := NToLE(DWord(1));
     TimeStamp:= NToBE(MilliSecondOfTheDay(Now)); //bigendian
     LanguageID := NToLE(DWord($0409)); // English / English_US
-    Guid1 := ITSFHeaderGUID;
-    Guid2 := ITSFHeaderGUID;
   end;
 end;
 
@@ -314,6 +312,12 @@ end;
 procedure TITSFWriter.WriteHeader(Stream: TStream);
 begin
   Stream.Write(ITSFHeader, SizeOf(TITSFHeader));
+
+  if ITSFHeader.Version < 4 then
+  begin
+    Stream.Write(ITSFHeaderGUID, SizeOf(TGuid));
+    Stream.Write(ITSFHeaderGUID, SizeOf(TGuid));
+  end;
   Stream.Write(HeaderSection0Table, SizeOf(TITSFHeaderEntry));
   Stream.Write(HeaderSection1Table, SizeOf(TITSFHeaderEntry));
   Stream.Write(HeaderSuffix, SizeOf(TITSFHeaderSuffix));
@@ -897,7 +901,7 @@ begin
 
   lzx_finish(LZXdata, nil);
   {$ELSE}
-  Compressor := TLZXCompressor.Create(10);
+  Compressor := TLZXCompressor.Create(4);
   Compressor.OnChunkDone  :=@LTChunkDone;
   Compressor.OnGetData    :=@LTGetData;
   Compressor.OnIsEndOfFile:=@LTIsEndOfFile;
diff --git a/packages/chm/src/lzxcompressthread.pas b/packages/chm/src/lzxcompressthread.pas
index f22dd2b1d2..80ed3bc295 100644
--- a/packages/chm/src/lzxcompressthread.pas
+++ b/packages/chm/src/lzxcompressthread.pas
@@ -249,7 +249,7 @@ begin
     FMasterThread.Resume;
     if WaitForFinish then
       While Running do
-        CheckSynchronize(50);
+        CheckSynchronize(10);
 end;
 
 { TLZXMasterThread }
@@ -263,6 +263,7 @@ function TLZXMasterThread.BlockDone(Worker: TLZXWorkerThread; ABlock: PLZXFinish
 begin
   Lock;
   REsult := True;
+
   FCompressor.BlockIsFinished(ABlock);
   if DataRemains then
     QueueThread(Worker)
@@ -349,7 +350,8 @@ begin
 
   Thread.CompressData(FBlockNumber);
   Inc(FBlockNumber);
-  Thread.Resume;
+  if Thread.Suspended then
+    Thread.Resume;
   UnLockTmpData;
 end;
 
@@ -370,7 +372,7 @@ begin
   //Suspend;
   while Working do
   begin
-      Sleep(50);
+      Sleep(0);
   end;
   FRunning:= False;
 end;
@@ -489,12 +491,16 @@ begin
   while not Terminated do
   begin
     lzx_reset(LZXdata);
+
     lzx_compress_block(LZXdata, WSize, True);
 
     MasterThread.Synchronize(@NotifyMasterDone);
 
     if ShouldSuspend then
+    begin
       Suspend;
+    end;
+
   end;
 end;
 
diff --git a/packages/chm/src/paslzxcomp.pas b/packages/chm/src/paslzxcomp.pas
index 676744c71c..ac12801d54 100644
--- a/packages/chm/src/paslzxcomp.pas
+++ b/packages/chm/src/paslzxcomp.pas
@@ -285,9 +285,8 @@ begin
 	  if (leaves[leaves_left].freq <> 1) then begin
             leaves[leaves_left].freq := leaves[leaves_left].freq shr 1;
             codes_too_long := 0;
-            Inc(leaves_left);
           end;
-
+          Inc(leaves_left);
         end;
         if codes_too_long <> 0 then
           raise Exception.Create('!codes_too_long');
@@ -994,7 +993,6 @@ begin
   Fillchar(lzxd^.length_freq_table[0], NUM_SECONDARY_LENGTHS * sizeof(longint), 0);
   Fillchar(lzxd^.main_freq_table[0], lzxd^.main_tree_size * sizeof(longint), 0);
   Fillchar(lzxd^.aligned_freq_table[0], LZX_ALIGNED_SIZE * sizeof(longint), 0);
-
   while ((lzxd^.left_in_block<>0) and ((lz_left_to_process(lzxd^.lzi)<>0) or not(lzxd^.at_eof(lzxd^.in_arg)))) do begin
     lz_compress(lzxd^.lzi, lzxd^.left_in_block);
 
@@ -1002,7 +1000,6 @@ begin
       lzxd^.left_in_frame := LZX_FRAME_SIZE;
     end;
     
-    if lzxd^.at_eof(lzxd^.in_arg) then Sleep(500);
     if ((lzxd^.subdivide<0)
       or (lzxd^.left_in_block = 0)
       or ((lz_left_to_process(lzxd^.lzi) = 0) and lzxd^.at_eof(lzxd^.in_arg))) then begin
@@ -1023,7 +1020,6 @@ begin
 	lzx_write_bits(lzxd, 1, 0);
 	lzxd^.need_1bit_header := 0;
       end;
-
       //* handle extra bits */
       uncomp_bits := 0;
       comp_bits := 0;