obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 328 insertions, 0 deletions

diff --git a/gcc/ada/s-scaval.adb b/gcc/ada/s-scaval.adb
new file mode 100644
index 000000000..632e30e4b
--- /dev/null
+++ b/gcc/ada/s-scaval.adb
@@ -0,0 +1,328 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                          GNAT RUN-TIME COMPONENTS                        --
+--                                                                          --
+--                  S Y S T E M . S C A L A R _ V A L U E S                 --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2003-2009, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+
+package body System.Scalar_Values is
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (Mode1 : Character; Mode2 : Character) is
+      C1 : Character := Mode1;
+      C2 : Character := Mode2;
+
+      procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
+
+      subtype String2 is String (1 .. 2);
+      type String2_Ptr is access all String2;
+
+      Env_Value_Ptr    : aliased String2_Ptr;
+      Env_Value_Length : aliased Integer;
+
+      EV_Val : aliased constant String :=
+                 "GNAT_INIT_SCALARS" & ASCII.NUL;
+
+      B : Byte1;
+
+      EFloat : constant Boolean := Long_Long_Float'Size > Long_Float'Size;
+      --  Set True if we are on an x86 with 96-bit floats for extended
+
+      AFloat : constant Boolean :=
+                 Long_Float'Size = 48 and then 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); --  why ???
+      function To_ByteLF is new Ada.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
+      --  format little-endian addressing for this type. On non-Intel
+      --  architectures, this is the same length as Byte8 and holds
+      --  a Long_Float value.
+
+      --  The following variables are used to initialize the float values
+      --  by overlay. We can't assign directly to the float values, since
+      --  we may be assigning signalling Nan's that will cause a trap if
+      --  loaded into a floating-point register.
+
+      IV_Isf : aliased Byte4;     -- Initialize short float
+      IV_Ifl : aliased Byte4;     -- Initialize 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;
+      for IV_Ilf'Address use IS_Ilf'Address;
+      for IV_Ill'Address use IS_Ill'Address;
+
+      --  The following pragmas are used to suppress initialization
+
+      pragma Import (Ada, IV_Isf);
+      pragma Import (Ada, IV_Ifl);
+      pragma Import (Ada, IV_Ilf);
+      pragma Import (Ada, IV_Ill);
+
+   begin
+      --  Acquire environment variable value if necessary
+
+      if C1 = 'E' and then C2 = 'V' then
+         Get_Env_Value_Ptr
+           (EV_Val'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
+
+         --  Ignore if length is not 2
+
+         if Env_Value_Length /= 2 then
+            C1 := 'I';
+            C2 := 'N';
+
+         --  Length is 2, see if it is a valid value
+
+         else
+            --  Acquire two characters and fold to upper case
+
+            C1 := Env_Value_Ptr (1);
+            C2 := Env_Value_Ptr (2);
+
+            if C1 in 'a' .. 'z' then
+               C1 := Character'Val (Character'Pos (C1) - 32);
+            end if;
+
+            if C2 in 'a' .. 'z' then
+               C2 := Character'Val (Character'Pos (C2) - 32);
+            end if;
+
+            --  IN/LO/HI are ok values
+
+            if (C1 = 'I' and then C2 = 'N')
+                  or else
+               (C1 = 'L' and then C2 = 'O')
+                  or else
+               (C1 = 'H' and then C2 = 'I')
+            then
+               null;
+
+            --  Try for valid hex digits
+
+            elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'Z')
+                     or else
+                  (C2 in '0' .. '9' or else C2 in 'A' .. 'Z')
+            then
+               null;
+
+            --  Otherwise environment value is bad, ignore and use IN (invalid)
+
+            else
+               C1 := 'I';
+               C2 := 'N';
+            end if;
+         end if;
+      end if;
+
+      --  IN (invalid value)
+
+      if C1 = 'I' and then C2 = 'N' then
+         IS_Is1 := 16#80#;
+         IS_Is2 := 16#8000#;
+         IS_Is4 := 16#8000_0000#;
+         IS_Is8 := 16#8000_0000_0000_0000#;
+
+         IS_Iu1 := 16#FF#;
+         IS_Iu2 := 16#FFFF#;
+         IS_Iu4 := 16#FFFF_FFFF#;
+         IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
+
+         IS_Iz1 := 16#00#;
+         IS_Iz2 := 16#0000#;
+         IS_Iz4 := 16#0000_0000#;
+         IS_Iz8 := 16#0000_0000_0000_0000#;
+
+         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);
+         end if;
+
+      --  LO (Low values)
+
+      elsif C1 = 'L' and then C2 = 'O' then
+         IS_Is1 := 16#80#;
+         IS_Is2 := 16#8000#;
+         IS_Is4 := 16#8000_0000#;
+         IS_Is8 := 16#8000_0000_0000_0000#;
+
+         IS_Iu1 := 16#00#;
+         IS_Iu2 := 16#0000#;
+         IS_Iu4 := 16#0000_0000#;
+         IS_Iu8 := 16#0000_0000_0000_0000#;
+
+         IS_Iz1 := 16#00#;
+         IS_Iz2 := 16#0000#;
+         IS_Iz4 := 16#0000_0000#;
+         IS_Iz8 := 16#0000_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);
+         end if;
+
+      --  HI (High values)
+
+      elsif C1 = 'H' and then C2 = 'I' then
+         IS_Is1 := 16#7F#;
+         IS_Is2 := 16#7FFF#;
+         IS_Is4 := 16#7FFF_FFFF#;
+         IS_Is8 := 16#7FFF_FFFF_FFFF_FFFF#;
+
+         IS_Iu1 := 16#FF#;
+         IS_Iu2 := 16#FFFF#;
+         IS_Iu4 := 16#FFFF_FFFF#;
+         IS_Iu8 := 16#FFFF_FFFF_FFFF_FFFF#;
+
+         IS_Iz1 := 16#FF#;
+         IS_Iz2 := 16#FFFF#;
+         IS_Iz4 := 16#FFFF_FFFF#;
+         IS_Iz8 := 16#FFFF_FFFF_FFFF_FFFF#;
+
+         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);
+         end if;
+
+      --  -Shh (hex byte)
+
+      else
+         --  Convert the two hex digits (we know they are valid here)
+
+         B := 16 * (Character'Pos (C1)
+                     - (if C1 in '0' .. '9'
+                        then Character'Pos ('0')
+                        else Character'Pos ('A') - 10))
+                 + (Character'Pos (C2)
+                     - (if C2 in '0' .. '9'
+                        then Character'Pos ('0')
+                        else Character'Pos ('A') - 10));
+
+         --  Initialize data values from the hex value
+
+         IS_Is1 := B;
+         IS_Is2 := 2**8  * Byte2 (IS_Is1) + Byte2 (IS_Is1);
+         IS_Is4 := 2**16 * Byte4 (IS_Is2) + Byte4 (IS_Is2);
+         IS_Is8 := 2**32 * Byte8 (IS_Is4) + Byte8 (IS_Is4);
+
+         IS_Iu1 := IS_Is1;
+         IS_Iu2 := IS_Is2;
+         IS_Iu4 := IS_Is4;
+         IS_Iu8 := IS_Is8;
+
+         IS_Iz1 := IS_Is1;
+         IS_Iz2 := IS_Is2;
+         IS_Iz4 := IS_Is4;
+         IS_Iz8 := IS_Is8;
+
+         IV_Isf := IS_Is4;
+         IV_Ifl := IS_Is4;
+
+         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);
+         end if;
+      end if;
+
+      --  If no separate Long_Long_Float, then use Long_Float value as
+      --  Long_Long_Float initial value.
+
+      if not EFloat then
+         declare
+            pragma Warnings (Off);  -- why???
+            function To_ByteLLF is
+              new Ada.Unchecked_Conversion (ByteLF, ByteLLF);
+            pragma Warnings (On);
+         begin
+            IV_Ill := To_ByteLLF (IV_Ilf);
+         end;
+      end if;
+   end Initialize;
+
+end System.Scalar_Values;