with Debug; use Debug;
with Lib; use Lib;
with Lib.Util; use Lib.Util;
+with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
+with Put_SCOs;
+with SCOs; use SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
+with Snames; use Snames;
with Table;
with GNAT.HTable; use GNAT.HTable;
package body Par_SCO is
- ---------------
- -- SCO_Table --
- ---------------
-
- -- Internal table used to store recorded SCO values. Table is populated by
- -- calls to SCO_Record, and entries may be modified by Set_SCO_Condition.
-
- type SCO_Table_Entry is record
- From : Source_Ptr;
- To : Source_Ptr;
- C1 : Character;
- C2 : Character;
- Last : Boolean;
- end record;
-
- package SCO_Table is new Table.Table (
- Table_Component_Type => SCO_Table_Entry,
- Table_Index_Type => Nat,
- Table_Low_Bound => 1,
- Table_Initial => 500,
- Table_Increment => 300,
- Table_Name => "SCO_Table_Entry");
-
- -- The SCO_Table_Entry values appear as follows:
-
- -- Statements
- -- C1 = 'S'
- -- C2 = ' '
- -- From = starting sloc
- -- To = ending sloc
- -- Last = unused
-
- -- Exit
- -- C1 = 'T'
- -- C2 = ' '
- -- From = starting sloc
- -- To = ending sloc
- -- Last = unused
-
- -- Simple Decision
- -- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
- -- C2 = 'c', 't', or 'f'
- -- From = starting sloc
- -- To = ending sloc
- -- Last = True
-
- -- Complex Decision
- -- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
- -- C2 = ' '
- -- From = No_Location
- -- To = No_Location
- -- Last = False
-
- -- Operator
- -- C1 = '!', '^', '&', '|'
- -- C2 = ' '
- -- From = No_Location
- -- To = No_Location
- -- Last = False
-
- -- Element
- -- C1 = ' '
- -- C2 = 'c', 't', or 'f' (condition/true/false)
- -- From = starting sloc
- -- To = ending sloc
- -- Last = False for all but the last entry, True for last entry
-
- -- Note: the sequence starting with a decision, and continuing with
- -- operators and elements up to and including the first one labeled with
- -- Last=True, indicate the sequence to be output for a complex decision
- -- on a single CD decision line.
-
- ----------------
- -- Unit Table --
- ----------------
+ -----------------------
+ -- Unit Number Table --
+ -----------------------
- -- This table keeps track of the units and the corresponding starting and
- -- ending indexes (From, To) in the SCO table. Note that entry zero is
- -- unused, it is for convenience in calling the sort routine.
+ -- This table parallels the SCO_Unit_Table, keeping track of the unit
+ -- numbers corresponding to the entries made in this table, so that before
+ -- writing out the SCO information to the ALI file, we can fill in the
+ -- proper dependency numbers and file names.
- type SCO_Unit_Table_Entry is record
- Unit : Unit_Number_Type;
- From : Nat;
- To : Nat;
- end record;
+ -- Note that the zero'th entry is here for convenience in sorting the
+ -- table, the real lower bound is 1.
- package SCO_Unit_Table is new Table.Table (
- Table_Component_Type => SCO_Unit_Table_Entry,
- Table_Index_Type => Int,
- Table_Low_Bound => 0,
+ package SCO_Unit_Number_Table is new Table.Table (
+ Table_Component_Type => Unit_Number_Type,
+ Table_Index_Type => SCO_Unit_Index,
+ Table_Low_Bound => 0, -- see note above on sort
Table_Initial => 20,
Table_Increment => 200,
- Table_Name => "SCO_Unit_Table_Entry");
+ Table_Name => "SCO_Unit_Number_Entry");
--------------------------
-- Condition Hash Table --
function Is_Logical_Operator (N : Node_Id) return Boolean;
-- N is the node for a subexpression. This procedure just tests N to see
- -- if it is a logical operator (including short circuit conditions) and
- -- returns True if so, False otherwise, it does no other processing.
+ -- if it is a logical operator (including short circuit conditions, but
+ -- excluding OR and AND) and returns True if so, False otherwise, it does
+ -- no other processing.
procedure Process_Decisions (N : Node_Id; T : Character);
-- If N is Empty, has no effect. Otherwise scans the tree for the node N,
- -- to output any decisions it contains. T is one of IEWX (for context of
- -- expresion: if/while/when-exit/expression). If T is other than X, then
- -- the node is always a decision a decision is always present (at the very
- -- least a simple decision is present at the top level).
+ -- to output any decisions it contains. T is one of IEPWX (for context of
+ -- expresion: if/exit when/pragma/while/expression). If T is other than X,
+ -- then a decision is always present (at the very least a simple decision
+ -- is present at the top level).
procedure Process_Decisions (L : List_Id; T : Character);
-- Calls above procedure for each element of the list L
procedure Traverse_Subprogram_Body (N : Node_Id);
-- Traverse the corresponding construct, generating SCO table entries
- procedure dsco;
- -- Debug routine to dump SCO table
+ procedure Write_SCOs_To_ALI_File is new Put_SCOs;
+ -- Write SCO information to the ALI file using routines in Lib.Util
----------
-- dsco --
procedure dsco is
begin
+ -- Dump SCO unit table
+
Write_Line ("SCO Unit Table");
Write_Line ("--------------");
- for Index in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop
- Write_Str (" ");
- Write_Int (Index);
- Write_Str (". Unit = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).Unit));
- Write_Str (" From = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).From));
- Write_Str (" To = ");
- Write_Int (Int (SCO_Unit_Table.Table (Index).To));
- Write_Eol;
+ for Index in 1 .. SCO_Unit_Table.Last loop
+ declare
+ UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
+
+ begin
+ Write_Str (" ");
+ Write_Int (Int (Index));
+ Write_Str (". Dep_Num = ");
+ Write_Int (Int (UTE.Dep_Num));
+ Write_Str (" From = ");
+ Write_Int (Int (UTE.From));
+ Write_Str (" To = ");
+ Write_Int (Int (UTE.To));
+
+ Write_Str (" File_Name = """);
+
+ if UTE.File_Name /= null then
+ Write_Str (UTE.File_Name.all);
+ end if;
+
+ Write_Char ('"');
+ Write_Eol;
+ end;
end loop;
+ -- Dump SCO Unit number table if it contains any entries
+
+ if SCO_Unit_Number_Table.Last >= 1 then
+ Write_Eol;
+ Write_Line ("SCO Unit Number Table");
+ Write_Line ("---------------------");
+
+ for Index in 1 .. SCO_Unit_Number_Table.Last loop
+ Write_Str (" ");
+ Write_Int (Int (Index));
+ Write_Str (". Unit_Number = ");
+ Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
+ Write_Eol;
+ end loop;
+ end if;
+
+ -- Dump SCO table itself
+
Write_Eol;
Write_Line ("SCO Table");
Write_Line ("---------");
- for Index in SCO_Table.First .. SCO_Table.Last loop
+ for Index in 1 .. SCO_Table.Last loop
declare
T : SCO_Table_Entry renames SCO_Table.Table (Index);
begin
- Write_Str (" ");
- Write_Int (Index);
- Write_Str (". C1 = '");
- Write_Char (T.C1);
- Write_Str ("' C2 = '");
- Write_Char (T.C2);
- Write_Str ("' From = ");
- Write_Location (T.From);
- Write_Str (" To = ");
- Write_Location (T.To);
- Write_Str (" Last = ");
+ Write_Str (" ");
+ Write_Int (Index);
+ Write_Char ('.');
+
+ if T.C1 /= ' ' then
+ Write_Str (" C1 = '");
+ Write_Char (T.C1);
+ Write_Char (''');
+ end if;
+
+ if T.C2 /= ' ' then
+ Write_Str (" C2 = '");
+ Write_Char (T.C2);
+ Write_Char (''');
+ end if;
+
+ if T.From /= No_Source_Location then
+ Write_Str (" From = ");
+ Write_Int (Int (T.From.Line));
+ Write_Char (':');
+ Write_Int (Int (T.From.Col));
+ end if;
+
+ if T.To /= No_Source_Location then
+ Write_Str (" To = ");
+ Write_Int (Int (T.To.Line));
+ Write_Char (':');
+ Write_Int (Int (T.To.Col));
+ end if;
if T.Last then
- Write_Str (" True");
+ Write_Str (" True");
else
- Write_Str (" False");
+ Write_Str (" False");
end if;
Write_Eol;
procedure Initialize is
begin
- SCO_Unit_Table.Init;
- SCO_Unit_Table.Increment_Last;
- SCO_Table.Init;
+ SCO_Unit_Number_Table.Init;
+
+ -- Set dummy 0'th entry in place for sort
+
+ SCO_Unit_Number_Table.Increment_Last;
end Initialize;
-------------------------
function Is_Logical_Operator (N : Node_Id) return Boolean is
begin
- return Nkind_In (N, N_Op_And,
- N_Op_Or,
- N_Op_Xor,
+ return Nkind_In (N, N_Op_Xor,
N_Op_Not,
N_And_Then,
N_Or_Else);
C : Character;
L : Node_Id;
- FSloc : Source_Ptr;
- LSloc : Source_Ptr;
-
begin
if No (N) then
return;
end if;
end if;
- Sloc_Range (N, FSloc, LSloc);
- Set_Table_Entry (C, ' ', FSloc, LSloc, False);
+ Set_Table_Entry (C, ' ', No_Location, No_Location, False);
Output_Decision_Operand (L);
Output_Decision_Operand (Right_Opnd (N));
begin
case Nkind (N) is
- -- Logical operators and short circuit forms, output table
- -- entries and then process operands recursively to deal with
- -- nested conditions.
+ -- Logical operators, output table entries and then process
+ -- operands recursively to deal with nested conditions.
when N_And_Then |
N_Or_Else |
- N_Op_And |
- N_Op_Or |
- N_Op_Xor |
N_Op_Not =>
declare
Traverse (N);
end Process_Decisions;
- ----------------
- -- SCO_Output --
- ----------------
+ -----------
+ -- pscos --
+ -----------
- procedure SCO_Output is
- Start : Nat;
- Stop : Nat;
- U : Unit_Number_Type;
+ procedure pscos is
- procedure Output_Range (From : Source_Ptr; To : Source_Ptr);
- -- Outputs Sloc range in line:col-line:col format (for now we do not
- -- worry about generic instantiations???)
+ procedure Write_Info_Char (C : Character) renames Write_Char;
+ -- Write one character;
- ------------------
- -- Output_Range --
- ------------------
+ procedure Write_Info_Initiate (Key : Character) renames Write_Char;
+ -- Start new one and write one character;
+
+ procedure Write_Info_Nat (N : Nat);
+ -- Write value of N
+
+ procedure Write_Info_Terminate renames Write_Eol;
+ -- Terminate current line
- procedure Output_Range (From : Source_Ptr; To : Source_Ptr) is
+ --------------------
+ -- Write_Info_Nat --
+ --------------------
+
+ procedure Write_Info_Nat (N : Nat) is
begin
- Write_Info_Nat (Int (Get_Logical_Line_Number (From)));
- Write_Info_Char (':');
- Write_Info_Nat (Int (Get_Column_Number (From)));
- Write_Info_Char ('-');
- Write_Info_Nat (Int (Get_Logical_Line_Number (To)));
- Write_Info_Char (':');
- Write_Info_Nat (Int (Get_Column_Number (To)));
- end Output_Range;
+ Write_Int (N);
+ end Write_Info_Nat;
- -- Start of processing for SCO_Output
+ procedure Debug_Put_SCOs is new Put_SCOs;
+
+ -- Start of processing for pscos
+
+ begin
+ Debug_Put_SCOs;
+ end pscos;
+ ----------------
+ -- SCO_Output --
+ ----------------
+
+ procedure SCO_Output is
begin
if Debug_Flag_Dot_OO then
dsco;
end if;
- -- Sort the unit table
+ -- Sort the unit tables based on dependency numbers
Unit_Table_Sort : declare
function Lt (Op1, Op2 : Natural) return Boolean is
begin
- return Dependency_Num (SCO_Unit_Table.Table (Nat (Op1)).Unit) <
- Dependency_Num (SCO_Unit_Table.Table (Nat (Op2)).Unit);
+ return
+ Dependency_Num
+ (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
+ <
+ Dependency_Num
+ (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
end Lt;
----------
procedure Move (From : Natural; To : Natural) is
begin
- SCO_Unit_Table.Table (Nat (To)) :=
- SCO_Unit_Table.Table (Nat (From));
+ SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
+ SCO_Unit_Table.Table (SCO_Unit_Index (From));
+ SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
+ SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
end Move;
package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
Sorting.Sort (Integer (SCO_Unit_Table.Last));
end Unit_Table_Sort;
- -- Loop through entries in the unit table
+ -- Loop through entries in the unit table to set file name and
+ -- dependency number entries.
for J in 1 .. SCO_Unit_Table.Last loop
- U := SCO_Unit_Table.Table (J).Unit;
-
- -- Output header line preceded by blank line
-
- Write_Info_Terminate;
- Write_Info_Initiate ('C');
- Write_Info_Char (' ');
- Write_Info_Nat (Dependency_Num (U));
- Write_Info_Char (' ');
- Write_Info_Name (Reference_Name (Source_Index (U)));
- Write_Info_Terminate;
-
- Start := SCO_Unit_Table.Table (J).From;
- Stop := SCO_Unit_Table.Table (J).To;
-
- -- Loop through relevant entries in SCO table, outputting C lines
-
- while Start <= Stop loop
- declare
- T : SCO_Table_Entry renames SCO_Table.Table (Start);
-
- begin
- Write_Info_Initiate ('C');
- Write_Info_Char (T.C1);
-
- case T.C1 is
-
- -- Statements, exit
-
- when 'S' | 'T' =>
- Write_Info_Char (' ');
- Output_Range (T.From, T.To);
-
- -- Decision
-
- when 'I' | 'E' | 'W' | 'X' =>
- if T.C2 = ' ' then
- Start := Start + 1;
- end if;
-
- -- Loop through table entries for this decision
-
- loop
- declare
- T : SCO_Table_Entry renames SCO_Table.Table (Start);
-
- begin
- Write_Info_Char (' ');
-
- if T.C1 = '!' or else
- T.C1 = '^' or else
- T.C1 = '&' or else
- T.C1 = '|'
- then
- Write_Info_Char (T.C1);
-
- else
- Write_Info_Char (T.C2);
- Output_Range (T.From, T.To);
- end if;
-
- exit when T.Last;
- Start := Start + 1;
- end;
- end loop;
-
- when others =>
- raise Program_Error;
- end case;
-
- Write_Info_Terminate;
- end;
+ declare
+ U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
+ UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
+ begin
+ Get_Name_String (Reference_Name (Source_Index (U)));
+ UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
+ UTE.Dep_Num := Dependency_Num (U);
+ end;
+ end loop;
- exit when Start = Stop;
- Start := Start + 1;
+ -- Now the tables are all setup for output to the ALI file
- pragma Assert (Start <= Stop);
- end loop;
- end loop;
+ Write_SCOs_To_ALI_File;
end SCO_Output;
----------------
-- Ignore call if this unit already recorded
- for J in 1 .. SCO_Unit_Table.Last loop
- if SCO_Unit_Table.Table (J).Unit = U then
+ for J in 1 .. SCO_Unit_Number_Table.Last loop
+ if U = SCO_Unit_Number_Table.Table (J) then
return;
end if;
end loop;
Process_Decisions (Lu, 'X');
end if;
- -- Make entry for new unit in unit table
+ -- Make entry for new unit in unit tables, we will fill in the file
+ -- name and dependency numbers later.
+
+ SCO_Unit_Table.Append (
+ (Dep_Num => 0,
+ File_Name => null,
+ From => From,
+ To => SCO_Table.Last));
- SCO_Unit_Table.Append ((Unit => U, From => From, To => SCO_Table.Last));
+ SCO_Unit_Number_Table.Append (U);
end SCO_Record;
-----------------------
To : Source_Ptr;
Last : Boolean)
is
+ function To_Source_Location (S : Source_Ptr) return Source_Location;
+ -- Converts Source_Ptr value to Source_Location (line/col) format
+
+ ------------------------
+ -- To_Source_Location --
+ ------------------------
+
+ function To_Source_Location (S : Source_Ptr) return Source_Location is
+ begin
+ if S = No_Location then
+ return No_Source_Location;
+ else
+ return
+ (Line => Get_Logical_Line_Number (S),
+ Col => Get_Column_Number (S));
+ end if;
+ end To_Source_Location;
+
+ -- Start of processing for Set_Table_Entry
+
begin
- SCO_Table.Append ((C1 => C1,
- C2 => C2,
- From => From,
- To => To,
- Last => Last));
+ Add_SCO
+ (C1 => C1,
+ C2 => C2,
+ From => To_Source_Location (From),
+ To => To_Source_Location (To),
+ Last => Last);
end Set_Table_Entry;
-----------------------------------------
procedure Traverse_Declarations_Or_Statements (L : List_Id) is
N : Node_Id;
- Start : Source_Ptr;
Dummy : Source_Ptr;
- Stop : Source_Ptr;
- From : Source_Ptr;
- To : Source_Ptr;
- Term : Boolean;
- -- Set False if current entity terminates statement list
+ type SC_Entry is record
+ From : Source_Ptr;
+ To : Source_Ptr;
+ Typ : Character;
+ end record;
+ -- Used to store a single entry in the following array
+
+ SC_Array : array (Nat range 1 .. 10_000) of SC_Entry;
+ SC_Last : Nat;
+ -- Used to store statement components for a CS entry to be output
+ -- as a result of the call to this procedure. SC_Last is the last
+ -- entry stored, so the current statement sequence is represented
+ -- by SC_Array (1 .. SC_Last). Extend_Statement_Sequence adds an
+ -- entry to this array, and Set_Statement_Entry clears it, copying
+ -- the entries to the main SCO output table. The reason that we do
+ -- the temporary caching of results in this array is that we want
+ -- the SCO table entries for a given CS line to be contiguous, and
+ -- the processing may output intermediate entries such as decision
+ -- entries. Note that the limit of 10_000 here is arbitrary, but does
+ -- not cause any trouble, if we encounter more than 10_000 statements
+ -- we simply break the current CS sequence at that point, which is
+ -- harmless, since this is only used for back annotation and it is
+ -- not critical that back annotation always work in all cases. Anyway
+ -- exceeding 10,000 statements in a basic block is very unlikely.
+
+ procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
+ -- Extend the current statement sequence to encompass the node N. Typ
+ -- is the letter that identifies the type of statement/declaration that
+ -- is being added to the sequence.
+
+ procedure Extend_Statement_Sequence
+ (From : Node_Id;
+ To : Node_Id;
+ Typ : Character);
+ -- This version extends the current statement sequence with an entry
+ -- that starts with the first token of From, and ends with the last
+ -- token of To. It is used for example in a CASE statement to cover
+ -- the range from the CASE token to the last token of the expression.
procedure Set_Statement_Entry;
-- If Start is No_Location, does nothing, otherwise outputs a SCO_Table
-------------------------
procedure Set_Statement_Entry is
+ C1 : Character;
+
begin
- Term := True;
+ if SC_Last /= 0 then
+ for J in 1 .. SC_Last loop
+ if J = 1 then
+ C1 := 'S';
+ else
+ C1 := 's';
+ end if;
- if Start /= No_Location then
- Set_Table_Entry ('S', ' ', Start, Stop, False);
- Start := No_Location;
- Stop := No_Location;
+ Set_Table_Entry
+ (C1 => C1,
+ C2 => SC_Array (J).Typ,
+ From => SC_Array (J).From,
+ To => SC_Array (J).To,
+ Last => (J = SC_Last));
+ end loop;
+
+ SC_Last := 0;
end if;
end Set_Statement_Entry;
+ -------------------------------
+ -- Extend_Statement_Sequence --
+ -------------------------------
+
+ procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
+ begin
+ -- Clear out statement sequence if array full
+
+ if SC_Last = SC_Array'Last then
+ Set_Statement_Entry;
+ else
+ SC_Last := SC_Last + 1;
+ end if;
+
+ -- Record new entry
+
+ Sloc_Range
+ (N, SC_Array (SC_Last).From, SC_Array (SC_Last).To);
+ SC_Array (SC_Last).Typ := Typ;
+ end Extend_Statement_Sequence;
+
+ procedure Extend_Statement_Sequence
+ (From : Node_Id;
+ To : Node_Id;
+ Typ : Character)
+ is
+ begin
+ -- Clear out statement sequence if array full
+
+ if SC_Last = SC_Array'Last then
+ Set_Statement_Entry;
+ else
+ SC_Last := SC_Last + 1;
+ end if;
+
+ -- Make new entry
+
+ Sloc_Range (From, SC_Array (SC_Last).From, Dummy);
+ Sloc_Range (To, Dummy, SC_Array (SC_Last).To);
+ SC_Array (SC_Last).Typ := Typ;
+ end Extend_Statement_Sequence;
+
-- Start of processing for Traverse_Declarations_Or_Statements
begin
if Is_Non_Empty_List (L) then
- N := First (L);
- Start := No_Location;
+ SC_Last := 0;
-- Loop through statements or declarations
+ N := First (L);
while Present (N) loop
- Term := False;
+
+ -- Initialize or extend current statement sequence. Note that for
+ -- special cases such as IF and Case statements we will modify
+ -- the range to exclude internal statements that should not be
+ -- counted as part of the current statement sequence.
case Nkind (N) is
Set_Statement_Entry;
Traverse_Subprogram_Body (N);
- -- Exit statement
+ -- Exit statement, which is an exit statement in the SCO sense,
+ -- so it is included in the current statement sequence, but
+ -- then it terminates this sequence. We also have to process
+ -- any decisions in the exit statement expression.
when N_Exit_Statement =>
+ Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
Process_Decisions (Condition (N), 'E');
- -- This is an exit point
-
- Sloc_Range (N, From, To);
- Set_Table_Entry ('T', ' ', From, To, False);
-
- -- Label (breaks statement sequence)
+ -- Label, which breaks the current statement sequence, but the
+ -- label itself is not included in the next statement sequence,
+ -- since it generates no code.
when N_Label =>
Set_Statement_Entry;
- -- Block statement
+ -- Block statement, which breaks the current statement sequence
when N_Block_Statement =>
Set_Statement_Entry;
Traverse_Handled_Statement_Sequence
(Handled_Statement_Sequence (N));
- -- If statement
+ -- If statement, which breaks the current statement sequence,
+ -- but we include the condition in the current sequence.
when N_If_Statement =>
+ Extend_Statement_Sequence (N, Condition (N), 'I');
Set_Statement_Entry;
Process_Decisions (Condition (N), 'I');
Traverse_Declarations_Or_Statements (Then_Statements (N));
Traverse_Declarations_Or_Statements (Else_Statements (N));
- -- Unconditional exit points
+ -- Case statement, which breaks the current statement sequence,
+ -- but we include the expression in the current sequence.
+
+ when N_Case_Statement =>
+ Extend_Statement_Sequence (N, Expression (N), 'C');
+ Set_Statement_Entry;
+ Process_Decisions (Expression (N), 'X');
+
+ -- Process case branches
+
+ declare
+ Alt : Node_Id;
+
+ begin
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+ Traverse_Declarations_Or_Statements (Statements (Alt));
+ Next (Alt);
+ end loop;
+ end;
+
+ -- Unconditional exit points, which are included in the current
+ -- statement sequence, but then terminate it
when N_Requeue_Statement |
N_Goto_Statement |
N_Raise_Statement =>
+ Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
- Sloc_Range (N, From, To);
- Set_Table_Entry ('T', ' ', From, To, False);
- -- Simple return statement
+ -- Simple return statement. which is an exit point, but we
+ -- have to process the return expression for decisions.
when N_Simple_Return_Statement =>
+ Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
-
- -- Process possible return expression
-
Process_Decisions (Expression (N), 'X');
- -- Return is an exit point
-
- Sloc_Range (N, From, To);
- Set_Table_Entry ('T', ' ', From, To, False);
-
-- Extended return statement
when N_Extended_Return_Statement =>
- Set_Statement_Entry;
- Traverse_Declarations_Or_Statements
- (Return_Object_Declarations (N));
+ declare
+ Odecl : constant Node_Id :=
+ First (Return_Object_Declarations (N));
+ begin
+ if Present (Expression (Odecl)) then
+ Extend_Statement_Sequence
+ (N, Expression (Odecl), 'R');
+ Process_Decisions (Expression (Odecl), 'X');
+ end if;
+ end;
+
Traverse_Handled_Statement_Sequence
(Handled_Statement_Sequence (N));
- -- Return is an exit point
+ -- Loop ends the current statement sequence, but we include
+ -- the iteration scheme if present in the current sequence.
+ -- But the body of the loop starts a new sequence, since it
+ -- may not be executed as part of the current sequence.
+
+ when N_Loop_Statement =>
+ if Present (Iteration_Scheme (N)) then
- Sloc_Range (N, From, To);
- Set_Table_Entry ('T', ' ', From, To, False);
+ -- If iteration scheme present, extend the current
+ -- statement sequence to include the iteration scheme
+ -- and process any decisions it contains.
- -- Loop
+ declare
+ ISC : constant Node_Id := Iteration_Scheme (N);
- when N_Loop_Statement =>
+ begin
+ -- While statement
- -- Even if not a while loop, we want a new statement seq
+ if Present (Condition (ISC)) then
+ Extend_Statement_Sequence (N, ISC, 'W');
+ Process_Decisions (Condition (ISC), 'W');
- Set_Statement_Entry;
+ -- For statement
- if Present (Iteration_Scheme (N)) then
- Process_Decisions
- (Condition (Iteration_Scheme (N)), 'W');
+ else
+ Extend_Statement_Sequence (N, ISC, 'F');
+ Process_Decisions
+ (Loop_Parameter_Specification (ISC), 'X');
+ end if;
+ end;
end if;
+ Set_Statement_Entry;
Traverse_Declarations_Or_Statements (Statements (N));
- -- All other cases
+ -- Pragma
+
+ when N_Pragma =>
+ Extend_Statement_Sequence (N, 'P');
+
+ -- For pragmas Assert, Check, Precondition, and
+ -- Postcondition, we generate decision entries for the
+ -- condition only if the pragma is enabled. For now, we just
+ -- check Assertions_Enabled, which will be set to reflect
+ -- the presence of -gnata.
+
+ -- Later we should move processing of the relevant pragmas
+ -- to Par_Prag, and properly set the flag Pragma_Enabled at
+ -- parse time, so that we can check this flag instead ???
+
+ -- For all other pragmas, we always generate decision
+ -- entries for any embedded expressions.
+
+ declare
+ Nam : constant Name_Id :=
+ Chars (Pragma_Identifier (N));
+ Arg : Node_Id := First (Pragma_Argument_Associations (N));
+ begin
+ case Nam is
+ when Name_Assert |
+ Name_Check |
+ Name_Precondition |
+ Name_Postcondition =>
+
+ if Nam = Name_Check then
+ Next (Arg);
+ end if;
+
+ if Assertions_Enabled then
+ Process_Decisions (Expression (Arg), 'P');
+ end if;
+
+ when others =>
+ Process_Decisions (N, 'X');
+ end case;
+ end;
+
+ -- All other cases, which extend the current statement sequence
+ -- but do not terminate it, even if they have nested decisions.
when others =>
+
+ -- Determine required type character code
+
+ declare
+ Typ : Character;
+
+ begin
+ case Nkind (N) is
+ when N_Full_Type_Declaration |
+ N_Incomplete_Type_Declaration |
+ N_Private_Type_Declaration |
+ N_Private_Extension_Declaration =>
+ Typ := 't';
+
+ when N_Subtype_Declaration =>
+ Typ := 's';
+
+ when N_Object_Declaration =>
+ Typ := 'o';
+
+ when N_Renaming_Declaration =>
+ Typ := 'r';
+
+ when N_Generic_Instantiation =>
+ Typ := 'i';
+
+ when others =>
+ Typ := ' ';
+ end case;
+
+ Extend_Statement_Sequence (N, Typ);
+ end;
+
+ -- Process any embedded decisions
+
if Has_Decision (N) then
- Set_Statement_Entry;
Process_Decisions (N, 'X');
end if;
end case;
- -- If that element did not terminate the current sequence of
- -- statements, then establish or extend this sequence.
-
- if not Term then
- if Start = No_Location then
- Sloc_Range (N, Start, Stop);
- else
- Sloc_Range (N, Dummy, Stop);
- end if;
- end if;
-
Next (N);
end loop;
Handler : Node_Id;
begin
- if Present (N) then
+
+ -- For package bodies without a statement part, the parser adds an empty
+ -- one, to normalize the representation. The null statement therein,
+ -- which does not come from source, does not get a SCO.
+
+ if Present (N) and then Comes_From_Source (N) then
Traverse_Declarations_Or_Statements (Statements (N));
if Present (Exception_Handlers (N)) then
OSDN Git Service
