From 49742f9981bcb0c58c668b0ccc047a14d7865d59 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Mon, 25 Sep 2017 08:52:51 +0000 Subject: [PATCH] [multiple changes] 2017-09-25 Doug Rupp * libgnarl/s-taprop__linux.adb (Compute_Base_Monotonic_Clock): Refine. 2017-09-25 Javier Miranda * 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 * 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 --- gcc/ada/ChangeLog | 20 ++++ gcc/ada/einfo.adb | 11 ++- gcc/ada/exp_imgv.adb | 184 ++++++++++++++++++++++++++++++++++- gcc/ada/libgnarl/s-taprop__linux.adb | 14 ++- gcc/ada/sem_util.adb | 24 ----- 5 files changed, 214 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 371d50e..e309185 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-09-25 Doug Rupp + + * libgnarl/s-taprop__linux.adb (Compute_Base_Monotonic_Clock): Refine. + +2017-09-25 Javier Miranda + + * 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 + + * 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 * 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 --- 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 --- 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 --- 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 --- 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)); -- 2.7.4