Skip to content

Commit

Permalink
Speeding up iXMLNode.NextSibling/PrevSibling
Browse files Browse the repository at this point in the history 
Got quite a nasty example: Excel XML-SS file with some worksheet having up to 16K (sic!) invisible columns.
On AMD Phenom2-X4-965 machine (3.4 GHz) scanning of a specific worksheet into the TStringGrid took:
1) 37,6 seconds for .NextSibling/PrevSibling loops with old "linear search" implementations
2) 0,33 secs for index-based loops
3) 0,41 secs for new caching .NextSibling/PrevSibling

However +12 bytes per node....
  • Loading branch information
the-Arioch authored and the-Arioch committed Oct 3, 2016
1 parent 462e8f8 commit d71bfa0
Showing 1 changed file with 139 additions and 38 deletions.
177 changes: 139 additions & 38 deletions OmniXML.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -390,6 +390,9 @@ TXMLTextStream = class(TInterfacedObject, IUnicodeStream)
function HasChildNodes: Boolean;
function CloneNode(const Deep: Boolean): IXMLNode;

procedure SetCachedSiblings(const PrevOne, NextOne: iXMLNode);
procedure SetNoCachedSiblings;

property NodeName: XmlString read GetNodeName;
property NodeValue: XmlString read GetNodeValue write SetNodeValue;
property NodeType: TNodeType read GetNodeType;
Expand Down Expand Up @@ -420,6 +423,7 @@ TXMLTextStream = class(TInterfacedObject, IUnicodeStream)
// protected
function GetLength: Integer;
function GetItem(const Index: Integer): IXMLNode;
procedure MakeChildrenCacheSiblings(const Value: boolean);
// public
property Item[const Index: Integer]: IXMLNode read GetItem;
property Length: Integer read GetLength;
Expand Down Expand Up @@ -644,6 +648,8 @@ TXMLNode = class(TInterfacedObject, IXMLNode)
FChildNodes: IXMLNodeList;
FParentNode: IXMLNode;
FNodeValueId: TDicId;
FCachingIndex: boolean;

procedure ClearChildNodes;
function HasAttributes: Boolean;
function GetAttributes: IXMLNamedNodeMap;
Expand All @@ -666,6 +672,9 @@ TXMLNode = class(TInterfacedObject, IXMLNode)
function GetXML: XmlString;
procedure SelectNodes(Pattern: string; var Result: IXMLNodeList); overload; virtual;
procedure SelectSingleNode(Pattern: string; var Result: IXMLNode); overload; virtual;

procedure SetCachedSiblings(const PrevOne, NextOne: iXMLNode);
procedure SetNoCachedSiblings;
public
Dictionary: TDictionary;
property NodeName: XmlString read GetNodeName;
Expand Down Expand Up @@ -725,10 +734,13 @@ TXMLCustomList = class(TInterfacedObject, IXMLCustomList)
{$ELSE}
FList: TList;
{$ENDIF}
FChildrenCachedSiblings: boolean;
protected
function GetLength: Integer;
function GetItem(const Index: Integer): IXMLNode;
procedure Put(Index: Integer; Item: IXMLNode);

procedure MakeChildrenCacheSiblings(const Value: boolean);
public
constructor Create;
destructor Destroy; override;
Expand Down Expand Up @@ -1962,22 +1974,78 @@ procedure TXMLParseError.SetURL(const URL: string);

{ TXMLCustomList }

type TNotifyingList = class({$IFDEF OmniXML_Generics}TList<IXMLNode>{$Else}TList{$EndIf})
private
Owner: TXMLCustomList;
protected
{$IfDef OmniXML_Generics}
procedure Notify(const Item: IXMLNode; Action: TCollectionNotification); override;
{$Else}
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
{$EndIf}
end;

{$IFDEF OmniXML_Generics}
procedure TNotifyingList.Notify(const Item: IXMLNode; Action: TCollectionNotification);
{$Else}
procedure TNotifyingList.Notify(Ptr: Pointer; Action: TListNotification);
{$EndIf}
begin
// for preformance reasons we would not call inherited function here
// 1) non-generic TList.Notify is empty anywhere
// 2) generic TList<T>.Notify merely checks event property and possibly calls
// it, which implies extra redirection and AddRef/Release calls
// And yet again, we do not use that event.

if Count > 0 then
if Owner <> nil then
if Owner.FChildrenCachedSiblings then
Owner.MakeChildrenCacheSiblings( False );
end;

constructor TXMLCustomList.Create;
begin
{$IFDEF OmniXML_Generics}
FList := TList<IXMLNode>.Create;
{$ELSE}
FList := TList.Create;
{$ENDIF}
FList := TNotifyingList.Create;
TNotifyingList(FList).Owner := Self;
end;

