[fpc-devel] Code generation in function with absolute Result construct and $O+

[Arnstein Prytz]

I have come across what appears to be a code-generation bug when
using 'absolute' to reference the 'Result' variable in a function
with compiler directive $O+.

Free Pascal Compiler version 3.2.2 [2021/07/09] for x86_64
Running under Linux Mint.

The following program illustrates the problem, with failing
calls indicated by '<FAIL' in the output.  Changing $O+ to $O-
results in the program running correctly.

Looking at the assembler code generated by fpc -a shows that
xmm0 is not updated with the modified Result variable after the
sign has been modified.  Of course, I am assuming that even under
$O+ the function result is passed back to the caller in xmm0.

I know that there is a better way to calculate |Mth_Sign| than
the below; this is older code which I have ported from Delphi
to fpc on Linux only recently and my own standard tests found
this failure.

{$MODE Delphi}
{$O+}
program tmp;
type
  Int8 = System.ShortInt; {|-128..127|}
  UInt8 = System.Byte; {|0..255|}
  Int16 = System.SmallInt; {|-32768..32767|}
  UInt16 = System.Word; {|0..65535|}
  Int32 = System.LongInt; {|-2147483648..2147483647|}
  integer = Int32;
  Extended = Double;
  Extended_Record =
    packed record
      case integer of
        1: (rx_Real: Extended);
        2: (rx_UInt8: array [1..SizeOf(Extended)] of UInt8);
        3: (rx_ULow8: array [1..SizeOf(Extended) - SizeOf(Int8)] of UInt8;
            rx_Sign8: Int8);
        4: (rx_UInt16: array [1..SizeOf(Extended) div SizeOf(UInt16)] of UInt16);
        5: (rx_ULow16: array [1..(SizeOf(Extended) - SizeOf(Int16)) div SizeOf(UInt16)] of UInt16;
            rx_Sign16: Int16);
        6: (rx_UInt32: array [1..SizeOf(Extended) div SizeOf(UInt32)] of UInt32);
        7: (rx_Pad16: array [1..(SizeOf(Extended) - SizeOf(Int32)) div SizeOf(UInt16)] of UInt16;
            rx_Sign32: Int32);
        8: (rx_Set: set of 0..8*SizeOf(Extended) - 1);
    end;

function Mth_Sign(
    const _value: Extended;
    const _sign: integer): Extended;
  var
    v: Extended_Record absolute _value;
    r: Extended_Record absolute Result;
  begin
    Mth_Sign := _value;
    if _sign < 0
      then r.rx_Sign8 := v.rx_Sign8 or $80
      else r.rx_Sign8 := v.rx_Sign8 and $7F;
  end;

procedure test_sign;
  type
    i_index = 1..3;
    r_index = 1..4;
  const
    i_list: array [i_index] of integer = (-23456, 0, 12976644);
    i_signs: array [i_index] of integer = (-1, 1, 1);
    r_list: array [r_index] of real = (-23.456E+22, 0, -0.0, 1297.6644E-19);
  var
    j, k: Cardinal;
    m: integer;
    p, r: real;
  begin
    for j := Low(r_list) to High(r_list)
      do begin
        p := r_list[j];
        for k := Low(i_list) to High(i_list)
          do begin
            m := i_list[k];
            write('Mth_Sign(', p:15, ',', m:8, ')=');
            r := Mth_Sign(p, m);
            write(r:15);
            if r <> abs(p)*i_signs[k]
              then write('<FAIL');
            writeln;
          end;
      end;
  end;
begin
  test_sign;
end.

--
Arnstein.