aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-09-25 08:52:51 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-09-25 08:52:51 +0000
commit49742f9981bcb0c58c668b0ccc047a14d7865d59 (patch)
treee3811b8ab201c8f7bf6d12f899c3d7b960f13665
parent7b6078223126fb3927b8199d9048e4f0cccc17e9 (diff)
downloadgcc-49742f9981bcb0c58c668b0ccc047a14d7865d59.zip
gcc-49742f9981bcb0c58c668b0ccc047a14d7865d59.tar.gz
gcc-49742f9981bcb0c58c668b0ccc047a14d7865d59.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog20
-rw-r--r--gcc/ada/einfo.adb11
-rw-r--r--gcc/ada/exp_imgv.adb184
-rw-r--r--gcc/ada/libgnarl/s-taprop__linux.adb14
-rw-r--r--gcc/ada/sem_util.adb24
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 <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
--- 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));