Преглед изворни кода

* compiler discerns between +0.0 and -0.0
+ test for the above

git-svn-id: trunk@1917 -

Jonas Maebe пре 19 година
родитељ
комит
b3b104130d
4 измењених фајлова са 55 додато и 8 уклоњено
  1. 1 0
      .gitattributes
  2. 19 0
      compiler/globals.pas
  3. 9 8
      compiler/ncgcon.pas
  4. 26 0
      tests/webtbs/tw4534.pp

+ 1 - 0
.gitattributes

@@ -6392,6 +6392,7 @@ tests/webtbs/tw4519.pp -text svneol=unset#text/plain
 tests/webtbs/tw4520.pp -text svneol=unset#text/plain
 tests/webtbs/tw4529.pp -text svneol=unset#text/plain
 tests/webtbs/tw4533.pp svneol=native#text/plain
+tests/webtbs/tw4534.pp svneol=native#text/plain
 tests/webtbs/tw4537.pp svneol=native#text/plain
 tests/webtbs/tw4540.pp -text svneol=unset#text/plain
 tests/webtbs/tw4557.pp svneol=native#text/plain

+ 19 - 0
compiler/globals.pas

@@ -339,6 +339,8 @@ interface
 
     procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
     function is_number_float(d : double) : boolean;
+    { discern +0.0 and -0.0 }
+    function get_real_sign(r: bestreal): longint;
 
     function SetAktProcCall(const s:string; changeInit: boolean):boolean;
     function SetProcessor(const s:string; changeInit: boolean):boolean;
@@ -1811,6 +1813,23 @@ end;
 {$endif FPC_BIG_ENDIAN}
         end;
 
+    function get_real_sign(r: bestreal): longint;
+      var
+        p: pbyte;
+      begin
+        p := @r;
+{$ifdef CPU_ARM}
+        inc(p,4);
+{$else}   
+{$ifdef FPC_LITTLE_ENDIAN}
+        inc(p,sizeof(r)-1);
+{$endif}          
+{$endif}             
+        if (p^ and $80) = 0 then
+          result := 1
+        else
+          result := -1;
+      end;
 
     function convertdoublearray(d : tdoublearray) : tdoublearray;{$ifdef USEINLINE}inline;{$endif}
 {$ifdef CPUARM}

+ 9 - 8
compiler/ncgcon.pas

@@ -85,6 +85,7 @@ implementation
          hp1 : tai;
          lastlabel : tasmlabel;
          realait : taitype;
+         value_real_sign, hp1_sign: pbyte;
 {$ifdef ARM}
          hiloswapped : boolean;
 {$endif ARM}
@@ -111,22 +112,22 @@ implementation
                          begin
                             if is_number_float(value_real) and
                               (
-                               ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real) and is_number_float(tai_real_32bit(hp1).value)) or
+                               ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real) and is_number_float(tai_real_32bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_32bit(hp1).value))) or
                                ((realait=ait_real_64bit) and
 {$ifdef ARM}
                                  ((tai_real_64bit(hp1).formatoptions=fo_hiloswapped)=hiloswapped) and
 {$endif ARM}
-                                 (tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value)) or
-                               ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value)) or
+                                 (tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_64bit(hp1).value))) or
+                               ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
 {$ifdef cpufloat128}
-                               ((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value)) or
+                               ((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_128bit(hp1).value))) or
 {$endif cpufloat128}
-                               ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real) and is_number_float(tai_comp_64bit(hp1).value))
+                               ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real) and is_number_float(tai_comp_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_comp_64bit(hp1).value)))
                               ) then
                               begin
-                                 { found! }
-                                 lab_real:=lastlabel;
-                                 break;
+                                { found! }
+                                lab_real:=lastlabel;
+                                break;
                               end;
                          end;
                        lastlabel:=nil;

+ 26 - 0
tests/webtbs/tw4534.pp

@@ -0,0 +1,26 @@
+type
+  pbyte = ^byte;
+
+procedure checksigns(a,b: extended);
+var
+  p1, p2: pbyte;
+  i: longint;
+begin
+  p1 := @a;
+  p2 := @b;
+  for i := 1 to sizeof(a) do
+    begin
+      if (p1^ xor p2^) = $80 then
+        halt(0);
+      halt(1);
+    end;
+end;
+
+var x,y:extended;
+
+Begin
+    x:=-0.0;
+    y:=0.0;
+    checksigns(x,y);
+End.
+