Add explicitalignment field to record symtable and getlocal method

compiler/hlcgobj.pas

@@ -5490,8 +5490,14 @@ implementation
 
 
   procedure thlcgobj.getlocal(list: TAsmList; sym: tsym; size: asizeint; alignment: shortint; def: tdef; out ref: treference);
+    var
+      explicitalign : shortint;
     begin
-      tg.getlocal(list,size,alignment,def,sym,ref);
+      if def.inheritsfrom(tabstractrecorddef) and (def.typ in [recorddef]) then
+        explicitalign:=tabstractrecordsymtable(tabstractrecorddef(def).symtable).explicitrecordalignment
+      else
+        explicitalign:=0;
+      tg.getlocal(list,size,alignment,explicitalign,def,sym,ref);
       recordnewsymloc(list,sym,def,ref,true);
     end;
 

compiler/jvm/tgcpu.pas

@@ -45,7 +45,7 @@ unit tgcpu;
          procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); override;
         public
          procedure setfirsttemp(l : asizeint); override;
-         procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref: treference); override;
+         procedure getlocal(list: TAsmList; size: asizeint; alignment,explicitalignment: shortint; def: tdef; sym : tsym; var ref: treference); override;
          procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
          procedure gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
        end;
@@ -250,7 +250,7 @@ unit tgcpu;
       end;
 
 
-    procedure ttgjvm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref: treference);
+    procedure ttgjvm.getlocal(list: TAsmList; size: asizeint; alignment,explicitalignment: shortint; def: tdef; sym : tsym; var ref: treference);
       begin
         if not getifspecialtemp(list,def,size,tt_persistent,ref) then
           inherited;

compiler/llvm/tgllvm.pas

@@ -67,7 +67,7 @@ unit tgllvm;
         destructor destroy; override;
         procedure setfirsttemp(l: asizeint); override;
         procedure temp_to_ref(p: ptemprecord; out ref: treference); override;
-        procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref: treference); override;
+        procedure getlocal(list: TAsmList; size: asizeint; alignment, explicitalignment: shortint; def: tdef; sym : tsym; var ref: treference); override;
         procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
       end;
 
@@ -203,7 +203,7 @@ implementation
       end;
 
 
-    procedure ttgllvm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref: treference);
+    procedure ttgllvm.getlocal(list: TAsmList; size: asizeint; alignment, explicitalignment: shortint; def: tdef; sym : tsym; var ref: treference);
       begin
         alignment:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax);
         gethltempintern(list,def,alignment,size,tt_persistent,ref);

compiler/msg/errore.msg

@@ -168,7 +168,7 @@ general_t_objectpath_local=01033_T_$1: Using local object path: $2
 #
 # Scanner
 #
-# 02115 is the last used one
+# 02119 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -407,9 +407,11 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 scanner_e_illegal_alignment_directive=02088_E_Illegal alignment directive
 % The alignment directive is not valid. Either the alignment type is not known or the alignment
 % value is not a power of two.
-scanner_w_alignment_large_than_max=02114_N_Variable "$1" has align directive larger than system maximum alignment for variables
+scanner_w_alignment_larger_than_max=02114_W_Variable "$1" has align directive larger than system maximum alignment for variables
+scanner_n_alignment_larger_than_max=02118_N_Variable "$1" has align directive larger than system maximum alignment for variables
 % The type of the variable has an 'align' directive which is larger than  current maximum
-scanner_w_local_alignment_large_than_max=02115_N_Local variable "$1" has align directive larger than system maximum alignment for local variables
+scanner_w_local_alignment_larger_than_max=02115_W_Local variable "$1" has align directive larger than system maximum alignment for local variables
+scanner_n_local_alignment_larger_than_max=02119_N_Local variable "$1" has align directive larger than system maximum alignment for local variables
 % The type of the variable has an 'align' directive which is larger than current  maximum.
 scanner_f_illegal_utf8_bom=02089_F_It is not possible to include a file that starts with an UTF-8 BOM in a module that uses a different code page
 % All source code that is part of a single compilation entity (program, library, unit) must be encoded

compiler/ncgflw.pas

@@ -767,7 +767,7 @@ implementation
          if assigned(exceptvarsym) then
            begin
              location_reset_ref(exceptvarsym.localloc, LOC_REFERENCE, def_cgsize(voidpointertype), voidpointertype.alignment, []);
