Skip to content

R
riscv-gcc-1
Commit 9dbf1c3e by Robert Dewar Committed by Arnaud Charlet
Options

par_sco.adb (Traverse_Declarations_Or_Statments): Implement new format of… 

par_sco.adb (Traverse_Declarations_Or_Statments): Implement new format of statement sequence SCO entries (one location/statement).

2010-01-26  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb (Traverse_Declarations_Or_Statments): Implement new
	format of statement sequence SCO entries (one location/statement).
	* put_scos.adb (Put_SCOs): Implement new format of CS lines
	* scos.ads: Update comments.
	* sem_eval.adb: Minor reformatting.

From-SVN: r156242
parent 7ef50d41
Showing with 180 additions and 53 deletions
gcc/ada/ChangeLog
2010-01-26 Robert Dewar <dewar@adacore.com> 2010-01-26 Robert Dewar <dewar@adacore.com>
* par_sco.adb (Traverse_Declarations_Or_Statments): Implement new
format of statement sequence SCO entries (one location/statement).
* put_scos.adb (Put_SCOs): Implement new format of CS lines
* scos.ads: Update comments.
* sem_eval.adb: Minor reformatting.
2010-01-26 Robert Dewar <dewar@adacore.com>
* par_sco.ads, par_sco.adb (Set_Statement_Entry): New handling of exits * par_sco.ads, par_sco.adb (Set_Statement_Entry): New handling of exits
(Extend_Statement_Sequence): New procedures (Extend_Statement_Sequence): New procedures
(Traverse_Declarations_Or_Statements): New handling for exits. (Traverse_Declarations_Or_Statements): New handling for exits.
......
gcc/ada/par_sco.adb
...@@ -757,14 +757,41 @@ package body Par_SCO is ...@@ -757,14 +757,41 @@ package body Par_SCO is
procedure Traverse_Declarations_Or_Statements (L : List_Id) is procedure Traverse_Declarations_Or_Statements (L : List_Id) is
N : Node_Id; N : Node_Id;
Start : Source_Ptr;
Dummy : Source_Ptr; Dummy : Source_Ptr;
Stop : Source_Ptr;
procedure Extend_Statement_Sequence (N : Node_Id); type SC_Entry is record
-- Extend the current statement sequence to encompass the node N From : Source_Ptr;
To : Source_Ptr;
procedure Extend_Statement_Sequence (From : Node_Id; To : Node_Id); Typ : Character;
end record;
-- Used to store a single entry in the following array
SC_Array : array (Nat range 1 .. 100) 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 100 here is arbitrary, but does
-- not cause any trouble, if we encounter more than 100 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.
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 -- This version extends the current statement sequence with an entry
-- that starts with the first token of From, and ends with the last -- 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 -- token of To. It is used for example in a CASE statement to cover
...@@ -782,11 +809,26 @@ package body Par_SCO is ...@@ -782,11 +809,26 @@ package body Par_SCO is
------------------------- -------------------------
procedure Set_Statement_Entry is procedure Set_Statement_Entry is
C1 : Character;
begin begin
if Start /= No_Location then if SC_Last /= 0 then
Set_Table_Entry ('S', ' ', Start, Stop, False); for J in 1 .. SC_Last loop
Start := No_Location; if J = 1 then
Stop := No_Location; C1 := 'S';
else
C1 := 's';
end if;
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 if;
end Set_Statement_Entry; end Set_Statement_Entry;
...@@ -794,33 +836,53 @@ package body Par_SCO is ...@@ -794,33 +836,53 @@ package body Par_SCO is
-- Extend_Statement_Sequence -- -- Extend_Statement_Sequence --
------------------------------- -------------------------------
procedure Extend_Statement_Sequence (N : Node_Id) is procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
begin begin
if Start = No_Location then -- Clear out statement sequence if array full
Sloc_Range (N, Start, Stop);
if SC_Last = SC_Array'Last then
Set_Statement_Entry;
else else
Sloc_Range (N, Dummy, Stop); SC_Last := SC_Last + 1;
end if; 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; end Extend_Statement_Sequence;
procedure Extend_Statement_Sequence (From : Node_Id; To : Node_Id) is procedure Extend_Statement_Sequence
(From : Node_Id;
To : Node_Id;
Typ : Character)
is
begin begin
if Start = No_Location then -- Clear out statement sequence if array full
Sloc_Range (From, Start, Dummy);
if SC_Last = SC_Array'Last then
Set_Statement_Entry;
else
SC_Last := SC_Last + 1;
end if; end if;
Sloc_Range (To, Dummy, Stop); -- 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; end Extend_Statement_Sequence;
-- Start of processing for Traverse_Declarations_Or_Statements -- Start of processing for Traverse_Declarations_Or_Statements
begin begin
if Is_Non_Empty_List (L) then if Is_Non_Empty_List (L) then
N := First (L); SC_Last := 0;
Start := No_Location;
-- Loop through statements or declarations -- Loop through statements or declarations
N := First (L);
while Present (N) loop while Present (N) loop
-- Initialize or extend current statement sequence. Note that for -- Initialize or extend current statement sequence. Note that for
...@@ -875,7 +937,7 @@ package body Par_SCO is ...@@ -875,7 +937,7 @@ package body Par_SCO is
-- any decisions in the exit statement expression. -- any decisions in the exit statement expression.
when N_Exit_Statement => when N_Exit_Statement =>
Extend_Statement_Sequence (N); Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry; Set_Statement_Entry;
Process_Decisions (Condition (N), 'E'); Process_Decisions (Condition (N), 'E');
...@@ -884,7 +946,7 @@ package body Par_SCO is ...@@ -884,7 +946,7 @@ package body Par_SCO is
when N_Label => when N_Label =>
Set_Statement_Entry; Set_Statement_Entry;
Extend_Statement_Sequence (N); Extend_Statement_Sequence (N, ' ');
-- Block statement, which breaks the current statement seqeunce -- Block statement, which breaks the current statement seqeunce
-- it probably does not need to, but for now it does. -- it probably does not need to, but for now it does.
...@@ -899,7 +961,7 @@ package body Par_SCO is ...@@ -899,7 +961,7 @@ package body Par_SCO is
-- but we include the condition in the current sequence. -- but we include the condition in the current sequence.
when N_If_Statement => when N_If_Statement =>
Extend_Statement_Sequence (N, Condition (N)); Extend_Statement_Sequence (N, Condition (N), 'I');
Set_Statement_Entry; Set_Statement_Entry;
Process_Decisions (Condition (N), 'I'); Process_Decisions (Condition (N), 'I');
Traverse_Declarations_Or_Statements (Then_Statements (N)); Traverse_Declarations_Or_Statements (Then_Statements (N));
...@@ -923,8 +985,7 @@ package body Par_SCO is ...@@ -923,8 +985,7 @@ package body Par_SCO is
-- but we include the expression in the current sequence. -- but we include the expression in the current sequence.
when N_Case_Statement => when N_Case_Statement =>
Extend_Statement_Sequence (N, Expression (N), 'C');
Extend_Statement_Sequence (N, Expression (N));
Set_Statement_Entry; Set_Statement_Entry;
Process_Decisions (Expression (N), 'X'); Process_Decisions (Expression (N), 'X');
...@@ -947,23 +1008,31 @@ package body Par_SCO is ...@@ -947,23 +1008,31 @@ package body Par_SCO is
when N_Requeue_Statement | when N_Requeue_Statement |
N_Goto_Statement | N_Goto_Statement |
N_Raise_Statement => N_Raise_Statement =>
Extend_Statement_Sequence (N); Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry; Set_Statement_Entry;
-- Simple return statement. which is an exit point, but we -- Simple return statement. which is an exit point, but we
-- have to process the return expression for decisions. -- have to process the return expression for decisions.
when N_Simple_Return_Statement => when N_Simple_Return_Statement =>
Extend_Statement_Sequence (N); Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry; Set_Statement_Entry;
Process_Decisions (Expression (N), 'X'); Process_Decisions (Expression (N), 'X');
-- Extended return statement -- Extended return statement
when N_Extended_Return_Statement => when N_Extended_Return_Statement =>
Set_Statement_Entry; declare
Traverse_Declarations_Or_Statements Odecl : constant Node_Id :=
(Return_Object_Declarations (N)); 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 Traverse_Handled_Statement_Sequence
(Handled_Statement_Sequence (N)); (Handled_Statement_Sequence (N));
...@@ -974,9 +1043,8 @@ package body Par_SCO is ...@@ -974,9 +1043,8 @@ package body Par_SCO is
when N_Loop_Statement => when N_Loop_Statement =>
if Present (Iteration_Scheme (N)) then if Present (Iteration_Scheme (N)) then
Extend_Statement_Sequence (N, Iteration_Scheme (N)); Extend_Statement_Sequence (N, Iteration_Scheme (N), 'F');
Process_Decisions Process_Decisions (Condition (Iteration_Scheme (N)), 'W');
(Condition (Iteration_Scheme (N)), 'W');
end if; end if;
Set_Statement_Entry; Set_Statement_Entry;
...@@ -986,7 +1054,43 @@ package body Par_SCO is ...@@ -986,7 +1054,43 @@ package body Par_SCO is
-- but do not terminate it, even if they have nested decisions. -- but do not terminate it, even if they have nested decisions.
when others => when others =>
Extend_Statement_Sequence (N);
-- 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 N_Pragma =>
Typ := 'P';
when others =>
Typ := ' ';
end case;
Extend_Statement_Sequence (N, Typ);
end;
-- Process any embedded decisions
if Has_Decision (N) then if Has_Decision (N) then
Process_Decisions (N, 'X'); Process_Decisions (N, 'X');
......
gcc/ada/put_scos.adb
...@@ -90,13 +90,30 @@ begin ...@@ -90,13 +90,30 @@ begin
case T.C1 is case T.C1 is
-- Statements, exit -- Statements
when 'S' | 'T' => when 'S' =>
Write_Info_Char (' '); loop
Output_Range (T); Write_Info_Char (' ');
if SCO_Table.Table (Start).C2 /= ' ' then
Write_Info_Char (SCO_Table.Table (Start).C2);
end if;
Output_Range (SCO_Table.Table (Start));
exit when SCO_Table.Table (Start).Last;
Start := Start + 1;
pragma Assert (SCO_Table.Table (Start).C1 = 's');
end loop;
-- Statement continuations should not occur since they
-- are supposed to have been handled in the loop above.
when 's' =>
raise Program_Error;
-- Decision -- Decision
when 'I' | 'E' | 'W' | 'X' => when 'I' | 'E' | 'W' | 'X' =>
if T.C2 = ' ' then if T.C2 = ' ' then
......
gcc/ada/scos.ads
...@@ -48,10 +48,6 @@ package SCOs is ...@@ -48,10 +48,6 @@ package SCOs is
-- Put_SCO reads the internal tables and generates text lines in the ALI -- Put_SCO reads the internal tables and generates text lines in the ALI
-- format. -- format.
-- ??? The specification below for the SCO ALI format and the internal
-- data structures have been modified, but the implementation has not been
-- updated yet to reflect these specification changes.
-------------------- --------------------
-- SCO ALI Format -- -- SCO ALI Format --
-------------------- --------------------
...@@ -150,8 +146,10 @@ package SCOs is ...@@ -150,8 +146,10 @@ package SCOs is
-- o object declaration -- o object declaration
-- r renaming declaration -- r renaming declaration
-- i generic instantiation -- i generic instantiation
-- C CASE statement -- C CASE statement (includes only the expression)
-- F FOR loop statement -- F FOR/WHILE loop statement (includes only the iteration scheme)
-- I IF statement (includes only the condition [in the RM sense, which
-- is a decision in the SCO sense])
-- P PRAGMA -- P PRAGMA
-- R extended RETURN statement -- R extended RETURN statement
...@@ -279,9 +277,9 @@ package SCOs is ...@@ -279,9 +277,9 @@ package SCOs is
-- Statements -- Statements
-- C1 = 'S' for entry point, 's' otherwise -- C1 = 'S' for entry point, 's' otherwise
-- C2 = 't', 's', 'o', 'r', 'i', 'C', 'F', 'P', 'R', ' ' -- C2 = 't', 's', 'o', 'r', 'i', 'C', 'F', 'I', 'P', 'R', ' '
-- (type/subtype/object/renaming/instantiation/ -- (type/subtype/object/renaming/instantiation/
-- CASE/FOR/PRAGMA/RETURN/other) -- CASE/FOR or WHILE/IF/PRAGMA/RETURN/other)
-- From = starting source location -- From = starting source location
-- To = ending source location -- To = ending source location
-- Last = False for all but the last entry, True for last entry -- Last = False for all but the last entry, True for last entry
...@@ -316,7 +314,7 @@ package SCOs is ...@@ -316,7 +314,7 @@ package SCOs is
-- Note: the sequence starting with a decision, and continuing with -- Note: the sequence starting with a decision, and continuing with
-- operators and elements up to and including the first one labeled 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 -- Last = True, indicate the sequence to be output for a complex decision
-- on a single CD decision line. -- on a single CD decision line.
---------------- ----------------
......
gcc/ada/sem_eval.adb
...@@ -1911,9 +1911,9 @@ package body Sem_Eval is ...@@ -1911,9 +1911,9 @@ package body Sem_Eval is
Atyp := Designated_Type (Atyp); Atyp := Designated_Type (Atyp);
end if; end if;
-- If we have an array type (we should have but perhaps there -- If we have an array type (we should have but perhaps there are
-- are error cases where this is not the case), then see if we -- error cases where this is not the case), then see if we can do
-- can do a constant evaluation of the array reference. -- a constant evaluation of the array reference.
if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then
if Ekind (Atyp) = E_String_Literal_Subtype then if Ekind (Atyp) = E_String_Literal_Subtype then
...@@ -1983,8 +1983,8 @@ package body Sem_Eval is ...@@ -1983,8 +1983,8 @@ package body Sem_Eval is
-- Numeric literals are static (RM 4.9(1)), and have already been marked -- Numeric literals are static (RM 4.9(1)), and have already been marked
-- as static by the analyzer. The reason we did it that early is to allow -- as static by the analyzer. The reason we did it that early is to allow
-- the possibility of turning off the Is_Static_Expression flag after -- the possibility of turning off the Is_Static_Expression flag after
-- analysis, but before resolution, when integer literals are generated -- analysis, but before resolution, when integer literals are generated in
-- in the expander that do not correspond to static expressions. -- the expander that do not correspond to static expressions.
procedure Eval_Integer_Literal (N : Node_Id) is procedure Eval_Integer_Literal (N : Node_Id) is
T : constant Entity_Id := Etype (N); T : constant Entity_Id := Etype (N);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment