* C record packing fixed to also check first entry of the record

    if bigger than the recordalignment itself
  * variant record alignment uses alignment per variant and saves the
    highest alignment value

compiler/pdecl.pas

@@ -326,7 +326,7 @@ unit pdecl;
          pconstsym : ptypedconstsym;
          { maxsize contains the max. size of a variant }
          { startvarrec contains the start of the variant part of a record }
-         maxsize,startvarrec : longint;
+         maxsize,maxalignment,startvarrecalign,startvarrecsize : longint;
          pt : ptree;
       begin
          old_block_type:=block_type;
@@ -649,6 +649,7 @@ unit pdecl;
          if is_record and (token=_CASE) then
            begin
               maxsize:=0;
+              maxalignment:=0;
               consume(_CASE);
               s:=pattern;
               getsym(s,false);
@@ -665,7 +666,8 @@ unit pdecl;
               if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
                Message(type_e_ordinal_expr_expected);
               consume(_OF);
-              startvarrec:=symtablestack^.datasize;
+              startvarrecsize:=symtablestack^.datasize;
+              startvarrecalign:=symtablestack^.dataalignment;
               repeat
                 repeat
                   pt:=comp_expr(true);
@@ -688,8 +690,10 @@ unit pdecl;
                 consume(_RKLAMMER);
                 { calculates maximal variant size }
                 maxsize:=max(maxsize,symtablestack^.datasize);
+                maxalignment:=max(maxalignment,symtablestack^.dataalignment);
                 { the items of the next variant are overlayed }
-                symtablestack^.datasize:=startvarrec;
+                symtablestack^.datasize:=startvarrecsize;
+                symtablestack^.dataalignment:=startvarrecalign;
                 if (token<>_END) and (token<>_RKLAMMER) then
                   consume(_SEMICOLON)
                 else
@@ -697,6 +701,7 @@ unit pdecl;
               until (token=_END) or (token=_RKLAMMER);
               { at last set the record size to that of the biggest variant }
               symtablestack^.datasize:=maxsize;
+              symtablestack^.dataalignment:=maxalignment;
            end;
          block_type:=old_block_type;
       end;
@@ -1208,7 +1213,13 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.185  2000-06-11 06:59:36  peter
+  Revision 1.186  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.185  2000/06/11 06:59:36  peter
     * support procvar directive without ; before the directives
 
   Revision 1.184  2000/06/09 21:34:40  peter

compiler/symconst.pas

@@ -114,7 +114,8 @@ type
     po_exports,           { Procedure has export directive (needed for OS/2) }
     po_external,          { Procedure is external (in other object or lib)}
     po_savestdregs,       { save std regs cdecl and stdcall need that ! }
-    po_saveregisters      { save all registers }
+    po_saveregisters,     { save all registers }
+    po_overload           { procedure is declared with overload directive }
   );
   tprocoptions=set of tprocoption;
 
@@ -214,7 +215,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-06-02 21:15:49  pierre
+  Revision 1.13  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.12  2000/06/02 21:15:49  pierre
    + vo_is_exported for bug0317 fix
 
   Revision 1.11  2000/03/19 14:56:38  florian

compiler/symdef.inc

@@ -2112,8 +2112,33 @@
 
 
     function trecorddef.alignment:longint;
-      begin
-        alignment:=symtable^.dataalignment;
+      var
+        l  : longint;
+        hp : pvarsym;
+      begin
+        { also check the first symbol for it's size, because a
+          packed record has dataalignment of 1, but the first
+          sym could be a longint which should be aligned on 4 bytes,
+          this is compatible with C record packing (PFV) }
+        hp:=pvarsym(symtable^.symindex^.first);
+        if assigned(hp) then
+         begin
+           l:=hp^.vartype.def^.size;
+           if l>symtable^.dataalignment then
+            begin
+              if l>=4 then
+               alignment:=4
+              else
+               if l>=2 then
+                alignment:=2
+              else
+               alignment:=1;
+            end
+           else
+            alignment:=symtable^.dataalignment;
+         end
+        else
+         alignment:=symtable^.dataalignment;
       end;
 
 {$ifdef GDB}
@@ -4061,7 +4086,13 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.200  2000-06-02 18:48:47  florian
+  Revision 1.201  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.200  2000/06/02 18:48:47  florian
     + fieldtable support for classes
 
   Revision 1.199  2000/04/01 14:17:08  peter
@@ -4152,4 +4183,4 @@ Const local_symtable_index : longint = $8001;
   Revision 1.174  1999/11/06 14:34:26  peter
     * truncated log to 20 revs
 
-}
+}

compiler/symsym.inc

@@ -1322,16 +1322,19 @@
                    if (aktpackrecords=packrecord_C) then
                     begin
                       varalign:=vartype.def^.alignment;
-                      if varalign=0 then
+                      if (owner^.dataalignment<4) then
                        begin
-                         if (owner^.dataalignment<4) then
+                         if varalign=0 then
                           begin
                             if (l>=4) then
                              owner^.dataalignment:=4
                             else
                              if (owner^.dataalignment<2) and (l>=2) then
                               owner^.dataalignment:=2;
-                          end;
+                          end
+                         else
+                          if varalign>owner^.dataalignment then
+                           owner^.dataalignment:=varalign;
                        end;
                     end
                    else
