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

* patch by Sergei Gorelkin to improve class creation speed and make objpas.inc more readable

Browse Source 
git-svn-id: trunk@11036 -
This commit is contained in:
florian 2008-05-22 11:49:40 +00:00
parent 085d5423ac
commit d79851dc1b
4 changed files with 133 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/nobj.pas
View File

@ -1425,8 +1425,10 @@ implementation
{ interface table } { interface table }
if _class.ImplementedInterfaces.count>0 then if _class.ImplementedInterfaces.count>0 then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable)) current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable))
else if _class.implements_any_interfaces then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil))
else else
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF')));
{ table for string messages } { table for string messages }
if (oo_has_msgstr in _class.objectoptions) then if (oo_has_msgstr in _class.objectoptions) then
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(strmessagetable)) current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(strmessagetable))

6
compiler/symdef.pas
View File

@ -263,6 +263,7 @@ interface
procedure insertvmt; procedure insertvmt;
procedure set_parent(c : tobjectdef); procedure set_parent(c : tobjectdef);
function FindDestructor : tprocdef; function FindDestructor : tprocdef;
function implements_any_interfaces: boolean;
end; end;
tclassrefdef = class(tabstractpointerdef) tclassrefdef = class(tabstractpointerdef)
@ -4004,6 +4005,11 @@ implementation
end; end;
end; end;
function tobjectdef.implements_any_interfaces: boolean;
begin
result := (ImplementedInterfaces.Count > 0) or
(assigned(childof) and childof.implements_any_interfaces);
end;
function tobjectdef.size : aint; function tobjectdef.size : aint;
begin begin

204
rtl/inc/objpas.inc
View File

