home *** CD-ROM | disk | FTP | other *** search
- unit TreeCode;
-
- {
- VPatch 2 - Binary Checksum Tree
- ===============================
-
- (c) 2002-2003 Van de Sande Productions
-
- This unit implements a binary search tree, which is constructed from a memory
- block by BuildTree. This memory block is divided into equal-sized blocks of
- BlockSize, and for every block a checksum is calculated. Then, it is inserted
- in the binary tree, which is sorted on the checksum.
- The patch generator will search for the checksums using a binary search, which
- is O(log n) (much better than the old 1.x algoritm, which was O(n)).
-
- What's new
- ----------
- 2.1 20031219 Koen Fixed bug in TreeFind: when tree was a nil
- pointer, now returns instead of AVing
- 2.0 20030811 Koen Initial documentation
- }
-
- interface
-
- type
- TSortStack=record
- lo,hi: Integer;
- end;
- PTreeNode = ^TTreeNode;
- TTreeNode = record
- Checksum: Cardinal;
- Offset: Cardinal;
- end;
-
- const
- TREENODE_SIZE = SizeOf(TTreeNode);
-
- procedure calculateChecksum(AData: Pointer; AStart, ASize: Cardinal; var K: Cardinal);
- procedure calculateNext(AData: Pointer; AStart, ASize: Cardinal; var K: Cardinal);
- function BuildTree(ASource: Pointer; var ATree: Pointer; ASourceSize, ABLOCKSIZE: Cardinal): Cardinal;
- procedure SortTree(ATree: Pointer; ANodeCount: Cardinal);
- procedure ClearTree(var ATree: Pointer; ANodeCount: Cardinal);
- function TreeFind(AChecksum: Cardinal; ABlockTree: Pointer; ABlockTreeNodeCount: Integer; var FoundCount: Integer): PTreeNode;
- function GetItem(ATree: Pointer; Index, ANodeCount: Cardinal): TTreeNode;
-
- procedure Test;
-
- implementation
-
- uses SysUtils;
-
- procedure calculateChecksum(AData: Pointer; AStart, ASize: Cardinal; var K: Cardinal);
- var
- A,B,i,j: Cardinal;
- begin
- A:=K and $0000FFFF;
- B:=(K and $FFFF0000) shr 16;
- j:=Cardinal(AData)+AStart;
- for i:=1 to ASize do begin
- A:=A + PByte(j)^;
- B:=B + (ASize-i+1)*PByte(j)^;
- Inc(j);
- end;
- K:=(A and $0000FFFF) or ((B and $0000FFFF) shl 16);
- end;
-
- procedure calculateNext(AData: Pointer; AStart, ASize: Cardinal; var K: Cardinal);
- var
- A,B,j: Cardinal;
- begin
- j:=Cardinal(AData)+AStart;
- A:=(K-PByte(j-1)^+PByte(j+ASize-1)^) and $0000FFFF;
- B:=((K shr 16)-ASize*PByte(j-1)^+A) and $0000FFFF;
- K:=A or (B shl 16);
- end;
-
- function BuildTree(ASource: Pointer; var ATree: Pointer; ASourceSize, ABLOCKSIZE: Cardinal): Cardinal;
- var
- i, NodeCount: Cardinal;
- Node: TTreeNode;
- begin
- Assert(not Assigned(ATree),'Cannot use initialized tree in BuildTree!');
- NodeCount:=ASourceSize div ABLOCKSIZE;
- GetMem(ATree,NodeCount*TREENODE_SIZE);
- if NodeCount > 0 then begin
- for i:=0 to Pred(NodeCount) do begin
- Node.Offset:=i*ABLOCKSIZE;
- Node.Checksum:=0;
- calculateChecksum(ASource,Node.Offset,ABLOCKSIZE,Node.Checksum);
- Move(Node,Pointer(Cardinal(ATree)+i*TREENODE_SIZE)^,TREENODE_SIZE);
- end;
- end;
- Result:=NodeCount;
- end;
-
- procedure SetItem(ATree: Pointer; Index, ANodeCount: Cardinal; New: TTreeNode);
- var
- p: PTreeNode;
- begin
- Assert(Index<ANodeCount,'Tree/GetItem: Index too big');
- p:=PTreeNode(Cardinal(ATree)+Index*TREENODE_SIZE);
- p^:=New;
- end;
-
- function GetItem(ATree: Pointer; Index, ANodeCount: Cardinal): TTreeNode;
- var
- p: PTreeNode;
- begin
- Assert(Index<ANodeCount,'Tree/GetItem: Index too big '+IntToStr(Index));
- p:=PTreeNode(Cardinal(ATree)+Index*TREENODE_SIZE);
- Result:=p^;
- end;
-
- procedure SortTree(ATree: Pointer; ANodeCount: Cardinal);
- var
- compare: Cardinal;
- aStack: Array[1..128] of TSortStack;
- StackPtr: Integer;
- Mid,i,j,low,hi: Integer;
- Switcher: TTreeNode;
- begin
- If ANodeCount = 0 Then Exit;
- StackPtr:=1;
- aStack[StackPtr].lo:=0;
- aStack[StackPtr].hi:=ANodeCount - 1;
- Inc(StackPtr);
- while not (StackPtr=1) do begin
- StackPtr:=StackPtr-1;
- low:=aStack[StackPtr].lo;
- hi:=aStack[StackPtr].hi;
- while true do begin
- i:=low;
- j:=hi;
- Mid:=(low + hi) div 2;
- compare:=PTreeNode(Integer(ATree)+Mid*TREENODE_SIZE)^.Checksum;
- while true do begin
- While PTreeNode(Integer(ATree)+i*TREENODE_SIZE)^.Checksum < compare do begin
- Inc(i);
- end;
- While PTreeNode(Integer(ATree)+j*TREENODE_SIZE)^.Checksum > compare do begin
- j:=j-1;
- end;
- If (i <= j) Then begin
- Move(Pointer(Integer(ATree)+j*TREENODE_SIZE)^,Switcher,TREENODE_SIZE);
- Move(Pointer(Integer(ATree)+i*TREENODE_SIZE)^,Pointer(Integer(ATree)+j*TREENODE_SIZE)^,TREENODE_SIZE);
- Move(Switcher,Pointer(Integer(ATree)+i*TREENODE_SIZE)^,TREENODE_SIZE);
- Inc(i);
- Dec(j);
- End;
- if not (i <= j) then break;
- end;
- If j - low < hi - i Then begin
- If i < hi Then begin
- aStack[StackPtr].lo:=i;
- aStack[StackPtr].hi:=hi;
- Inc(StackPtr);
- End;
- hi:=j;
- end Else begin
- If low < j Then begin
- aStack[StackPtr].lo:=low;
- aStack[StackPtr].hi:=j;
- Inc(StackPtr);
- End;
- low:=i;
- End;
- if not (low<hi) then break;
- end;
- if StackPtr=1 then break;
- end;
- end;
-
- procedure ClearTree(var ATree: Pointer; ANodeCount: Cardinal);
- begin
- FreeMem(ATree,ANodeCount*TREENODE_SIZE);
- ATree:=nil;
- end;
-
- function TreeFind(AChecksum: Cardinal; ABlockTree: Pointer; ABlockTreeNodeCount: Integer; var FoundCount: Integer): PTreeNode;
- var
- lo,mid,hi,m: Integer;
- tmp: Cardinal;
- begin
- if not Assigned(ABlockTree) then begin
- FoundCount:=0; Result:=nil;
- Exit;
- end;
- lo:=0;
- hi:=ABlockTreeNodeCount-1;
- while true do begin
- mid:=(lo+hi) div 2;
- tmp:=PCardinal(Integer(ABlockTree)+mid*TREENODE_SIZE)^;
- if tmp = AChecksum then begin
- FoundCount:=1;
- m:=mid;
- Result:=PTreeNode(Integer(ABlockTree)+m*TREENODE_SIZE);
- while m > 0 do begin
- Dec(m);
- if PCardinal(Integer(ABlockTree)+m*TREENODE_SIZE)^ = tmp then begin
- Result:=PTreeNode(Integer(ABlockTree)+m*TREENODE_SIZE);
- Inc(FoundCount);
- end else
- Break;
- end;
- m:=mid;
- while m < ABlockTreeNodeCount-1 do begin
- Inc(m);
- if PCardinal(Integer(ABlockTree)+m*TREENODE_SIZE)^ = tmp then begin
- Inc(FoundCount);
- end else
- Break;
- end;
- Exit;
- end;
- if lo>=hi then Break;
- if AChecksum < tmp then begin
- hi:=mid-1;
- end else begin
- lo:=mid+1;
- end;
- end;
- FoundCount:=0; Result:=nil;
- end;
-
- procedure Test;
- var
- p: Pointer;
- t: TTreeNode;
- r: PTreeNode;
- i,q: Integer;
- NC: Integer;
- begin
- NC:=100;
- GetMem(p,800);
- for i:=0 to 99 do begin
- t.Offset:=i*100;
- t.Checksum:=i div 2;
- SetItem(p,i,NC,t);
- end;
- SortTree(p,NC);
- for i:=0 to 99 do begin
- t:=GetItem(p,i,NC);
- Write(IntToStr(t.Checksum)+' ');
- end;
- r:=TreeFind(7,p,NC,q);
- WriteLn(IntToStr(q));
- t:=r^;
- WriteLn(IntToStr(t.Checksum)+' ');
- end;
-
- end.
-