-             tg.GetLocal(current_asmdata.CurrAsmList, exceptvarsym.vardef.size, voidpointertype.alignment, exceptvarsym.vardef, exceptvarsym, exceptvarsym.localloc.reference);
+             tg.GetLocal(current_asmdata.CurrAsmList, exceptvarsym.vardef.size, voidpointertype.alignment, 0, exceptvarsym.vardef, exceptvarsym, exceptvarsym.localloc.reference);
              hlcg.a_load_reg_ref(current_asmdata.CurrAsmList, exceptlocdef, exceptvarsym.vardef, exceptlocreg, exceptvarsym.localloc.reference);
            end;
          { in the case that another exception is risen

compiler/ngenutil.pas

@@ -955,7 +955,7 @@ implementation
   class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
     var
       l : asizeint;
-      varalign,wantedalign : shortint;
+      varalign,wantedalign,explicitalign : shortint;
       storefilepos : tfileposinfo;
       list : TAsmList;
       sectype : TAsmSectiontype;
@@ -965,17 +965,27 @@ implementation
       current_filepos:=sym.fileinfo;
       l:=sym.getsize;
       wantedalign:=sym.vardef.alignment;
+      if sym.vardef.inheritsfrom(tabstractrecorddef) and
+         (sym.vardef.typ in [recorddef]) then
+        explicitalign:=tabstractrecordsymtable(tabstractrecorddef(sym.vardef).symtable).explicitrecordalignment
+      else
+        explicitalign:=0;
       if (wantedalign=0) then
         varalign:=var_align_size(l)
       else
         begin
           varalign:=var_align(wantedalign);
-          if (wantedalign>varalign) then
+          if (explicitalign>varalign) then
+            begin
+              Message1(scanner_w_alignment_larger_than_max,sym.name);
+              varalign:=explicitalign;
+            end
+          else if (wantedalign>varalign) then
             begin
               { varalign:=wantedalign; this can lead to
                 troubles on systems like for instance
                 msdos which do not support 8-byte alignment }
-              Message1(scanner_w_alignment_large_than_max,sym.name);
+              Message1(scanner_n_alignment_larger_than_max,sym.name);
 	    end;
 	end;
       asmtype:=AT_DATA;

compiler/pdecvar.pas

@@ -2131,6 +2131,9 @@ implementation
               if unionsymtable.recordalignment>recst.fieldalignment then
                 recst.fieldalignment:=unionsymtable.recordalignment;
 
+              if unionsymtable.explicitrecordalignment>recst.explicitrecordalignment then
+                recst.explicitrecordalignment:=unionsymtable.explicitrecordalignment;
+
               trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               uniondef.owner.deletedef(uniondef);
            end;

compiler/ppu.pas

@@ -48,7 +48,7 @@ const
   CurrentPPUVersion = 208;
   { for any other changes to the ppu format, increase this version number
     (it's a cardinal) }
-  CurrentPPULongVersion = 29;
+  CurrentPPULongVersion = 30;
 
 { unit flags }
   uf_big_endian          = $000004;

compiler/ptype.pas

@@ -1161,7 +1161,10 @@ implementation
              if ((alignment and not $7F) <> 0) or (PopCnt(Byte(alignment))<>1) then
                message(scanner_e_illegal_alignment_directive)
              else
-               recst.recordalignment:=shortint(alignment);
+               begin
+                 recst.recordalignment:=shortint(alignment);
+                 recst.explicitrecordalignment:=shortint(alignment);
+               end;
            end;
          { make the record size aligned (has to be done before inserting the
            parameters, because that may depend on the record's size) }

compiler/symdef.pas

@@ -5469,6 +5469,7 @@ implementation
              symtable:=trecordsymtable.create(objrealname^,0,0);
              trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).explicitrecordalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).recordalignmin:=shortint(ppufile.getbyte);
@@ -5627,6 +5628,7 @@ implementation
            begin
              ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
              ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).explicitrecordalignment));
              ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
              ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment));
              ppufile.putbyte(byte(trecordsymtable(symtable).recordalignmin));

compiler/symtable.pas

@@ -113,6 +113,7 @@ interface
        public
           usefieldalignment,     { alignment to use for fields (PACKRECORDS value), C_alignment is C style }
           recordalignment,       { alignment desired when inserting this record }
+          explicitrecordalignment, { explicit alignment for inserting this record, given by align XX at end of declaration }
           fieldalignment,        { alignment current alignment used when fields are inserted }
           padalignment : shortint;   { size to a multiple of which the symtable has to be rounded up }
           recordalignmin: shortint; { local equivalentsof global settings, so that records can be created with custom settings internally }
@@ -1193,6 +1194,7 @@ implementation
         _datasize:=0;
         databitsize:=0;
         recordalignment:=1;
