是高手的帮忙看看!(100分)

  • 主题发起人 seven_918
  • 开始时间
S

seven_918

Unregistered / Unconfirmed
GUEST, unregistred user!
有如下单元,在倒数几行有一个错误,我已经用星号标出来了,请高手帮忙看看!
unit AVLtrees;
interface
{$ifdef debug_arrays}
{$define debug}
{$endif}
uses
SysUtils, Classes;
type
EAVLtreeException = class(Exception);
TBalancedTree = class;
PBalancedTree = ^TBalancedTree;
TBTTreateNode = function ( ANode : TBalancedTree;
AParm : Pointer ) : Boolean;
// True -> break treation loop
// Generic low-level AVL-Tree node class
// Warninig: use Destroy for root node only.
TBalancedTree = class(TPersistent)
protected
LLink, RLink : TBalancedTree;
FBal, FCmp : Byte;
function Compare( AWith : TBalancedTree ) : Integer;
virtual;
abstract;
public
procedure BeforeDestruction;
override;
// destroy tree - all node children.
class function Add( var ARoot {: TBalancedTree};
ANode : TBalancedTree;
var bFound : Boolean ) : TBalancedTree;
virtual;
class function AddItem( var ARoot {: TBalancedTree};
ANode : TBalancedTree;
const bRaiseError : Boolean ) : TBalancedTree;
virtual;
procedure Beat( AProc : TBTTreateNode;
AParm : Pointer );
//
procedure RecursiveBeat( AProc : TBTTreateNode;
AParm : Pointer );
function Find( ANode : TBalancedTree ) : TBalancedTree;
end;
TBTClass = class of TBalancedTree;
//-------------------------------------------------------------
THackBTree = class(TBalancedTree)
public
property Left : TBalancedTree read LLink;
property Right : TBalancedTree read RLink;
end;

//-------------------------------------------------------------
// TStringBTree is for backward compatibility
// Key - string
// Case insensetive compare (AnsiCompareText) is used!
TStringBTree = class(TBalancedTree)
protected
FKey : String;
function Compare( AWith : TBalancedTree ) : Integer;
override;
public
constructor Create( const AKey : String );
function FindKey( const AKey : String ) : TStringBTree;
property Key : String read FKey write FKey;
end;

//=============================================================
// User friendly AVL-tree classes
TAVLtreeNode = class;
TAVLtreeNodeClass = class of TAVLtreeNode;
TAVLtree = class(TPersistent)
protected
FRoot : TAVLtreeNode;
FNodeClass : TAVLtreeNodeClass;
public
constructor Create( ANodeClass : TAVLtreeNodeClass );
destructor Destroy;
override;
// destroy all tree nodes
function AddNodeEx( ANode : TAVLtreeNode;
var ASuccess : Boolean ) : TAVLtreeNode;
virtual;
// result = ANode or node with same key from tree
function AddNode( ANode : TAVLtreeNode ) : Boolean;
function Unlink( ANode : TAVLtreeNode ) : Boolean;
property Root : TAVLtreeNode read FRoot;
property NodeClass : TAVLtreeNodeClass read FNodeClass;
end;

// abstract AVL-tree node class
TAVLtreeNode = class(TBalancedTree)
protected
FTree : TAVLtree;
procedure SetTree( Value : TAVLtree );
public
procedure BeforeDestruction;
override;
// unlink from tree
property Tree : TAVLtree read FTree write SetTree;
end;
PAVLtreeNode = ^TAVLtreeNode;
//-------------------------------------------------------------
// Integer key
TIntKeyAVLtreeNode = class;
TIntKeyAVLtreeNodeClass = class of TIntKeyAVLtreeNode;
TIntKeyAVLtree = class(TAVLtree)
public
function Add( const AKey : Integer ) : TIntKeyAVLtreeNode;
// warning: return Nil if AKey already exists
function Find( const AKey : Integer ) : TIntKeyAVLtreeNode;
end;

TIntKeyAVLtreeNode = class(TAVLTreeNode)
protected
FKey : Integer;
function Compare( AWith : TBalancedTree ) : Integer ;
override;
public
constructor Create( ATree : TIntKeyAVLtree;
const AKey : Integer );
virtual;
// ATree can be Nil
property Key : Integer read FKey;
end;

