[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 Aug 2011 13:08:34 +0000 (15:08 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 Aug 2011 13:08:34 +0000 (15:08 +0200)
2011-08-02  Javier Miranda  <miranda@adacore.com>

* exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine
in CodePeer mode.

2011-08-02  Geert Bosch  <bosch@adacore.com>

* cstand.adb (Back_End_Float_Types): Use Elist instead of Nlist
(Find_Back_End_Float_Type): Likewise
(Create_Back_End_Float_Types): Likewise
(Create_Float_Types): Likewise
(Register_Float_Type): Likewise
* sem_ch3.adb (Floating_Point_Type_Declaration): Use Elist instead of
Nlist and split out type selection in new local Find_Base_Type function.
* sem_prag.adb (Process_Import_Predefined_Type): Use Elist instead of
Nlist
* stand.ads (Predefined_Float_Types): Use Elist instead of Nlist

2011-08-02  Robert Dewar  <dewar@adacore.com>

* inline.adb: Minor code reorganization (put Get_Code_Unit_Entity in
alpha order).
* opt.ads: Minor comment change.
* sem_ch12.adb: Minor code reorganization.

From-SVN: r177144

gcc/ada/ChangeLog
gcc/ada/cstand.adb
gcc/ada/exp_pakd.adb
gcc/ada/inline.adb
gcc/ada/opt.ads
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_prag.adb
gcc/ada/stand.ads

index 7495e774ef737755cbadd2633af30d45b7a389d7..7954c5584094c59c034a175291bf08af8b1d9214 100644 (file)
@@ -1,3 +1,28 @@
+2011-08-02  Javier Miranda  <miranda@adacore.com>
+
+       * exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine
+       in CodePeer mode.
+
+2011-08-02  Geert Bosch  <bosch@adacore.com>
+
+       * cstand.adb (Back_End_Float_Types): Use Elist instead of Nlist
+       (Find_Back_End_Float_Type): Likewise
+       (Create_Back_End_Float_Types): Likewise
+       (Create_Float_Types): Likewise
+       (Register_Float_Type): Likewise
+       * sem_ch3.adb (Floating_Point_Type_Declaration): Use Elist instead of
+       Nlist and split out type selection in new local Find_Base_Type function.
+       * sem_prag.adb (Process_Import_Predefined_Type): Use Elist instead of
+       Nlist
+       * stand.ads (Predefined_Float_Types): Use Elist instead of Nlist
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+       * inline.adb: Minor code reorganization (put Get_Code_Unit_Entity in
+       alpha order).
+       * opt.ads: Minor comment change.
+       * sem_ch12.adb: Minor code reorganization.
+
 2011-08-02  Gary Dismukes  <dismukes@adacore.com>
 
        * sem_ch3.adb (Complete_Private_Subtype): Don't append the private
index 26b19afd5254f4cb48e525555feef5f50f463ced..ad79aabd360fba2651b4d3fb7566040570b57f2a 100644 (file)
@@ -28,6 +28,7 @@ with Back_End; use Back_End;
 with Csets;    use Csets;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
+with Elists;   use Elists;
 with Layout;   use Layout;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -52,7 +53,7 @@ package body CStand is
    Staloc : constant Source_Ptr := Standard_ASCII_Location;
    --  Standard abbreviations used throughout this package
 
-   Back_End_Float_Types : List_Id := No_List;
+   Back_End_Float_Types : Elist_Id := No_Elist;
    --  List used for any floating point supported by the back end. This needs
    --  to be at the library level, because the call back procedures retrieving
    --  this information are at that level.
@@ -200,14 +201,15 @@ package body CStand is
    ------------------------
 
    function Find_Back_End_Float_Type (Name : String) return Entity_Id is
-      N    : Node_Id := First (Back_End_Float_Types);
+      N : Elmt_Id := First_Elmt (Back_End_Float_Types);
 
    begin
-      while Present (N) and then Get_Name_String (Chars (N)) /= Name loop
-         Next (N);
+      while Present (N) and then Get_Name_String (Chars (Node (N))) /= Name
+      loop
+         Next_Elmt (N);
       end loop;
 
-      return Entity_Id (N);
+      return Node (N);
    end Find_Back_End_Float_Type;
 
    -------------------------------
@@ -427,7 +429,7 @@ package body CStand is
 
       procedure Create_Back_End_Float_Types is
       begin
-         Back_End_Float_Types := No_List;
+         Back_End_Float_Types := No_Elist;
          Register_Back_End_Types (Register_Float_Type'Access);
       end Create_Back_End_Float_Types;
 
@@ -447,8 +449,10 @@ package body CStand is
          Copy_Float_Type (Standard_Long_Float,
            Find_Back_End_Float_Type ("double"));
 
-         Predefined_Float_Types := New_List
-           (Standard_Short_Float, Standard_Float, Standard_Long_Float);
+         Predefined_Float_Types := New_Elmt_List;
+         Append_Elmt (Standard_Short_Float, Predefined_Float_Types);
+         Append_Elmt (Standard_Float, Predefined_Float_Types);
+         Append_Elmt (Standard_Long_Float, Predefined_Float_Types);
 
          --  ??? For now, we don't have a good way to tell the widest float
          --  type with hardware support. Basically, GCC knows the size of that
@@ -464,21 +468,23 @@ package body CStand is
             LF_Digs     : constant Pos :=
                             UI_To_Int (Digits_Value (Standard_Long_Float));
             LLF : Entity_Id := Find_Back_End_Float_Type ("long double");
-            N   : Node_Id := First (Back_End_Float_Types);
+            E   : Elmt_Id := First_Elmt (Back_End_Float_Types);
+            N   : Node_Id;
 
          begin
             if Present (LLF) and then Digits_Value (LLF) > Max_HW_Digs then
                LLF := Empty;
             end if;
 
-            while No (LLF) and then Present (N) loop
+            while No (LLF) and then Present (E) loop
+               N := Node (E);
                if UI_To_Int (Digits_Value (N)) in LF_Digs + 1 .. Max_HW_Digs
                  and then Machine_Radix_Value (N) = Uint_2
                then
                   LLF := N;
                end if;
 
-               Next (N);
+               Next_Elmt (E);
             end loop;
 
             if No (LLF) then
@@ -487,10 +493,22 @@ package body CStand is
 
             Copy_Float_Type (Standard_Long_Long_Float, LLF);
 
-            Append (Standard_Long_Long_Float, Predefined_Float_Types);
+            Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
          end;
 
-         Append_List (Back_End_Float_Types, To => Predefined_Float_Types);
+         --  Any other back end types are appended at the end of the list of
+         --  predefined float types, and will only be selected if the none of
+         --  the types in Standard is suitable, or if a specific named type is
+         --  requested through a pragma Import.
+
+         while not Is_Empty_Elmt_List (Back_End_Float_Types) loop
+            declare
+               E : constant Elmt_Id := First_Elmt (Back_End_Float_Types);
+            begin
+               Append_Elmt (Node (E), To => Predefined_Float_Types);
+               Remove_Elmt (Back_End_Float_Types, E);
+            end;
+         end loop;
       end Create_Float_Types;
 
       ----------------------
@@ -2095,11 +2113,10 @@ package body CStand is
             Set_Alignment (Ent, UI_From_Int (Int (Alignment / 8)));
 
             if No (Back_End_Float_Types) then
-               Back_End_Float_Types := New_List (Ent);
-
-            else
-               Append (Ent, Back_End_Float_Types);
+               Back_End_Float_Types := New_Elmt_List;
             end if;
+
+            Append_Elmt (Ent, Back_End_Float_Types);
          end;
       end if;
    end Register_Float_Type;
index 4d3ea06881942ed9c17182ef51914f6763a2dbea..9367e9391926b71e9d2d32bdbdaefbe1b5ac1c95 100644 (file)
@@ -1932,6 +1932,13 @@ package body Exp_Pakd is
       Arg   : Node_Id;
 
    begin
+      --  Disable this routine in CodePeer mode since the expansion of packed
+      --  arrays confuses the gnat2scil back end.
+
+      if CodePeer_Mode then
+         return;
+      end if;
+
       --  If not bit packed, we have the enumeration case, which is easily
       --  dealt with (just adjust the subscripts of the indexed component)
 
index 6678057ff02eae9feab698e11d2dd82ac7d6408e..c4937976be26d10ca3c475673e977689bc6c6787 100644 (file)
@@ -982,6 +982,15 @@ package body Inline is
       end loop;
    end Cleanup_Scopes;
 
+   --------------------------
+   -- Get_Code_Unit_Entity --
+   --------------------------
+
+   function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is
+   begin
+      return Cunit_Entity (Get_Code_Unit (E));
+   end Get_Code_Unit_Entity;
+
    --------------------------
    -- Has_Initialized_Type --
    --------------------------
@@ -1165,15 +1174,6 @@ package body Inline is
       end loop;
    end Remove_Dead_Instance;
 
-   --------------------------
-   -- Get_Code_Unit_Entity --
-   --------------------------
-
-   function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is
-   begin
-      return Cunit_Entity (Get_Code_Unit (E));
-   end Get_Code_Unit_Entity;
-
    ------------------------
    -- Scope_In_Main_Unit --
    ------------------------
index bd97c0df80722cae1c91a6303cc31cb4bf38cf60..b05dda45b120e423b036a9f2ec3e3b701e510549 100644 (file)
@@ -1080,6 +1080,8 @@ package Opt is
    Preprocessing_Symbol_Defs : String_List_Access := new String_List (1 .. 4);
    --  An extensible array to temporarily stores symbol definitions specified
    --  on the command line with -gnateD switches.
+   --  What is this magic constant 4 ???
+   --  What is extensible about this fixed length array ???
 
    Preprocessing_Symbol_Last : Natural := 0;
    --  Index of last symbol definition in array Symbol_Definitions
index 218028f7ddfdb486f197aba41e4839dd6cf60b7a..3d0bc99d32992934dad71367f806d086d1e5bdab 100644 (file)
@@ -2927,6 +2927,9 @@ package body Sem_Ch12 is
       Needs_Body       : Boolean;
       Inline_Now       : Boolean := False;
 
+      Save_Style_Check : constant Boolean := Style_Check;
+      --  Save style check mode for restore on exit
+
       procedure Delay_Descriptors (E : Entity_Id);
       --  Delay generation of subprogram descriptors for given entity
 
@@ -2975,8 +2978,6 @@ package body Sem_Ch12 is
          return False;
       end Might_Inline_Subp;
 
-      Save_Style_Check : constant Boolean := Style_Check;
-
    --  Start of processing for Analyze_Package_Instantiation
 
    begin
@@ -3958,6 +3959,9 @@ package body Sem_Ch12 is
       Parent_Installed : Boolean := False;
       Renaming_List    : List_Id;
 
+      Save_Style_Check : constant Boolean := Style_Check;
+      --  Save style check mode for restore on exit
+
       procedure Analyze_Instance_And_Renamings;
       --  The instance must be analyzed in a context that includes the mappings
       --  of generic parameters into actuals. We create a package declaration
@@ -4116,8 +4120,6 @@ package body Sem_Ch12 is
          end if;
       end Analyze_Instance_And_Renamings;
 
-      Save_Style_Check : constant Boolean := Style_Check;
-
    --  Start of processing for Analyze_Subprogram_Instantiation
 
    begin
index 30fb8782d2e26598a7a51716242208f018107b00..6517f70f6aeab3e6f4f273d4e6a80550da309d65 100644 (file)
@@ -15056,6 +15056,10 @@ package body Sem_Ch3 is
       --  Find if given digits value, and possibly a specified range, allows
       --  derivation from specified type
 
+      function Find_Base_Type return Entity_Id;
+      --  Find a predefined base type that Def can derive from, or generate
+      --  an error and substitute Long_Long_Float if none exists.
+
       ---------------------
       -- Can_Derive_From --
       ---------------------
@@ -15085,6 +15089,45 @@ package body Sem_Ch3 is
          return True;
       end Can_Derive_From;
 
+      --------------------
+      -- Find_Base_Type --
+      --------------------
+
+      function Find_Base_Type return Entity_Id is
+         Choice : Elmt_Id := First_Elmt (Predefined_Float_Types);
+
+      begin
+         --  Iterate over the predefined types in order, returning the first
+         --  one that Def can derive from.
+
+         while Present (Choice) loop
+            if Can_Derive_From (Node (Choice)) then
+               return Node (Choice);
+            end if;
+
+            Next_Elmt (Choice);
+         end loop;
+
+         --  If we can't derive from any existing type, use Long_Long_Float
+         --  and give appropriate message explaining the problem.
+
+         if Digs_Val > Max_Digs_Val then
+            --  It might be the case that there is a type with the requested
+            --  range, just not the combination of digits and range.
+
+            Error_Msg_N
+              ("no predefined type has requested range and precision",
+               Real_Range_Specification (Def));
+
+         else
+            Error_Msg_N
+              ("range too large for any predefined type",
+               Real_Range_Specification (Def));
+         end if;
+
+         return Standard_Long_Long_Float;
+      end Find_Base_Type;
+
    --  Start of processing for Floating_Point_Type_Declaration
 
    begin
@@ -15127,32 +15170,9 @@ package body Sem_Ch3 is
          end;
       end if;
 
-      Base_Typ := First (Predefined_Float_Types);
-
-      while Present (Base_Typ) and then not Can_Derive_From (Base_Typ) loop
-         Next (Base_Typ);
-      end loop;
-
-      --  If we can't derive from any existing type, use Long_Long_Float
-      --  and give appropriate message explaining the problem.
-
-      if No (Base_Typ) then
-         Base_Typ := Standard_Long_Long_Float;
-
-         if Digs_Val > Max_Digs_Val then
-            --  It might be the case that there is a type with the requested
-            --  range, just not the combination of digits and range.
-
-            Error_Msg_N
-              ("no predefined type has requested range and precision",
-               Real_Range_Specification (Def));
+      --  Find a suitable type to derive from or complain and use a substitute
 
-         else
-            Error_Msg_N
-              ("range too large for any predefined type",
-               Real_Range_Specification (Def));
-         end if;
-      end if;
+      Base_Typ := Find_Base_Type;
 
       --  If there are bounds given in the declaration use them as the bounds
       --  of the type, otherwise use the bounds of the predefined base type
index 27264662c467b5a0c4e8e34b192447902443239d..ec7c44c28c0c352fe7761e13b02475cc10d13afc 100644 (file)
@@ -3865,7 +3865,8 @@ package body Sem_Prag is
 
       procedure Process_Import_Predefined_Type is
          Loc  : constant Source_Ptr := Sloc (N);
-         Ftyp : Node_Id := First (Predefined_Float_Types);
+         Elmt : Elmt_Id := First_Elmt (Predefined_Float_Types);
+         Ftyp : Node_Id := Empty;
          Decl : Node_Id;
          Def  : Node_Id;
          Nam  : Name_Id;
@@ -3873,10 +3874,12 @@ package body Sem_Prag is
          String_To_Name_Buffer (Strval (Expression (Arg3)));
          Nam := Name_Find;
 
-         while Present (Ftyp) and then Chars (Ftyp) /= Nam loop
-            Next (Ftyp);
+         while Present (Elmt) and then Chars (Node (Elmt)) /= Nam loop
+            Next_Elmt (Elmt);
          end loop;
 
+         Ftyp := Node (Elmt);
+
          if Present (Ftyp) then
             --  Don't build a derived type declaration, because predefined C
             --  types have no declaration anywhere, so cannot really be named.
index 1c93078f20c3fe48153b8d1759333caeb2a73989..b9dac00655d7fe9cf999fa23fc0055354e68c9ca 100644 (file)
@@ -343,7 +343,7 @@ package Stand is
    --  A zero-size subtype of Integer, used as the type of variables used
    --  to provide the debugger with name encodings for renaming declarations.
 
-   Predefined_Float_Types : List_Id;
+   Predefined_Float_Types : Elist_Id;
    --  Entities for predefined floating point types. These are used by
    --  the semantic phase to select appropriate types for floating point
    --  declarations. This list is ordered by preference. All types up to