diff options
Diffstat (limited to 'gcc/ada/exp_ch4.adb')
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 84 |
1 files changed, 83 insertions, 1 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ccd990eeb6a..6586e619288 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -657,6 +657,11 @@ package body Exp_Ch4 is Make_Allocator (Loc, New_Reference_To (Etype (Exp), Loc))); + -- Copy the Comes_From_Source flag for the allocator we just + -- built, since logically this allocator is a replacement of + -- the original allocator node. This is for proper handling of + -- restriction No_Implicit_Heap_Allocations. + Set_Comes_From_Source (Expression (Tmp_Node), Comes_From_Source (N)); @@ -672,6 +677,7 @@ package body Exp_Ch4 is end if; Convert_Aggr_In_Allocator (N, Tmp_Node, Exp); + else Node := Relocate_Node (N); Set_Analyzed (Node); @@ -727,6 +733,11 @@ package body Exp_Ch4 is Make_Allocator (Loc, New_Reference_To (Etype (Exp), Loc))); + -- Copy the Comes_From_Source flag for the allocator we just + -- built, since logically this allocator is a replacement of + -- the original allocator node. This is for proper handling + -- of restriction No_Implicit_Heap_Allocations. + Set_Comes_From_Source (Expression (Tmp_Node), Comes_From_Source (N)); @@ -929,6 +940,11 @@ package body Exp_Ch4 is Expression => Make_Allocator (Loc, New_Reference_To (Etype (Exp), Loc))); + -- Copy the Comes_From_Source flag for the allocator we just built, + -- since logically this allocator is a replacement of the original + -- allocator node. This is for proper handling of restriction + -- No_Implicit_Heap_Allocations. + Set_Comes_From_Source (Expression (Tmp_Node), Comes_From_Source (N)); @@ -4185,7 +4201,7 @@ package body Exp_Ch4 is Make_Integer_Literal (Loc, Dim))); end Construct_Attribute_Reference; - -- Start processing for Check_Subscripts + -- Start of processing for Check_Subscripts begin for J in 1 .. Number_Dimensions (Typ) loop @@ -7920,6 +7936,72 @@ package body Exp_Ch4 is or else (Is_Fixed_Point_Type (Target_Type) and then Conversion_OK (N))) then + -- Handle case in which type conversions from real types to integers + -- are truncated instead of rounded. For example, in the .NET target + -- the only instructions available for conversion from float types to + -- integers truncate the result. That is, the result of Integer (3.9) + -- is 3 instead of 4. The frontend expansion done here to handle also + -- negative values is the following composition of conditional + -- expressions: + + -- (if Abs (Operand - Float(Integer(Operand))) >= 0.5 then + -- (if Operand >= 0.0 then + -- Integer(Operand) + 1 + -- else + -- Integer(Operand) - 1) + -- else + -- Integer(Operand)) + + if Integer_Truncation_On_Target and then Comes_From_Source (N) then + declare + Conv_Node : Node_Id; + + begin + -- This code is weird, why are we doing all these copy tree + -- operations, instead of just capturing Integer(Operand) + -- once and then reusing the value instead of forcing this + -- conversion to be done four times! ??? + + -- There should be no New_Copy_Tree operations in the below + -- code at all??? + + Conv_Node := New_Copy_Tree (N); + Set_Parent (Conv_Node, Parent (N)); + Set_Comes_From_Source (Conv_Node, False); + Analyze_And_Resolve (Conv_Node, Target_Type); + + Rewrite (N, + Make_Conditional_Expression (Loc, + Expressions => New_List ( + Make_Op_Ge (Loc, + Left_Opnd => + Make_Op_Abs (Loc, + Make_Op_Subtract (Loc, + New_Copy_Tree (Operand), + Make_Type_Conversion (Loc, + New_Reference_To (Etype (Operand), Loc), + New_Copy_Tree (Conv_Node)))), + Right_Opnd => Make_Real_Literal (Loc, Ureal_Half)), + + Make_Conditional_Expression (Loc, + Expressions => New_List ( + Make_Op_Ge (Loc, + Left_Opnd => New_Copy_Tree (Operand), + Right_Opnd => Make_Real_Literal (Loc, Ureal_0)), + Make_Op_Add (Loc, + New_Copy_Tree (Conv_Node), + Make_Integer_Literal (Loc, 1)), + Make_Op_Subtract (Loc, + New_Copy_Tree (Conv_Node), + Make_Integer_Literal (Loc, 1)))), + + New_Copy_Tree (Conv_Node)))); + + Analyze_And_Resolve (N, Target_Type); + return; + end; + end if; + -- One more check here, gcc is still not able to do conversions of -- this type with proper overflow checking, and so gigi is doing an -- approximation of what is required by doing floating-point compares |
