mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-27 20:09:12 +02:00
* fixed alignment/endianess for sparc
git-svn-id: trunk@6957 -
This commit is contained in:
parent
6278435a3d
commit
92fe571ea8
@ -243,23 +243,36 @@ type
|
|||||||
PMethodNameTable = ^TMethodNameTable;
|
PMethodNameTable = ^TMethodNameTable;
|
||||||
|
|
||||||
PFieldClassTable = ^TFieldClassTable;
|
PFieldClassTable = ^TFieldClassTable;
|
||||||
TFieldClassTable = packed record
|
TFieldClassTable =
|
||||||
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
packed
|
||||||
|
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
record
|
||||||
Count: Word;
|
Count: Word;
|
||||||
Entries: array[Word] of TPersistentClass;
|
Entries: array[Word] of TPersistentClass;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
PFieldInfo = ^TFieldInfo;
|
PFieldInfo = ^TFieldInfo;
|
||||||
TFieldInfo = packed record
|
TFieldInfo =
|
||||||
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
packed
|
||||||
|
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
record
|
||||||
FieldOffset: LongWord;
|
FieldOffset: LongWord;
|
||||||
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: PFieldClassTable;
|
ClassTable: PFieldClassTable;
|
||||||
// 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;
|
||||||
|
|
||||||
function GetVMTSize(AClass: TClass): integer;
|
function GetVMTSize(AClass: TClass): integer;
|
||||||
@ -488,15 +501,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
Result:=Result+'}';
|
Result:=Result+'}';
|
||||||
FieldInfo := PFieldInfo(Pointer(FieldTable) + 6);
|
FieldInfo := @FieldTable^.Fields;
|
||||||
Result:=Result+' Fields={';
|
Result := Result + ' Fields={';
|
||||||
for i:=0 to FieldTable^.FieldCount-1 do begin
|
for i := 0 to FieldTable^.FieldCount-1 do begin
|
||||||
if i>0 then Result:=Result+',';
|
if i > 0 then Result:=Result+',';
|
||||||
Result:=Result+IntToStr(i)+':Name="'+FieldInfo^.Name+'"'
|
Result := Result + IntToStr(i)
|
||||||
+':Offset='+IntToStr(FieldInfo^.FieldOffset);
|
+ ':Name="' + FieldInfo^.Name + '"'
|
||||||
Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name));
|
+ ':Offset=' +IntToStr(FieldInfo^.FieldOffset);
|
||||||
|
FieldInfo := @FieldInfo^.Name + 1 + Length(FieldInfo^.Name);
|
||||||
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
FieldInfo := Align(FieldInfo, SizeOf(Pointer));
|
||||||
|
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
end;
|
end;
|
||||||
Result:=Result+'}';
|
Result := Result+'}';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
//------------------------------------------------------------------------------
|
//------------------------------------------------------------------------------
|
||||||
@ -998,8 +1015,12 @@ begin
|
|||||||
NewFieldTable^.ClassTable:=NewClassTable;
|
NewFieldTable^.ClassTable:=NewClassTable;
|
||||||
|
|
||||||
// set vmtTypeInfo
|
// set vmtTypeInfo
|
||||||
TypeDataSize:=SizeOf(TTypeData)+2; // TTypeData + one word for new prop count
|
TypeDataSize := SizeOf(TTypeData) + 2; // TTypeData + one word for new prop count
|
||||||
TypeInfoSize:=SizeOf(TTypeKind)+1+length(NewClassName)+TypeDataSize;
|
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
if TypeDataSize and (SizeOf(Pointer) - 1) <> 0
|
||||||
|
then Inc(TypeDataSize, SizeOf(Pointer)); // a few bytes to much, but atleast enough
|
||||||
|
{$endif}
|
||||||
|
TypeInfoSize := SizeOf(TTypeKind) + 1 + length(NewClassName) + TypeDataSize;
|
||||||
{$warnings off}
|
{$warnings off}
|
||||||
if SizeOf(TTypeKind)<>1 then
|
if SizeOf(TTypeKind)<>1 then
|
||||||
raise Exception.Create('CreateNewClass SizeOf(TTypeInfo^.Kind)<>1');
|
raise Exception.Create('CreateNewClass SizeOf(TTypeInfo^.Kind)<>1');
|
||||||
@ -1022,6 +1043,9 @@ begin
|
|||||||
NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount;
|
NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount;
|
||||||
NewTypeData^.UnitName:=NewUnitName;
|
NewTypeData^.UnitName:=NewUnitName;
|
||||||
AddedPropCount:=PWord(@(NewTypeData^.UnitName)+Length(NewTypeData^.UnitName)+1);
|
AddedPropCount:=PWord(@(NewTypeData^.UnitName)+Length(NewTypeData^.UnitName)+1);
|
||||||
|
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
AddedPropCount := Align(AddedPropCount, SizeOf(Pointer));
|
||||||
|
{$endif}
|
||||||
AddedPropCount^:=0;
|
AddedPropCount^:=0;
|
||||||
|
|
||||||
// copy the standard methods
|
// copy the standard methods
|
||||||
|
@ -1589,6 +1589,17 @@ end;
|
|||||||
|
|
||||||
// -----------------------------------------------------------
|
// -----------------------------------------------------------
|
||||||
|
|
||||||
|
function AlignToPtr(const p: Pointer): Pointer;
|
||||||
|
begin
|
||||||
|
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
Result := Align(p, SizeOf(Pointer));
|
||||||
|
{$ELSE}
|
||||||
|
Result := p;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
// -----------------------------------------------------------
|
||||||
|
|
||||||
var
|
var
|
||||||
PropertyEditorMapperList:TList;
|
PropertyEditorMapperList:TList;
|
||||||
PropertyClassList:TList;
|
PropertyClassList:TList;
|
||||||
@ -1619,6 +1630,7 @@ var
|
|||||||
TypeInfo: PTypeInfo;
|
TypeInfo: PTypeInfo;
|
||||||
TypeData: PTypeData;
|
TypeData: PTypeData;
|
||||||
PropInfo: PPropInfo;
|
PropInfo: PPropInfo;
|
||||||
|
PropData: ^TPropData;
|
||||||
CurCount, i: integer;
|
CurCount, i: integer;
|
||||||
//CurParent: TClass;
|
//CurParent: TClass;
|
||||||
begin
|
begin
|
||||||
@ -1633,10 +1645,10 @@ begin
|
|||||||
// read all property infos of current class
|
// read all property infos of current class
|
||||||
TypeData:=GetTypeData(TypeInfo);
|
TypeData:=GetTypeData(TypeInfo);
|
||||||
// skip unitname
|
// skip unitname
|
||||||
PropInfo:=(@TypeData^.UnitName+Length(TypeData^.UnitName)+1);
|
PropData:=AlignToPtr(Pointer(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
|
||||||
// read property count
|
// read property count
|
||||||
CurCount:=PWord(PropInfo)^;
|
CurCount:=PropData^.PropCount;
|
||||||
inc(PtrInt(PropInfo),SizeOf(Word));
|
PropInfo:=@PropData^.PropList;
|
||||||
|
|
||||||
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',DbgS(TypeData^.ClassType));
|
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',DbgS(TypeData^.ClassType));
|
||||||
writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
|
writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
|
||||||
@ -1667,7 +1679,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
// point PropInfo to next propinfo record.
|
// point PropInfo to next propinfo record.
|
||||||
// Located at Name[Length(Name)+1] !
|
// Located at Name[Length(Name)+1] !
|
||||||
PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1);
|
PropInfo:=PPropInfo(AlignToPtr(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1));
|
||||||
dec(CurCount);
|
dec(CurCount);
|
||||||
end;
|
end;
|
||||||
TypeInfo:=TypeData^.ParentInfo;
|
TypeInfo:=TypeData^.ParentInfo;
|
||||||
@ -2889,9 +2901,11 @@ end;
|
|||||||
function TEnumPropertyEditor.OrdValueToVisualValue(OrdValue: longint): string;
|
function TEnumPropertyEditor.OrdValueToVisualValue(OrdValue: longint): string;
|
||||||
var
|
var
|
||||||
L: Longint;
|
L: Longint;
|
||||||
|
TypeData: PTypeData;
|
||||||
begin
|
begin
|
||||||
L := OrdValue;
|
L := OrdValue;
|
||||||
with GetTypeData(GetPropType)^ do
|
TypeData := GetTypeData(GetPropType);
|
||||||
|
with TypeData^ do
|
||||||
if (L < MinValue) or (L > MaxValue) then L := MaxValue;
|
if (L < MinValue) or (L > MaxValue) then L := MaxValue;
|
||||||
Result := GetEnumName(GetPropType, L);
|
Result := GetEnumName(GetPropType, L);
|
||||||
end;
|
end;
|
||||||
|
@ -1962,7 +1962,17 @@ begin
|
|||||||
ExponentAndSign:=Exponent or ((e.ExponentAndSign and $8000) shr 4);
|
ExponentAndSign:=Exponent or ((e.ExponentAndSign and $8000) shr 4);
|
||||||
// i386 extended has leading 1, double has not (shl 1)
|
// i386 extended has leading 1, double has not (shl 1)
|
||||||
// i386 has 64 bit, double has 52 bit (shr 12)
|
// i386 has 64 bit, double has 52 bit (shr 12)
|
||||||
Mantissa:=(e.Mantissa shl 1) shr 12;
|
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
{$IFDEF ENDIAN_BIG}
|
||||||
|
// accessing Mantissa will couse trouble, copy it first
|
||||||
|
System.Move(e.Mantissa, Mantissa, SizeOf(Mantissa));
|
||||||
|
Mantissa := (Mantissa shl 1) shr 12;
|
||||||
|
{$ELSE ENDIAN_BIG}
|
||||||
|
Mantissa := (e.Mantissa shl 1) shr 12;
|
||||||
|
{$ENDIF ENDIAN_BIG}
|
||||||
|
{$ELSE FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
Mantissa := (e.Mantissa shl 1) shr 12;
|
||||||
|
{$ENDIF FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
// put together
|
// put together
|
||||||
QWord(Result):=Mantissa or (qword(ExponentAndSign) shl 52);
|
QWord(Result):=Mantissa or (qword(ExponentAndSign) shl 52);
|
||||||
end;
|
end;
|
||||||
@ -2405,22 +2415,20 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function TLRSObjectReader.ReadFloat: Extended;
|
function TLRSObjectReader.ReadFloat: Extended;
|
||||||
{$ifdef Endian_BIG}
|
{$ifndef FPC_HAS_TYPE_EXTENDED}
|
||||||
var
|
var
|
||||||
e: array[1..10] of byte;
|
e: array[1..10] of byte;
|
||||||
{$endif}
|
{$endif}
|
||||||
begin
|
begin
|
||||||
{$ifdef Endian_BIG}
|
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||||
if SizeOf(extended)=10 then begin
|
|
||||||
Read(Result, 10);
|
|
||||||
ReverseBytes(@Result,10);
|
|
||||||
end else begin
|
|
||||||
Read(e,10);
|
|
||||||
Result:=ConvertLRSExtendedToDouble(@e);
|
|
||||||
end;
|
|
||||||
{$else not Endian_BIG}
|
|
||||||
Read(Result, 10);
|
Read(Result, 10);
|
||||||
{$endif}
|
{$ifdef ENDIAN_BIG}
|
||||||
|
ReverseBytes(@Result, 10);
|
||||||
|
{$endif ENDIAN_BIG}
|
||||||
|
{$else FPC_HAS_TYPE_EXTENDED}
|
||||||
|
Read(e, 10);
|
||||||
|
Result := ConvertLRSExtendedToDouble(@e);
|
||||||
|
{$endif FPC_HAS_TYPE_EXTENDED}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TLRSObjectReader.ReadSingle: Single;
|
function TLRSObjectReader.ReadSingle: Single;
|
||||||
|
@ -739,6 +739,7 @@ procedure TPkgManager.OnApplicationIdle(Sender: TObject);
|
|||||||
begin
|
begin
|
||||||
if (Screen.ActiveCustomForm<>nil)
|
if (Screen.ActiveCustomForm<>nil)
|
||||||
and (fsModal in Screen.ActiveCustomForm.FormState) then exit;
|
and (fsModal in Screen.ActiveCustomForm.FormState) then exit;
|
||||||
|
if PackageGraph = nil then Exit;
|
||||||
PackageGraph.CloseUnneededPackages;
|
PackageGraph.CloseUnneededPackages;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user