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

* fixed FieldAddress for 64 bit and CPUs requiring proper alignment

Browse Source
This commit is contained in:
florian 2005-03-13 08:34:58 +00:00
parent baa3e86332
commit 7b56e65a4b
2 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/symdef.pas
View File

@ -5794,9 +5794,9 @@ implementation
(tsym(sym).typ=fieldvarsym) then (tsym(sym).typ=fieldvarsym) then
begin begin
{$ifdef cpurequiresproperalignment} {$ifdef cpurequiresproperalignment}
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); rttilist.concat(Tai_align.Create(sizeof(AInt)));
{$endif cpurequiresproperalignment} {$endif cpurequiresproperalignment}
rttiList.concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset)); rttiList.concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset));
hp:=searchclasstablelist(tobjectdef(tfieldvarsym(sym).vartype.def)); hp:=searchclasstablelist(tobjectdef(tfieldvarsym(sym).vartype.def));
if not(assigned(hp)) then if not(assigned(hp)) then
internalerror(0206002); internalerror(0206002);
@ -6394,7 +6394,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.299 2005-03-07 17:58:27 peter Revision 1.300 2005-03-13 08:35:09 florian
* fixed FieldAddress for 64 bit and CPUs requiring proper alignment
Revision 1.299 2005/03/07 17:58:27 peter
* fix protected checking * fix protected checking
Revision 1.298 2005/02/26 15:43:09 florian Revision 1.298 2005/02/26 15:43:09 florian

34
rtl/inc/objpas.inc
View File

@ -303,17 +303,27 @@
function TObject.FieldAddress(const name : shortstring) : pointer; function TObject.FieldAddress(const name : shortstring) : pointer;
type type
PFieldInfo = ^TFieldInfo; PFieldInfo = ^TFieldInfo;
TFieldInfo = packed record TFieldInfo =
FieldOffset: LongWord; {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
FieldOffset: PtrUInt;
ClassTypeIndex: Word; ClassTypeIndex: Word;
Name: ShortString; Name: ShortString;
end; end;
PFieldTable = ^TFieldTable; PFieldTable = ^TFieldTable;
TFieldTable = packed record TFieldTable =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
FieldCount: Word; FieldCount: Word;
ClassTable: Pointer; ClassTable: Pointer;
{ Fields: array[Word] of TFieldInfo; Elements have variant size! } { should be array[Word] of TFieldInfo; but
Elements have variant size! force at least proper alignment }
Fields: array[0..0] of TFieldInfo
end; end;
var var
@ -333,7 +343,7 @@
FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^); FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
if FieldTable <> nil then if FieldTable <> nil then
begin begin
FieldInfo := PFieldInfo(Pointer(FieldTable) + 6); FieldInfo := @FieldTable^.Fields;
for i := 0 to FieldTable^.FieldCount - 1 do for i := 0 to FieldTable^.FieldCount - 1 do
begin begin
if UpCase(FieldInfo^.Name) = UName then if UpCase(FieldInfo^.Name) = UName then
@ -341,7 +351,11 @@
fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset; fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
exit; exit;
end; end;
Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name)); FieldInfo := @FieldInfo^.Name + 1 + Length(FieldInfo^.Name);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
{ align to largest field of TFieldInfo }
FieldInfo := Align(FieldInfo, SizeOf(PtrUInt));
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end; end;
end; end;
{ Try again with the parent class type } { Try again with the parent class type }
@ -747,7 +761,13 @@
{ {
$Log$ $Log$
Revision 1.46 2005-02-14 17:13:26 peter Revision 1.47 2005-03-13 08:34:58 florian
* fixed FieldAddress for 64 bit and CPUs requiring proper alignment
Revision 1.46 2005/02/14 17:13:26 peter
* truncate log * truncate log
} }