[multiple changes]

2017-09-25  Doug Rupp  <rupp@adacore.com>

	* libgnarl/s-taprop__linux.adb (Compute_Base_Monotonic_Clock): Refine.

2017-09-25  Javier Miranda  <miranda@adacore.com>

	* exp_imgv.adb (Is_User_Defined_Enumeration_Type): New subprogram.
	(Expand_User_Defined_Enumeration_Image): New subprogram.
	(Expand_Image_Attribute): Enable speed-optimized expansion of
	user-defined enumeration types when we are compiling with optimizations
	enabled.

2017-09-25  Piotr Trojanek  <trojanek@adacore.com>

	* sem_util.adb (Has_Null_Abstract_State): Remove, as an exactly same
	routine is already provided by Einfo.
	* einfo.adb (Has_Null_Abstract_State): Replace with the body from
	Sem_Util, which had better comments and avoided double calls to
	Abstract_State.

From-SVN: r253138

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 371d50e..e309185 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2017-09-25  Doug Rupp  <rupp@adacore.com>
+
+       * libgnarl/s-taprop__linux.adb (Compute_Base_Monotonic_Clock): Refine.
+
+2017-09-25  Javier Miranda  <miranda@adacore.com>
+
+       * exp_imgv.adb (Is_User_Defined_Enumeration_Type): New subprogram.
+       (Expand_User_Defined_Enumeration_Image): New subprogram.
+       (Expand_Image_Attribute): Enable speed-optimized expansion of
+       user-defined enumeration types when we are compiling with optimizations
+       enabled.
+
+2017-09-25  Piotr Trojanek  <trojanek@adacore.com>
+
+       * sem_util.adb (Has_Null_Abstract_State): Remove, as an exactly same
+       routine is already provided by Einfo.
+       * einfo.adb (Has_Null_Abstract_State): Replace with the body from
+       Sem_Util, which had better comments and avoided double calls to
+       Abstract_State.
+
 2017-09-25  Bob Duff  <duff@adacore.com>
 
        * exp_ch3.adb: Rename Comp_Type_Simple to be Comp_Simple_Init.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 21d8838..e947cba 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -7707,12 +7707,17 @@ package body Einfo is
    -----------------------------
 
    function Has_Null_Abstract_State (Id : E) return B is
-   begin
       pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
 
+      States : constant Elist_Id := Abstract_States (Id);
+
+   begin
+      --  Check first available state of related package. A null abstract
+      --  state always appears as the sole element of the state list.
+
       return
-        Present (Abstract_States (Id))
-          and then Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
+        Present (States)
+          and then Is_Null_State (Node (First_Elmt (States)));
    end Has_Null_Abstract_State;
 
    ---------------------------------

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index f42f94d..4f12a8c 100644 (file)
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -263,10 +263,176 @@ package body Exp_Imgv is
    --  position of the enumeration value in the enumeration type.
 
    procedure Expand_Image_Attribute (N : Node_Id) is