//-------------------------------------------------------------
// String key
TStringKeyAVLtreeNode = class;
TStringKeyAVLtreeNodeClass = class of TStringKeyAVLtreeNode;
TStringCompareProc = function ( S1, S2 : String ) : Integer of object;
// case insensetive compare (AnsiCompareText)
TStringKeyAVLtree = class(TAVLtree)
protected
FCompareMethod : TStringCompareProc;
// Is there is no other legal way to call virtual method from basm ?
function CompareKeys( S1, S2 : String ) : Integer;
virtual;
// case insensetive ANSI compare
public
constructor Create( ANodeClass : TStringKeyAVLtreeNodeClass );
function Add( const AKey : String ) : TStringKeyAVLtreeNode;
// warning: return Nil if AKey already exists
function Find( const AKey : String ) : TStringKeyAVLtreeNode;
virtual;
end;

TStringKeyAVLtreeNode = class(TAVLTreeNode)
protected
FKey : String;
function Compare( AWith : TBalancedTree ) : Integer ;
override;
public
constructor Create( ATree : TStringKeyAVLtree;
const AKey : String );
virtual;
property Key : String read FKey;
end;

// binary compare
TBinaryKeyAVLtree = class(TStringKeyAVLtree)
protected
function CompareKeys( S1, S2 : String ) : Integer;
override;
end;

TBinaryKeyAVLtreeNode = TStringKeyAVLtreeNode;
//-------------------------------------------------------------
// Low level functions
function gbt_insert( var ARoot{ : TBalancedTree};
ANode : TBalancedTree ) : TBalancedTree;
function gbt_replace( var ARoot{ : TBalancedTree};
ANode : TBalancedTree ) : TBalancedTree;
function gbt_unlink( var ARoot{ : TBalancedTree};
ANode : TBalancedTree ) : Boolean;
const
offsetLLink = 4;
offsetRLink = 8;
vmtCompare = 12;
//=============================================================
implementation
uses Windows;
{$ifndef VER130}
procedure FreeAndNil(var Obj);
// VP Delphi 5+ only
var
P: TObject;
begin
P := TObject(Obj);
if P<>nil then
begin
TObject(Obj) := nil;
// clear the reference before destroying the object
P.Destroy;
end;
end;
{$endif}

