paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 23:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 'classified' tdictionary, but leave it within an define

Browse Source
This commit is contained in:
peter 2000-12-29 21:57:27 +00:00
parent 24cf673f91
commit bd64ad0539
1 changed files with 259 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

538
compiler/cclasses.pas
View File

@ -133,7 +133,7 @@ interface
property Doubles:boolean read FDoubles write FDoubles; property Doubles:boolean read FDoubles write FDoubles;
end; end;
{$ifdef OLD} {$ifdef NODIC}
{******************************************** {********************************************
Dictionary Dictionary
********************************************} ********************************************}
@ -144,108 +144,85 @@ interface
type type
{ namedindexobect for use with dictionary and indexarray } { namedindexobect for use with dictionary and indexarray }
Pnamedindexobject=^Tnamedindexobject; Tnamedindexobject=class
Tnamedindexobject=object
{ indexarray } { indexarray }
indexnr : integer; indexnr : integer;
indexNext : Pnamedindexobject; indexNext : TNamedIndexObject;
{ dictionary } { dictionary }
_name : Pstring; _name : Pstring;
_valuename : Pstring; { uppercase name } _valuename : Pstring; { uppercase name }
left,right : Pnamedindexobject; left,right : TNamedIndexObject;
speedvalue : integer; speedvalue : integer;
{ singleList } { singleList }
ListNext : Pnamedindexobject; ListNext : TNamedIndexObject;
constructor init; constructor create;
constructor initname(const n:string); constructor createname(const n:string);
destructor done;virtual; destructor destroy;override;
procedure setname(const n:string);virtual; procedure setname(const n:string);virtual;
function name:string;virtual; function name:string;virtual;
end; end;
Pdictionaryhasharray=^Tdictionaryhasharray; Pdictionaryhasharray=^Tdictionaryhasharray;
Tdictionaryhasharray=array[-hasharraysize..hasharraysize] of Pnamedindexobject; Tdictionaryhasharray=array[-hasharraysize..hasharraysize] of TNamedIndexObject;
Tnamedindexcallback = procedure(p:Pnamedindexobject); Tnamedindexcallback = procedure(p:TNamedIndexObject) of object;
Pdictionary=^Tdictionary; Tdictionary=class
Tdictionary=object
noclear : boolean; noclear : boolean;
replace_existing : boolean; replace_existing : boolean;
constructor init; constructor Create;
destructor done;virtual; destructor Destroy;override;
procedure usehash; procedure usehash;
procedure clear; procedure clear;
function delete(const s:string):Pnamedindexobject; function delete(const s:string):TNamedIndexObject;
function empty:boolean; function empty:boolean;
procedure foreach(proc2call:Tnamedindexcallback); procedure foreach(proc2call:Tnamedindexcallback);
function insert(obj:Pnamedindexobject):Pnamedindexobject; function insert(obj:TNamedIndexObject):TNamedIndexObject;
function rename(const olds,News : string):Pnamedindexobject; function rename(const olds,News : string):TNamedIndexObject;
function search(const s:string):Pnamedindexobject; function search(const s:string):TNamedIndexObject;
function speedsearch(const s:string;speedvalue:integer):Pnamedindexobject; function speedsearch(const s:string;speedvalue:integer):TNamedIndexObject;
private private
root : Pnamedindexobject; root : TNamedIndexObject;
hasharray : Pdictionaryhasharray; hasharray : Pdictionaryhasharray;
procedure cleartree(obj:Pnamedindexobject); procedure cleartree(obj:TNamedIndexObject);
function insertNode(NewNode:Pnamedindexobject;var currNode:Pnamedindexobject):Pnamedindexobject; function insertNode(NewNode:TNamedIndexObject;var currNode:TNamedIndexObject):TNamedIndexObject;
procedure inserttree(currtree,currroot:Pnamedindexobject); procedure inserttree(currtree,currroot:TNamedIndexObject);
end; end;
psingleList=^tsingleList; psingleList=^tsingleList;
tsingleList=object tsingleList=class
First, First,
last : Pnamedindexobject; last : TNamedIndexObject;
constructor init; constructor Create;
destructor done;
procedure reset; procedure reset;
procedure clear; procedure clear;
procedure insert(p:Pnamedindexobject); procedure insert(p:TNamedIndexObject);
end; end;
tindexobjectarray=array[1..16000] of Pnamedindexobject; tindexobjectarray=array[1..16000] of TNamedIndexObject;
Pnamedindexobjectarray=^tindexobjectarray; TNamedIndexObjectarray=^tindexobjectarray;
pindexarray=^tindexarray; pindexarray=^tindexarray;
tindexarray=object tindexarray=class
noclear : boolean; noclear : boolean;
First : Pnamedindexobject; First : TNamedIndexObject;
count : integer; count : integer;
constructor init(Agrowsize:integer); constructor Create(Agrowsize:integer);
destructor done; destructor destroy;override;
procedure clear; procedure clear;
procedure foreach(proc2call : Tnamedindexcallback); procedure foreach(proc2call : Tnamedindexcallback);
procedure deleteindex(p:Pnamedindexobject); procedure deleteindex(p:TNamedIndexObject);
procedure delete(var p:Pnamedindexobject); procedure delete(var p:TNamedIndexObject);
procedure insert(p:Pnamedindexobject); procedure insert(p:TNamedIndexObject);
function search(nr:integer):Pnamedindexobject; function search(nr:integer):TNamedIndexObject;
private private
growsize, growsize,
size : integer; size : integer;
data : Pnamedindexobjectarray; data : TNamedIndexObjectarray;
procedure grow(gsize:integer); procedure grow(gsize:integer);
end; end;
{$endif NODIC}
{$ifdef fixLeaksOnError}
PStackItem = ^TStackItem;
TStackItem = record
Next: PStackItem;
data: pointer;
end;
PStack = ^TStack;
TStack = object
constructor init;
destructor done;
procedure push(p: pointer);
function pop: pointer;
function top: pointer;
function isEmpty: boolean;
private
head: PStackItem;
end;
{$endif fixLeaksOnError}
{$endif OLD}
{******************************************** {********************************************
DynamicArray DynamicArray
@ -761,12 +738,12 @@ end;
end; end;
{$ifdef OLD} {$ifdef NODIC}
{**************************************************************************** {****************************************************************************
Tnamedindexobject Tnamedindexobject
****************************************************************************} ****************************************************************************}
constructor Tnamedindexobject.init; constructor Tnamedindexobject.Create;
begin begin
{ index } { index }
indexnr:=-1; indexnr:=-1;
@ -780,7 +757,7 @@ begin
ListNext:=nil; ListNext:=nil;
end; end;
constructor Tnamedindexobject.initname(const n:string); constructor Tnamedindexobject.Createname(const n:string);
begin begin
{ index } { index }
indexnr:=-1; indexnr:=-1;
@ -794,11 +771,13 @@ begin
ListNext:=nil; ListNext:=nil;
end; end;
destructor Tnamedindexobject.done;
destructor Tnamedindexobject.destroy;
begin begin
stringdispose(_name); stringdispose(_name);
end; end;
procedure Tnamedindexobject.setname(const n:string); procedure Tnamedindexobject.setname(const n:string);
begin begin
if speedvalue=-1 then if speedvalue=-1 then
@ -809,6 +788,7 @@ begin
end; end;
end; end;
function Tnamedindexobject.name:string; function Tnamedindexobject.name:string;
begin begin
if assigned(_name) then if assigned(_name) then
@ -822,7 +802,7 @@ end;
TDICTIONARY TDICTIONARY
****************************************************************************} ****************************************************************************}
constructor Tdictionary.init; constructor Tdictionary.Create;
begin begin
root:=nil; root:=nil;
hasharray:=nil; hasharray:=nil;
@ -842,7 +822,7 @@ end;
end; end;
destructor Tdictionary.done; destructor Tdictionary.destroy;
begin begin
if not noclear then if not noclear then
clear; clear;
@ -851,13 +831,13 @@ end;
end; end;
procedure Tdictionary.cleartree(obj:Pnamedindexobject); procedure Tdictionary.cleartree(obj:TNamedIndexObject);
begin begin
if assigned(obj^.left) then if assigned(obj.left) then
cleartree(obj^.left); cleartree(obj.left);
if assigned(obj^.right) then if assigned(obj.right) then
cleartree(obj^.right); cleartree(obj.right);
dispose(obj,done); obj.free;
obj:=nil; obj:=nil;
end; end;
@ -874,125 +854,126 @@ end;
cleartree(hasharray^[w]); cleartree(hasharray^[w]);
end; end;
function Tdictionary.delete(const s:string):Pnamedindexobject;
var p,speedvalue:integer; function Tdictionary.delete(const s:string):TNamedIndexObject;
n:Pnamedindexobject; var
p,speedvalue : integer;
procedure insert_right_bottom(var root,Atree:Pnamedindexobject); n : TNamedIndexObject;
procedure insert_right_bottom(var root,Atree:TNamedIndexObject);
begin begin
while root^.right<>nil do while root.right<>nil do
root:=root^.right; root:=root.right;
root^.right:=Atree; root.right:=Atree;
end; end;
function delete_from_tree(root:Pnamedindexobject):Pnamedindexobject; function delete_from_tree(root:TNamedIndexObject):TNamedIndexObject;
type
type leftright=(left,right); leftright=(left,right);
var
var lr:leftright; lr : leftright;
oldroot:Pnamedindexobject; oldroot : TNamedIndexObject;
begin begin
oldroot:=nil; oldroot:=nil;
while (root<>nil) and (root^.speedvalue<>speedvalue) do while (root<>nil) and (root.speedvalue<>speedvalue) do
begin begin
oldroot:=root; oldroot:=root;
if speedvalue<root^.speedvalue then if speedvalue<root.speedvalue then
begin begin
root:=root^.right; root:=root.right;
lr:=right; lr:=right;
end end
else else
begin begin
root:=root^.left; root:=root.left;
lr:=left; lr:=left;
end; end;
end; end;
while (root<>nil) and (root^._name^<>s) do while (root<>nil) and (root._name^<>s) do
begin begin
oldroot:=root; oldroot:=root;
if s<root^._name^ then if s<root._name^ then
begin begin
root:=root^.right; root:=root.right;
lr:=right; lr:=right;
end end
else else
begin begin
root:=root^.left; root:=root.left;
lr:=left; lr:=left;
end; end;
end; end;
if root^.left<>nil then if root.left<>nil then
begin begin
{Now the Node pointing to root must point to the left { Now the Node pointing to root must point to the left
subtree of root. The right subtree of root must be subtree of root. The right subtree of root must be
connected to the right bottom of the left subtree.} connected to the right bottom of the left subtree.}
if lr=left then if lr=left then
oldroot^.left:=root^.left oldroot.left:=root.left
else else
oldroot^.right:=root^.left; oldroot.right:=root.left;
if root^.right<>nil then if root.right<>nil then
insert_right_bottom(root^.left,root^.right); insert_right_bottom(root.left,root.right);
end end
else else
{There is no left subtree. So we can just replace the Node to begin
delete with the right subtree.} { There is no left subtree. So we can just replace the Node to
if lr=left then delete with the right subtree.}
oldroot^.left:=root^.right if lr=left then
else oldroot.left:=root.right
oldroot^.right:=root^.right; else
delete_from_tree:=root; oldroot.right:=root.right;
end;
delete_from_tree:=root;
end; end;
begin begin
speedvalue:=Getspeedvalue(s); speedvalue:=Getspeedvalue(s);
n:=root; n:=root;
if assigned(hasharray) then if assigned(hasharray) then
begin begin
{First, check if the Node to delete directly located under { First, check if the Node to delete directly located under
the hasharray.} the hasharray.}
p:=speedvalue mod hasharraysize; p:=speedvalue mod hasharraysize;
n:=hasharray^[p]; n:=hasharray^[p];
if (n<>nil) and (n^.speedvalue=speedvalue) and if (n<>nil) and (n.speedvalue=speedvalue) and
(n^._name^=s) then (n._name^=s) then
begin begin
{The Node to delete is directly located under the { The Node to delete is directly located under the
hasharray. Make the hasharray point to the left hasharray. Make the hasharray point to the left
subtree of the Node and place the right subtree on subtree of the Node and place the right subtree on
the right-bottom of the left subtree.} the right-bottom of the left subtree.}
if n^.left<>nil then if n.left<>nil then
begin begin
hasharray^[p]:=n^.left; hasharray^[p]:=n.left;
if n^.right<>nil then if n.right<>nil then
insert_right_bottom(n^.left,n^.right); insert_right_bottom(n.left,n.right);
end end
else else
hasharray^[p]:=n^.right; hasharray^[p]:=n.right;
delete:=n; delete:=n;
exit; exit;
end; end;
end end
else else
begin begin
{First check if the Node to delete is the root.} { First check if the Node to delete is the root.}
if (root<>nil) and (n^.speedvalue=speedvalue) if (root<>nil) and (n.speedvalue=speedvalue) and
and (n^._name^=s) then (n._name^=s) then
begin begin
if n^.left<>nil then if n.left<>nil then
begin begin
root:=n^.left; root:=n.left;
if n^.right<>nil then if n.right<>nil then
insert_right_bottom(n^.left,n^.right); insert_right_bottom(n.left,n.right);
end end
else else
root:=n^.right; root:=n.right;
delete:=n; delete:=n;
exit; exit;
end; end;
end; end;
delete:=delete_from_tree(n); delete:=delete_from_tree(n);
end; end;
function Tdictionary.empty:boolean; function Tdictionary.empty:boolean;
@ -1014,13 +995,13 @@ end;
procedure Tdictionary.foreach(proc2call:Tnamedindexcallback); procedure Tdictionary.foreach(proc2call:Tnamedindexcallback);
procedure a(p:Pnamedindexobject); procedure a(p:TNamedIndexObject);
begin begin
proc2call(p); proc2call(p);
if assigned(p^.left) then if assigned(p.left) then
a(p^.left); a(p.left);
if assigned(p^.right) then if assigned(p.right) then
a(p^.right); a(p.right);
end; end;
var var
@ -1038,17 +1019,17 @@ end;
end; end;
function Tdictionary.insert(obj:Pnamedindexobject):Pnamedindexobject; function Tdictionary.insert(obj:TNamedIndexObject):TNamedIndexObject;
begin begin
obj^.speedvalue:=Getspeedvalue(obj^._name^); obj.speedvalue:=Getspeedvalue(obj._name^);
if assigned(hasharray) then if assigned(hasharray) then
insert:=insertNode(obj,hasharray^[obj^.speedvalue mod hasharraysize]) insert:=insertNode(obj,hasharray^[obj.speedvalue mod hasharraysize])
else else
insert:=insertNode(obj,root); insert:=insertNode(obj,root);
end; end;
function tdictionary.insertNode(NewNode:Pnamedindexobject;var currNode:Pnamedindexobject):Pnamedindexobject; function tdictionary.insertNode(NewNode:TNamedIndexObject;var currNode:TNamedIndexObject):TNamedIndexObject;
begin begin
if currNode=nil then if currNode=nil then
begin begin
@ -1057,25 +1038,25 @@ end;
end end
{ First check speedvalue, to allow a fast insert } { First check speedvalue, to allow a fast insert }
else else
if currNode^.speedvalue>NewNode^.speedvalue then if currNode.speedvalue>NewNode.speedvalue then
insertNode:=insertNode(NewNode,currNode^.right) insertNode:=insertNode(NewNode,currNode.right)
else else
if currNode^.speedvalue<NewNode^.speedvalue then if currNode.speedvalue<NewNode.speedvalue then
insertNode:=insertNode(NewNode,currNode^.left) insertNode:=insertNode(NewNode,currNode.left)
else else
begin begin
if currNode^._name^>NewNode^._name^ then if currNode._name^>NewNode._name^ then
insertNode:=insertNode(NewNode,currNode^.right) insertNode:=insertNode(NewNode,currNode.right)
else else
if currNode^._name^<NewNode^._name^ then if currNode._name^<NewNode._name^ then
insertNode:=insertNode(NewNode,currNode^.left) insertNode:=insertNode(NewNode,currNode.left)
else else
begin begin
if replace_existing and if replace_existing and
assigned(currNode) then assigned(currNode) then
begin begin
NewNode^.left:=currNode^.left; NewNode.left:=currNode.left;
NewNode^.right:=currNode^.right; NewNode.right:=currNode.right;
currNode:=NewNode; currNode:=NewNode;
insertNode:=NewNode; insertNode:=NewNode;
end end
@ -1086,24 +1067,24 @@ end;
end; end;
procedure tdictionary.inserttree(currtree,currroot:Pnamedindexobject); procedure tdictionary.inserttree(currtree,currroot:TNamedIndexObject);
begin begin
if assigned(currtree) then if assigned(currtree) then
begin begin
inserttree(currtree^.left,currroot); inserttree(currtree.left,currroot);
inserttree(currtree^.right,currroot); inserttree(currtree.right,currroot);
currtree^.right:=nil; currtree.right:=nil;
currtree^.left:=nil; currtree.left:=nil;
insertNode(currtree,currroot); insertNode(currtree,currroot);
end; end;
end; end;
function tdictionary.rename(const olds,News : string):Pnamedindexobject; function tdictionary.rename(const olds,News : string):TNamedIndexObject;
var var
spdval : integer; spdval : integer;
lasthp, lasthp,
hp,hp2,hp3 : Pnamedindexobject; hp,hp2,hp3 : TNamedIndexObject;
begin begin
spdval:=Getspeedvalue(olds); spdval:=Getspeedvalue(olds);
if assigned(hasharray) then if assigned(hasharray) then
@ -1113,36 +1094,36 @@ end;
lasthp:=nil; lasthp:=nil;
while assigned(hp) do while assigned(hp) do
begin begin
if spdval>hp^.speedvalue then if spdval>hp.speedvalue then
begin begin
lasthp:=hp; lasthp:=hp;
hp:=hp^.left hp:=hp.left
end end
else else
if spdval<hp^.speedvalue then if spdval<hp.speedvalue then
begin begin
lasthp:=hp; lasthp:=hp;
hp:=hp^.right hp:=hp.right
end end
else else
begin begin
if (hp^.name=olds) then if (hp.name=olds) then
begin begin
{ Get in hp2 the replacer for the root or hasharr } { Get in hp2 the replacer for the root or hasharr }
hp2:=hp^.left; hp2:=hp.left;
hp3:=hp^.right; hp3:=hp.right;
if not assigned(hp2) then if not assigned(hp2) then
begin begin
hp2:=hp^.right; hp2:=hp.right;
hp3:=hp^.left; hp3:=hp.left;
end; end;
{ remove entry from the tree } { remove entry from the tree }
if assigned(lasthp) then if assigned(lasthp) then
begin begin
if lasthp^.left=hp then if lasthp.left=hp then
lasthp^.left:=hp2 lasthp.left:=hp2
else else
lasthp^.right:=hp2; lasthp.right:=hp2;
end end
else else
begin begin
@ -1154,43 +1135,43 @@ end;
{ reinsert the hp3 in the tree from hp2 } { reinsert the hp3 in the tree from hp2 }
inserttree(hp3,hp2); inserttree(hp3,hp2);
{ reset Node with New values } { reset Node with New values }
stringdispose(hp^._name); stringdispose(hp._name);
hp^._name:=stringdup(News); hp._name:=stringdup(News);
hp^.speedvalue:=Getspeedvalue(News); hp.speedvalue:=Getspeedvalue(News);
hp^.left:=nil; hp.left:=nil;
hp^.right:=nil; hp.right:=nil;
{ reinsert } { reinsert }
if assigned(hasharray) then if assigned(hasharray) then
rename:=insertNode(hp,hasharray^[hp^.speedvalue mod hasharraysize]) rename:=insertNode(hp,hasharray^[hp.speedvalue mod hasharraysize])
else else
rename:=insertNode(hp,root); rename:=insertNode(hp,root);
exit; exit;
end end
else else
if olds>hp^.name then if olds>hp.name then
begin begin
lasthp:=hp; lasthp:=hp;
hp:=hp^.left hp:=hp.left
end end
else else
begin begin
lasthp:=hp; lasthp:=hp;
hp:=hp^.right; hp:=hp.right;
end; end;
end; end;
end; end;
end; end;
function Tdictionary.search(const s:string):Pnamedindexobject; function Tdictionary.search(const s:string):TNamedIndexObject;
begin begin
search:=speedsearch(s,Getspeedvalue(s)); search:=speedsearch(s,Getspeedvalue(s));
end; end;
function Tdictionary.speedsearch(const s:string;speedvalue:integer):Pnamedindexobject; function Tdictionary.speedsearch(const s:string;speedvalue:integer):TNamedIndexObject;
var var
NewNode:Pnamedindexobject; NewNode:TNamedIndexObject;
begin begin
if assigned(hasharray) then if assigned(hasharray) then
NewNode:=hasharray^[speedvalue mod hasharraysize] NewNode:=hasharray^[speedvalue mod hasharraysize]
@ -1198,23 +1179,23 @@ end;
NewNode:=root; NewNode:=root;
while assigned(NewNode) do while assigned(NewNode) do
begin begin
if speedvalue>NewNode^.speedvalue then if speedvalue>NewNode.speedvalue then
NewNode:=NewNode^.left NewNode:=NewNode.left
else else
if speedvalue<NewNode^.speedvalue then if speedvalue<NewNode.speedvalue then
NewNode:=NewNode^.right NewNode:=NewNode.right
else else
begin begin
if (NewNode^._name^=s) then if (NewNode._name^=s) then
begin begin
speedsearch:=NewNode; speedsearch:=NewNode;
exit; exit;
end end
else else
if s>NewNode^._name^ then if s>NewNode._name^ then
NewNode:=NewNode^.left NewNode:=NewNode.left
else else
NewNode:=NewNode^.right; NewNode:=NewNode.right;
end; end;
end; end;
speedsearch:=nil; speedsearch:=nil;
@ -1225,18 +1206,13 @@ end;
tsingleList tsingleList
****************************************************************************} ****************************************************************************}
constructor tsingleList.init; constructor tsingleList.create;
begin begin
First:=nil; First:=nil;
last:=nil; last:=nil;
end; end;
destructor tsingleList.done;
begin
end;
procedure tsingleList.reset; procedure tsingleList.reset;
begin begin
First:=nil; First:=nil;
@ -1246,30 +1222,31 @@ end;
procedure tsingleList.clear; procedure tsingleList.clear;
var var
hp,hp2 : pnamedindexobject; hp,hp2 : TNamedIndexObject;
begin begin
hp:=First; hp:=First;
while assigned(hp) do while assigned(hp) do
begin begin
hp2:=hp; hp2:=hp;
hp:=hp^.ListNext; hp:=hp.ListNext;
dispose(hp2,done); hp2.free;
end; end;
First:=nil; First:=nil;
last:=nil; last:=nil;
end; end;
procedure tsingleList.insert(p:Pnamedindexobject); procedure tsingleList.insert(p:TNamedIndexObject);
begin begin
if not assigned(First) then if not assigned(First) then
First:=p First:=p
else else
last^.ListNext:=p; last.ListNext:=p;
last:=p; last:=p;
p^.ListNext:=nil; p.ListNext:=nil;
end; end;
{**************************************************************************** {****************************************************************************
tindexarray tindexarray
****************************************************************************} ****************************************************************************}
@ -1284,6 +1261,7 @@ end;
noclear:=false; noclear:=false;
end; end;
destructor tindexarray.destroy; destructor tindexarray.destroy;
begin begin
if assigned(data) then if assigned(data) then
@ -1296,7 +1274,7 @@ end;
end; end;
function tindexarray.search(nr:integer):Pnamedindexobject; function tindexarray.search(nr:integer):TNamedIndexObject;
begin begin
if nr<=count then if nr<=count then
search:=data^[nr] search:=data^[nr]
@ -1312,7 +1290,7 @@ end;
for i:=1 to count do for i:=1 to count do
if assigned(data^[i]) then if assigned(data^[i]) then
begin begin
dispose(data^[i],done); data^[i].free;
data^[i]:=nil; data^[i]:=nil;
end; end;
count:=0; count:=0;
@ -1341,11 +1319,11 @@ end;
end; end;
procedure tindexarray.deleteindex(p:Pnamedindexobject); procedure tindexarray.deleteindex(p:TNamedIndexObject);
var var
i : integer; i : integer;
begin begin
i:=p^.indexnr; i:=p.indexnr;
{ update counter } { update counter }
if i=count then if i=count then
dec(count); dec(count);
@ -1355,71 +1333,70 @@ end;
dec(i); dec(i);
if (i>0) and assigned(data^[i]) then if (i>0) and assigned(data^[i]) then
begin begin
data^[i]^.indexNext:=data^[p^.indexnr]^.indexNext; data^[i].indexNext:=data^[p.indexnr].indexNext;
break; break;
end; end;
end; end;
if i=0 then if i=0 then
First:=p^.indexNext; First:=p.indexNext;
data^[p^.indexnr]:=nil; data^[p.indexnr]:=nil;
{ clear entry } { clear entry }
p^.indexnr:=-1; p.indexnr:=-1;
p^.indexNext:=nil; p.indexNext:=nil;
end; end;
procedure tindexarray.delete(var p:Pnamedindexobject); procedure tindexarray.delete(var p:TNamedIndexObject);
begin begin
deleteindex(p); deleteindex(p);
dispose(p,done); p.free;
p:=nil; p:=nil;
end; end;
procedure tindexarray.insert(p:Pnamedindexobject); procedure tindexarray.insert(p:TNamedIndexObject);
var var
i : integer; i : integer;
begin begin
if p^.indexnr=-1 then if p.indexnr=-1 then
begin begin
inc(count); inc(count);
p^.indexnr:=count; p.indexnr:=count;
end; end;
if p^.indexnr>count then if p.indexnr>count then
count:=p^.indexnr; count:=p.indexnr;
if count>size then if count>size then
grow(((count div growsize)+1)*growsize); grow(((count div growsize)+1)*growsize);
Assert(not assigned(data^[p^.indexnr]) or (p=data^[p^.indexnr])); Assert(not assigned(data^[p.indexnr]) or (p=data^[p.indexnr]));
data^[p^.indexnr]:=p; data^[p.indexnr]:=p;
{ update Linked List backward } { update Linked List backward }
i:=p^.indexnr; i:=p.indexnr;
while (i>0) do while (i>0) do
begin begin
dec(i); dec(i);
if (i>0) and assigned(data^[i]) then if (i>0) and assigned(data^[i]) then
begin begin
data^[i]^.indexNext:=p; data^[i].indexNext:=p;
break; break;
end; end;
end; end;
if i=0 then if i=0 then
First:=p; First:=p;
{ update Linked List forward } { update Linked List forward }
i:=p^.indexnr; i:=p.indexnr;
while (i<=count) do while (i<=count) do
begin begin
inc(i); inc(i);
if (i<=count) and assigned(data^[i]) then if (i<=count) and assigned(data^[i]) then
begin begin
p^.indexNext:=data^[i]; p.indexNext:=data^[i];
exit; exit;
end; end;
end; end;
if i>count then if i>count then
p^.indexNext:=nil; p.indexNext:=nil;
end; end;
{$endif OLD} {$endif NODIC}
{**************************************************************************** {****************************************************************************
tdynamicarray tdynamicarray
@ -1652,7 +1629,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-12-25 00:07:25 peter Revision 1.3 2000-12-29 21:57:27 peter
* 'classified' tdictionary, but leave it within an define
Revision 1.2 2000/12/25 00:07:25 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and + new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects) tlinkedlist objects)