diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-12-05 10:55:42 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-12-05 10:55:42 +0000 |
commit | bd0f1ca54f34d96ad5e32d882fb3c5f2258fb7f8 (patch) | |
tree | 125bcd0e1d28de72c61c9d14eb0e0ef10da3b17c /gcc | |
parent | c6431a40435e7709d115c466b204fe9b26c27f1f (diff) | |
download | gcc-bd0f1ca54f34d96ad5e32d882fb3c5f2258fb7f8.tar.gz |
2012-12-05 Robert Dewar <dewar@adacore.com>
* lib-writ.adb (Write_ALI): Output T lines.
* lib-writ.ads: Minor reformatting. Add documentation of T lines.
* opt.ads (Generate_Target_Dependent_Info): New flag.
* switch-c.adb (Scan_Switches): Recognize -gnatet switch
(target dependent info).
* ttypes.ads: Add four letter codes to declarations (for target
dependent info).
* usage.adb: Add line for -gnatet switch.
2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
* exp_prag.adb (Expand_N_Pragma): Add a call to expand
pragma Loop_Variant.
(Expand_Pragma_Loop_Assertion): Removed.
(Expand_Pragma_Loop_Variant): New routine.
* par-prag.adb: Remove Pragma_Loop_Assertion and add two new
Pragma_Loop_Invariant and Pragma_Loop_Variant entries.
* sem_attr.adb (Analyze_Attribute): Update the code which
locates the enclosing pragma.
* sem_prag.adb (Analyze_Pragma): Remove the code which analyzes
pragma Loop_Assertion as the pragma is now obsolete. Add the
machinery to checks the semantics of pragmas Loop_Invariant
and Loop_Variant.
(Check_Loop_Invariant_Variant_Placement): New routine.
* snames.ads-tmpl: Remove name Loop_Assertion. Add new names
Loop_Invariant and Loop_Variant. Rename Name_Decreasing
to Name_Decreases and Name_Increasing to Name_Increases.
Remove the pragma Id for Loop_Assertion and add two new Ids for
Loop_Invariant and Loop_Variant.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194203 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
-rw-r--r-- | gcc/ada/exp_prag.adb | 153 | ||||
-rw-r--r-- | gcc/ada/lib-writ.adb | 88 | ||||
-rw-r--r-- | gcc/ada/lib-writ.ads | 25 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
-rw-r--r-- | gcc/ada/par-prag.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 192 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 10 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 6 | ||||
-rw-r--r-- | gcc/ada/ttypes.ads | 111 | ||||
-rw-r--r-- | gcc/ada/usage.adb | 5 |
12 files changed, 381 insertions, 259 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1fb42a70c71..6550c58943a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,37 @@ 2012-12-05 Robert Dewar <dewar@adacore.com> + * lib-writ.adb (Write_ALI): Output T lines. + * lib-writ.ads: Minor reformatting. Add documentation of T lines. + * opt.ads (Generate_Target_Dependent_Info): New flag. + * switch-c.adb (Scan_Switches): Recognize -gnatet switch + (target dependent info). + * ttypes.ads: Add four letter codes to declarations (for target + dependent info). + * usage.adb: Add line for -gnatet switch. + +2012-12-05 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_prag.adb (Expand_N_Pragma): Add a call to expand + pragma Loop_Variant. + (Expand_Pragma_Loop_Assertion): Removed. + (Expand_Pragma_Loop_Variant): New routine. + * par-prag.adb: Remove Pragma_Loop_Assertion and add two new + Pragma_Loop_Invariant and Pragma_Loop_Variant entries. + * sem_attr.adb (Analyze_Attribute): Update the code which + locates the enclosing pragma. + * sem_prag.adb (Analyze_Pragma): Remove the code which analyzes + pragma Loop_Assertion as the pragma is now obsolete. Add the + machinery to checks the semantics of pragmas Loop_Invariant + and Loop_Variant. + (Check_Loop_Invariant_Variant_Placement): New routine. + * snames.ads-tmpl: Remove name Loop_Assertion. Add new names + Loop_Invariant and Loop_Variant. Rename Name_Decreasing + to Name_Decreases and Name_Increasing to Name_Increases. + Remove the pragma Id for Loop_Assertion and add two new Ids for + Loop_Invariant and Loop_Variant. + +2012-12-05 Robert Dewar <dewar@adacore.com> + * gnatchop.adb, sem_attr.ads, sem_ch4.adb, sem_ch6.adb, exp_disp.adb, atree.adb, sem_eval.adb: Minor reformatting. diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index c21c21c5c80..94ca24202e0 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -69,7 +69,7 @@ package body Exp_Prag is procedure Expand_Pragma_Import_Export_Exception (N : Node_Id); procedure Expand_Pragma_Inspection_Point (N : Node_Id); procedure Expand_Pragma_Interrupt_Priority (N : Node_Id); - procedure Expand_Pragma_Loop_Assertion (N : Node_Id); + procedure Expand_Pragma_Loop_Variant (N : Node_Id); procedure Expand_Pragma_Psect_Object (N : Node_Id); procedure Expand_Pragma_Relative_Deadline (N : Node_Id); @@ -191,8 +191,8 @@ package body Exp_Prag is when Pragma_Interrupt_Priority => Expand_Pragma_Interrupt_Priority (N); - when Pragma_Loop_Assertion => - Expand_Pragma_Loop_Assertion (N); + when Pragma_Loop_Variant => + Expand_Pragma_Loop_Variant (N); when Pragma_Psect_Object => Expand_Pragma_Psect_Object (N); @@ -795,20 +795,19 @@ package body Exp_Prag is end if; end Expand_Pragma_Interrupt_Priority; - ---------------------------------- - -- Expand_Pragma_Loop_Assertion -- - ---------------------------------- + -------------------------------- + -- Expand_Pragma_Loop_Variant -- + -------------------------------- - -- Pragma Loop_Assertion is expanded in the following manner: + -- Pragma Loop_Variant is expanded in the following manner: -- Original code -- for | while ... loop -- <preceding source statements> - -- pragma Loop_Assertion - -- (Invariant => Invar_Expr, - -- Variant => (Increasing => Incr_Expr, - -- Decreasing => Decr_Expr)); + -- pragma Loop_Variant + -- (Increases => Incr_Expr, + -- Decreases => Decr_Expr); -- <succeeding source statements> -- end loop; @@ -823,8 +822,6 @@ package body Exp_Prag is -- for | while ... loop -- <preceding source statements> - -- pragma Assert (<Invar_Expr>); - -- if Flag then -- Old_1 := Curr_1; -- Old_2 := Curr_2; @@ -846,7 +843,9 @@ package body Exp_Prag is -- <succeeding source statements> -- end loop; - procedure Expand_Pragma_Loop_Assertion (N : Node_Id) is + procedure Expand_Pragma_Loop_Variant (N : Node_Id) is + Last_Var : constant Node_Id := + Last (Pragma_Argument_Associations (N)); Loc : constant Source_Ptr := Sloc (N); Curr_Assign : List_Id := No_List; Flag_Id : Entity_Id := Empty; @@ -854,27 +853,23 @@ package body Exp_Prag is Loop_Scop : Entity_Id; Loop_Stmt : Node_Id; Old_Assign : List_Id := No_List; + Variant : Node_Id; - procedure Process_Increase_Decrease - (Variant : Node_Id; - Is_Last : Boolean); + procedure Process_Variant (Variant : Node_Id; Is_Last : Boolean); -- Process a single increasing / decreasing termination variant. Flag -- Is_Last should be set when processing the last variant. - ------------------------------- - -- Process_Increase_Decrease -- - ------------------------------- + --------------------- + -- Process_Variant -- + --------------------- - procedure Process_Increase_Decrease - (Variant : Node_Id; - Is_Last : Boolean) - is + procedure Process_Variant (Variant : Node_Id; Is_Last : Boolean) is function Make_Op (Loc : Source_Ptr; Curr_Val : Node_Id; Old_Val : Node_Id) return Node_Id; -- Generate a comparison between Curr_Val and Old_Val depending on - -- the argument name (Increases / Decreases). + -- the change mode (Increases / Decreases) of the variant. ------------- -- Make_Op -- @@ -885,12 +880,11 @@ package body Exp_Prag is Curr_Val : Node_Id; Old_Val : Node_Id) return Node_Id is - Modif : constant Node_Id := First (Choices (Variant)); begin - if Chars (Modif) = Name_Increasing then + if Chars (Variant) = Name_Increases then return Make_Op_Gt (Loc, Curr_Val, Old_Val); - else pragma Assert (Chars (Modif) = Name_Decreasing); + else pragma Assert (Chars (Variant) = Name_Decreases); return Make_Op_Lt (Loc, Curr_Val, Old_Val); end if; end Make_Op; @@ -898,13 +892,14 @@ package body Exp_Prag is -- Local variables Expr : constant Node_Id := Expression (Variant); + Expr_Typ : constant Entity_Id := Etype (Expr); Loc : constant Source_Ptr := Sloc (Expr); Loop_Loc : constant Source_Ptr := Sloc (Loop_Stmt); Curr_Id : Entity_Id; Old_Id : Entity_Id; Prag : Node_Id; - -- Start of processing for Process_Increase_Decrease + -- Start of processing for Process_Variant begin -- All temporaries generated in this routine must be inserted before @@ -959,8 +954,7 @@ package body Exp_Prag is Insert_Action (Loop_Stmt, Make_Object_Declaration (Loop_Loc, Defining_Identifier => Curr_Id, - Object_Definition => - New_Reference_To (Etype (Expr), Loop_Loc))); + Object_Definition => New_Reference_To (Expr_Typ, Loop_Loc))); -- Generate: -- Old : <type of Expr>; @@ -970,8 +964,7 @@ package body Exp_Prag is Insert_Action (Loop_Stmt, Make_Object_Declaration (Loop_Loc, Defining_Identifier => Old_Id, - Object_Definition => - New_Reference_To (Etype (Expr), Loop_Loc))); + Object_Definition => New_Reference_To (Expr_Typ, Loop_Loc))); -- Restore original scope after all temporaries have been analyzed @@ -1066,12 +1059,7 @@ package body Exp_Prag is Right_Opnd => New_Reference_To (Old_Id, Loc)), Then_Statements => New_List (Prag))); end if; - end Process_Increase_Decrease; - - -- Local variables - - Arg : Node_Id; - Invar : Node_Id := Empty; + end Process_Variant; -- Start of processing for Expand_Pragma_Loop_Assertion @@ -1093,76 +1081,29 @@ package body Exp_Prag is Loop_Scop := Entity (Identifier (Loop_Stmt)); - -- Process all pragma arguments - - Arg := First (Pragma_Argument_Associations (N)); - while Present (Arg) loop - - -- Termination variants appear as components in an aggregate + -- Create the circuitry which verifies individual variants - if Chars (Arg) = Name_Variant then - declare - Variants : constant Node_Id := Expression (Arg); - Last_Var : constant Node_Id := - Last (Component_Associations (Variants)); - Variant : Node_Id; - - begin - Variant := First (Component_Associations (Variants)); - while Present (Variant) loop - Process_Increase_Decrease - (Variant => Variant, - Is_Last => Variant = Last_Var); - - Next (Variant); - end loop; - end; + Variant := First (Pragma_Argument_Associations (N)); + while Present (Variant) loop + Process_Variant (Variant, Is_Last => Variant = Last_Var); - -- Invariant - - else - Invar := Expression (Arg); - end if; - - Next (Arg); + Next (Variant); end loop; - -- Verify the invariant expression, generate: - -- pragma Assert (<Invar>); - - -- Use the Sloc of the invariant for better error reporting - - if Present (Invar) then - declare - Invar_Loc : constant Source_Ptr := Sloc (Invar); - begin - Insert_Action (N, - Make_Pragma (Invar_Loc, - Chars => Name_Assert, - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Invar_Loc, - Expression => Relocate_Node (Invar))))); - end; - end if; - -- Construct the segment which stores the old values of all expressions. -- Generate: -- if Flag then -- <Old_Assign> -- end if; - if Present (Old_Assign) then - Insert_Action (N, - Make_If_Statement (Loc, - Condition => New_Reference_To (Flag_Id, Loc), - Then_Statements => Old_Assign)); - end if; + Insert_Action (N, + Make_If_Statement (Loc, + Condition => New_Reference_To (Flag_Id, Loc), + Then_Statements => Old_Assign)); -- Update the values of all expressions - if Present (Curr_Assign) then - Insert_Actions (N, Curr_Assign); - end if; + Insert_Actions (N, Curr_Assign); -- Add the assertion circuitry to test all changes in expressions. -- Generate: @@ -1172,22 +1113,20 @@ package body Exp_Prag is -- Flag := True; -- end if; - if Present (If_Stmt) then - Insert_Action (N, - Make_If_Statement (Loc, - Condition => New_Reference_To (Flag_Id, Loc), - Then_Statements => New_List (If_Stmt), - Else_Statements => New_List ( - Make_Assignment_Statement (Loc, - Name => New_Reference_To (Flag_Id, Loc), - Expression => New_Reference_To (Standard_True, Loc))))); - end if; + Insert_Action (N, + Make_If_Statement (Loc, + Condition => New_Reference_To (Flag_Id, Loc), + Then_Statements => New_List (If_Stmt), + Else_Statements => New_List ( + Make_Assignment_Statement (Loc, + Name => New_Reference_To (Flag_Id, Loc), + Expression => New_Reference_To (Standard_True, Loc))))); -- Note: the pragma has been completely transformed into a sequence of -- corresponding declarations and statements. We leave it in the tree -- for documentation purposes. It will be ignored by the backend. - end Expand_Pragma_Loop_Assertion; + end Expand_Pragma_Loop_Variant; -------------------------------- -- Expand_Pragma_Psect_Object -- diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index e84023c1f19..7f743e23aa9 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -49,6 +49,7 @@ with Sinput; use Sinput; with Snames; use Snames; with Stringt; use Stringt; with Tbuild; use Tbuild; +with Ttypes; use Ttypes; with Uname; use Uname; with System.Case_Util; use System.Case_Util; @@ -1440,6 +1441,93 @@ package body Lib.Writ is Output_Alfa; end if; + -- Output target dependent information if needed + + if Generate_Target_Dependent_Info then + Gen_TDI : declare + subtype Str4 is String (1 .. 4); + + procedure Gen_TDI_Bool (Code : Str4; Val : Boolean); + -- Generate T line for Bool value + + procedure Gen_TDI_Nat (Code : Str4; Val : Int); + -- Generate T line for Pos or Nat value + + ------------------ + -- Gen_TDI_Bool -- + ------------------ + + procedure Gen_TDI_Bool (Code : Str4; Val : Boolean) is + begin + Write_Info_Initiate ('T'); + Write_Info_Char (' '); + Write_Info_Str (Code); + + if Val then + Write_Info_Str (" TRUE"); + else + Write_Info_Str (" FALSE"); + end if; + + Write_Info_EOL; + end Gen_TDI_Bool; + + ----------------- + -- Gen_TDI_Nat -- + ----------------- + + procedure Gen_TDI_Nat (Code : Str4; Val : Int) is + begin + Write_Info_Initiate ('T'); + Write_Info_Char (' '); + Write_Info_Str (Code); + Write_Info_Char (' '); + Write_Info_Nat (Val); + + Write_Info_EOL; + end Gen_TDI_Nat; + + -- Start of processing for Gen_TDI + + begin + Gen_TDI_Nat ("SINS", Standard_Short_Short_Integer_Size); + Gen_TDI_Nat ("SINW", Standard_Short_Short_Integer_Width); + Gen_TDI_Nat ("SHIS", Standard_Short_Integer_Size); + Gen_TDI_Nat ("SHIW", Standard_Short_Integer_Width); + Gen_TDI_Nat ("INTS", Standard_Integer_Size); + Gen_TDI_Nat ("INTW", Standard_Integer_Width); + Gen_TDI_Nat ("LINS", Standard_Long_Integer_Size); + Gen_TDI_Nat ("LINW", Standard_Long_Integer_Width); + Gen_TDI_Nat ("LLIS", Standard_Long_Long_Integer_Size); + Gen_TDI_Nat ("LLIW", Standard_Long_Long_Integer_Width); + Gen_TDI_Nat ("SFLS", Standard_Short_Float_Size); + Gen_TDI_Nat ("SFLD", Standard_Short_Float_Digits); + Gen_TDI_Nat ("FLTS", Standard_Float_Size); + Gen_TDI_Nat ("FLTD", Standard_Float_Digits); + Gen_TDI_Nat ("LFLS", Standard_Long_Float_Size); + Gen_TDI_Nat ("LFLD", Standard_Long_Float_Digits); + Gen_TDI_Nat ("LLFS", Standard_Long_Long_Float_Size); + Gen_TDI_Nat ("LLFD", Standard_Long_Long_Float_Digits); + Gen_TDI_Nat ("CHAS", Standard_Character_Size); + Gen_TDI_Nat ("WCHS", Standard_Wide_Character_Size); + Gen_TDI_Nat ("WWCS", Standard_Wide_Wide_Character_Size); + Gen_TDI_Nat ("ADRS", System_Address_Size); + Gen_TDI_Nat ("MBMP", System_Max_Binary_Modulus_Power); + Gen_TDI_Nat ("MNMP", System_Max_Nonbinary_Modulus_Power); + Gen_TDI_Nat ("SUNI", System_Storage_Unit); + Gen_TDI_Nat ("WRDS", System_Word_Size); + Gen_TDI_Nat ("TICK", System_Tick_Nanoseconds); + Gen_TDI_Nat ("WCTS", Interfaces_Wchar_T_Size); + Gen_TDI_Nat ("MAXA", Maximum_Alignment); + Gen_TDI_Nat ("ALLA", System_Allocator_Alignment); + Gen_TDI_Nat ("MUNF", Max_Unaligned_Field); + Gen_TDI_Bool ("BEND", Bytes_Big_Endian); + Gen_TDI_Bool ("STRA", Target_Strict_Alignment); + Gen_TDI_Nat ("DFLA", Target_Double_Float_Alignment); + Gen_TDI_Nat ("DSCA", Target_Double_Scalar_Alignment); + end Gen_TDI; + end if; + -- Output final blank line and we are done. This final blank line is -- probably junk, but we don't feel like making an incompatible change! diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 72f10d9c11a..3867c5f2643 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -801,21 +801,40 @@ package Lib.Writ is -------------------------- -- The cross-reference data follows the dependency lines. See the spec of - -- Lib.Xref for details on the format of this data. + -- Lib.Xref in file lib-xref.ads for details on the format of this data. --------------------------------- -- Source Coverage Obligations -- --------------------------------- -- The Source Coverage Obligation (SCO) information follows the cross- - -- reference data. See the spec of Par_SCO for full details of the format. + -- reference data. See the spec of Par_SCO in file par_sco.ads for full + -- details of the format. ---------------------- -- Alfa Information -- ---------------------- -- The Alfa information follows the SCO information. See the spec of Alfa - -- for full details of the format. + -- in file alfa.ads for full details of the format. + + ------------------------------------- + -- T Target Dependent Information -- + ------------------------------------- + + -- This section is present if the option to generate target dependent + -- information is present (this flag is set by the -gnatT switch). The + -- format of T lines is: + + -- T key val + + -- There is one line for each constant declared in the Ttypes package + + -- key is the four letter code (which can be found as a comment on each + -- of the constant declarations in Ttypes). + + -- val is the value of the constant, which is either a non-negative + -- decimal constant, or TRUE or FALSE for a Boolean value. ---------------------- -- Global Variables -- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 9221be94e04..b8d169700dc 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -658,6 +658,11 @@ package Opt is -- True when switch -fdebug-instances is used. When True, a table of -- instances is included in SCOs. + Generate_Target_Dependent_Info : Boolean := False; + -- GNAT + -- When true (-gnatet switch used). True if target dependent info is to be + -- generated in the ali file. + Generating_Code : Boolean := False; -- GNAT -- True if the frontend finished its work and has called the backend to diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 73a2fe40a26..9d974f3b09a 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1189,7 +1189,8 @@ begin Pragma_Lock_Free | Pragma_Locking_Policy | Pragma_Long_Float | - Pragma_Loop_Assertion | + Pragma_Loop_Invariant | + Pragma_Loop_Variant | Pragma_Machine_Attribute | Pragma_Main | Pragma_Main_Storage | diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index b68b5937c38..7803d365558 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3795,15 +3795,17 @@ package body Sem_Attr is Stmt := N; while Present (Stmt) loop - -- Locate the enclosing Loop_Assertion pragma (if any). Note that - -- when Loop_Assertion is expanded, we must look for an Assertion - -- pragma. + -- Locate the enclosing Loop_Invariant / Loop_Variant pragma (if + -- any). Note that when these two are expanded, we must look for + -- an Assertion pragma. if Nkind (Original_Node (Stmt)) = N_Pragma and then (Pragma_Name (Original_Node (Stmt)) = Name_Assert or else - Pragma_Name (Original_Node (Stmt)) = Name_Loop_Assertion) + Pragma_Name (Original_Node (Stmt)) = Name_Loop_Invariant + or else + Pragma_Name (Original_Node (Stmt)) = Name_Loop_Variant) then In_Loop_Assertion := True; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e4ee1f6409a..3e70492fb96 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -618,6 +618,10 @@ package body Sem_Prag is -- Common processing for first argument of pragma Interrupt_Handler or -- pragma Attach_Handler. + procedure Check_Loop_Invariant_Variant_Placement; + -- Verify whether pragma Loop_Invariant or pragma Loop_Variant appear + -- immediately within the statements of the related loop. + procedure Check_Is_In_Decl_Part_Or_Package_Spec; -- Check that pragma appears in a declarative part, or in a package -- specification, i.e. that it does not occur in a statement sequence @@ -1912,6 +1916,44 @@ package body Sem_Prag is end if; end Check_Interrupt_Or_Attach_Handler; + -------------------------------------------- + -- Check_Loop_Invariant_Variant_Placement -- + -------------------------------------------- + + procedure Check_Loop_Invariant_Variant_Placement is + Loop_Stmt : Node_Id; + + begin + -- Locate the enclosing loop statement (if any) + + Loop_Stmt := N; + while Present (Loop_Stmt) loop + if Nkind (Loop_Stmt) = N_Loop_Statement then + exit; + + -- Prevent the search from going too far + + elsif Nkind_In (Loop_Stmt, N_Entry_Body, + N_Package_Body, + N_Package_Declaration, + N_Protected_Body, + N_Subprogram_Body, + N_Task_Body) + then + Error_Pragma ("pragma % must appear inside a loop statement"); + return; + + else + Loop_Stmt := Parent (Loop_Stmt); + end if; + end loop; + + if List_Containing (N) /= Statements (Loop_Stmt) then + Error_Pragma + ("pragma % must occur immediately in the statements of a loop"); + end if; + end Check_Loop_Invariant_Variant_Placement; + ------------------------------------------- -- Check_Is_In_Decl_Part_Or_Package_Spec -- ------------------------------------------- @@ -11453,74 +11495,62 @@ package body Sem_Prag is end Long_Float; -------------------- - -- Loop_Assertion -- + -- Loop_Invariant -- -------------------- - -- pragma Loop_Assertion - -- ( [Invariant =>] boolean_Expression ); - -- | ( [[Invariant =>] boolean_Expression ,] - -- Variant => - -- ( TERMINATION_VARIANT {, TERMINATION_VARIANT ) ); - - -- TERMINATION_VARIANT ::= CHANGE_MODIFIER => discrete_EXPRESSION - - -- CHANGE_MODIFIER ::= Increasing | Decreasing + -- pragma Loop_Invariant ( boolean_EXPRESSION ); - when Pragma_Loop_Assertion => Loop_Assertion : declare - procedure Check_Variant (Arg : Node_Id); - -- Verify the legality of a variant - - ------------------- - -- Check_Variant -- - ------------------- + when Pragma_Loop_Invariant => Loop_Invariant : declare + begin + GNAT_Pragma; + S14_Pragma; + Check_Arg_Count (1); + Check_Loop_Invariant_Variant_Placement; - procedure Check_Variant (Arg : Node_Id) is - Expr : constant Node_Id := Expression (Arg); + -- Completely ignore if disabled - begin - -- Variants appear in aggregate form + if Check_Disabled (Pname) then + Rewrite (N, Make_Null_Statement (Loc)); + Analyze (N); + return; + end if; - if Nkind (Expr) = N_Aggregate then - declare - Comp : Node_Id; - Extra : Node_Id; - Modif : Node_Id; + Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean); - begin - Comp := First (Component_Associations (Expr)); - while Present (Comp) loop - Modif := First (Choices (Comp)); - Extra := Next (Modif); + -- Transform pagma Loop_Invariant into an equivalent pragma Check. + -- Generate: + -- pragma Check (Loop_Invaraint, Arg1); - Check_Arg_Is_One_Of - (Modif, Name_Decreasing, Name_Increasing); + Rewrite (N, + Make_Pragma (Loc, + Chars => Name_Check, + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Make_Identifier (Loc, Name_Loop_Invariant)), + Relocate_Node (Arg1)))); - if Present (Extra) then - Error_Pragma_Arg - ("only one modifier allowed in argument", Expr); - end if; + Analyze (N); + end Loop_Invariant; - Preanalyze_And_Resolve - (Expression (Comp), Any_Discrete); + ------------------ + -- Loop_Variant -- + ------------------ - Next (Comp); - end loop; - end; - else - Error_Pragma_Arg - ("expression on variant must be an aggregate", Expr); - end if; - end Check_Variant; + -- pragma Loop_Variant + -- ( LOOP_VARIANT_ITEM {, LOOP_VARIANT_ITEM } ); - -- Local variables + -- LOOP_VARIANT_ITEM ::= CHANGE_DIRECTION => discrete_EXPRESSION - Stmt : Node_Id; + -- CHANGE_DIRECTION ::= Increases | Decreases - -- Start of processing for Loop_Assertion + when Pragma_Loop_Variant => Loop_Variant : declare + Variant : Node_Id; begin GNAT_Pragma; S14_Pragma; + Check_At_Least_N_Arguments (1); + Check_Loop_Invariant_Variant_Placement; -- Completely ignore if disabled @@ -11530,56 +11560,21 @@ package body Sem_Prag is return; end if; - -- Verify that the pragma appears inside a loop - - Stmt := N; - while Present (Stmt) and then Nkind (Stmt) /= N_Loop_Statement loop - Stmt := Parent (Stmt); - end loop; - - if No (Stmt) then - Error_Pragma ("pragma % must appear inside a loop"); - end if; - - Check_At_Least_N_Arguments (1); - Check_At_Most_N_Arguments (2); - - -- Process the first argument - - if Chars (Arg1) = Name_Variant then - Check_Variant (Arg1); - - elsif Chars (Arg1) = No_Name - or else Chars (Arg1) = Name_Invariant - then - Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean); - - else - Error_Pragma_Arg ("argument not allowed in pragma %", Arg1); - end if; - - -- Process the second argument + -- Process all increasing / decreasing expressions - if Present (Arg2) then - if Chars (Arg2) = Name_Variant then - if Chars (Arg1) = Name_Variant then - Error_Pragma ("only one variant allowed in pragma %"); - else - Check_Variant (Arg2); - end if; + Variant := First (Pragma_Argument_Associations (N)); + while Present (Variant) loop + if Chars (Variant) /= Name_Decreases + and then Chars (Variant) /= Name_Increases + then + Error_Pragma_Arg ("wrong change modifier", Variant); + end if; - elsif Chars (Arg2) = Name_Invariant then - if Chars (Arg1) = Name_Variant then - Error_Pragma_Arg ("invariant must precede variant", Arg2); - else - Error_Pragma ("only one invariant allowed in pragma %"); - end if; + Preanalyze_And_Resolve (Expression (Variant), Any_Discrete); - else - Error_Pragma_Arg ("argument not allowed in pragma %", Arg2); - end if; - end if; - end Loop_Assertion; + Next (Variant); + end loop; + end Loop_Variant; ----------------------- -- Machine_Attribute -- @@ -15707,7 +15702,8 @@ package body Sem_Prag is Pragma_Lock_Free => -1, Pragma_Locking_Policy => -1, Pragma_Long_Float => -1, - Pragma_Loop_Assertion => -1, + Pragma_Loop_Invariant => -1, + Pragma_Loop_Variant => -1, Pragma_Machine_Attribute => -1, Pragma_Main => -1, Pragma_Main_Storage => -1, diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 3b3f8dbfa04..05168b37a4a 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -405,7 +405,8 @@ package Snames is Name_License : constant Name_Id := N + $; -- GNAT Name_Locking_Policy : constant Name_Id := N + $; Name_Long_Float : constant Name_Id := N + $; -- VMS - Name_Loop_Assertion : constant Name_Id := N + $; -- GNAT + Name_Loop_Invariant : constant Name_Id := N + $; -- GNAT + Name_Loop_Variant : constant Name_Id := N + $; -- GNAT Name_No_Run_Time : constant Name_Id := N + $; -- GNAT Name_No_Strict_Aliasing : constant Name_Id := N + $; -- GNAT Name_Normalize_Scalars : constant Name_Id := N + $; @@ -671,7 +672,7 @@ package Snames is Name_Component_Size_4 : constant Name_Id := N + $; Name_Copy : constant Name_Id := N + $; Name_D_Float : constant Name_Id := N + $; - Name_Decreasing : constant Name_Id := N + $; + Name_Decreases : constant Name_Id := N + $; Name_Descriptor : constant Name_Id := N + $; Name_Disable : constant Name_Id := N + $; Name_Dot_Replacement : constant Name_Id := N + $; @@ -691,7 +692,7 @@ package Snames is Name_GPL : constant Name_Id := N + $; Name_IEEE_Float : constant Name_Id := N + $; Name_Ignore : constant Name_Id := N + $; - Name_Increasing : constant Name_Id := N + $; + Name_Increases : constant Name_Id := N + $; Name_Info : constant Name_Id := N + $; Name_Internal : constant Name_Id := N + $; Name_Link_Name : constant Name_Id := N + $; @@ -1686,7 +1687,8 @@ package Snames is Pragma_License, Pragma_Locking_Policy, Pragma_Long_Float, - Pragma_Loop_Assertion, + Pragma_Loop_Invariant, + Pragma_Loop_Variant, Pragma_No_Run_Time, Pragma_No_Strict_Aliasing, Pragma_Normalize_Scalars, diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 031e9cf4ce0..920b2a5773a 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -614,6 +614,12 @@ package body Switch.C is Generate_SCO := True; Ptr := Ptr + 1; + -- -gnatet (generate target dependent information) + + when 't' => + Generate_Target_Dependent_Info := True; + Ptr := Ptr + 1; + -- -gnateV (validity checks on parameters) when 'V' => diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads index ef57187c6b2..be0162d6b44 100644 --- a/gcc/ada/ttypes.ads +++ b/gcc/ada/ttypes.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,11 +38,10 @@ package Ttypes is -- types on the host and types on the target, since in the general -- case of a cross-compiler these will be different. - -- This package and its companion Ttypef provide definitions of values - -- that describe the properties of the target types. All instances of - -- target dependencies, including the definitions of such packages as - -- Standard and System depend directly or indirectly on the definitions - -- in the Ttypes and Ttypef packages. + -- This package provides definitions of values that describe the properties + -- of the target types. All instances of target dependencies, including the + -- definitions of such packages as Standard and System depend directly or + -- indirectly on the definitions in the Ttypes packages. -- In the source of the compiler, references to attributes such as -- Integer'Size will give information regarding the host types (i.e. @@ -93,6 +92,18 @@ package Ttypes is -- than referencing System.Storage_Unit, or Standard'Storage_Unit, both of -- which would yield the host value. + ---------------------------------------------- + -- Target-Dependent Information in ALI File -- + ---------------------------------------------- + + -- If the flag Generate_Target_Dependent_Info is set (e.g. by use of the + -- -gnatT switch), then the ALI file contains T lines representing each of + -- the constants defined in this package (see Lib-Writ spec for details). + + -- These T lines use a code consisting of four upper case letters to + -- identify the constant whose value is output. These four letter codes + -- may be found as a comment in the declaration of each constant. + --------------------------------------------------- -- Target-Dependent Values for Types in Standard -- --------------------------------------------------- @@ -102,55 +113,65 @@ package Ttypes is -- example, on some machines, Short_Float may be the same as Float, and -- Long_Long_Float may be the same as Long_Float. - Standard_Short_Short_Integer_Size : constant Pos := Get_Char_Size; - Standard_Short_Short_Integer_Width : constant Pos := + Standard_Short_Short_Integer_Size : constant Pos := -- SINS + Get_Char_Size; + Standard_Short_Short_Integer_Width : constant Pos := -- SINW Width_From_Size (Standard_Short_Short_Integer_Size); - Standard_Short_Integer_Size : constant Pos := Get_Short_Size; - Standard_Short_Integer_Width : constant Pos := + Standard_Short_Integer_Size : constant Pos := -- SHIS + Get_Short_Size; + Standard_Short_Integer_Width : constant Pos := -- SHIW Width_From_Size (Standard_Short_Integer_Size); - Standard_Integer_Size : constant Pos := Get_Int_Size; - Standard_Integer_Width : constant Pos := + Standard_Integer_Size : constant Pos := -- INTS + Get_Int_Size; + Standard_Integer_Width : constant Pos := -- INTW Width_From_Size (Standard_Integer_Size); - Standard_Long_Integer_Size : constant Pos := Get_Long_Size; - Standard_Long_Integer_Width : constant Pos := + Standard_Long_Integer_Size : constant Pos := -- LINS + Get_Long_Size; + Standard_Long_Integer_Width : constant Pos := -- LINW Width_From_Size (Standard_Long_Integer_Size); - Standard_Long_Long_Integer_Size : constant Pos := Get_Long_Long_Size; - Standard_Long_Long_Integer_Width : constant Pos := + Standard_Long_Long_Integer_Size : constant Pos := -- LLIS + Get_Long_Long_Size; + Standard_Long_Long_Integer_Width : constant Pos := -- LLIW Width_From_Size (Standard_Long_Long_Integer_Size); - Standard_Short_Float_Size : constant Pos := Get_Float_Size; - Standard_Short_Float_Digits : constant Pos := + Standard_Short_Float_Size : constant Pos := -- SFLS + Get_Float_Size; + Standard_Short_Float_Digits : constant Pos := -- SFLD Digits_From_Size (Standard_Short_Float_Size); - Standard_Float_Size : constant Pos := Get_Float_Size; - Standard_Float_Digits : constant Pos := + Standard_Float_Size : constant Pos := -- FLTS + Get_Float_Size; + Standard_Float_Digits : constant Pos := -- FLTD Digits_From_Size (Standard_Float_Size); - Standard_Long_Float_Size : constant Pos := Get_Double_Size; - Standard_Long_Float_Digits : constant Pos := + Standard_Long_Float_Size : constant Pos := -- LFLS + Get_Double_Size; + Standard_Long_Float_Digits : constant Pos := -- LFLD Digits_From_Size (Standard_Long_Float_Size); - Standard_Long_Long_Float_Size : constant Pos := Get_Long_Double_Size; - Standard_Long_Long_Float_Digits : constant Pos := + Standard_Long_Long_Float_Size : constant Pos := -- LLFS + Get_Long_Double_Size; + Standard_Long_Long_Float_Digits : constant Pos := -- LLFD Digits_From_Size (Standard_Long_Long_Float_Size); - Standard_Character_Size : constant Pos := Get_Char_Size; + Standard_Character_Size : constant Pos := -- CHAS + Get_Char_Size; - Standard_Wide_Character_Size : constant Pos := 16; - Standard_Wide_Wide_Character_Size : constant Pos := 32; + Standard_Wide_Character_Size : constant Pos := 16; -- WCHS + Standard_Wide_Wide_Character_Size : constant Pos := 32; -- WWCS -- Standard wide character sizes -- Note: there is no specific control over the representation of @@ -166,18 +187,19 @@ package Ttypes is -- Target-Dependent Values for Types in System -- ------------------------------------------------- - System_Address_Size : constant Pos := Get_Pointer_Size; + System_Address_Size : constant Pos := Get_Pointer_Size; -- ADRS -- System.Address'Size (also size of all thin pointers) - System_Max_Binary_Modulus_Power : constant Pos := + System_Max_Binary_Modulus_Power : constant Pos := -- MBMP Standard_Long_Long_Integer_Size; - System_Max_Nonbinary_Modulus_Power : constant Pos := Standard_Integer_Size; + System_Max_Nonbinary_Modulus_Power : constant Pos := -- MNMP + Standard_Integer_Size; - System_Storage_Unit : constant Pos := Get_Bits_Per_Unit; - System_Word_Size : constant Pos := Get_Bits_Per_Word; + System_Storage_Unit : constant Pos := Get_Bits_Per_Unit; -- SUNI + System_Word_Size : constant Pos := Get_Bits_Per_Word; -- WRDS - System_Tick_Nanoseconds : constant Pos := 1_000_000_000; + System_Tick_Nanoseconds : constant Pos := 1_000_000_000; -- TICK -- Value of System.Tick in nanoseconds. At the moment, this is a fixed -- constant (with value of 1.0 seconds), but later we should add this -- value to the GCC configuration file so that its value can be made @@ -187,25 +209,25 @@ package Ttypes is -- Target-Dependent Values for Types in Interfaces -- ----------------------------------------------------- - Interfaces_Wchar_T_Size : constant Pos := Get_Wchar_T_Size; + Interfaces_Wchar_T_Size : constant Pos := Get_Wchar_T_Size; -- WCTS ---------------------------------------- -- Other Target-Dependent Definitions -- ---------------------------------------- - Maximum_Alignment : constant Pos := Get_Maximum_Alignment; + Maximum_Alignment : constant Pos := Get_Maximum_Alignment; -- MAXA -- The maximum alignment, in storage units, that an object or type may -- require on the target machine. - System_Allocator_Alignment : constant Pos := + System_Allocator_Alignment : constant Pos := -- ALLA Get_System_Allocator_Alignment; -- The alignment in storage units of addresses returned by malloc - Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field; + Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field; -- MUNF -- The maximum supported size in bits for a field that is not aligned -- on a storage unit boundary. - Bytes_Big_Endian : Boolean := Get_Bytes_BE /= 0; + Bytes_Big_Endian : Boolean := Get_Bytes_BE /= 0; -- BEND -- Important note: for Ada purposes, the important setting is the bytes -- endianness (Bytes_Big_Endian), not the bits value (Bits_Big_Endian). -- This is because Ada bit addressing must be compatible with the byte @@ -215,15 +237,20 @@ package Ttypes is -- and thus relevant only to the back end. Note that this is a variable -- rather than a constant, since it can be modified (flipped) by -gnatd8. - Target_Strict_Alignment : Boolean := Get_Strict_Alignment /= 0; - -- True if instructions will fail if data is misaligned + Target_Strict_Alignment : Boolean := -- STRA + Get_Strict_Alignment /= 0; + -- True if instructions will fail if data is misaligned. Note that this + -- is a variable rather than a constant since it can be modified (set to + -- True) if the debug flag -gnatd.A is used. - Target_Double_Float_Alignment : Nat := Get_Double_Float_Alignment; + Target_Double_Float_Alignment : constant Nat := -- DFLA + Get_Double_Float_Alignment; -- The default alignment of "double" floating-point types, i.e. floating -- point types whose size is equal to 64 bits, or 0 if this alignment is -- not specifically capped. - Target_Double_Scalar_Alignment : Nat := Get_Double_Scalar_Alignment; + Target_Double_Scalar_Alignment : constant Nat := -- DSCA + Get_Double_Scalar_Alignment; -- The default alignment of "double" or larger scalar types, i.e. scalar -- types whose size is greater or equal to 64 bits, or 0 if this alignment -- is not specifically capped. diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index c492ecfea65..6b6605d8eb6 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -232,6 +232,11 @@ begin Write_Switch_Char ("eS"); Write_Line ("Generate SCO (Source Coverage Obligation) information"); + -- Line for -gnatet switch + + Write_Switch_Char ("et"); + Write_Line ("Generate target dependent information in ALI file"); + -- Line for -gnateV switch Write_Switch_Char ("eV"); |