-      Loc       : constant Source_Ptr := Sloc (N);
-      Exprs     : constant List_Id    := Expressions (N);
-      Pref      : constant Node_Id    := Prefix (N);
-      Expr      : constant Node_Id    := Relocate_Node (First (Exprs));
+      Loc   : constant Source_Ptr := Sloc (N);
+      Exprs : constant List_Id    := Expressions (N);
+      Expr  : constant Node_Id    := Relocate_Node (First (Exprs));
+      Pref  : constant Node_Id    := Prefix (N);
+
+      function Is_User_Defined_Enumeration_Type
+        (Typ : Entity_Id) return Boolean;
+      --  Return True if Typ is an user-defined enumeration type
+
+      procedure Expand_User_Defined_Enumeration_Image;
+      --  Expand attribute 'Image in user-defined enumeration types avoiding
+      --  string copy.
+
+      -------------------------------------------
+      -- Expand_User_Defined_Enumeration_Image --
+      -------------------------------------------
+
+      procedure Expand_User_Defined_Enumeration_Image is
+         Ins_List : constant List_Id   := New_List;
+         P1_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
+         P2_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
+         P3_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
+         P4_Id    : constant Entity_Id := Make_Temporary (Loc, 'P');
+         Ptyp     : constant Entity_Id := Entity (Pref);
+         Rtyp     : constant Entity_Id := Root_Type (Ptyp);
+         S1_Id    : constant Entity_Id := Make_Temporary (Loc, 'S');
+
+      begin
+         --  Apply a validity check, since it is a bit drastic to get a
+         --  completely junk image value for an invalid value.
+
+         if not Expr_Known_Valid (Expr) then
+            Insert_Valid_Check (Expr);
+         end if;
+
+         --  Generate:
+         --    P1 : constant Natural := Pos;
+
+         Append_To (Ins_List,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => P1_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (Standard_Natural, Loc),
+             Constant_Present    => True,
+             Expression =>
+               Convert_To (Standard_Natural,
+                 Make_Attribute_Reference (Loc,
+                   Attribute_Name => Name_Pos,
+                   Prefix         => New_Occurrence_Of (Ptyp, Loc),
+                   Expressions    => New_List (Expr)))));
+
+         --  Compute the index of the string start generating:
+         --    P2 : constant Natural := call_put_enumN (P1);
+
+         Append_To (Ins_List,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => P2_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (Standard_Natural, Loc),
+             Constant_Present    => True,
+             Expression =>
+               Convert_To (Standard_Natural,
+                 Make_Indexed_Component (Loc,
+                   Prefix      =>
+                     New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
+                   Expressions =>
+                     New_List (New_Occurrence_Of (P1_Id, Loc))))));
+
+         --  Compute the index of the next value generating:
+         --    P3 : constant Natural := call_put_enumN (P1 + 1);
+
+         declare
+            Add_Node : constant Node_Id := New_Op_Node (N_Op_Add, Loc);
+
+         begin
+            Set_Left_Opnd  (Add_Node, New_Occurrence_Of (P1_Id, Loc));
+            Set_Right_Opnd (Add_Node, Make_Integer_Literal (Loc, 1));
+
+            Append_To (Ins_List,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => P3_Id,
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Natural, Loc),
+                Constant_Present    => True,
+                Expression =>
+                  Convert_To (Standard_Natural,
+                    Make_Indexed_Component (Loc,
+                      Prefix      =>
+                        New_Occurrence_Of (Lit_Indexes (Rtyp), Loc),
+                      Expressions =>
+                        New_List (Add_Node)))));
+         end;
+
+         --  Generate:
+         --    S4 : String renames call_put_enumS (S2 .. S3 - 1);
+
+         declare
+            Sub_Node : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc);
+
+         begin
+            Set_Left_Opnd  (Sub_Node, New_Occurrence_Of (P3_Id, Loc));
+            Set_Right_Opnd (Sub_Node, Make_Integer_Literal (Loc, 1));
+
+            Append_To (Ins_List,
+              Make_Object_Renaming_Declaration (Loc,
+                Defining_Identifier => P4_Id,
+                Subtype_Mark        =>
+                  New_Occurrence_Of (Standard_String, Loc),
+                Name                =>
+                  Make_Slice (Loc,
+                    Prefix         =>
+                      New_Occurrence_Of (Lit_Strings (Rtyp), Loc),
+                    Discrete_Range =>
+                      Make_Range (Loc,
+                        Low_Bound  => New_Occurrence_Of (P2_Id, Loc),
+                        High_Bound => Sub_Node))));
+         end;
+
+         --  Generate:
+         --    subtype S1 is string (1 .. P3 - P2);
+
+         declare
+            HB : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc);
+
+         begin
+            Set_Left_Opnd  (HB, New_Occurrence_Of (P3_Id, Loc));
+            Set_Right_Opnd (HB, New_Occurrence_Of (P2_Id, Loc));
+
+            Append_To (Ins_List,
+              Make_Subtype_Declaration (Loc,
+                Defining_Identifier => S1_Id,
+                Subtype_Indication  =>
+                  Make_Subtype_Indication (Loc,
+                    Subtype_Mark =>
+                      New_Occurrence_Of (Standard_String, Loc),
+                    Constraint   =>
+                      Make_Index_Or_Discriminant_Constraint (Loc,
+                        Constraints => New_List (
+                          Make_Range (Loc,
+                            Low_Bound  => Make_Integer_Literal (Loc, 1),
+                            High_Bound => HB))))));
+         end;
+
+         --  Insert all the above declarations before N. We suppress checks
+         --  because everything is in range at this stage.
+
+         Insert_Actions (N, Ins_List, Suppress => All_Checks);
+
+         Rewrite (N,
+           Unchecked_Convert_To (S1_Id,
+             New_Occurrence_Of (P4_Id, Loc)));
+         Analyze_And_Resolve (N, Standard_String);
+      end Expand_User_Defined_Enumeration_Image;
+
+      --------------------------------------
+      -- Is_User_Defined_Enumeration_Type --
+      --------------------------------------
+
+      function Is_User_Defined_Enumeration_Type
+        (Typ : Entity_Id) return Boolean is
+      begin
+         return Ekind (Typ) = E_Enumeration_Type
+           and then Typ /= Standard_Boolean
+           and then Typ /= Standard_Character
+           and then Typ /= Standard_Wide_Character
+           and then Typ /= Standard_Wide_Wide_Character;
+      end Is_User_Defined_Enumeration_Type;
+
+      --  Local variables
+
       Imid      : RE_Id;
       Ptyp      : Entity_Id;
       Rtyp      : Entity_Id;
