* take care of the fact that there are 32 bit abis (e.g. ARMHF) which align qword on 8 byte boundaries, resolves issue #31132

git-svn-id: trunk@35218 -

compiler/ncgrtti.pas

@@ -454,7 +454,7 @@ implementation
         end;
 
       begin
-        tcb.begin_anonymous_record('',defaultpacking,reqalign,
+        tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PtrInt)),
           targetinfos[target_info.system]^.alignment.recordalignmin,
           targetinfos[target_info.system]^.alignment.maxCrecordalign);
         tcb.emit_ord_const(published_properties_count(st),u16inttype);
@@ -475,7 +475,7 @@ implementation
                   alignment), but it starts aligned }
                 tcb.begin_anonymous_record(
                   propdefname,
-                  1,reqalign,
+                  1,min(reqalign,SizeOf(PtrInt)),
                   targetinfos[target_info.system]^.alignment.recordalignmin,
                   targetinfos[target_info.system]^.alignment.maxCrecordalign);
                 if ppo_indexed in tpropertysym(sym).propoptions then
@@ -754,11 +754,12 @@ implementation
              else
                tcb.emit_ord_const(otUByte,u8inttype);
            end;
-           { since this record has an alignment of reqalign, its size will also
-             be rounded up to a multiple of reqalign -> the following value will
-             also be properly aligned without having to start an extra record }
            tcb.end_anonymous_record;
