Allow compilation of softfpu unit with 128-bit upport on big endian code (code generated might be wrong)

git-svn-id: trunk@37257 -

rtl/inc/softfpu.pp

@@ -1720,6 +1720,17 @@ const
 (*                      End Low-Level arithmetic                             *)
 (*****************************************************************************)
 
+{*----------------------------------------------------------------------------
+| Returns 1 if the 128-bit value formed by concatenating `a0' and `a1' is less
+| than the 128-bit value formed by concatenating `b0' and `b1'.  Otherwise,
+| returns 0.
+*----------------------------------------------------------------------------*}
+
+function lt128(a0: bits64; a1: bits64; b0: bits64; b1 : bits64): flag;inline;
+begin
+    result := ord(( a0 < b0 ) or ( ( a0 = b0 ) and ( a1 < b1 ) ));
+end;
+
 
 {*
 -------------------------------------------------------------------------------
@@ -1783,7 +1794,7 @@ Returns the result of converting the single-precision floating-point NaN
 exception is raised.
 -------------------------------------------------------------------------------
 *}
-Procedure float32ToCommonNaN( a: float32; VAR c:commonNaNT  );
+function float32ToCommonNaN(a: float32) : commonNaNT;
 var
     z : commonNaNT ;
 Begin
@@ -1792,8 +1803,7 @@ Begin
     z.sign := a shr 31;
     z.low := 0;
     z.high := a shl 9;
-    c := z;
-
+    result := z;
 End;
 
 {*
@@ -1914,18 +1924,6 @@ Returns the result of converting the double-precision floating-point NaN
 exception is raised.
 -------------------------------------------------------------------------------
 *}
-Procedure float64ToCommonNaN( a : float64; VAR c:commonNaNT );
-Var
-    z : commonNaNT;
-Begin
-    if ( float64_is_signaling_nan( a )<>0 ) then
-        float_raise( float_flag_invalid );
-    z.sign := a.high shr 31;
-    shortShift64Left( a.high, a.low, 12, z.high, z.low );
-    c := z;
-
-End;
-
 function float64ToCommonNaN( a : float64 ) : commonNaNT;
 Var
     z : commonNaNT;
@@ -1943,13 +1941,13 @@ Returns the result of converting the canonical NaN `a' to the double-
 precision floating-point format.
 -------------------------------------------------------------------------------
 *}
-Procedure commonNaNToFloat64( a : commonNaNT; VAR c: float64  );
+function commonNaNToFloat64( a : commonNaNT) : float64;
 Var
     z: float64;
 Begin
     shift64Right( a.high, a.low, 12, z.high, z.low );
     z.high := z.high or ( ( bits32 (a.sign) ) shl 31 ) or $7FF80000;
-    c := z;
+    result := z;
 End;
 
 {*
@@ -2013,17 +2011,6 @@ Begin
     End;
 End;
 
-{*----------------------------------------------------------------------------
-| Returns 1 if the 128-bit value formed by concatenating `a0' and `a1' is less
-| than the 128-bit value formed by concatenating `b0' and `b1'.  Otherwise,
-| returns 0.
-*----------------------------------------------------------------------------*}
-
-function lt128(a0: bits64; a1: bits64; b0: bits64; b1 : bits64): flag;inline;
-begin
-    result := ord(( a0 < b0 ) or ( ( a0 = b0 ) and ( a1 < b1 ) ));
-end;
-
 {*----------------------------------------------------------------------------
 | Returns 1 if the quadruple-precision floating-point value `a' is a NaN;
 | otherwise returns 0.
@@ -2179,7 +2166,7 @@ function float32_is_signaling_nan(a: float32):flag;
 | `a' to the canonical NaN format.  If `a' is a signaling NaN, the invalid
 | exception is raised.
 *----------------------------------------------------------------------------*)
-Procedure float32ToCommonNaN( a: float32; VAR c:commonNaNT  );
+function float32ToCommonNaN( a: float32) : commonNaNT;
  var
   z: commonNANT;
  begin
@@ -2188,7 +2175,7 @@ Procedure float32ToCommonNaN( a: float32; VAR c:commonNaNT  );
    z.sign := a shr 31;
    z.low := 0;
    z.high := a shl 9;
