* moved most handling of records that fit in a register but that cannot be

    treated as a regvar from pass_1 to the code generator, because this
    can always occur with a function result from a called function (in
    case the ABI prescribes returning certain records in registers)
    (mantis #16163)

git-svn-id: trunk@15101 -

.gitattributes

@@ -10340,6 +10340,7 @@ tests/webtbs/tw16004.pp svneol=native#text/plain
 tests/webtbs/tw16040.pp svneol=native#text/plain
 tests/webtbs/tw16083.pp svneol=native#text/plain
 tests/webtbs/tw16108.pp svneol=native#text/plain
+tests/webtbs/tw16163.pp svneol=native#text/plain
 tests/webtbs/tw1617.pp svneol=native#text/plain
 tests/webtbs/tw1622.pp svneol=native#text/plain
 tests/webtbs/tw1623.pp svneol=native#text/plain

compiler/ncgmem.pas

@@ -371,7 +371,13 @@ implementation
                LOC_REGISTER,
                LOC_CREGISTER:
                  begin
-                   if (left.resultdef.size > sizeof(pint)) then
+                   // in case the result is not something that can be put
+                   // into an integer register (e.g.
+                   // function_returning_record().non_regable_field, or
+                   // a function returning a value > sizeof(intreg))
+                   // -> force to memory
+                   if not tstoreddef(left.resultdef).is_intregable or
+                      not tstoreddef(resultdef).is_intregable then
                      location_force_mem(current_asmdata.CurrAsmList,location)
                    else
                      begin

compiler/nmem.pas

@@ -629,9 +629,10 @@ implementation
         maybe_call_procvar(left,true);
         resultdef:=vs.vardef;
 
-        // don't put records from which we load fields which aren't regable in integer registers
-        if (left.resultdef.typ = recorddef) and
-           not(tstoreddef(resultdef).is_intregable) then
+        // don't put records from which we load float fields
+        // in integer registers
+        if (left.resultdef.typ=recorddef) and
+           (resultdef.typ=floatdef) then
           make_not_regable(left,[ra_addr_regable]);
       end;
 

tests/webtbs/tw16163.pp

@@ -0,0 +1,36 @@
+{ %norun }
+
+program test;
+
+{$mode objfpc}
+
+type
+  TFColor = record
+    b, g, r : Byte;
+    // m : Byte; // uncomment it to avoid InternalError 200301231
+  end;
+
+  TFColorA = record
+    c : TFColor;
+    a : Byte;
+    // adding some field here, or chaning a type to Word or Interger
+    // also fixed the problem. 
+  end;
+
+function FColorToFColorA(C : TFColor) : TFColorA;
+begin
+  Result.c:=C;
+  Result.a:=255;
+end;
+
+var
+  t : TFColor;
+  a : TFColor;
+begin
+  FillChar(a, sizeof(a), $55);
+  t:=FColorToFColorA(a).c; // IE 200301231 why?
+  if (t.b<>$55) or
+     (t.r<>$55) or
+     (t.g<>$55) then
+    halt(1);
+end.