+           tcb.begin_anonymous_record('',defaultpacking,reqalign,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
            write_rtti_reference(tcb,def.elementdef,rt);
+           tcb.end_anonymous_record;
         end;
 
 
@@ -846,15 +847,25 @@ implementation
         procedure classrefdef_rtti(def:tclassrefdef);
         begin
           write_header(tcb,def,tkClassRef);
-          { will be aligned thanks to encompassing record }
+          tcb.begin_anonymous_record(
+            '',
+            defaultpacking,reqalign,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
           write_rtti_reference(tcb,def.pointeddef,rt);
+          tcb.end_anonymous_record;
         end;
 
         procedure pointerdef_rtti(def:tpointerdef);
         begin
           write_header(tcb,def,tkPointer);
-          { will be aligned thanks to encompassing record }
+          tcb.begin_anonymous_record(
+            '',
+            defaultpacking,reqalign,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
           write_rtti_reference(tcb,def.pointeddef,rt);
+          tcb.end_anonymous_record;
         end;
 
         procedure recorddef_rtti(def:trecorddef);
@@ -969,7 +980,7 @@ implementation
                    { every parameter is expected to start aligned }
                    tcb.begin_anonymous_record(
                      internaltypeprefixName[itp_rtti_proc_param]+tostr(length(parasym.realname)),
-                     defaultpacking,reqalign,
+                     defaultpacking,min(reqalign,SizeOf(PtrInt)),
                      targetinfos[target_info.system]^.alignment.recordalignmin,
                      targetinfos[target_info.system]^.alignment.maxCrecordalign);
                    { write flags for current parameter }
@@ -1367,7 +1378,7 @@ implementation
           { now emit the data: first the mode }
           tcb.emit_tai(Tai_const.create_32bit(longint(mode)),u32inttype);
           { align }
-          tcb.begin_anonymous_record('',defaultpacking,reqalign,
+          tcb.begin_anonymous_record('',defaultpacking,min(reqalign,sizeof(pointer)),
             targetinfos[target_info.system]^.alignment.recordalignmin,
             targetinfos[target_info.system]^.alignment.maxCrecordalign);
           if mode=lookup then
@@ -1394,7 +1405,7 @@ implementation
           else
             begin
               tcb.emit_ord_const(sym_count,u32inttype);
-              tcb.begin_anonymous_record('',defaultpacking,reqalign,
+              tcb.begin_anonymous_record('',defaultpacking,min(reqalign,sizeof(pointer)),
                 targetinfos[target_info.system]^.alignment.recordalignmin,
                 targetinfos[target_info.system]^.alignment.maxCrecordalign);
               for i:=0 to sym_count-1 do
@@ -1438,12 +1449,12 @@ implementation
           { write rtti data }
           tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
           { begin of Tstring_to_ord }
-          tcb.begin_anonymous_record('',defaultpacking,reqalign,
+          tcb.begin_anonymous_record('',defaultpacking,min(reqalign,sizeof(pointer)),
             targetinfos[target_info.system]^.alignment.recordalignmin,
             targetinfos[target_info.system]^.alignment.maxCrecordalign);
           tcb.emit_ord_const(syms.count,s32inttype);
           { begin of "data" array in Tstring_to_ord }
-          tcb.begin_anonymous_record('',defaultpacking,reqalign,
+          tcb.begin_anonymous_record('',defaultpacking,min(reqalign,sizeof(pointer)),
             targetinfos[target_info.system]^.alignment.recordalignmin,
             targetinfos[target_info.system]^.alignment.maxCrecordalign);
           for i:=0 to syms.count-1 do
@@ -1613,7 +1624,7 @@ implementation
         rttidef:=tcb.end_anonymous_record;
         rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA_FORCEINDIRECT,rttidef);
         current_asmdata.AsmLists[al_rtti].concatList(
-          tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,sizeof(pint)));
+          tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,min(target_info.alignment.maxCrecordalign,SizeOf(QWord))));
         tcb.free;
 
         current_module.add_public_asmsym(rttilab);
@@ -1627,7 +1638,7 @@ implementation
       begin
         if tf_requires_proper_alignment in target_info.flags then
           begin
-            reqalign:=sizeof(TConstPtrUInt);
+            reqalign:=target_info.alignment.maxCrecordalign;
             defaultpacking:=C_alignment;
           end
         else

packages/rtl-objpas/src/inc/variants.pp

@@ -389,16 +389,6 @@ begin
     DoVarClearComplex(v);
 end;
 
-function AlignToPtr(p : Pointer) : Pointer;inline;
-begin
-  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
-  Result:=align(p,SizeOf(p));
-  {$ELSE FPC_REQUIRES_PROPER_ALIGNMENT}
-  Result:=p;
-  {$ENDIF FPC_REQUIRES_PROPER_ALIGNMENT}
-end;
-
-
 { ---------------------------------------------------------------------
     String Messages
   ---------------------------------------------------------------------}
@@ -535,7 +525,7 @@ constructor tdynarrayiter.init(d : Pointer;typeInfo : Pointer;_dims: SizeInt;b :
         if i>0 then
           positions[i]:=Pointer(positions[i-1]^);
         { skip kind and name }
-        typeInfo:=aligntoptr(typeInfo+2+Length(PTypeInfo(typeInfo)^.Name));
+        typeInfo:=AlignTypeData(typeInfo+2+Length(PTypeInfo(typeInfo)^.Name));
 
         elesize[i]:=PTypeData(typeInfo)^.elSize;
         typeInfo:=PTypeData(typeInfo)^.elType2;
@@ -814,7 +804,7 @@ begin
 
   { get TypeInfo of second level }
   { skip kind and name }
-  TypeInfo:=aligntoptr(TypeInfo+2+Length(PTypeInfo(TypeInfo)^.Name));
+  TypeInfo:=AlignTypeData(TypeInfo+2+Length(PTypeInfo(TypeInfo)^.Name));
   TypeInfo:=PTypeData(TypeInfo)^.elType2;
 
   { check recursively? }
@@ -3376,7 +3366,7 @@ function DynArrayGetVariantInfo(p : Pointer; var Dims : sizeint) : sizeint;
   begin
     Result:=varNull;
     { skip kind and name }
-    p:=aligntoptr(p+2+Length(PTypeInfo(p)^.Name));
+    p:=AlignTypeData(p+2+Length(PTypeInfo(p)^.Name));
 
     { search recursive? }
     if PTypeInfo(PTypeData(p)^.elType2)^.kind=tkDynArray then

rtl/inc/dynarr.inc

@@ -90,7 +90,11 @@ procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_D
 
     if declocked(realp^.refcount) then
       begin
+{$ifdef VER3_0}
         ti:=aligntoptr(ti+2+PByte(ti)[1]);
+{$else VER3_0}
+        ti:=aligntoqword(ti+2+PByte(ti)[1]);
+{$endif VER3_0}
         if assigned(pdynarraytypedata(ti)^.elType) then
           int_finalizearray(p,pdynarraytypedata(ti)^.elType{$ifndef VER3_0}^{$endif},realp^.high+1);
         freemem(realp);
@@ -155,7 +159,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
        HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
 
      { skip kind and name }
+{$ifdef VER3_0}
      ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
+{$else VER3_0}
+     ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
+{$endif VER3_0}
 
      elesize:=pdynarraytypedata(ti)^.elSize;
      {$ifdef VER3_0}
@@ -317,7 +325,11 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
        exit;
 
      { skip kind and name }
+{$ifdef VER3_0}
      ti:=aligntoptr(ti+2+PByte(ti)[1]);
+{$else VER3_0}
+     ti:=aligntoqword(ti+2+PByte(ti)[1]);
+{$endif VER3_0}
 
      elesize:=pdynarraytypedata(ti)^.elSize;
      { only set if type needs finalization }
@@ -378,7 +390,11 @@ procedure fpc_dynarray_delete(var p : pointer;source,count : SizeInt;pti : point
        end;
 
      { skip kind and name }
+{$ifdef VER3_0}
      ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
+{$else VER3_0}
+     ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
+{$endif VER3_0}
 
      elesize:=pdynarraytypedata(ti)^.elSize;
      eletype:=pdynarraytypedata(ti)^.elType2^;
@@ -458,7 +474,11 @@ function DynArrayDim(typeInfo: Pointer): Integer;
     while (typeInfo <> nil) and (pdynarraytypeinfo(typeInfo)^.kind = tkDynArray) do
     begin
       { skip kind and name }
+{$ifdef VER3_0}
       typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+      typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
 
       { element type info}
       {$ifdef VER3_0}

rtl/inc/objpas.inc

@@ -965,7 +965,7 @@
             // offset PTypeInfo by Length(Name) + 2 (ShortString length byte + SizeOf(Kind))
             inc(Pointer(classtypeinfo), PByte(Pointer(classtypeinfo)+1)^ + 2);
             {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
-            classtypeinfo:=align(classtypeinfo,sizeof(classtypeinfo));
+            classtypeinfo:=aligntoqword(classtypeinfo);
             {$endif}
             result:=classtypeinfo^.UnitName;
           end

rtl/inc/rtti.inc

@@ -91,7 +91,11 @@ type
 
 function RTTIArraySize(typeInfo: Pointer): SizeInt;
 begin
+{$ifdef VER3_0}
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
   {$ifdef VER2_6}
   result:=PArrayInfo(typeInfo)^.Size*PArrayInfo(typeInfo)^.ElCount;
   {$else}
@@ -101,7 +105,11 @@ end;
 
 function RTTIRecordSize(typeInfo: Pointer): SizeInt;
 begin
+{$ifdef VER3_0}
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
   { for size field init table is compatible with rtti table }
   result:=PRecordInfoFull(typeInfo)^.Size;
 end;
@@ -111,7 +119,7 @@ begin
   result:=typeInfo;
 {$ifndef VER3_0}
   { find init table }
-  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
 
   { check terminator, maybe we are already in init table }
   if Assigned(PRecordInfoInit(typeInfo)^.Terminator) then
@@ -145,7 +153,11 @@ var
   count,
   i : longint;
 begin
+{$ifdef VER3_0}
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
   Count:=PRecordInfoInit(typeInfo)^.Count;
   Inc(PRecordInfoInit(typeInfo));
   { Process elements }
@@ -163,7 +175,11 @@ procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 var
   i: SizeInt;
 begin
+{$ifdef VER3_0}
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
   { Process elements }
   for I:=0 to PArrayInfo(typeInfo)^.ElCount-1 do
     rttiproc(Data+(I*PArrayInfo(typeInfo)^.Size),PArrayInfo(typeInfo)^.ElInfo);
@@ -174,7 +190,11 @@ var
   i,Count,ElSize: SizeInt;
   Info: Pointer;
 begin
+{$ifdef VER3_0}
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+  typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
   Count:=PArrayInfo(typeInfo)^.ElCount;
   { no elements to process => exit }
   if Count = 0 then
@@ -326,7 +346,11 @@ begin
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
     tkArray:
       begin
+{$ifdef VER3_0}
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+        Temp:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
       {$ifdef VER2_6}
         { Process elements }
         for I:=0 to PArrayInfo(Temp)^.ElCount-1 do
@@ -355,7 +379,11 @@ begin
     tkrecord:
       begin
         typeInfo:=RTTIRecordRttiInfoToInitInfo(typeInfo);
+{$ifdef VER3_0}
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$else VER3_0}
+        Temp:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
+{$endif VER3_0}
 
         Result:=PRecordInfoInit(Temp)^.Size;
         Count:=PRecordInfoInit(Temp)^.Count;

rtl/inc/sstrings.inc

@@ -519,16 +519,27 @@ type
     chars:array[0..0] of char; { variable length with size of num_chars }
   end;
 
+{$push}
+{$packrecords c}
   Penum_typedata=^Tenum_typedata;
   Tenum_typedata={$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
     ordtype:byte;
-    { this seemingly extraneous inner record is here for alignment purposes, so
-      that its data gets aligned properly (if FPC_REQUIRES_PROPER_ALIGNMENT is
-      set }
-    inner: {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
-      minvalue,maxvalue:longint;
-      basetype:pointer; { required for alignment }
-    end;
+    case byte of
+      tkInteger,tkChar,tkEnumeration,tkBool,tkWChar,tkSet: (
+        MinValue,MaxValue : Longint;
+        case byte of
+          tkEnumeration: (
+            BaseTypeRef : pointer
+            );
+{$ifndef VER3_0}
+        {tkBool with OrdType=otSQWord }
+        tkInt64:
+          (MinInt64Value, MaxInt64Value: Int64);
+        {tkBool with OrdType=otUQWord }
+        tkQWord:
+          (MinQWordValue, MaxQWordValue: QWord);
+{$endif VER3_0}
+    );
     { more data here, but not needed }
   end;
 
@@ -551,7 +562,7 @@ type
       1: (num_entries:longint;
           search_data:array[0..0] of Tsearch_data);
   end;
-
+{$pop}
 var
   enum_o2s : Penum_ord_to_string;
   header:Penum_typeinfo;
@@ -575,9 +586,14 @@ begin
         enum_rtti_header, and then align. Use an alignment of 1 (which
         does nothing) in case FPC_REQUIRES_PROPER_ALIGNMENT is not set
         to avoid the need for an if in this situation }
-      body:=Penum_typedata(align(ptruint(header) + 2 * sizeof(byte) { kind, num_chars } + header^.num_chars,
-        {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} 1 {$else} sizeof(pointer) {$endif}));
-      with (body^.inner) do
+
+{$ifdef VER3_0}
+      body:=Penum_typedata(aligntoptr(pointer(header) + 2 * sizeof(byte) { kind, num_chars } + header^.num_chars));
+{$else VER3_0}
+      body:=Penum_typedata(aligntoqword(pointer(header) + 2 * sizeof(byte) { kind, num_chars } + header^.num_chars));
+{$endif VER3_0}
+
+      with body^ do
         begin
           { Bounds check for the ordinal value for this enum }
           if (ordinal<minvalue) or (ordinal>maxvalue) then

rtl/inc/system.inc

@@ -444,6 +444,21 @@ function aligntoptr(p : pointer) : pointer;inline;
   end;
 
 
+function aligntoqword(p : pointer) : pointer;inline;
+  type
+    TAlignCheck = record
+      b : byte;
+      q : qword;
+    end;
+  begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+    result:=align(p,PtrInt(@TAlignCheck(nil^).q))
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+    result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  end;
+
+
 {****************************************************************************
                   Subroutines for String handling
 ****************************************************************************}

rtl/objpas/typinfo.pp

@@ -385,8 +385,8 @@ unit typinfo;
         PropCount : Word;
         PropList : record _alignmentdummy : ptrint; end;
       end;
-{$PACKRECORDS 1}
 
+{$PACKRECORDS 1}
       PPropInfo = ^TPropInfo;
       TPropInfo = packed record
       private
@@ -425,6 +425,7 @@ unit typinfo;
 
 // general property handling
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
+Function AlignTypeData(p : PTypeData) : PTypeData;
 
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string; AKinds: TTypeKinds): PPropInfo;
@@ -445,7 +446,6 @@ function GetPropList(AClass: TClass; out PropList: PPropList): Integer;
 function GetPropList(Instance: TObject; out PropList: PPropList): Integer;
 
 
-
 // Property information routines.
 Function IsStoredProp(Instance: TObject;PropInfo : PPropInfo) : Boolean;
 Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
@@ -802,9 +802,31 @@ begin
 end;
 
 
+Function AlignTypeData(p : PTypeData) : PTypeData;
+{$push}
+{$packrecords c}
+  type
+    TAlignCheck = record
+      b : byte;
+      q : qword;
+    end;
+{$pop}
+begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+{$ifdef VER3_0}
+  Result:=PTypeData(align(p,SizeOf(Pointer)));
+{$else VER3_0}
+  Result:=PTypeData(align(p,PtrInt(@TAlignCheck(nil^).q)))
+{$endif VER3_0}
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+end;
+
+
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 begin
-  GetTypeData:=PTypeData(aligntoptr(PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^)));
+  GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
 end;