-   c:=z;
+   result:=z;
  end;
 
 (*----------------------------------------------------------------------------
@@ -2265,7 +2252,7 @@ function float64_is_signaling_nan( a:float64): flag;
 | `a' to the canonical NaN format.  If `a' is a signaling NaN, the invalid
 | exception is raised.
 *----------------------------------------------------------------------------*)
-Procedure float64ToCommonNaN( a : float64; VAR c:commonNaNT );
+function float64ToCommonNaN( a : float64)  : commonNaNT;
  var
    z : commonNaNT;
  begin
@@ -2273,20 +2260,20 @@ Procedure float64ToCommonNaN( a : float64; VAR c:commonNaNT );
         float_raise( float_flag_invalid );
     z.sign := a.high shr 31;
     shortShift64Left( a.high, a.low, 12, z.high, z.low );
-    c:=z;
+    result:=z;
  end;
 
 (*----------------------------------------------------------------------------
 | Returns the result of converting the canonical NaN `a' to the double-
 | precision floating-point format.
 *----------------------------------------------------------------------------*)
-Procedure commonNaNToFloat64( a : commonNaNT; VAR c: float64  );
+function commonNaNToFloat64( a : commonNaNT): float64;
  var
   z: float64;
  begin
     shift64Right( a.high, a.low, 12, z.high, z.low );
     z.high := z.high or ( ( bits32 (a.sign) ) shl 31 ) or $7FF80000;
-    c:=z;
+    result:=z;
  end;
 
 (*----------------------------------------------------------------------------
@@ -2316,6 +2303,120 @@ var
         c := a;
  end;
 
+{*----------------------------------------------------------------------------
+| Returns 1 if the quadruple-precision floating-point value `a' is a NaN;
+| otherwise returns 0.
+*----------------------------------------------------------------------------*}
+
+function float128_is_nan( a : float128): flag;
+begin
+    result:= ord(( bits64( $FFFE000000000000 ) <= bits64( a.high shl 1 ) )
+        and ( (a.low<>0) or (( a.high and int64( $0000FFFFFFFFFFFF ) )<>0 ) ));
+end;
+
+{*----------------------------------------------------------------------------
+| Returns 1 if the quadruple-precision floating-point value `a' is a
+| signaling NaN; otherwise returns 0.
+*----------------------------------------------------------------------------*}
+
+function float128_is_signaling_nan( a : float128): flag;
+begin
+    result:=ord(( ( ( a.high shr 47 ) and $FFFF ) = $FFFE ) and
+        ( (a.low<>0) or (( a.high and int64( $00007FFFFFFFFFFF ) )<>0) ));
+end;
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the quadruple-precision floating-point NaN
+| `a' to the canonical NaN format.  If `a' is a signaling NaN, the invalid
+| exception is raised.
+*----------------------------------------------------------------------------*}
+
+function float128ToCommonNaN( a : float128): commonNaNT;
+var
+    z: commonNaNT;
+    qhigh,qlow : qword;
+begin
+    if ( float128_is_signaling_nan( a )<>0)  then
+      float_raise( float_flag_invalid );
+    z.sign := a.high shr 63;
+    shortShift128Left( a.high, a.low, 16, qhigh, qlow );
+    z.high:=qhigh shr 32;
+    z.low:=qhigh and $ffffffff;
+    result:=z;
+end;
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the canonical NaN `a' to the quadruple-
+| precision floating-point format.
+*----------------------------------------------------------------------------*}
+
+function commonNaNToFloat128( a : commonNaNT): float128;
+var
+    z: float128;
+begin
+    shift128Right( a.high, a.low, 16, z.high, z.low );
+    z.high := z.high or ( ( bits64(a.sign) ) shl 63 ) or int64( $7FFF800000000000 );
+    result:=z;
+end;
+
+{*----------------------------------------------------------------------------
+| Takes two quadruple-precision floating-point values `a' and `b', one of
+| which is a NaN, and returns the appropriate NaN result.  If either `a' or
+| `b' is a signaling NaN, the invalid exception is raised.
+*----------------------------------------------------------------------------*}
+
+function propagateFloat128NaN( a: float128; b : float128): float128;
+var
+    aIsNaN, aIsSignalingNaN, bIsNaN, bIsSignalingNaN: flag;
+label
+    returnLargerSignificand;
+begin
+    aIsNaN := float128_is_nan( a );
+    aIsSignalingNaN := float128_is_signaling_nan( a );
+    bIsNaN := float128_is_nan( b );
+    bIsSignalingNaN := float128_is_signaling_nan( b );
+    a.high := a.high or int64( $0000800000000000 );
+    b.high := b.high or int64( $0000800000000000 );
+    if ( aIsSignalingNaN or bIsSignalingNaN )<>0 then
+       float_raise( float_flag_invalid );
+    if ( aIsSignalingNaN )<>0 then
+    begin
+        if ( bIsSignalingNaN )<>0 then
+          goto returnLargerSignificand;
+        if bIsNaN<>0 then
+          result := b
+        else
+          result := a;
+        exit;
+    end
+    else if ( aIsNaN )<>0 then
+    begin
+        if ( bIsSignalingNaN or not( bIsNaN) )<>0 then
+          begin
+          	result := a;
+          	exit;
+          end;
+ returnLargerSignificand:
+        if ( lt128( a.high shl 1, a.low, b.high shl 1, b.low ) )<>0 then
+          begin
+          	result := b;
+          	exit;
+          end;
+        if ( lt128( b.high shl 1, b.low, a.high shl 1, a.low ) )<>0 then
+          begin
+          	result := a;
+          	exit
+          end;
+        if ( a.high < b.high ) then
+          result := a
+        else
+          result := b;
+        exit;
+    end
+    else
+    result:=b;
+end;
+
 {$ENDIF}
 
 (****************************************************************************)
