* the compiler now explicitly keeps track of the minimally guaranteed

    alignment for each memory reference (mantis #12137, and
    test/packages/fcl-registry/tregistry1.pp on sparc). This also
    enables better code generation for packed records in many cases.
  o several changes were made to the compiler to minimise the chances
    of accidentally forgetting to set the alignment of memory references
    in the future:
    - reference_reset*() now has an extra alignment parameter
    - location_reset() can now only be used for non LOC_(C)REFERENCE,
      use location_reset_ref() for those (split the tloc enum so the
      compiler can catch errors using range checking)


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@12719 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 30 insertions, 14 deletions

diff --git a/compiler/cgutils.pas b/compiler/cgutils.pas
index 91ca6bcd3d..0243adab66 100644
--- a/compiler/cgutils.pas
+++ b/compiler/cgutils.pas
@@ -126,12 +126,12 @@ unit cgutils;
     { trerefence handling }
 
     {# Clear to zero a treference }
-    procedure reference_reset(var ref : treference);
+    procedure reference_reset(var ref : treference; alignment: longint);
     {# Clear to zero a treference, and set is base address
        to base register.
     }
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
+    procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint);
+    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint);
     { This routine verifies if two references are the same, and
        if so, returns TRUE, otherwise returns false.
     }
@@ -139,7 +139,10 @@ unit cgutils;
 
     { tlocation handling }
 
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
+    { cannot be used for loc_(c)reference, because that one requires an alignment }
+    procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize);
+    { for loc_(c)reference }
+    procedure location_reset_ref(var l : tlocation;lt:TCGRefLoc;lsize:TCGSize; alignment: longint);
     procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
     procedure location_swap(var destloc,sourceloc : tlocation);
 
@@ -154,32 +157,34 @@ unit cgutils;
 implementation
 
 uses
-  systems;
+  systems,
+  verbose;
 
 {****************************************************************************
                                   TReference
 ****************************************************************************}
 
-    procedure reference_reset(var ref : treference);
+    procedure reference_reset(var ref : treference; alignment: longint);
       begin
         FillChar(ref,sizeof(treference),0);
 {$ifdef arm}
         ref.signindex:=1;
 {$endif arm}
+        ref.alignment:=alignment;
       end;
 
 
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
+    procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint);
       begin
-        reference_reset(ref);
+        reference_reset(ref,alignment);
         ref.base:=base;
         ref.offset:=offset;
       end;
 
 
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
+    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint);
       begin
-        reference_reset(ref);
+        reference_reset(ref,alignment);
         ref.symbol:=sym;
         ref.offset:=offset;
       end;
@@ -202,17 +207,28 @@ uses
                                   TLocation
 ****************************************************************************}
 
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
+    procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize);
       begin
         FillChar(l,sizeof(tlocation),0);
         l.loc:=lt;
         l.size:=lsize;
-{$ifdef arm}
         if l.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
-          l.reference.signindex:=1;
-{$endif arm}
+          { call location_reset_ref instead }
+          internalerror(2009020705);
       end;
 
+    procedure location_reset_ref(var l: tlocation; lt: tcgrefloc; lsize: tcgsize;
+      alignment: longint);
+    begin
+      FillChar(l,sizeof(tlocation),0);
+      l.loc:=lt;
+      l.size:=lsize;
+{$ifdef arm}
+      l.reference.signindex:=1;
+{$endif arm}
+      l.reference.alignment:=alignment;
+    end;
+
 
     procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
       begin