paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 18:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: designer: fixed jitform for fpc 3.1

Browse Source 
git-svn-id: trunk@52507 -
This commit is contained in:
mattias 2016-06-15 09:43:21 +00:00
parent 474fb2827d
commit ad3eacb527
1 changed files with 44 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
designer/jitforms.pp
View File

@ -417,11 +417,11 @@ function GetVMTSize(AClass: TClass): integer;
var
p: PPointer;
begin
Result:=10000;
Result:=100000;
if AClass=nil then exit;
p:=PPointer(pointer(AClass)+vmtMethodStart);
Result:=vmtMethodStart;
while (p^<>nil) and (Result<10000) do begin
while (p^<>nil) and (Result<100000) do begin
inc(p);
inc(Result,SizeOf(Pointer));
end;
@ -645,26 +645,6 @@ begin
Result := Result+'}';
end;
function CalculateTypeDataSize(PropInfoCount: integer): integer;
begin
Result := SizeOf(TTypeData) + 2; // TTypeData + one word for new prop count
// Actually the size depends on the UnitName. But SizeOf(TTypeData) already
// uses the maximum size of the shortstring.
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
if Result and (SizeOf(Pointer) - 1) <> 0 then
Inc(Result, SizeOf(Pointer)); // a few bytes too much, but at least enough
{$endif}
inc(Result,PropInfoCount*SizeOf(TPropInfo));
end;
function GetTypeDataPropCountAddr(TypeData: PTypeData): PWord;
begin
Result:=PWord(PByte(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
Result := Align(Result, SizeOf(Pointer));
{$endif}
end;
function GetJITMethod(const aMethod: TMethod; out aJITMethod: TJITMethod
): boolean;
begin
@ -687,10 +667,23 @@ begin
Result:=CompareText(JITMethod1.TheMethodName,JITMethod2.TheMethodName);
end;
function CalculateTypeDataSize(PropInfoCount: integer): integer;
begin
Result := SizeOf(TTypeData) + 2; // TTypeData + one word for new prop count
// Actually the size depends on the UnitName. But SizeOf(TTypeData) already
// uses the maximum size of the shortstring.
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
if Result and (SizeOf(Pointer) - 1) <> 0 then
Inc(Result, SizeOf(Pointer)); // a few bytes too much, but at least enough
{$endif}
inc(Result,PropInfoCount*SizeOf(TPropInfo));
end;
function CalculateTypeInfoSize(const AClassName: shortstring;
PropInfoCount: integer): integer;
begin
Result := SizeOf(TTypeKind) + 1 + length(AClassName)
Result := SizeOf(TTypeKind)
+ 1 + length(AClassName) // packed shortstring: length byte + chars
+ CalculateTypeDataSize(PropInfoCount);
{$warnings off}
if SizeOf(TTypeKind)<>1 then
@ -698,6 +691,14 @@ begin
{$warnings on}
end;
function GetTypeDataPropCountAddr(TypeData: PTypeData): PWord;
begin
Result:=PWord(PByte(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
Result := Align(Result, SizeOf(Pointer));
{$endif}
end;
//------------------------------------------------------------------------------
@ -1507,7 +1508,8 @@ begin
// set TypeData (PropCount is the total number of properties, including ancestors)
NewTypeData^.ClassType:=TClass(NewVMT);
{$IF FPC_FULLVERSION>=30100}
NewTypeData^.ParentInfoRef:=AncestorClass.ClassInfo;
GetMem(NewTypeData^.ParentInfoRef,SizeOf(Pointer));
NewTypeData^.ParentInfoRef^:=AncestorClass.ClassInfo;
{$ELSE}
NewTypeData^.ParentInfo:=AncestorClass.ClassInfo;
{$ENDIF}
@ -1551,32 +1553,45 @@ procedure TJITComponentList.FreeJITClass(var AClass: TClass);
end;
var
OldVMT: Pointer;
ClassNamePShortString: Pointer;
OldVMT, ClassNamePShortString: Pointer;
OldFieldTable: PFieldTable;
OldTypeInfo: PTypeInfo;
OldMethodTable: PMethodNameTable;
{$IF FPC_FULLVERSION>=30100}
OldTypeData: PTypeData;
{$ENDIF}
begin
// free TJITMethods
JITMethods.DeleteAllOfClass(AClass);
OldVMT:=Pointer(AClass);
// free methodtable
OldMethodTable:=PMethodNameTable((OldVMT+vmtMethodTable)^);
if Assigned(OldMethodTable) then begin
FreeMethodTableEntries(OldMethodTable);
FreeMem(OldMethodTable);
end;
// free classname
ClassNamePShortString:=Pointer(Pointer(OldVMT+vmtClassName)^);
ClassNamePShortString:=Pointer((OldVMT+vmtClassName)^);
FreeMem(ClassNamePShortString);
// free field table
OldFieldTable:=PFieldTable(Pointer(OldVMT+vmtFieldTable)^);
OldFieldTable:=PFieldTable((OldVMT+vmtFieldTable)^);
ReallocMem(OldFieldTable^.ClassTable,0);
FreeMem(OldFieldTable);
// free typeinfo
OldTypeInfo:=PTypeInfo(Pointer(OldVMT+vmtTypeInfo)^);
OldTypeInfo:=PTypeInfo((OldVMT+vmtTypeInfo)^);
{$IF FPC_FULLVERSION>=30100}
// free ParentInfoRef
OldTypeData:=GetTypeData(OldTypeInfo);
FreeMem(OldTypeData^.ParentInfoRef);
OldTypeData^.ParentInfoRef:=nil;
{$ENDIF}
FreeMem(OldTypeInfo);
// free vmt
FreeMem(OldVMT);
AClass:=nil;