+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,
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);
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);
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;
-- for | while ... loop
-- <preceding source statements>
- -- pragma Assert (<Invar_Expr>);
-
-- if Flag then
-- Old_1 := Curr_1;
-- Old_2 := Curr_2;
-- <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;
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 --
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;
-- 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
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>;
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
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
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:
-- 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 --
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;
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!
--------------------------
-- 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 --
-- 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
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 |
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;
-- 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
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 --
-------------------------------------------
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
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 --
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,
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 + $;
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 + $;
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 + $;
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,
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' =>
-- --
-- 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- --
-- 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.
-- 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 --
---------------------------------------------------
-- 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
-- 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
-- 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
-- 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.
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");
projects / gcc.git / commitdiff