+ align(<int64>,<int64>) and align(<qword>,<qword>), resolves an issue reported on the mailing list with large records

+ tests
* trecordsymtable.insertunionst takes a asizeint parameter
* changed one aint into a asizeint

git-svn-id: trunk@35662 -

.gitattributes

@@ -10475,6 +10475,8 @@ tests/tbf/tb0252a.pp svneol=native#text/plain
 tests/tbf/tb0252b.pp svneol=native#text/plain
 tests/tbf/tb0252c.pp svneol=native#text/plain
 tests/tbf/tb0253.pp svneol=native#text/pascal
+tests/tbf/tb0254a.pp svneol=native#text/pascal
+tests/tbf/tb0254b.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain

compiler/cutils.pas

@@ -58,6 +58,8 @@ interface
 
     {# Return value @var(i) aligned on @var(a) boundary }
     function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
+    function align(i,a:int64):int64;{$ifdef USEINLINE}inline;{$endif}
+    function align(i,a:qword):qword;{$ifdef USEINLINE}inline;{$endif}
     { if you have an address aligned using "oldalignment" and add an
       offset of (a multiple of) offset to it, this function calculates
       the new minimally guaranteed alignment
@@ -304,6 +306,37 @@ implementation
       end;
 
 
+    function align(i,a:int64):int64;{$ifdef USEINLINE}inline;{$endif}
+    {
+      return value <i> aligned <a> boundary
+    }
+      begin
+        { for 0 and 1 no aligning is needed }
+        if a<=1 then
+          result:=i
+        else
+          begin
+            if i<0 then
+              result:=((i-a+1) div a) * a
+            else
+              result:=((i+a-1) div a) * a;
+          end;
+      end;
+
+
+    function align(i,a:qword):qword;{$ifdef USEINLINE}inline;{$endif}
+    {
+      return value <i> aligned <a> boundary
+    }
+      begin
+        { for 0 and 1 no aligning is needed }
+        if a<=1 then
+          result:=i
+        else
+          result:=((i+a-1) div a) * a;
+      end;
+
+
     function size_2_align(len : longint) : shortint;
       begin
          if len>16 then

compiler/ogcoff.pas

@@ -2844,7 +2844,7 @@ const pemagic : array[0..3] of byte = (
               textobjsection.writereloc_internal(idata5objsection,idata5objsection.size,4,RELOC_ABSOLUTE32);
 {$endif x86_64}
 
-              textobjsection.write(nopopcodes,align(textobjsection.size,sizeof(nopopcodes))-textobjsection.size);
+              textobjsection.write(nopopcodes,align(textobjsection.size,qword(sizeof(nopopcodes)))-textobjsection.size);
             end;
           { idata5 section data }
           WriteTableEntry(idata5objsection);

compiler/symtable.pas

@@ -142,7 +142,7 @@ interface
           { for classes (like for Delphi .NET before) only for Delphi NEXTGEN  }
           managementoperators : tmanagementoperators;
           constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
-          procedure insertunionst(unionst : trecordsymtable;offset : longint);
+          procedure insertunionst(unionst : trecordsymtable;offset : asizeint);
           procedure includemanagementoperator(mop:tmanagementoperator);
        end;
 
@@ -1653,13 +1653,13 @@ implementation
     { the offset is the location of the start of the variant
       and datasize and dataalignment corresponds to
       the complete size (see code in pdecl unit) PM }
-    procedure trecordsymtable.insertunionst(unionst : trecordsymtable;offset : longint);
+    procedure trecordsymtable.insertunionst(unionst : trecordsymtable;offset : asizeint);
       var
         sym : tsym;
         def : tdef;
         i : integer;
         varalignrecord,varalign,
-        storesize,storealign : aint;
+        storesize,storealign : asizeint;
         bitsize: tcgint;
       begin
         storesize:=_datasize;

compiler/systems/t_win.pas

@@ -383,7 +383,7 @@ implementation
 {$else}
               objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
 {$endif x86_64}
-              objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size);
+              objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,qword(sizeof(nopopcodes)))-objdata.CurrObjSec.size);
             end;
           ObjOutput.exportsymbol(implabel);
           WriteObjData(objdata);

tests/tbf/tb0254a.pp

@@ -0,0 +1,41 @@
+{ %CPU=i386,powerpc,arm,sparc,mips }
+{ %fail }
+
+{ test should fail on 32 bit targets but not crash }
+
+{$MODE DELPHI}  // (1) _NOT_ using delphi mode works
+unit tb0254a;
+
+{==============================================================================}
+interface
+
+type
+  pSExp = pointer;
+  aSExpArr = array[0..((MaxInt div SizeOf(pSExp)) - 1)] of pSExp;
+  // aSExpArr = array[0..((MaxInt div 2*SizeOf(pSExp)) - 1)] of pSExp;
+  // (2) using a _shorter_ array, eg. ^^ works on Ubuntu (Mac still Error)
+
+  pFoo = ^aFoo;
+  aFoo = record
+    rec: aSExpArr;
+  end;
+
+function ahoppla(_x: pFoo): aSExpArr;
+
+{==============================================================================}
+implementation
+
+type
+  pData = ^aData;
+  aData = record
+    offset: array[1..24] of byte;  // (3) uncommenting offset works
+    SExpArr: aSExpArr;
+  end;
+
+function ahoppla(_x: pFoo): aSExpArr;
+  begin
+    ahoppla:= pData(_x)^.SExpArr;
+    // ahoppla:= _x.rec;           // (4) _not_ casting works on Ubuntu (Mac error)
+  end;
+
+end {a}.

tests/tbf/tb0254b.pp

@@ -0,0 +1,38 @@
+{ %CPU=x86_64,powerpc64,aarch64 }
+
+{$MODE DELPHI}  // (1) _NOT_ using delphi mode works
+unit tb0254b;
+
+{==============================================================================}
+interface
+
+type
+  pSExp = pointer;
+  aSExpArr = array[0..((MaxInt div SizeOf(pSExp)) - 1)] of pSExp;
+  // aSExpArr = array[0..((MaxInt div 2*SizeOf(pSExp)) - 1)] of pSExp;
+  // (2) using a _shorter_ array, eg. ^^ works on Ubuntu (Mac still Error)
+
+  pFoo = ^aFoo;
+  aFoo = record
+    rec: aSExpArr;
+  end;
+
+function ahoppla(_x: pFoo): aSExpArr;
+
+{==============================================================================}
+implementation
+
+type
+  pData = ^aData;
+  aData = record
+    offset: array[1..24] of byte;  // (3) uncommenting offset works
+    SExpArr: aSExpArr;
+  end;
+
+function ahoppla(_x: pFoo): aSExpArr;
+  begin
+    ahoppla:= pData(_x)^.SExpArr;
+    // ahoppla:= _x.rec;           // (4) _not_ casting works on Ubuntu (Mac error)
+  end;
+
+end {a}.