Commit 13b2f7fd by Arnaud Charlet

[multiple changes]

2013-10-17  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb: Synchronize declarations of other/all others.

2013-10-17  Thomas Quinot  <quinot@adacore.com>

	* exp_pakd.adb: Add missing guard protecting Reverse_Storage_Order
	call.
	* sem_res.adb: Minor code cleanup: use named parameter association
	(not positional) for Boolean parameter Sec_Stack in calls to
	Establish_Transient_Scope.

From-SVN: r203746
parent f4bed77b
2013-10-17 Tristan Gingold <gingold@adacore.com>
* a-exexpr-gcc.adb: Synchronize declarations of other/all others.
2013-10-17 Thomas Quinot <quinot@adacore.com>
* exp_pakd.adb: Add missing guard protecting Reverse_Storage_Order
call.
* sem_res.adb: Minor code cleanup: use named parameter association
(not positional) for Boolean parameter Sec_Stack in calls to
Establish_Transient_Scope.
2013-10-15 Thomas Quinot <quinot@adacore.com> 2013-10-15 Thomas Quinot <quinot@adacore.com>
* exp_pakd.adb (Expand_Packed_Element_Set, * exp_pakd.adb (Expand_Packed_Element_Set,
......
...@@ -45,11 +45,10 @@ package body Exception_Propagation is ...@@ -45,11 +45,10 @@ package body Exception_Propagation is
-- Entities to interface with the GCC runtime -- -- Entities to interface with the GCC runtime --
------------------------------------------------ ------------------------------------------------
-- These come from "C++ ABI for Itanium: Exception handling", which is -- These come from "C++ ABI for Itanium: Exception handling", which is the
-- the reference for GCC. -- reference for GCC.
-- Return codes from the GCC runtime functions used to propagate -- Return codes from GCC runtime functions used to propagate an exception
-- an exception.
type Unwind_Reason_Code is type Unwind_Reason_Code is
(URC_NO_REASON, (URC_NO_REASON,
...@@ -226,9 +225,8 @@ package body Exception_Propagation is ...@@ -226,9 +225,8 @@ package body Exception_Propagation is
UW_Argument : System.Address) return Unwind_Reason_Code; UW_Argument : System.Address) return Unwind_Reason_Code;
pragma Import (C, CleanupUnwind_Handler, pragma Import (C, CleanupUnwind_Handler,
"__gnat_cleanupunwind_handler"); "__gnat_cleanupunwind_handler");
-- Hook called at each step of the forced unwinding we perform to -- Hook called at each step of the forced unwinding we perform to trigger
-- trigger cleanups found during the propagation of an unhandled -- cleanups found during the propagation of an unhandled exception.
-- exception.
-- GCC runtime functions used. These are C non-void functions, actually, -- GCC runtime functions used. These are C non-void functions, actually,
-- but we ignore the return values. See raise.c as to why we are using -- but we ignore the return values. See raise.c as to why we are using
...@@ -295,7 +293,9 @@ package body Exception_Propagation is ...@@ -295,7 +293,9 @@ package body Exception_Propagation is
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
-- Currently, these only have their address taken and compared so there is -- Currently, these only have their address taken and compared so there is
-- no real point having whole exception data blocks allocated. -- no real point having whole exception data blocks allocated. Note that
-- there are corresponding declarations in gigi (trans.c) which must be
-- kept properly synchronized.
Others_Value : constant Character := 'O'; Others_Value : constant Character := 'O';
pragma Export (C, Others_Value, "__gnat_others_value"); pragma Export (C, Others_Value, "__gnat_others_value");
...@@ -315,6 +315,7 @@ package body Exception_Propagation is ...@@ -315,6 +315,7 @@ package body Exception_Propagation is
function Allocate_Occurrence return EOA is function Allocate_Occurrence return EOA is
Res : GNAT_GCC_Exception_Access; Res : GNAT_GCC_Exception_Access;
begin begin
Res := Res :=
new GNAT_GCC_Exception' new GNAT_GCC_Exception'
...@@ -432,6 +433,7 @@ package body Exception_Propagation is ...@@ -432,6 +433,7 @@ package body Exception_Propagation is
is is
begin begin
-- Simply propagate it -- Simply propagate it
Propagate_GCC_Exception (GCC_Exception); Propagate_GCC_Exception (GCC_Exception);
end Reraise_GCC_Exception; end Reraise_GCC_Exception;
...@@ -467,9 +469,10 @@ package body Exception_Propagation is ...@@ -467,9 +469,10 @@ package body Exception_Propagation is
-- unwinding hook calls Unhandled_Exception_Terminate when end of -- unwinding hook calls Unhandled_Exception_Terminate when end of
-- stack is reached. -- stack is reached.
Unwind_ForcedUnwind (GCC_Exception, Unwind_ForcedUnwind
CleanupUnwind_Handler'Address, (GCC_Exception,
System.Null_Address); CleanupUnwind_Handler'Address,
System.Null_Address);
-- We get here in case of error. The debugger has been notified before -- We get here in case of error. The debugger has been notified before
-- the second step above. -- the second step above.
...@@ -503,7 +506,7 @@ package body Exception_Propagation is ...@@ -503,7 +506,7 @@ package body Exception_Propagation is
declare declare
GNAT_Occurrence : constant GNAT_GCC_Exception_Access := GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (GCC_Exception); To_GNAT_GCC_Exception (GCC_Exception);
begin begin
Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence); Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
end; end;
......
...@@ -2135,10 +2135,16 @@ package body Exp_Pakd is ...@@ -2135,10 +2135,16 @@ package body Exp_Pakd is
-- Swap back if necessary -- Swap back if necessary
Set_Etype (Arg, Ctyp); Set_Etype (Arg, Ctyp);
if Byte_Swapped and then Reverse_Storage_Order (Ctyp) then
Arg := Byte_Swap (Arg, if Byte_Swapped
Left_Justify => not Bytes_Big_Endian, and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
Right_Justify => False); and then Reverse_Storage_Order (Ctyp)
then
Arg :=
Byte_Swap
(Arg,
Left_Justify => not Bytes_Big_Endian,
Right_Justify => False);
end if; end if;
-- We needed to analyze this before we do the unchecked convert -- We needed to analyze this before we do the unchecked convert
......
...@@ -3602,7 +3602,7 @@ package body Sem_Res is ...@@ -3602,7 +3602,7 @@ package body Sem_Res is
and then Full_Expander_Active and then Full_Expander_Active
and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F))) and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
then then
Establish_Transient_Scope (A, False); Establish_Transient_Scope (A, Sec_Stack => False);
Resolve (A, Etype (F)); Resolve (A, Etype (F));
-- A small optimization: if one of the actuals is a concatenation -- A small optimization: if one of the actuals is a concatenation
...@@ -3621,7 +3621,7 @@ package body Sem_Res is ...@@ -3621,7 +3621,7 @@ package body Sem_Res is
and then Chars (Nam) = Name_Asm) and then Chars (Nam) = Name_Asm)
and then not Static_Concatenation (A) and then not Static_Concatenation (A)
then then
Establish_Transient_Scope (A, False); Establish_Transient_Scope (A, Sec_Stack => False);
Resolve (A, Etype (F)); Resolve (A, Etype (F));
else else
...@@ -3680,7 +3680,7 @@ package body Sem_Res is ...@@ -3680,7 +3680,7 @@ package body Sem_Res is
if (Is_Controlled (DDT) or else Has_Task (DDT)) if (Is_Controlled (DDT) or else Has_Task (DDT))
and then Full_Expander_Active and then Full_Expander_Active
then then
Establish_Transient_Scope (A, False); Establish_Transient_Scope (A, Sec_Stack => False);
end if; end if;
end; end;
......
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