+2010-08-05 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch4.adb: Minor reformatting
+ * gnat1drv.adb: Minor reformatting.
+ Minor code reorganization (use Nkind_In).
+
+2010-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.ads, exp_util.adb (Needs_Constant_Address): New predicate to
+ determine whether the expression in an address clause for an
+ initialized object must be constant. Code moved from freeze.adb.
+ (Remove_Side_Effects): When the temporary is initialized with a
+ reference, indicate that the temporary is a constant as done in all
+ other cases.
+ * freeze.adb (Check_Address_Clause): use Needs_Constant_Address.
+ * exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case 'Address):
+ If object does not need a constant address, remove side effects from
+ address expression, so it is elaborated at the point of the address
+ clause and not at the freeze point of the object, so that elaboration
+ order is respected.
+
+2010-08-05 Vincent Celier <celier@adacore.com>
+
+ * prj.adb (Is_Compilable): Return False for header files of non Ada
+ languages.
+
+2010-08-05 Emmanuel Briot <briot@adacore.com>
+
+ * prj-nmsc.adb: The Missing_Source_Files flag also considers a missing
+ exec directory as a warning rather than an error.
+
2010-08-05 Thomas Quinot <quinot@adacore.com>
* sem_ch6.adb, gnat1drv.adb, exp_ch6.adb, sem_eval.adb: Minor
else
Set_Expression (Decl, Empty);
end if;
+
+ -- An object declaration to which an address clause applies
+ -- has a delayed freeze, but the address expression itself
+ -- must be elaborated at the point it appears. If the object
+ -- is controlled, additional checks apply elsewhere.
+
+ elsif Nkind (Decl) = N_Object_Declaration
+ and then not Needs_Constant_Address (Decl, Typ)
+ then
+ Remove_Side_Effects (Exp);
end if;
end;
Rtyp := Typ;
end if;
- -- The proper unsigned type must have a size compatible with
- -- the operand, to prevent misalignment..
+ -- The proper unsigned type must have a size compatible with the
+ -- operand, to prevent misalignment.
if RM_Size (Rtyp) <= 8 then
Utyp := RTE (RE_Unsigned_8);
begin
if Safe_In_Place_Array_Op (Lhs, Op1, Op2) then
- if N = Op1
- and then Nkind (Op2) = N_Op_Not
- then
+ if N = Op1 and then Nkind (Op2) = N_Op_Not then
-- (not A) op (not B) can be reduced to a single call
return;
- elsif N = Op2
- and then Nkind (Parent (N)) = N_Op_Xor
- then
+ elsif N = Op2 and then Nkind (Parent (N)) = N_Op_Xor then
-- A xor (not B) can also be special-cased
return;
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Make_Loop_Parameter_Specification (Loc,
- Defining_Identifier => J,
+ Defining_Identifier => J,
Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc,
- Prefix => Make_Identifier (Loc, Chars (A)),
+ Prefix => Make_Identifier (Loc, Chars (A)),
Attribute_Name => Name_Range))),
Statements => New_List (
Statements => New_List (
Loop_Statement,
Make_Simple_Return_Statement (Loc,
- Expression =>
- Make_Identifier (Loc, Chars (B)))))));
+ Expression => Make_Identifier (Loc, Chars (B)))))));
Rewrite (N,
Make_Function_Call (Loc,
- Name => New_Reference_To (Func_Name, Loc),
+ Name => New_Reference_To (Func_Name, Loc),
Parameter_Associations => New_List (Opnd)));
Analyze_And_Resolve (N, Typ);
elsif Is_Boolean_Type (Etype (N)) then
- -- Replace OR by OR ELSE if Short_Circuit_And_Or active and the
- -- type is standard Boolean (do not mess with AND that uses a non-
- -- standard Boolean type, because something strange is going on).
+ -- Replace OR by OR ELSE if Short_Circuit_And_Or active and the type
+ -- is standard Boolean (do not mess with AND that uses a non-standard
+ -- Boolean type, because something strange is going on).
if Short_Circuit_And_Or and then Typ = Standard_Boolean then
Rewrite (N,
Make_Conditional_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
- Left_Opnd => Duplicate_Subexpr (Right),
+ Left_Opnd => Duplicate_Subexpr (Right),
Right_Opnd =>
- Unchecked_Convert_To (Typ,
- Make_Integer_Literal (Loc, -1))),
+ Unchecked_Convert_To (Typ, Make_Integer_Literal (Loc, -1))),
Unchecked_Convert_To (Typ,
Make_Integer_Literal (Loc, Uint_0)),
-- Arithmetic overflow checks for signed integer/fixed point types
- if Is_Signed_Integer_Type (Typ)
- or else Is_Fixed_Point_Type (Typ)
- then
+ if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
Apply_Arithmetic_Overflow_Check (N);
- -- Vax floating-point types case
+ -- VAX floating-point types case
elsif Vax_Float (Typ) then
Expand_Vax_Arith (N);
null;
-- Don't do this on the left hand of an assignment statement.
- -- Normally one would think that references like this would
- -- not occur, but they do in generated code, and mean that
- -- we really do want to assign the discriminant!
+ -- Normally one would think that references like this would not
+ -- occur, but they do in generated code, and mean that we really
+ -- do want to assign the discriminant!
elsif Nkind (Par) = N_Assignment_Statement
and then Name (Par) = N
end if;
end May_Generate_Large_Temp;
+ ----------------------------
+ -- Needs_Constant_Address --
+ ----------------------------
+
+ function Needs_Constant_Address
+ (Decl : Node_Id;
+ Typ : Entity_Id) return Boolean
+ is
+ begin
+
+ -- If we have no initialization of any kind, then we don't need to
+ -- place any restrictions on the address clause, because the object
+ -- will be elaborated after the address clause is evaluated. This
+ -- happens if the declaration has no initial expression, or the type
+ -- has no implicit initialization, or the object is imported.
+
+ -- The same holds for all initialized scalar types and all access
+ -- types. Packed bit arrays of size up to 64 are represented using a
+ -- modular type with an initialization (to zero) and can be processed
+ -- like other initialized scalar types.
+
+ -- If the type is controlled, code to attach the object to a
+ -- finalization chain is generated at the point of declaration,
+ -- and therefore the elaboration of the object cannot be delayed:
+ -- the address expression must be a constant.
+
+ if No (Expression (Decl))
+ and then not Needs_Finalization (Typ)
+ and then
+ (not Has_Non_Null_Base_Init_Proc (Typ)
+ or else Is_Imported (Defining_Identifier (Decl)))
+ then
+ return False;
+
+ elsif (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
+ or else Is_Access_Type (Typ)
+ or else
+ (Is_Bit_Packed_Array (Typ)
+ and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
+ then
+ return False;
+
+ else
+
+ -- Otherwise, we require the address clause to be constant because
+ -- the call to the initialization procedure (or the attach code) has
+ -- to happen at the point of the declaration.
+
+ -- Actually the IP call has been moved to the freeze actions
+ -- anyway, so maybe we can relax this restriction???
+
+ return True;
+ end if;
+ end Needs_Constant_Address;
+
----------------------------
-- New_Class_Wide_Subtype --
----------------------------
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc),
+ Constant_Present => True,
Expression => New_Exp));
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- caller has to check whether stack checking is actually enabled in order
-- to guide the expansion (typically of a function call).
+ function Needs_Constant_Address
+ (Decl : Node_Id;
+ Typ : Entity_Id) return Boolean;
+ -- Check whether the expression in an address clause is restricted to
+ -- consist of constants, when the object has a non-trivial initialization
+ -- or is controlled.
+
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;
-- An anonymous access type may designate a limited view. Check whether
-- non-limited view is available during expansion, to examine components
if Present (Addr) then
Expr := Expression (Addr);
- -- If we have no initialization of any kind, then we don't need to
- -- place any restrictions on the address clause, because the object
- -- will be elaborated after the address clause is evaluated. This
- -- happens if the declaration has no initial expression, or the type
- -- has no implicit initialization, or the object is imported.
-
- -- The same holds for all initialized scalar types and all access
- -- types. Packed bit arrays of size up to 64 are represented using a
- -- modular type with an initialization (to zero) and can be processed
- -- like other initialized scalar types.
-
- -- If the type is controlled, code to attach the object to a
- -- finalization chain is generated at the point of declaration,
- -- and therefore the elaboration of the object cannot be delayed:
- -- the address expression must be a constant.
-
- if (No (Expression (Decl))
- and then not Needs_Finalization (Typ)
- and then (not Has_Non_Null_Base_Init_Proc (Typ)
- or else Is_Imported (E)))
- or else (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
- or else Is_Access_Type (Typ)
- or else
- (Is_Bit_Packed_Array (Typ)
- and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
- then
- null;
-
- -- Otherwise, we require the address clause to be constant because
- -- the call to the initialization procedure (or the attach code) has
- -- to happen at the point of the declaration.
-
- -- Actually the IP call has been moved to the freeze actions
- -- anyway, so maybe we can relax this restriction???
-
- else
+ if Needs_Constant_Address (Decl, Typ) then
Check_Constant_Address_Clause (Expr, E);
-- Has_Delayed_Freeze was set on E when the address clause was
Front_End_Inlining := False;
end if;
- -- Tune settings for optimal SCIL generation in CodePeer_Mode
+ -- Tune settings for optimal SCIL generation in CodePeer mode
if CodePeer_Mode then
-- Enable some restrictions systematically to simplify the generated
-- code (and ease analysis). Note that restriction checks are also
- -- disabled in CodePeer_Mode, see Restrict.Check_Restriction
+ -- disabled in CodePeer mode, see Restrict.Check_Restriction
- Restrict.Restrictions.Set (No_Task_Hierarchy) := True;
- Restrict.Restrictions.Set (No_Abort_Statements) := True;
- Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
+ Restrict.Restrictions.Set (No_Task_Hierarchy) := True;
+ Restrict.Restrictions.Set (No_Abort_Statements) := True;
+ Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0;
-- Suppress overflow, division by zero and access checks since they
Debug_Generated_Code := False;
- -- Turn cross-referencing on in case it was disabled (by e.g. -gnatD)
+ -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
-- Do we really need to spend time generating xref in CodePeer
-- mode??? Consider setting Xref_Active to False.
Polling_Required := False;
- -- Set operating mode to Generate_Code to benefit from full
- -- front-end expansion (e.g. generics).
+ -- Set operating mode to Generate_Code to benefit from full front-end
+ -- expansion (e.g. generics).
Operating_Mode := Generate_Code;
-- Enable assertions and debug pragmas, since they give CodePeer
-- valuable extra information.
- Assertions_Enabled := True;
- Debug_Pragmas_Enabled := True;
+ Assertions_Enabled := True;
+ Debug_Pragmas_Enabled := True;
-- Suppress compiler warnings, since what we are interested in here
-- is what CodePeer can find out. Also disable all simple value
end if;
end if;
- -- Set proper status for overflow checks. We turn on overflow checks
- -- if -gnatp was not specified, and either -gnato is set or the back
- -- end takes care of overflow checks. Otherwise we suppress overflow
- -- checks by default (since front end checks are expensive).
+ -- Set proper status for overflow checks. We turn on overflow checks if
+ -- -gnatp was not specified, and either -gnato is set or the back-end
+ -- takes care of overflow checks. Otherwise we suppress overflow checks
+ -- by default (since front end checks are expensive).
if not Opt.Suppress_Checks
and then (Opt.Enable_Overflow_Checks
Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);
end Bad_Body_Error;
- -- Start of processing for Check_Bad_Body
+ -- Start of processing for Check_Bad_Body
begin
-- Nothing to do if we are only checking syntax, because we don't know
Sname := Unit_Name (Main_Unit);
-- If we do not already have a body name, then get the body name
- -- (but how can we have a body name here ???)
+ -- (but how can we have a body name here???)
if not Is_Body_Name (Sname) then
Sname := Get_Body_Name (Sname);
Write_Str ("GNAT ");
Write_Str (Gnat_Version_String);
Write_Eol;
- Write_Str ("Copyright 1992-" &
- Current_Year &
- ", Free Software Foundation, Inc.");
+ Write_Str ("Copyright 1992-" & Current_Year
+ & ", Free Software Foundation, Inc.");
Write_Eol;
end if;
Set_Generate_Code (Main_Unit);
- -- If we have a corresponding spec, and it comes from source
- -- or it is not a generated spec for a child subprogram body,
- -- then we need object code for the spec unit as well.
+ -- If we have a corresponding spec, and it comes from source or it is
+ -- not a generated spec for a child subprogram body, then we need object
+ -- code for the spec unit as well.
if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
and then not Acts_As_Spec (Main_Unit_Node)
Back_End_Mode := Declarations_Only;
-- All remaining cases are cases in which the user requested that code
- -- be generated (i.e. no -gnatc or -gnats switch was used). Check if
- -- we can in fact satisfy this request.
+ -- be generated (i.e. no -gnatc or -gnats switch was used). Check if we
+ -- can in fact satisfy this request.
-- Cannot generate code if someone has turned off code generation for
-- any reason at all. We will try to figure out a reason below.
-- We can generate code for a package declaration or a subprogram
-- declaration only if it does not required a body.
- elsif (Main_Kind = N_Package_Declaration
- or else
- Main_Kind = N_Subprogram_Declaration)
+ elsif Nkind_In (Main_Kind,
+ N_Package_Declaration,
+ N_Subprogram_Declaration)
and then
(not Body_Required (Main_Unit_Node)
or else
-- We can generate code for a generic package declaration of a generic
-- subprogram declaration only if does not require a body.
- elsif (Main_Kind = N_Generic_Package_Declaration
- or else
- Main_Kind = N_Generic_Subprogram_Declaration)
+ elsif Nkind_In (Main_Kind,
+ N_Generic_Package_Declaration,
+ N_Generic_Subprogram_Declaration)
and then not Body_Required (Main_Unit_Node)
then
Back_End_Mode := Generate_Object;
- -- Compilation units that are renamings do not require bodies,
- -- so we can generate code for them.
+ -- Compilation units that are renamings do not require bodies, so we can
+ -- generate code for them.
- elsif Main_Kind = N_Package_Renaming_Declaration
- or else Main_Kind = N_Subprogram_Renaming_Declaration
+ elsif Nkind_In (Main_Kind,
+ N_Package_Renaming_Declaration,
+ N_Subprogram_Renaming_Declaration)
then
Back_End_Mode := Generate_Object;
if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
- Error_Msg
- (Data.Flags,
- "exec directory { not found",
- Project.Location, Project);
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Missing_Source_Files,
+ "exec directory { not found", Project.Location, Project);
end if;
end if;
end if;
begin
return Source.Language.Config.Compiler_Driver /= No_File
and then Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
- and then not Source.Locally_Removed;
+ and then not Source.Locally_Removed
+ and then (Source.Language.Config.Kind /= File_Based
+ or else
+ Source.Kind /= Spec);
end Is_Compilable;
------------------------------
projects / thirdparty / gcc.git / commitdiff
