Commit a39a553e by Arnaud Charlet

[multiple changes]

2012-08-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_mech.adb (Set_Mechanisms): OUT and IN OUT parameters are
	now unconditionally passed by reference. IN parameters subject
	to convention C_Pass_By_Copy are passed by copy, otherwise they
	are passed by reference.

2012-08-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): According to
	AI95-0303, protected objects with interrupt handlers can be
	declared in nested scopes. This is a binding interpretation,
	and thus applies to all versions of the compiler.

2012-08-06  Robert Dewar  <dewar@adacore.com>

	* frontend.adb, exp_aggr.adb: Minor reformatting.

2012-08-06  Thomas Quinot  <quinot@adacore.com>

	* par-endh.adb: Minor reformatting.

From-SVN: r190162
parent 5eeeed5e
2012-08-06 Hristian Kirtchev <kirtchev@adacore.com> 2012-08-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_mech.adb (Set_Mechanisms): OUT and IN OUT parameters are
now unconditionally passed by reference. IN parameters subject
to convention C_Pass_By_Copy are passed by copy, otherwise they
are passed by reference.
2012-08-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): According to
AI95-0303, protected objects with interrupt handlers can be
declared in nested scopes. This is a binding interpretation,
and thus applies to all versions of the compiler.
2012-08-06 Robert Dewar <dewar@adacore.com>
* frontend.adb, exp_aggr.adb: Minor reformatting.
2012-08-06 Thomas Quinot <quinot@adacore.com>
* par-endh.adb: Minor reformatting.
2012-08-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop * exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop
processing related to array initialization. The expansion of processing related to array initialization. The expansion of
loops already contains a mechanism to detect controlled objects loops already contains a mechanism to detect controlled objects
......
...@@ -5981,6 +5981,9 @@ package body Exp_Aggr is ...@@ -5981,6 +5981,9 @@ package body Exp_Aggr is
-- Bounds are within 32-bit Int range -- Bounds are within 32-bit Int range
-- All bounds and values are static -- All bounds and values are static
-- Note: for now, in the 2-D case, we only handle component sizes of
-- 1, 2, 4 (cases where an integral number of elements occupies a byte).
function Packed_Array_Aggregate_Handled (N : Node_Id) return Boolean is function Packed_Array_Aggregate_Handled (N : Node_Id) return Boolean is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
...@@ -6302,7 +6305,8 @@ package body Exp_Aggr is ...@@ -6302,7 +6305,8 @@ package body Exp_Aggr is
return False; return False;
else else
return Expr_Value (L1) /= Expr_Value (L2) return Expr_Value (L1) /= Expr_Value (L2)
or else Expr_Value (H1) /= Expr_Value (H2); or else
Expr_Value (H1) /= Expr_Value (H2);
end if; end if;
end if; end if;
end Must_Slide; end Must_Slide;
...@@ -6386,39 +6390,36 @@ package body Exp_Aggr is ...@@ -6386,39 +6390,36 @@ package body Exp_Aggr is
-- Expression in original aggregate -- Expression in original aggregate
One_Dim : Node_Id; One_Dim : Node_Id;
-- one-dimensional subaggregate -- One-dimensional subaggregate
begin begin
-- For now, only deal with tight packing. The boolean case is the -- For now, only deal with cases where an integral number of elements
-- most common. -- fit in a single byte. This includes the most common boolean case.
if Comp_Size = 1 if not (Comp_Size = 1 or else
or else Comp_Size = 2 Comp_Size = 2 or else
or else Comp_Size = 4 Comp_Size = 4)
then then
null;
else
return False; return False;
end if; end if;
Convert_To_Positional Convert_To_Positional
(N, Max_Others_Replicate => 64, Handle_Bit_Packed => True); (N, Max_Others_Replicate => 64, Handle_Bit_Packed => True);
-- Verify that all components are static. -- Verify that all components are static
if Nkind (N) = N_Aggregate if Nkind (N) = N_Aggregate
and then Compile_Time_Known_Aggregate (N) and then Compile_Time_Known_Aggregate (N)
then then
null; null;
-- The aggregate may have been re-analyzed and converted already. -- The aggregate may have been re-analyzed and converted already
elsif Nkind (N) /= N_Aggregate then elsif Nkind (N) /= N_Aggregate then
return True; return True;
-- If component associations remain, the aggregate is not static. -- If component associations remain, the aggregate is not static
elsif Present (Component_Associations (N)) then elsif Present (Component_Associations (N)) then
return False; return False;
...@@ -6460,17 +6461,17 @@ package body Exp_Aggr is ...@@ -6460,17 +6461,17 @@ package body Exp_Aggr is
Comp_Val : Uint; Comp_Val : Uint;
-- integer value of component -- integer value of component
Incr : Int; Incr : Int;
-- Step size for packing -- Step size for packing
Init_Shift : Int; Init_Shift : Int;
-- endian-dependent start position for packing -- Endian-dependent start position for packing
Shift : Int; Shift : Int;
-- current insertion position -- Current insertion position
Val : Int; Val : Int;
-- component of packed array being assembled. -- Component of packed array being assembled.
begin begin
Comps := New_List; Comps := New_List;
...@@ -6485,10 +6486,10 @@ package body Exp_Aggr is ...@@ -6485,10 +6486,10 @@ package body Exp_Aggr is
xor Reverse_Storage_Order (Base_Type (Typ)) xor Reverse_Storage_Order (Base_Type (Typ))
then then
Init_Shift := Byte_Size - Comp_Size; Init_Shift := Byte_Size - Comp_Size;
Incr := -Comp_Size; Incr := -Comp_Size;
else else
Init_Shift := 0; Init_Shift := 0;
Incr := +Comp_Size; Incr := +Comp_Size;
end if; end if;
Shift := Init_Shift; Shift := Init_Shift;
...@@ -6531,7 +6532,7 @@ package body Exp_Aggr is ...@@ -6531,7 +6532,7 @@ package body Exp_Aggr is
if Packed_Num > 0 then if Packed_Num > 0 then
-- Add final incomplete byte if present. -- Add final incomplete byte if present
Append (Make_Integer_Literal (Sloc (One_Dim), Val), Comps); Append (Make_Integer_Literal (Sloc (One_Dim), Val), Comps);
end if; end if;
...@@ -6540,8 +6541,8 @@ package body Exp_Aggr is ...@@ -6540,8 +6541,8 @@ package body Exp_Aggr is
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
Make_Qualified_Expression (Loc, Make_Qualified_Expression (Loc,
Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc), Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc),
Expression => Expression =>
Make_Aggregate (Loc, Expressions => Comps)))); Make_Aggregate (Loc, Expressions => Comps))));
Analyze_And_Resolve (N); Analyze_And_Resolve (N);
return True; return True;
end; end;
......
...@@ -282,8 +282,13 @@ begin ...@@ -282,8 +282,13 @@ begin
-- a context for their semantic processing. -- a context for their semantic processing.
if Config_Pragmas /= Error_List if Config_Pragmas /= Error_List
and then not Fatal_Error (Main_Unit)
and then Operating_Mode /= Check_Syntax and then Operating_Mode /= Check_Syntax
-- Do not attempt to process deferred configuration pragmas if the main
-- unit failed to load, to avoid cascaded inconsistencies that can lead
-- to a compiler crash.
and then not Fatal_Error (Main_Unit)
then then
-- Pragmas that require some semantic activity, such as -- Pragmas that require some semantic activity, such as
-- Interrupt_State, cannot be processed until the main unit -- Interrupt_State, cannot be processed until the main unit
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -199,7 +199,7 @@ package body Endh is ...@@ -199,7 +199,7 @@ package body Endh is
End_OK := True; End_OK := True;
Scan; -- past END Scan; -- past END
-- Set End_Span if expected. note that this will be useless -- Set End_Span if expected. Note that this will be useless
-- if we do not have the right ending keyword, but in this -- if we do not have the right ending keyword, but in this
-- case we have a malformed program anyway, and the setting -- case we have a malformed program anyway, and the setting
-- of End_Span will simply be unreliable in this case anyway. -- of End_Span will simply be unreliable in this case anyway.
......
...@@ -3078,8 +3078,11 @@ package body Sem_Ch3 is ...@@ -3078,8 +3078,11 @@ package body Sem_Ch3 is
-- in the RM is removed) because accessibility checks are sufficient -- in the RM is removed) because accessibility checks are sufficient
-- to make handlers not at the library level illegal. -- to make handlers not at the library level illegal.
-- AI05-0303: the AI is in fact a binding interpretation, and thus
-- applies to the '95 version of the language as well.
if Has_Interrupt_Handler (T) if Has_Interrupt_Handler (T)
and then Ada_Version < Ada_2005 and then Ada_Version < Ada_95
then then
Error_Msg_N Error_Msg_N
("interrupt object can only be declared at library level", Id); ("interrupt object can only be declared at library level", Id);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1996-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -352,13 +352,13 @@ package body Sem_Mech is ...@@ -352,13 +352,13 @@ package body Sem_Mech is
-- Access parameters (RM B.3(68)) -- Access parameters (RM B.3(68))
-- Access to subprogram types (RM B.3(71)) -- Access to subprogram types (RM B.3(71))
-- Note: in the case of access parameters, it is the -- Note: in the case of access parameters, it is the pointer
-- pointer that is passed by value. In GNAT access -- that is passed by value. In GNAT access parameters are
-- parameters are treated as IN parameters of an -- treated as IN parameters of an anonymous access type, so
-- anonymous access type, so this falls out free. -- this falls out free.
-- The bottom line is that all IN elementary types -- The bottom line is that all IN elementary types are
-- are passed by copy in GNAT. -- passed by copy in GNAT.
if Is_Elementary_Type (Typ) then if Is_Elementary_Type (Typ) then
if Ekind (Formal) = E_In_Parameter then if Ekind (Formal) = E_In_Parameter then
...@@ -385,10 +385,21 @@ package body Sem_Mech is ...@@ -385,10 +385,21 @@ package body Sem_Mech is
if Convention (Typ) /= Convention_C then if Convention (Typ) /= Convention_C then
Set_Mechanism (Formal, By_Reference); Set_Mechanism (Formal, By_Reference);
-- If convention C_Pass_By_Copy was specified for -- OUT and IN OUT parameters of record types are passed
-- the record type, then we pass by copy. -- by reference regardless of pragmas (RM B.3 (69/2)).
elsif C_Pass_By_Copy (Typ) then elsif Ekind_In (Formal, E_Out_Parameter,
E_In_Out_Parameter)
then
Set_Mechanism (Formal, By_Reference);
-- IN parameters of record types are passed by copy only
-- when the related type has convention C_Pass_By_Copy
-- (RM B.3 (68.1/2)).
elsif Ekind (Formal) = E_In_Parameter
and then C_Pass_By_Copy (Typ)
then
Set_Mechanism (Formal, By_Copy); Set_Mechanism (Formal, By_Copy);
-- Otherwise, for a C convention record, we set the -- Otherwise, for a C convention record, we set the
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment