mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-14 11:51:10 +08:00
[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
This commit is contained in:
Pierre-Marie de Rodat
parent
7b60782231
commit
49742f9981
@ -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.
|
||||
|
||||
@ -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;
|
||||
|
||||
---------------------------------
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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));
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user