@@ -3272,8 +3373,8 @@ Function float32_to_float64( a : float32rec) : Float64;compilerproc;
       Begin
         if ( aSig<>0 ) then
           Begin
-            float32ToCommonNaN(a.float32, tmp);
-            commonNaNToFloat64(tmp , result);
+            tmp:=float32ToCommonNaN(a.float32);
+            result:=commonNaNToFloat64(tmp);
             exit;
           End;
           packFloat64( aSign, $7FF, 0, 0, result);
@@ -3328,7 +3429,7 @@ begin
     aSign := extractFloat32Sign( a );
     if ( aExp = $FF ) then begin
         if ( aSig <> 0 ) then begin
-            float32ToCommonNaN( a, tmp );
+            tmp:=float32ToCommonNaN(a);
             result := commonNaNToFloatx80( tmp );
             exit;
         end;
@@ -3369,7 +3470,7 @@ begin
     aSign := extractFloat32Sign( a );
     if ( aExp = $FF ) then begin
         if ( aSig <> 0 ) then begin
-            float32ToCommonNaN( a, tmp );
+            tmp:=float32ToCommonNaN(a);
             result := commonNaNToFloat128( tmp );
             exit;
         end;
@@ -4579,7 +4680,7 @@ Begin
     Begin
         if ( aSig0 OR  aSig1 ) <> 0 then
         Begin
-            float64ToCommonNaN( a, tmp );
+            tmp:=float64ToCommonNaN(a);
             float64_to_float32.float32 := commonNaNToFloat32( tmp );
             exit;
         End;
@@ -6744,7 +6845,7 @@ begin
     aSign := extractFloatx80Sign( a );
     if ( aExp = $7FFF ) then begin
         if bits64( aSig shl 1 ) <> 0 then begin
-            commonNaNToFloat64( floatx80ToCommonNaN( a ), result );
+            result:=commonNaNToFloat64(floatx80ToCommonNaN(a));
             exit;
         end;
         result := packFloat64( aSign, $7FF, 0 );
@@ -8176,7 +8277,7 @@ begin
     begin
         if ( aSig0 or aSig1 )<>0 then
         begin
-            commonNaNToFloat64( float128ToCommonNaN( a ),result);
+            result:=commonNaNToFloat64(float128ToCommonNaN(a));
             exit;
         end;
         result:=packFloat64( aSign, $7FF, 0);