@ -133,14 +133,11 @@
{**************************************************************************** {****************************************************************************
TOBJECT TOBJECT
****************************************************************************} ****************************************************************************}
constructor TObject.Create; constructor TObject.Create;
begin begin
end; end;
destructor TObject.Destroy; destructor TObject.Destroy;
begin begin
end; end;
@ -155,19 +152,24 @@
class function TObject.InstanceSize : SizeInt; class function TObject.InstanceSize : SizeInt;
begin begin
InstanceSize:=pSizeInt(pointer(self)+vmtInstanceSize)^; InstanceSize := PVmt(Self)^.vInstanceSize;
end; end;
var
emptyintf: ptruint; public name 'FPC_EMPTYINTF';
procedure InitInterfacePointers(objclass: tclass;instance : pointer); procedure InitInterfacePointers(objclass: tclass;instance : pointer);
var var
i: integer; ovmt: PVmt;
i: longint;
intftable: pinterfacetable; intftable: pinterfacetable;
Res: pinterfaceentry; Res: pinterfaceentry;
begin begin
while assigned(objclass) do ovmt := PVmt(objclass);
while assigned(ovmt) and (ovmt^.vIntfTable <> @emptyintf) do
begin begin
intftable:=pinterfacetable((pointer(objclass)+vmtIntfTable)^); intftable:=ovmt^.vIntfTable;
if assigned(intftable) then if assigned(intftable) then
begin begin
i:=intftable^.EntryCount; i:=intftable^.EntryCount;
@ -180,7 +182,7 @@
dec(i); dec(i);
end; end;
end; end;
objclass:=pclass(pointer(objclass)+vmtParent)^; ovmt:=ovmt^.vParent;
end; end;
end; end;
@ -192,7 +194,8 @@
{ insert VMT pointer into the new created memory area } { insert VMT pointer into the new created memory area }
{ (in class methods self contains the VMT!) } { (in class methods self contains the VMT!) }
ppointer(instance)^:=pointer(self); ppointer(instance)^:=pointer(self);
InitInterfacePointers(self,instance); if PVmt(self)^.vIntfTable <> @emptyintf then
InitInterfacePointers(self,instance);
InitInstance:=TObject(Instance); InitInstance:=TObject(Instance);
end; end;
@ -201,7 +204,7 @@
begin begin
{ type of self is class of tobject => it points to the vmt } { type of self is class of tobject => it points to the vmt }
{ the parent vmt is saved at offset vmtParent } { the parent vmt is saved at offset vmtParent }
classparent:=pclass(pointer(self)+vmtParent)^; classparent:=tclass(PVmt(Self)^.vParent);
end; end;
class function TObject.NewInstance : tobject; class function TObject.NewInstance : tobject;
@ -247,13 +250,13 @@
var var
methodtable : pmethodnametable; methodtable : pmethodnametable;
i : dword; i : dword;
vmt : tclass; ovmt : PVmt;
begin begin
vmt:=self; ovmt:=PVmt(self);
while assigned(vmt) do while assigned(ovmt) do
begin begin
methodtable:=pmethodnametable((Pointer(vmt)+vmtMethodTable)^); methodtable:=pmethodnametable(ovmt^.vMethodTable);
if assigned(methodtable) then if assigned(methodtable) then
begin begin
for i:=0 to methodtable^.count-1 do for i:=0 to methodtable^.count-1 do
@ -263,7 +266,7 @@
exit; exit;
end; end;
end; end;
vmt:=pclass(pointer(vmt)+vmtParent)^; ovmt := ovmt^.vParent;
end; end;
MethodAddress:=nil; MethodAddress:=nil;
end; end;
@ -273,12 +276,12 @@
var var
methodtable : pmethodnametable; methodtable : pmethodnametable;
i : dword; i : dword;
vmt : tclass; ovmt : PVmt;
begin begin
vmt:=self; ovmt:=PVmt(self);
while assigned(vmt) do while assigned(ovmt) do
begin begin
methodtable:=pmethodnametable((Pointer(vmt)+vmtMethodTable)^); methodtable:=pmethodnametable(ovmt^.vMethodTable);
if assigned(methodtable) then if assigned(methodtable) then
begin begin
for i:=0 to methodtable^.count-1 do for i:=0 to methodtable^.count-1 do
@ -288,7 +291,7 @@
exit; exit;
end; end;
end; end;
vmt:=pclass(pointer(vmt)+vmtParent)^; ovmt := ovmt^.vParent;
end; end;
MethodName:=''; MethodName:='';
end; end;
@ -321,18 +324,18 @@
end; end;
var var
CurClassType: TClass; ovmt: PVmt;
FieldTable: PFieldTable; FieldTable: PFieldTable;
FieldInfo: PFieldInfo; FieldInfo: PFieldInfo;
i: Integer; i: longint;
begin begin
if Length(name) > 0 then if Length(name) > 0 then
begin begin
CurClassType := ClassType; ovmt := PVmt(ClassType);
while CurClassType <> nil do while ovmt <> nil do
begin begin
FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^); FieldTable := PFieldTable(ovmt^.vFieldTable);
if FieldTable <> nil then if FieldTable <> nil then
begin begin
FieldInfo := @FieldTable^.Fields[0]; FieldInfo := @FieldTable^.Fields[0];
@ -351,7 +354,7 @@
end; end;
end; end;
{ Try again with the parent class type } { Try again with the parent class type }
CurClassType:=pclass(pointer(CurClassType)+vmtParent)^; ovmt:=ovmt^.vParent;
end; end;
end; end;
@ -368,52 +371,42 @@
class function TObject.ClassInfo : pointer; class function TObject.ClassInfo : pointer;
begin begin
ClassInfo:=ppointer(Pointer(self)+vmtTypeInfo)^; ClassInfo := PVmt(Self)^.vTypeInfo;
end; end;
class function TObject.ClassName : ShortString; class function TObject.ClassName : ShortString;
begin begin
ClassName:=PShortString((Pointer(Self)+vmtClassName)^)^; ClassName := PVmt(Self)^.vClassName^;
end; end;
class function TObject.ClassNameIs(const name : string) : boolean; class function TObject.ClassNameIs(const name : string) : boolean;
begin begin
ClassNameIs:=ShortCompareText(ClassName, name) = 0; // call to ClassName inlined here, this eliminates stack and string copying.
ClassNameIs:=ShortCompareText(PVmt(Self)^.vClassName^, name) = 0;
end; end;
class function TObject.InheritsFrom(aclass : TClass) : Boolean; class function TObject.InheritsFrom(aclass : TClass) : Boolean;
var var
vmt : tclass; vmt: PVmt;
begin begin
vmt:=self; vmt:=PVmt(self);
while assigned(vmt) do while assigned(vmt) and (vmt <> PVmt(aclass)) do
begin vmt := vmt^.vParent;
if vmt=aclass then InheritsFrom := (vmt = PVmt(aclass));
begin
InheritsFrom:=true;
exit;
end;
vmt:=pclass(pointer(vmt)+vmtParent)^;
end;
InheritsFrom:=false;
end; end;
class function TObject.stringmessagetable : pstringmessagetable; class function TObject.stringmessagetable : pstringmessagetable;
begin begin
stringmessagetable:=pstringmessagetable((pointer(Self)+vmtMsgStrPtr)^); stringmessagetable:=PVmt(Self)^.vMsgStrPtr;
end; end;
type type
tmessagehandler = procedure(var msg) of object; tmessagehandler = procedure(var msg) of object;
tmessagehandlerrec = packed record
proc : pointer;
obj : pointer;
end;
procedure TObject.Dispatch(var message); procedure TObject.Dispatch(var message);
@ -431,20 +424,20 @@
count,i : longint; count,i : longint;
msgtable : pmsgtable; msgtable : pmsgtable;
p : pointer; p : pointer;
vmt : tclass; ovmt : PVmt;
msghandler : tmessagehandler; msghandler : tmessagehandler;
begin begin
index:=dword(message); index:=dword(message);
vmt:=ClassType; ovmt := PVmt(ClassType);
while assigned(vmt) do while assigned(ovmt) do
begin begin
// See if we have messages at all in this class. // See if we have messages at all in this class.
p:=pointer(vmt)+vmtDynamicTable; p:=ovmt^.vDynamicTable;
If assigned(PPointer(p)^) then If Assigned(p) then
begin begin
msgtable:=pmsgtable(Pointer(p^)+4); msgtable:=pmsgtable(p+4);
count:=pdword(p^)^; count:=pdword(p)^;
end end
else else
Count:=0; Count:=0;
@ -453,14 +446,13 @@
begin begin
if index=msgtable[i].index then if index=msgtable[i].index then
begin begin
p:=msgtable[i].method; TMethod(msghandler).Code:=msgtable[i].method;
tmessagehandlerrec(msghandler).proc:=p; TMethod(msghandler).Data:=self;
tmessagehandlerrec(msghandler).obj:=self;
msghandler(message); msghandler(message);
exit; exit;
end; end;
end; end;
vmt:=pclass(pointer(vmt)+vmtParent)^; ovmt:=ovmt^.vParent;
end; end;
DefaultHandler(message); DefaultHandler(message);
end; end;
@ -474,20 +466,20 @@
name : shortstring; name : shortstring;
count,i : longint; count,i : longint;
msgstrtable : pmsgstrtable; msgstrtable : pmsgstrtable;
p : pointer; p: pstringmessagetable;
vmt : tclass; ovmt : PVmt;
msghandler : tmessagehandler; msghandler : tmessagehandler;
begin begin
name:=pshortstring(@message)^; name:=pshortstring(@message)^;
vmt:=ClassType; ovmt:=PVmt(ClassType);
while assigned(vmt) do while assigned(ovmt) do
begin begin
p:=(pointer(vmt)+vmtMsgStrPtr); p := ovmt^.vMsgStrPtr;
If (P<>Nil) and (PPtruInt(P)^<>0) then if (P<>Nil) and (p^.count<>0) then
begin begin
count:=Pptruint(PSizeUInt(p)^)^; count:=p^.count;
msgstrtable:=pmsgstrtable(PSizeUInt(P)^+sizeof(ptruint)); msgstrtable:=@p^.msgstrtable;
end end
else else
Count:=0; Count:=0;
@ -496,15 +488,14 @@
begin begin
if name=msgstrtable[i].name^ then if name=msgstrtable[i].name^ then
begin begin
p:=msgstrtable[i].method; TMethod(msghandler).Code:=msgstrtable[i].method;
tmessagehandlerrec(msghandler).proc:=p; TMethod(msghandler).Data:=self;
tmessagehandlerrec(msghandler).obj:=self;
msghandler(message); msghandler(message);
exit; exit;
end; end;
end; end;
vmt:=pclass(pointer(vmt)+vmtParent)^; ovmt:=ovmt^.vParent;
end; end;
DefaultHandlerStr(message); DefaultHandlerStr(message);
end; end;
@ -535,7 +526,7 @@
end; end;
var var
vmt : tclass; vmt : PVmt;
temp : pbyte; temp : pbyte;
count, count,
i : longint; i : longint;
@ -543,12 +534,12 @@
recelem : TRecElem; recelem : TRecElem;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT} {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
begin begin
vmt:=ClassType; vmt := PVmt(ClassType);
while vmt<>nil do while vmt<>nil do
begin begin
{ This need to be included here, because Finalize() { This need to be included here, because Finalize()
has should support for tkClass } has should support for tkClass }
Temp:=Pointer((Pointer(vmt)+vmtInitTable)^); Temp:= vmt^.vInitTable;
if Assigned(Temp) then if Assigned(Temp) then
begin begin
inc(Temp); inc(Temp);
@ -572,7 +563,7 @@
int_Finalize (pointer(self)+Offset,Info); int_Finalize (pointer(self)+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT} {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end; end;
vmt:=pclass(pointer(vmt)+vmtParent)^; vmt:= vmt^.vParent;
end; end;
end; end;
@ -646,52 +637,55 @@
class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry; class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;
var var
i: integer; i: longint;
intftable: pinterfacetable; intftable: pinterfacetable;
Res: pinterfaceentry; ovmt: PVmt;
begin begin
getinterfaceentry:=nil; ovmt := PVmt(Self);
intftable:=pinterfacetable((pointer(Self)+vmtIntfTable)^); while Assigned(ovmt) and (ovmt^.vIntfTable <> @emptyintf) do
if assigned(intftable) then begin begin
i:=intftable^.EntryCount; intftable:=ovmt^.vIntfTable;
Res:=@intftable^.Entries[0]; if assigned(intftable) then
while (i>0) and begin
not (assigned(Res^.iid) and IsGUIDEqual(Res^.iid^,iid)) do begin for i:=0 to intftable^.EntryCount-1 do
inc(Res); begin
dec(i); result:=@intftable^.Entries[i];
if assigned(Result^.iid) and IsGUIDEqual(Result^.iid^,iid) then
Exit;
end;
end; end;
if (i>0) then ovmt := ovmt^.vParent;
getinterfaceentry:=Res;
end; end;
if (getinterfaceentry=nil)and not(classparent=nil) then result := nil;
getinterfaceentry:=classparent.getinterfaceentry(iid)
end; end;
class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry; class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
var var
i: integer; i: longint;
intftable: pinterfacetable; intftable: pinterfacetable;
Res: pinterfaceentry; ovmt: PVmt;
begin begin
getinterfaceentrybystr:=nil; ovmt := PVmt(Self);
intftable:=pinterfacetable((pointer(Self)+vmtIntfTable)^); while Assigned(ovmt) and (ovmt^.vIntfTable <> @emptyintf) do
if assigned(intftable) then begin begin
i:=intftable^.EntryCount; intftable:=ovmt^.vIntfTable;
Res:=@intftable^.Entries[0]; if assigned(intftable) then
while (i>0) and (Res^.iidstr^<>iidstr) do begin begin
inc(Res); for i:=0 to intftable^.EntryCount-1 do
dec(i); begin
result:=@intftable^.Entries[i];
if result^.iidstr^ = iidstr then
Exit;
end;
end; end;
if (i>0) then ovmt := ovmt^.vParent;
getinterfaceentrybystr:=Res;
end; end;
if (getinterfaceentrybystr=nil) and not(classparent=nil) then result:=nil;
getinterfaceentrybystr:=classparent.getinterfaceentrybystr(iidstr)
end; end;
class function TObject.getinterfacetable : pinterfacetable; class function TObject.getinterfacetable : pinterfacetable;
begin begin
getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^); getinterfacetable:=PVmt(Self)^.vIntfTable;
end; end;
{**************************************************************************** {****************************************************************************

26
rtl/inc/objpash.inc
View File

@ -89,6 +89,31 @@
end; end;
pstringmessagetable = ^tstringmessagetable; pstringmessagetable = ^tstringmessagetable;
pinterfacetable = ^tinterfacetable;
PVmt = ^TVmt;
TVmt = record
vInstanceSize: SizeInt;
vInstanceSize2: SizeInt;
vParent: PVmt;
vClassName: PShortString;
vDynamicTable: Pointer;
vMethodTable: Pointer;
vFieldTable: Pointer;
vTypeInfo: Pointer;
vInitTable: Pointer;
vAutoTable: Pointer;
vIntfTable: PInterfaceTable;
vMsgStrPtr: pstringmessagetable;
vDestroy: Pointer;
vNewInstance: Pointer;
vFreeInstance: Pointer;
vSafeCallException: Pointer;
vDefaultHandler: Pointer;
vAfterConstruction: Pointer;
vBeforeDestruction: Pointer;
vDefaultHandlerStr: Pointer;
end;
PGuid = ^TGuid; PGuid = ^TGuid;
TGuid = packed record TGuid = packed record
@ -133,7 +158,6 @@
false : (__pad_dummy : pointer); false : (__pad_dummy : pointer);
end; end;
pinterfacetable = ^tinterfacetable;
tinterfacetable = record tinterfacetable = record
EntryCount : ptruint; EntryCount : ptruint;
Entries : array[0..0] of tinterfaceentry; Entries : array[0..0] of tinterfaceentry;