destructor TXMLCustomList.Destroy;
begin
if GetLength > 0 then
MakeChildrenCacheSiblings(False);
if FList <> nil then
(FList as TNotifyingList).Owner := nil;
Clear;
FList.Free;
inherited;
end;

procedure TXMLCustomList.MakeChildrenCacheSiblings(const Value: boolean);
var i, l: integer;
iNext, iPrev, iCurr: IXMLNode;
begin
if Value then begin
L := GetLength();
if L > 0 then begin
i := 0;
iNext := GetItem(0);
while iNext <> nil do begin
iPrev := iCurr;
iCurr := iNext;
Inc(i);
if i < L
then iNext := GetItem( i )
else iNext := nil;
iCurr.SetCachedSiblings(iPrev, iNext);
end;
end;
end else begin
for i := 0 to GetLength - 1 do
GetItem(i).SetNoCachedSiblings;
end;
FChildrenCachedSiblings := Value;
end;

function TXMLCustomList.GetItem(const Index: Integer): IXMLNode;
begin
{$IFDEF OmniXML_Generics}
Expand Down Expand Up @@ -2145,6 +2213,7 @@ constructor TXMLNode.Create(const AOwnerDocument: TXMLDocument);

destructor TXMLNode.Destroy;
begin
SetNoCachedSiblings;
FAttributes := nil;
FChildNodes := nil;
Pointer(FParentNode) := nil; // (gp)
Expand Down Expand Up @@ -2282,44 +2351,60 @@ function TXMLNode.GetOwnerDocument: IXMLDocument;
end;

function TXMLNode.GetPreviousSibling: IXMLNode;
function FindPreviousNode(const Self: IXMLNode): IXMLNode;
var
Childs: IXMLNodeList;
Index: Integer;
begin
Childs := FParentNode.ChildNodes;
Index := Childs.IndexOf(Self);
if (Index >= 0) and ((Index - 1) >= 0) then
Result := Childs.Item[Index - 1]
else
Result := nil;
end;
begin
if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
Result := FindPreviousNode(Self as IXMLNode)
else
Result := nil;
if not FCachingSiblings then
if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
FParentNode.ChildNodes.MakeChildrenCacheSiblings(True);
Result := FSibPrev;
end;

function TXMLNode.GetNextSibling: IXMLNode;
function FindNextNode(const Self: IXMLNode): IXMLNode;
var
Childs: IXMLNodeList;
Index: Integer;
begin
Childs := FParentNode.ChildNodes;
Index := Childs.IndexOf(Self);
if (Index >= 0) and ((Index + 1) < Childs.Length) then
Result := Childs.Item[Index + 1]
else
Result := nil;
end;
begin
if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
Result := FindNextNode(Self as IXMLNode)
else
Result := nil;
end;
if not FCachingSiblings then
if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
FParentNode.ChildNodes.MakeChildrenCacheSiblings(True);
Result := FSibNext;
end;

//function TXMLNode.GetPreviousSibling: IXMLNode;
// function FindPreviousNode(const Self: IXMLNode): IXMLNode;
// var
// Childs: IXMLNodeList;
// Index: Integer;
// begin
// Childs := FParentNode.ChildNodes;
// Index := Childs.IndexOf(Self);
// if (Index >= 0) and ((Index - 1) >= 0) then
// Result := Childs.Item[Index - 1]
// else
// Result := nil;
// end;
//begin
// if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
// Result := FindPreviousNode(Self as IXMLNode)
// else
// Result := nil;
//end;
//
//function TXMLNode.GetNextSibling: IXMLNode;
// function FindNextNode(const Self: IXMLNode): IXMLNode;
// var
// Childs: IXMLNodeList;
// Index: Integer;
// begin
// Childs := FParentNode.ChildNodes;
// Index := Childs.IndexOf(Self);
// if (Index >= 0) and ((Index + 1) < Childs.Length) then
// Result := Childs.Item[Index + 1]
// else
// Result := nil;
// end;
//begin
// if (FParentNode <> nil) and (FParentNode.HasChildNodes) then
// Result := FindNextNode(Self as IXMLNode)
// else
// Result := nil;
//end;

function TXMLNode.HasChildNodes: Boolean;
begin
Expand Down Expand Up @@ -2525,6 +2610,22 @@ function TXMLNode.SelectSingleNode(Pattern: string): IXMLNode;
SelectSingleNode(Pattern, Result);
end;

procedure TXMLNode.SetCachedSiblings(const PrevOne, NextOne: iXMLNode);
begin
FSibPrev := PrevOne;
FSibNext := NextOne;
FCachingSiblings := True;
end;

procedure TXMLNode.SetNoCachedSiblings;
begin
FCachingSiblings := False;
FSibNext := nil;
FSibPrev := nil;
end;



{ TODO -omr : re-add after IXMLDocumentType will be properly supported }
(*
{ TXMLDocumentType }
Expand Down

0 comments on commit d71bfa0

Please sign in to comment.