//=============================================================
function gbt_insert( var ARoot{ : TBalancedTree};
ANode : TBalancedTree ) : TBalancedTree;
assembler;
var N : TBalancedTree;
T : PBalancedTree;
asm
test eax,eax
jz @@Exit0
push esi
push edi
// p = ATree;
s = ATree;
mov edi,[eax] // P = edi
test edi,edi
jnz @@A101
mov [eax],edx
jmp @@Null
@@A101:
mov esi,edi // S = esi
mov T,eax
mov N,edx
// goto A2;
xor eax,eax
jmp @@A2
@@A3:
// if( B(Q) )
cmp [edx].TBalancedTree.FBal,0
jz @@A301
// { T = W;
S = Q }
mov T,ecx
mov esi,edx
@@A301:
// P = Q;
mov edi,edx
@@A2:
mov eax,N
mov edx,edi
mov ecx,[eax] // VMT
// mov ecx,[ecx+4*3] // offset TBalancedTree.Compare
// call ecx
call dword ptr [ecx].vmtCompare
test eax,eax
jz @@Found
// Q = *(W = pLink(P,a)) ecx = W
mov eax,offset(TBalancedTree.LLink)
jl @@A201
mov eax,offset(TBalancedTree.RLink)
@@A201:
lea ecx,[edi+eax]
mov [edi].TBalancedTree.FCmp,al
mov edx,[ecx] // edx = Q
test edx,edx
jnz @@A3
// *W=Q=N
mov edx,N
mov [ecx],edx
// A6
// R = P = Link(S,A(S))
mov al,[esi].TBalancedTree.FCmp
mov edi,[esi+eax]
mov ecx,edi // ecx = R
cmp edi,edx
je @@A7
// while( P != Q ) P = Link( P, B(P)=A(P) );
@@A601:
mov al,[edi].TBalancedTree.FCmp
mov [edi].TBalancedTree.FBal,al
mov edi,[edi+eax]
cmp edi,edx
jne @@A601
@@A7:
// if( ( a = A(S) ) != B(S) )
mov al,[esi].TBalancedTree.FCmp
cmp al,[esi].TBalancedTree.FBal
je @@A702
// B(S) = (byte)( B(S) ? 0 : (byte)a );
return NULL;
cmp [esi].TBalancedTree.FBal,0
jz @@A701
xor al,al
@@A701:
mov [esi].TBalancedTree.FBal,al
jmp @@Null
@@A702: // edx = W = pLink( R, Neg(a) )
mov edx,(offset(TBalancedTree.LLink) xor offset(TBalancedTree.RLink))
xor dl,al
add edx,ecx
// if( B(R)==a )
cmp al,[ecx].TBalancedTree.FBal
jne @@A9
@@A8:
// P = R;
mov edi,ecx
// B(R) = B(S) = 0
mov [ecx].TBalancedTree.FBal,0
mov [esi].TBalancedTree.FBal,0
// Link(S,a) = *( W = pLink( R, Neg(a) ) );
mov ecx,[edx]
mov [esi+eax],ecx
// *W = S
mov [edx],esi
jmp @@A10
@@Found:
mov eax,edi
jmp @@Exit
@@A9:
push ebx
// P = *(W = pLink( R, Neg(a) ) );
mov edi,[edx]
// *W = Link(P,a);
Link(P,a) = R
mov ebx,[edi+eax]
mov [edx],ebx
mov [edi+eax],ecx
// Link( S, a ) = *(W = pLink( P, Neg(a) ));
mov ebx,(offset(TBalancedTree.LLink) xor offset(TBalancedTree.RLink))
xor ebx,eax // ebx = Neg(a)
mov edx,[edi+ebx]
mov [esi+eax],edx
// *W = S;
mov [edi+ebx],esi
// if( !B(P) )
cmp [edi].TBalancedTree.FBal,0
jnz @@A901
//{ B(S) = 0;
mov [esi].TBalancedTree.FBal,0
jmp @@A909
@@A901:
//}else
if( B(P) != a )
cmp al,[edi].TBalancedTree.FBal
je @@A908
//{ B(S) = 0;
B(R) = (byte)a;
}
mov [esi].TBalancedTree.FBal,0
mov [ecx].TBalancedTree.FBal,al
jmp @@A999
@@A908:
// B(S) = Neg(a);
mov [esi].TBalancedTree.FBal,bl
@@A909:
// B(R) = 0;
mov [ecx].TBalancedTree.FBal,0
@@A999:
// B(P)=0;
mov [edi].TBalancedTree.FBal,0
pop ebx
@@A10:
mov edx,T // ATree
mov [edx],edi
@@Null:
xor eax,eax
@@Exit:
pop edi
pop esi
@@Exit0:
end;
//-------------------------------------------------------------
// 羼腓 磬殇屐 箸咫 ?蜞觇?驽 觌?铎, 蝾 镱潇屙
 
我倒!这么长的代码
 
也不是啊,上面出错的一句,
call TMethod[eax+Offset(TStringKeyAVLtree.FCompareMethod)].Code
如果我换成
call TMethod[eax].Code
就可以编译通过了。
我不懂汇编,大家帮帮忙啦!谢谢!分不够可以再加的!
 
怎么没人回答我的问题呀?
很急的呀!摆脱了!
 
倒!!
好长的代码?
 
Add eax,offset(TStringKeyAVLtree.FCompareMethod)
call TMethod[eax].Code
sub eax,offset(TStringKeyAVLtree.FCompareMethod)
应该可以吧,只是不太好。
 
多人接受答案了。
 

Similar threads

I
回复
0
查看
720
import
I
I
回复
0
查看
683
import
I
I
回复
0
查看
668
import
I
I
回复
0
查看
730
import
I
I
回复
0
查看
656
import
I
顶部