+2015-10-20 Bob Duff <duff@adacore.com>
+
+ * s-mudido-affinity.adb (Create): Correct subranges of slices of CPU
+ arrays.
+
+2015-10-20 Arnaud Charlet <charlet@adacore.com>
+
+ * sinfo.ads, g-pehage.adb, par-ch12.adb,
+ layout.adb, exp_util.adb, sem_aux.adb, make.adb, checks.adb,
+ sem_ch12.adb, sem_res.adb, sem_attr.adb, a-ngelfu.adb, sem_ch4.adb,
+ switch-b.adb, sem_ch6.adb, prj-dect.adb, gnatxref.adb, sem_ch13.adb,
+ lib-xref.adb: Fix typos.
+
+2015-10-20 Tristan Gingold <gingold@adacore.com>
+
+ * exp_ch4.adb (Expand_Array_Comparison): Use
+ generic code if runtime routine is not available.
+
2015-10-20 Yannick Moy <moy@adacore.com>
* a-sytaco.ads (Ada.Synchronous_Task_Control): Package
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
elsif X < 1.0 + Sqrt_Epsilon then
return Sqrt (2.0 * (X - 1.0));
- elsif X > 1.0 / Sqrt_Epsilon then
+ elsif X > 1.0 / Sqrt_Epsilon then
return Log (X) + Log_Two;
else
if Y < Sqrt_Epsilon then
return 1.0;
- elsif Y > Log_Inverse_Epsilon then
+ elsif Y > Log_Inverse_Epsilon then
Z := Exp_Strict (Y - Lnv);
return (Z + V2minus1 * Z);
if Y < Sqrt_Epsilon then
return X;
- elsif Y > Log_Inverse_Epsilon then
+ elsif Y > Log_Inverse_Epsilon then
Z := Exp_Strict (Y - Lnv);
Z := Z + V2minus1 * Z;
(Compile_Time_Constraint_Error
(Wnode, "too few elements for}??", T_Typ));
- elsif L_Length < R_Length then
+ elsif L_Length < R_Length then
Add_Check
(Compile_Time_Constraint_Error
(Wnode, "too many elements for}??", T_Typ));
end if;
end if;
- Remove_Side_Effects (Op1, Name_Req => True);
- Remove_Side_Effects (Op2, Name_Req => True);
+ if RTE_Available (Comp) then
- Rewrite (Op1,
- Make_Function_Call (Sloc (Op1),
- Name => New_Occurrence_Of (RTE (Comp), Loc),
+ -- Expand to a call only if the runtime function is available,
+ -- otherwise fallback to inline code.
- Parameter_Associations => New_List (
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Op1),
- Attribute_Name => Name_Address),
+ Remove_Side_Effects (Op1, Name_Req => True);
+ Remove_Side_Effects (Op2, Name_Req => True);
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Op2),
- Attribute_Name => Name_Address),
+ Rewrite (Op1,
+ Make_Function_Call (Sloc (Op1),
+ Name => New_Occurrence_Of (RTE (Comp), Loc),
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Op1),
- Attribute_Name => Name_Length),
+ Parameter_Associations => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => Relocate_Node (Op1),
+ Attribute_Name => Name_Address),
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Op2),
- Attribute_Name => Name_Length))));
+ Make_Attribute_Reference (Loc,
+ Prefix => Relocate_Node (Op2),
+ Attribute_Name => Name_Address),
- Rewrite (Op2,
- Make_Integer_Literal (Sloc (Op2),
- Intval => Uint_0));
+ Make_Attribute_Reference (Loc,
+ Prefix => Relocate_Node (Op1),
+ Attribute_Name => Name_Length),
- Analyze_And_Resolve (Op1, Standard_Integer);
- Analyze_And_Resolve (Op2, Standard_Integer);
- return;
+ Make_Attribute_Reference (Loc,
+ Prefix => Relocate_Node (Op2),
+ Attribute_Name => Name_Length))));
+
+ Rewrite (Op2,
+ Make_Integer_Literal (Sloc (Op2),
+ Intval => Uint_0));
+
+ Analyze_And_Resolve (Op1, Standard_Integer);
+ Analyze_And_Resolve (Op2, Standard_Integer);
+ return;
+ end if;
end if;
-- Cases where we cannot make runtime call
Insert_Action (N, Func_Body);
Rewrite (N, Expr);
Analyze_And_Resolve (N, Standard_Boolean);
-
- exception
- when RE_Not_Available =>
- return;
end Expand_Array_Comparison;
---------------------------
when
N_Raise_xxx_Error =>
if Etype (P) = Standard_Void_Type then
- if P = Wrapped_Node then
+ if P = Wrapped_Node then
Store_Before_Actions_In_Scope (Ins_Actions);
else
Insert_List_Before_And_Analyze (P, Ins_Actions);
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2011, AdaCore --
+-- Copyright (C) 2002-2015, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
when Function_Table_1 =>
return Get_Table (T1, J, K);
- when Function_Table_2 =>
+ when Function_Table_2 =>
return Get_Table (T2, J, K);
when Graph_Table =>
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
elsif Src_Path_Name = null
and then Lib_Path_Name = null
then
- Osint.Fail ("RTS path not valid: missing " &
- "adainclude and adalib directories");
+ Osint.Fail
+ ("RTS path not valid: missing adainclude and "
+ & "adalib directories");
elsif Src_Path_Name = null then
- Osint.Fail ("RTS path not valid: missing " &
- "adainclude directory");
+ Osint.Fail
+ ("RTS path not valid: missing adainclude directory");
- elsif Lib_Path_Name = null then
- Osint.Fail ("RTS path not valid: missing " &
- "adalib directory");
+ elsif Lib_Path_Name = null then
+ Osint.Fail
+ ("RTS path not valid: missing adalib directory");
end if;
end;
Osint.Fail ("--ext cannot be specified multiple times");
end if;
- if EXT_Specified'Length
- = Osint.ALI_Default_Suffix'Length
+ if EXT_Specified'Length = Osint.ALI_Default_Suffix'Length
then
Osint.ALI_Suffix := EXT_Specified.all'Access;
else
-- type is the partial or full view, so that types will always
-- match on calls from one size function to another.
- if Has_Private_Declaration (Vtype) then
+ if Has_Private_Declaration (Vtype) then
Vtype_Primary_View := Etype (Vtype);
else
Vtype_Primary_View := Vtype;
-- Write out information about generic parent, if entity
-- is an instance.
- if Is_Generic_Instance (XE.Key.Ent) then
+ if Is_Generic_Instance (XE.Key.Ent) then
declare
Gen_Par : constant Entity_Id :=
Generic_Parent
elsif Src_Path_Name = null
and then Lib_Path_Name = null
then
- Make_Failed ("RTS path not valid: missing "
- & "adainclude and adalib directories");
+ Make_Failed
+ ("RTS path not valid: missing adainclude and adalib "
+ & "directories");
elsif Src_Path_Name = null then
- Make_Failed ("RTS path not valid: missing adainclude "
- & "directory");
+ Make_Failed
+ ("RTS path not valid: missing adainclude directory");
- elsif Lib_Path_Name = null then
- Make_Failed ("RTS path not valid: missing adalib "
- & "directory");
+ elsif Lib_Path_Name = null then
+ Make_Failed
+ ("RTS path not valid: missing adalib directory");
end if;
end;
end if;
- elsif Argv'Length > Source_Info_Option'Length and then
- Argv (1 .. Source_Info_Option'Length) = Source_Info_Option
+ elsif Argv'Length > Source_Info_Option'Length
+ and then Argv (1 .. Source_Info_Option'Length) = Source_Info_Option
then
Project_Tree.Source_Info_File_Name :=
new String'(Argv (Source_Info_Option'Length + 1 .. Argv'Last));
- elsif Argv'Length >= 8 and then
- Argv (1 .. 8) = "--param="
- then
+ elsif Argv'Length >= 8 and then Argv (1 .. 8) = "--param=" then
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Linker, And_Save => And_Save);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return Error;
end if;
- when Tok_Private =>
+ when Tok_Private =>
return P_Formal_Private_Type_Definition;
- when Tok_Tagged =>
+ when Tok_Tagged =>
if Next_Token_Is (Tok_Semicolon) then
Typedef_Node :=
New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr);
and then Variable_Kind_Of (Current_Attribute) /=
Expression_Kind_Of (Expression, In_Tree)
then
- if Variable_Kind_Of (Current_Attribute) = Undefined then
+ if Variable_Kind_Of (Current_Attribute) = Undefined then
Set_Variable_Kind_Of
(Current_Attribute,
To => Expression_Kind_Of (Expression, In_Tree));
-- --
-- B o d y --
-- --
--- Copyright (C) 2011-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end Create;
function Create (Set : CPU_Set) return Dispatching_Domain is
- ST_DD : aliased constant ST.Dispatching_Domain
- := ST.Dispatching_Domain (Set);
- subtype Rng is CPU_Range range
- Get_First_CPU (ST_DD'Unrestricted_Access) ..
- Get_Last_CPU (ST_DD'Unrestricted_Access);
+ ST_DD : aliased constant ST.Dispatching_Domain :=
+ ST.Dispatching_Domain (Set);
+ First : constant CPU := Get_First_CPU (ST_DD'Unrestricted_Access);
+ Last : constant CPU_Range := Get_Last_CPU (ST_DD'Unrestricted_Access);
+ subtype Rng is CPU_Range range First .. Last;
use type ST.Dispatching_Domain;
use type ST.Dispatching_Domain_Access;
New_System_Domain : ST.Dispatching_Domain := ST.System_Domain.all;
- New_Domain : Dispatching_Domain;
+ ST_DD_Slice : constant ST.Dispatching_Domain := ST_DD (Rng);
begin
-- The set of processors for creating a dispatching domain must
if Rng'Last > Number_Of_CPUs then
raise Dispatching_Domain_Error with
"CPU not supported by the target";
+ end if;
- elsif (ST_DD and not ST.System_Domain (Rng)) /= (Rng => False) then
- raise Dispatching_Domain_Error with
- "CPU not currently in System_Dispatching_Domain";
+ declare
+ System_Domain_Slice : constant ST.Dispatching_Domain :=
+ ST.System_Domain (Rng);
+ Actual : constant ST.Dispatching_Domain :=
+ ST_DD_Slice and not System_Domain_Slice;
+ Expected : constant ST.Dispatching_Domain := (Rng => False);
+ begin
+ if Actual /= Expected then
+ raise Dispatching_Domain_Error with
+ "CPU not currently in System_Dispatching_Domain";
+ end if;
+ end;
- elsif Self /= Environment_Task then
+ if Self /= Environment_Task then
raise Dispatching_Domain_Error with
"only the environment task can create dispatching domains";
+ end if;
- elsif ST.Dispatching_Domains_Frozen then
+ if ST.Dispatching_Domains_Frozen then
raise Dispatching_Domain_Error with
"cannot create dispatching domain after call to main procedure";
end if;
end if;
end loop;
- New_System_Domain (Rng) := New_System_Domain (Rng) and not ST_DD;
+ New_System_Domain (Rng) := New_System_Domain (Rng) and not ST_DD_Slice;
if New_System_Domain = (New_System_Domain'Range => False) then
raise Dispatching_Domain_Error with
"would leave System_Dispatching_Domain empty";
end if;
- New_Domain := new ST.Dispatching_Domain'(ST_DD);
-
- -- At this point we need to fix the processors belonging to the system
- -- domain, and change the affinity of every task that has been created
- -- and assigned to the system domain.
-
- ST.Initialization.Defer_Abort (Self);
+ return Result : constant Dispatching_Domain :=
+ new ST.Dispatching_Domain'(ST_DD_Slice)
+ do
+ -- At this point we need to fix the processors belonging to the
+ -- system domain, and change the affinity of every task that has
+ -- been created and assigned to the system domain.
- Lock_RTS;
+ ST.Initialization.Defer_Abort (Self);
- ST.System_Domain (Rng) := New_System_Domain (Rng);
- pragma Assert (ST.System_Domain.all = New_System_Domain);
+ Lock_RTS;
- -- Iterate the list of tasks belonging to the default system
- -- dispatching domain and set the appropriate affinity.
+ ST.System_Domain (Rng) := New_System_Domain (Rng);
+ pragma Assert (ST.System_Domain.all = New_System_Domain);
- T := ST.All_Tasks_List;
+ -- Iterate the list of tasks belonging to the default system
+ -- dispatching domain and set the appropriate affinity.
- while T /= null loop
- if T.Common.Domain = ST.System_Domain then
- Set_Task_Affinity (T);
- end if;
+ T := ST.All_Tasks_List;
- T := T.Common.All_Tasks_Link;
- end loop;
+ while T /= null loop
+ if T.Common.Domain = ST.System_Domain then
+ Set_Task_Affinity (T);
+ end if;
- Unlock_RTS;
+ T := T.Common.All_Tasks_Link;
+ end loop;
- ST.Initialization.Undefer_Abort (Self);
+ Unlock_RTS;
- return New_Domain;
+ ST.Initialization.Undefer_Abort (Self);
+ end return;
end Create;
-----------------------------
("expression for dimension must be static!", E1);
Error_Attr;
- elsif UI_To_Int (Expr_Value (E1)) > D
+ elsif UI_To_Int (Expr_Value (E1)) > D
or else UI_To_Int (Expr_Value (E1)) < 1
then
Error_Attr ("invalid dimension number for array type", E1);
if Is_Itype (Ent) then
null;
- elsif Ekind (Ent) = E_Discriminant
+ elsif Ekind (Ent) = E_Discriminant
and then Is_Completely_Hidden (Ent)
then
return True;
return False;
elsif Is_Entity_Name (Constant_Value (Ent)) then
- if Entity (Constant_Value (Ent)) = E1 then
+ if Entity (Constant_Value (Ent)) = E1 then
return True;
else
Ent := Entity (Constant_Value (Ent));
-- the type of the formal match, or one is the class-wide of the
-- other, in the case of a class-wide stream operation.
- if Base_Type (Typ) = Base_Type (Ent)
+ if Base_Type (Typ) = Base_Type (Ent)
or else (Is_Class_Wide_Type (Typ)
and then Typ = Class_Wide_Type (Base_Type (Ent)))
or else (Is_Class_Wide_Type (Ent)
if Is_Class_Wide_Type (T) then
if not Is_Overloaded (Expr) then
- if Base_Type (Etype (Expr)) /= Base_Type (T) then
+ if Base_Type (Etype (Expr)) /= Base_Type (T) then
if Nkind (Expr) = N_Aggregate then
Error_Msg_N ("type of aggregate cannot be class-wide", Expr);
else
-- inside of the subprogram (except if it is the subtype indication
-- of an extended return statement).
- elsif Ekind (R_Type) = E_Anonymous_Access_Subprogram_Type then
+ elsif Ekind (R_Type) = E_Anonymous_Access_Subprogram_Type then
if not Comes_From_Source (Current_Scope)
or else Ekind (Current_Scope) = E_Return_Statement
then
-- operators, which are not declared with the type
-- of the operand, but appear forever in Standard.
- if It.Typ = Universal_Fixed
+ if It.Typ = Universal_Fixed
and then Scope (It.Nam) = Standard_Standard
then
Error_Msg_N
begin
New_Actuals := New_List (Obj);
- if Nkind (Entry_Name) = N_Indexed_Component then
+ if Nkind (Entry_Name) = N_Indexed_Component then
Append_To (New_Actuals,
New_Copy_Tree (First (Expressions (Entry_Name))));
end if;
-- SCIL_Controlling_Tag (Node5-Sem)
--
-- An N_Scil_Dispatching call node may be associated (via Get_SCIL_Node)
- -- with the N_Procedure_Call or N_Function_Call node (or a rewriting
- -- thereof) corresponding to a dispatching call.
+ -- with the N_Procedure_Call_Statement or N_Function_Call node (or a
+ -- rewriting thereof) corresponding to a dispatching call.
-- N_SCIL_Membership_Test
-- Sloc references the node of a membership test
Ptr := Max + 1;
- elsif Src_Path_Name = null
+ elsif Src_Path_Name = null
and then Lib_Path_Name = null
then
- Osint.Fail ("RTS path not valid: missing " &
- "adainclude and adalib directories");
+ Osint.Fail
+ ("RTS path not valid: missing adainclude and "
+ & "adalib directories");
elsif Src_Path_Name = null then
- Osint.Fail ("RTS path not valid: missing " &
- "adainclude directory");
- elsif Lib_Path_Name = null then
- Osint.Fail ("RTS path not valid: missing " &
- "adalib directory");
+ Osint.Fail
+ ("RTS path not valid: missing adainclude directory");
+ elsif Lib_Path_Name = null then
+ Osint.Fail
+ ("RTS path not valid: missing adalib directory");
end if;
end;
end if;
projects / gcc.git / commitdiff