@@ -288,6 +454,16 @@ package body Exp_Imgv is
       if Is_Object_Image (Pref) then
          Rewrite_Object_Image (N, Pref, Name_Image, Standard_String);
          return;
+
+      --  Enable speed optimized expansion of user-defined enumeration types
+      --  if we are compiling with optimizations enabled. Otherwise the call
+      --  will be expanded into a call to the runtime library.
+
+      elsif Optimization_Level > 0
+        and then Is_User_Defined_Enumeration_Type (Root_Type (Entity (Pref)))
+      then
+         Expand_User_Defined_Enumeration_Image;
+         return;
       end if;
 
       Ptyp := Entity (Pref);

diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
index 4f83d73..0be44ed 100644 (file)
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -38,7 +38,9 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during tasking
 --  operations. It causes infinite loops and other problems.
 
-with Interfaces.C; use Interfaces; use type Interfaces.C.int;
+with Interfaces.C; use Interfaces;
+use type Interfaces.C.int;
+use type Interfaces.C.long;
 
 with System.Task_Info;
 with System.Tasking.Debug;
@@ -64,7 +66,6 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
    use System.Task_Info;
-   use type Interfaces.C.long;
 
    ----------------
    -- Local Data --
@@ -316,12 +317,9 @@ package body System.Task_Primitives.Operations is
              TS_Aft0.tv_nsec - TS_Bef0.tv_nsec))
             --  The most recent calls to clock_gettime were more better.
          then
-            TS_Bef0.tv_sec := TS_Bef.tv_sec;
-            TS_Bef0.tv_nsec := TS_Bef.tv_nsec;
-            TS_Aft0.tv_sec := TS_Aft.tv_sec;
-            TS_Aft0.tv_nsec := TS_Aft.tv_nsec;
-            TS_Mon0.tv_sec := TS_Mon.tv_sec;
-            TS_Mon0.tv_nsec := TS_Mon.tv_nsec;
+            TS_Bef0 := TS_Bef;
+            TS_Aft0 := TS_Aft;
+            TS_Mon0 := TS_Mon;
          end if;
       end loop;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0b73112..20cda2d 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3138,34 +3138,10 @@ package body Sem_Util is
    ---------------------------
 
    procedure Check_No_Hidden_State (Id : Entity_Id) is
-      function Has_Null_Abstract_State (Pkg : Entity_Id) return Boolean;
-      --  Determine whether the entity of a package denoted by Pkg has a null
-      --  abstract state.
-
-      -----------------------------
-      -- Has_Null_Abstract_State --
-      -----------------------------
-
-      function Has_Null_Abstract_State (Pkg : Entity_Id) return Boolean is
-         States : constant Elist_Id := Abstract_States (Pkg);
-
-      begin
-         --  Check first available state of related package. A null abstract
-         --  state always appears as the sole element of the state list.
-
-         return
-           Present (States)
-             and then Is_Null_State (Node (First_Elmt (States)));
-      end Has_Null_Abstract_State;
-
-      --  Local variables
-
       Context     : Entity_Id := Empty;
       Not_Visible : Boolean   := False;
       Scop        : Entity_Id;
 
-   --  Start of processing for Check_No_Hidden_State
-
    begin
       pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));