@@ -2163,7 +2166,13 @@
 
 {
   $Log$
-  Revision 1.148  2000-06-02 21:16:42  pierre
+  Revision 1.149  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.148  2000/06/02 21:16:42  pierre
    * vo_is_exported needs init_global also
 
   Revision 1.147  2000/06/01 19:09:56  peter
@@ -2282,4 +2291,4 @@
     * -CX is create smartlink
     * -CD is create dynamic, but does nothing atm.
 
-}
+}

compiler/symsymh.inc

@@ -319,7 +319,13 @@
 
 {
   $Log$
-  Revision 1.50  2000-05-18 17:05:17  peter
+  Revision 1.51  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.50  2000/05/18 17:05:17  peter
     * fixed size of const parameters in asm readers
 
   Revision 1.49  2000/05/03 14:34:05  pierre
@@ -404,4 +410,4 @@
     + resourcestring implemented
     + start of longstring support
 
-}
+}

compiler/symtable.pas

@@ -179,7 +179,7 @@ unit symtable;
           next      : psymtable;
           defowner  : pdef; { for records and objects }
           { alignment used in this symtable }
-          alignment : longint;
+{          alignment : longint; }
           { only used for parameter symtable to determine the offset relative }
           { to the frame pointer and for local inline }
           address_fixup : longint;
@@ -212,7 +212,7 @@ unit symtable;
           procedure check_forwards;
           procedure checklabels;
           { change alignment for args  only parasymtable }
-          procedure set_alignment(_alignment : byte);
+          procedure set_alignment(_alignment : longint);
           { find arg having offset  only parasymtable }
           function  find_at_offset(l : longint) : pvarsym;
 {$ifdef CHAINPROCSYMS}
@@ -1414,7 +1414,10 @@ implementation
          name:=nil;
          address_fixup:=0;
          datasize:=0;
-         dataalignment:=1;
+         if t=parasymtable then
+          dataalignment:=4
+         else
+          dataalignment:=1;
          new(symindex,init(indexgrowsize));
          new(defindex,init(indexgrowsize));
          if symtabletype<>withsymtable then
@@ -1424,7 +1427,6 @@ implementation
            end
          else
            symsearch:=nil;
-         alignment:=def_alignment;
       end;
 
 
@@ -1660,7 +1662,10 @@ implementation
        { reset }
          defowner:=nil;
          name:=nil;
-         alignment:=def_alignment;
+         if typ=parasymtable then
+          dataalignment:=4
+         else
+          dataalignment:=1;
          datasize:=0;
          address_fixup:= 0;
          unitid:=0;
@@ -1854,9 +1859,12 @@ implementation
           begin
             { in TP and Delphi you can have a local with the
               same name as the function, the function is then hidden for
-              the user. (Under delphi it can still be accessed using result) (PFV) }
-            if (hsym^.typ=funcretsym) and
-               (m_tp in aktmodeswitches) then
+              the user. (Under delphi it can still be accessed using result),
+              but don't allow hiding of RESULT }
+            if (m_tp in aktmodeswitches) and
+               (hsym^.typ=funcretsym) and
+               not((m_result in aktmodeswitches) and
+                   (hsym^.name='RESULT')) then
              hsym^.owner^.rename(hsym^.name,'hidden'+hsym^.name)
             else
              begin
@@ -1875,8 +1883,11 @@ implementation
                   if assigned(hsym) then
                    begin
                      { a parameter and the function can have the same
-                       name in TP and Delphi }
-                     if (sym^.typ=funcretsym) then
+                       name in TP and Delphi, but RESULT not }
+                     if (m_tp in aktmodeswitches) and
+                        (sym^.typ=funcretsym) and
+                        not((m_result in aktmodeswitches) and
+                            (sym^.name='RESULT')) then
                       sym^.setname('hidden'+sym^.name)
                      else
                       begin
@@ -2174,14 +2185,12 @@ implementation
          foreach({$ifndef TP}@{$endif}labeldefined);
       end;
 
-    procedure tsymtable.set_alignment(_alignment : byte);
+    procedure tsymtable.set_alignment(_alignment : longint);
       var
          sym : pvarsym;
          l : longint;
       begin
-        { this can not be done if there is an
-          hasharray ! }
-        alignment:=_alignment;
+        dataalignment:=_alignment;
         if (symtabletype<>parasymtable) then
           internalerror(1111);
         sym:=pvarsym(symindex^.first);
@@ -2191,7 +2200,7 @@ implementation
           begin
              l:=sym^.getpushsize;
              sym^.address:=datasize;
-             datasize:=align(datasize+l,alignment);
+             datasize:=align(datasize+l,dataalignment);
              sym:=pvarsym(sym^.next);
           end;
       end;
@@ -2925,7 +2934,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.99  2000-06-14 19:00:58  peter
+  Revision 1.100  2000-06-18 18:11:32  peter
+    * C record packing fixed to also check first entry of the record
+      if bigger than the recordalignment itself
+    * variant record alignment uses alignment per variant and saves the
+      highest alignment value
+
+  Revision 1.99  2000/06/14 19:00:58  peter
     * rename the result of a function to hide it instead of using setname
 
   Revision 1.98  2000/06/14 16:51:18  peter