+        explicitrecordalignment:=0;
         usefieldalignment:=usealign;
         recordalignmin:=recordminalign;
         padalignment:=1;
@@ -1230,6 +1232,7 @@ implementation
         if ppufile.readentry<>ibrecsymtableoptions then
           Message(unit_f_ppu_read_error);
         recordalignment:=shortint(ppufile.getbyte);
+        explicitrecordalignment:=shortint(ppufile.getbyte);
         usefieldalignment:=shortint(ppufile.getbyte);
         recordalignmin:=shortint(ppufile.getbyte);
         if (usefieldalignment=C_alignment) then
@@ -1248,6 +1251,7 @@ implementation
          { in case of classes using C alignment, the alignment of the parent
            affects the alignment of fields of the childs }
          ppufile.putbyte(byte(recordalignment));
+         ppufile.putbyte(byte(explicitrecordalignment));
          ppufile.putbyte(byte(usefieldalignment));
          ppufile.putbyte(byte(recordalignmin));
          if (usefieldalignment=C_alignment) then

compiler/tgobj.pas

@@ -35,7 +35,7 @@ unit tgobj;
 
     uses
       globals,globtype,
-      symtype,
+      symconst,symdef,symtype,symtable,
       cpubase,cgbase,cgutils,
       aasmtai,aasmdata;
 
@@ -125,7 +125,7 @@ unit tgobj;
 
           { Allocate space for a local }
           procedure getlocal(list: TAsmList; size: asizeint; def: tdef; var ref : treference);
-          procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref : treference); virtual;
+          procedure getlocal(list: TAsmList; size: asizeint; alignment,explicitalignment: shortint; def: tdef; sym : tsym; var ref : treference); virtual;
           procedure UnGetLocal(list: TAsmList; const ref : treference);
        end;
        ttgobjclass = class of ttgobj;
@@ -747,20 +747,32 @@ implementation
 
     procedure ttgobj.getlocal(list: TAsmList; size: asizeint; def: tdef; var ref : treference);
       begin
-        getlocal(list, size, def.alignment, def, nil, ref);
+        if def.inheritsfrom(tabstractrecorddef) and (def.typ in [recorddef])  then
+          getlocal(list, size, def.alignment, tabstractrecordsymtable(tabstractrecorddef(def).symtable).explicitrecordalignment, def, nil, ref)
+        else
+          getlocal(list, size, def.alignment, 0, def, nil, ref);
       end;
 
 
-    procedure ttgobj.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref : treference);
+    procedure ttgobj.getlocal(list: TAsmList; size: asizeint; alignment, explicitalignment: shortint; def: tdef; sym : tsym; var ref : treference);
       var
         lalign : shortint;
       begin
         lalign:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax);
-        if (alignment>lalign) then
-          if assigned(sym) then
-            CGMessage1(scanner_w_local_alignment_large_than_max,sym.name)
-          else
-            CGMessage1(scanner_w_local_alignment_large_than_max,def.typename);
+        if (explicitalignment>lalign) then
+          begin
+            if assigned(sym) then
+              CGMessage1(scanner_w_local_alignment_larger_than_max,sym.name)
+            else
+              CGMessage1(scanner_w_local_alignment_larger_than_max,def.typename);
+          end
+        else if (alignment>lalign) then
+          begin
+            if assigned(sym) then
+              CGMessage1(scanner_n_local_alignment_larger_than_max,sym.name)
+            else
+              CGMessage1(scanner_n_local_alignment_larger_than_max,def.typename);
+	  end;
         alloctemp(list,size,lalign,tt_persistent,def,false,ref);
       end;
 

compiler/wasm32/tgcpu.pas

@@ -86,7 +86,7 @@ unit tgcpu;
          procedure ungettemp(list: TAsmList; const ref : treference); override;
          procedure allocframepointer(list: TAsmList; out ref: treference);
          procedure allocbasepointer(list: TAsmList; out ref: treference);
-         procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref : treference); override;
+         procedure getlocal(list: TAsmList; size: asizeint; alignment, explicitalignment: shortint; def: tdef; sym : tsym; var ref : treference); override;
        end;
 
     function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
@@ -300,7 +300,7 @@ unit tgcpu;
         updateFirstTemp;
       end;
 
-    procedure ttgwasm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; sym : tsym; var ref : treference);
+    procedure ttgwasm.getlocal(list: TAsmList; size: asizeint; alignment, explicitalignment: shortint; def: tdef; sym : tsym; var ref : treference);
       var
         wbt: TWasmBasicType;
       begin