s-scaval.adb (Initialize): Add new Boolean flag AFloat that is set True when...

2006-10-31  Gary Dismukes  <dismukes@adacore.com>

	* s-scaval.adb (Initialize): Add new Boolean flag AFloat that is set
	True when AAMP extended floating-point is in use (48-bit). Change type
	ByteLF to ByteLLF, add new array type ByteLF and condition the size of
	the two byte array types on AFloat. Change type of IV_Ilf overlay
	variable from Byte8 to ByteLF. Add appropriate initializations of
	floating-point overlays for AAMP cases.

From-SVN: r118316

diff --git a/gcc/ada/s-scaval.adb b/gcc/ada/s-scaval.adb
index c0ad1e10c309b477cc36d0e7237a46b073533f01..6339d26c774336153f7aa012b1eccee7ec58687c 100644 (file)
--- a/gcc/ada/s-scaval.adb
+++ b/gcc/ada/s-scaval.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -60,7 +60,29 @@ package body System.Scalar_Values is
       EFloat : constant Boolean := Long_Long_Float'Size > Long_Float'Size;
       --  Set True if we are on an x86 with 96-bit floats for extended
 
-      type ByteLF is array (0 .. 7 + 4 * Boolean'Pos (EFloat)) of Byte1;
+      AFloat : constant Boolean :=
+                 Long_Float'Size = 48 and Long_Long_Float'Size = 48;
+      --  Set True if we are on an AAMP with 48-bit extended floating point
+
+      type ByteLF is array (0 .. 7 - 2 * Boolean'Pos (AFloat)) of Byte1;
+
+      for ByteLF'Component_Size use 8;
+
+      --  Type used to hold Long_Float values on all targets and to initialize
+      --  48-bit Long_Float values used on AAMP. On AAMP, this type is 6 bytes.
+      --  On other targets the type is 8 bytes, and type Byte8 is used for
+      --  values that are then converted to ByteLF.
+
+      pragma Warnings (Off);
+      function To_ByteLF is new Unchecked_Conversion (Byte8, ByteLF);
+      pragma Warnings (On);
+
+      type ByteLLF is
+        array (0 .. 7 + 4 * Boolean'Pos (EFloat) - 2 * Boolean'Pos (AFloat))
+          of Byte1;
+
+      for ByteLLF'Component_Size use 8;
+
       --  Type used to initialize Long_Long_Float values used on x86 and
       --  any other target with the same 80-bit floating-point values that
       --  GCC always stores in 96-bits. Note that we are assuming Intel
@@ -75,8 +97,8 @@ package body System.Scalar_Values is
 
       IV_Isf : aliased Byte4;     -- Initialize short float
       IV_Ifl : aliased Byte4;     -- Initialize float
-      IV_Ilf : aliased Byte8;     -- Initialize long float
-      IV_Ill : aliased ByteLF;    -- Initialize long long float
+      IV_Ilf : aliased ByteLF;    -- Initialize long float
+      IV_Ill : aliased ByteLLF;   -- Initialize long long float
 
       for IV_Isf'Address use IS_Isf'Address;
       for IV_Ifl'Address use IS_Ifl'Address;
@@ -164,9 +186,16 @@ package body System.Scalar_Values is
          IS_Iz4 := 16#0000_0000#;
          IS_Iz8 := 16#0000_0000_0000_0000#;
 
-         IV_Isf := IS_Iu4;
-         IV_Ifl := IS_Iu4;
-         IV_Ilf := IS_Iu8;
+         if AFloat then
+            IV_Isf := 16#FFFF_FF00#;
+            IV_Ifl := 16#FFFF_FF00#;
+            IV_Ilf := (0, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#);
+
+         else
+            IV_Isf := IS_Iu4;
+            IV_Ifl := IS_Iu4;
+            IV_Ilf := To_ByteLF (IS_Iu8);
+         end if;
 
          if EFloat then
             IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#C0#, 16#FF#, 16#FF#, 0, 0);
@@ -190,9 +219,16 @@ package body System.Scalar_Values is
          IS_Iz4 := 16#0000_0000#;
          IS_Iz8 := 16#0000_0000_0000_0000#;
 
-         IV_Isf := 16#FF80_0000#;
-         IV_Ifl := 16#FF80_0000#;
-         IV_Ilf := 16#FFF0_0000_0000_0000#;
+         if AFloat then
+            IV_Isf := 16#0000_0001#;
+            IV_Ifl := 16#0000_0001#;
+            IV_Ilf := (1, 0, 0, 0, 0, 0);
+
+         else
+            IV_Isf := 16#FF80_0000#;
+            IV_Ifl := 16#FF80_0000#;
+            IV_Ilf := To_ByteLF (16#FFF0_0000_0000_0000#);
+         end if;
 
          if EFloat then
             IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#FF#, 0, 0);
@@ -216,9 +252,16 @@ package body System.Scalar_Values is
          IS_Iz4 := 16#FFFF_FFFF#;
          IS_Iz8 := 16#FFFF_FFFF_FFFF_FFFF#;
 
-         IV_Isf := 16#7F80_0000#;
-         IV_Ifl := 16#7F80_0000#;
-         IV_Ilf := 16#7FF0_0000_0000_0000#;
+         if AFloat then
+            IV_Isf := 16#7FFF_FFFF#;
+            IV_Ifl := 16#7FFF_FFFF#;
+            IV_Ilf := (16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#FF#, 16#7F#);
+
+         else
+            IV_Isf := 16#7F80_0000#;
+            IV_Ifl := 16#7F80_0000#;
+            IV_Ilf := To_ByteLF (16#7FF0_0000_0000_0000#);
+         end if;
 
          if EFloat then
             IV_Ill := (0, 0, 0, 0, 0, 0, 0, 16#80#, 16#FF#, 16#7F#, 0, 0);
@@ -260,7 +303,12 @@ package body System.Scalar_Values is
 
          IV_Isf := IS_Is4;
          IV_Ifl := IS_Is4;
-         IV_Ilf := IS_Is8;
+
+         if AFloat then
+            IV_Ill := (B, B, B, B, B, B);
+         else
+            IV_Ilf := To_ByteLF (IS_Is8);
+         end if;
 
          if EFloat then
             IV_Ill := (B, B, B, B, B, B, B, B, B, B, B, B);
@@ -273,10 +321,10 @@ package body System.Scalar_Values is
       if not EFloat then
          declare
             pragma Warnings (Off);
-            function To_ByteLF is new Unchecked_Conversion (Byte8, ByteLF);
+            function To_ByteLLF is new Unchecked_Conversion (ByteLF, ByteLLF);
             pragma Warnings (On);
          begin
-            IV_Ill := To_ByteLF (IV_Ilf);
+            IV_Ill := To_ByteLLF (IV_Ilf);
          end;
       end if;
    end Initialize;