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>
* 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
(Extend_Statement_Sequence): New procedures
(Traverse_Declarations_Or_Statements): New handling for exits.
......
gcc/ada/par_sco.adb
......@@ -757,14 +757,41 @@ package body Par_SCO is
procedure Traverse_Declarations_Or_Statements (L : List_Id) is
N : Node_Id;
Start : Source_Ptr;
Dummy : Source_Ptr;
Stop : Source_Ptr;
procedure Extend_Statement_Sequence (N : Node_Id);
-- Extend the current statement sequence to encompass the node N
procedure Extend_Statement_Sequence (From : Node_Id; To : Node_Id);
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 .. 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
-- 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
......@@ -782,11 +809,26 @@ package body Par_SCO is
-------------------------
procedure Set_Statement_Entry is
C1 : Character;
begin
if Start /= No_Location then
Set_Table_Entry ('S', ' ', Start, Stop, False);
Start := No_Location;
Stop := No_Location;
if SC_Last /= 0 then
for J in 1 .. SC_Last loop
if J = 1 then
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 Set_Statement_Entry;
......@@ -794,33 +836,53 @@ package body Par_SCO is
-- Extend_Statement_Sequence --
-------------------------------
procedure Extend_Statement_Sequence (N : Node_Id) is
procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
begin
if Start = No_Location then
Sloc_Range (N, Start, Stop);
-- Clear out statement sequence if array full
if SC_Last = SC_Array'Last then
Set_Statement_Entry;
else
Sloc_Range (N, Dummy, Stop);
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) is
procedure Extend_Statement_Sequence
(From : Node_Id;
To : Node_Id;
Typ : Character)
is
begin
if Start = No_Location then
Sloc_Range (From, Start, Dummy);
-- 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;
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;
-- 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
-- Initialize or extend current statement sequence. Note that for
......@@ -875,7 +937,7 @@ package body Par_SCO is
-- any decisions in the exit statement expression.
when N_Exit_Statement =>
Extend_Statement_Sequence (N);
Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
Process_Decisions (Condition (N), 'E');
......@@ -884,7 +946,7 @@ package body Par_SCO is
when N_Label =>
Set_Statement_Entry;
Extend_Statement_Sequence (N);
Extend_Statement_Sequence (N, ' ');
-- Block statement, which breaks the current statement seqeunce
-- it probably does not need to, but for now it does.
......@@ -899,7 +961,7 @@ package body Par_SCO is
-- but we include the condition in the current sequence.
when N_If_Statement =>
Extend_Statement_Sequence (N, Condition (N));
Extend_Statement_Sequence (N, Condition (N), 'I');
Set_Statement_Entry;
Process_Decisions (Condition (N), 'I');
Traverse_Declarations_Or_Statements (Then_Statements (N));
......@@ -923,8 +985,7 @@ package body Par_SCO is
-- but we include the expression in the current sequence.
when N_Case_Statement =>
Extend_Statement_Sequence (N, Expression (N));
Extend_Statement_Sequence (N, Expression (N), 'C');
Set_Statement_Entry;
Process_Decisions (Expression (N), 'X');
......@@ -947,23 +1008,31 @@ package body Par_SCO is
when N_Requeue_Statement |
N_Goto_Statement |
N_Raise_Statement =>
Extend_Statement_Sequence (N);
Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
-- 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);
Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
Process_Decisions (Expression (N), 'X');
-- 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));
......@@ -974,9 +1043,8 @@ package body Par_SCO is
when N_Loop_Statement =>
if Present (Iteration_Scheme (N)) then
Extend_Statement_Sequence (N, Iteration_Scheme (N));
Process_Decisions
(Condition (Iteration_Scheme (N)), 'W');
Extend_Statement_Sequence (N, Iteration_Scheme (N), 'F');
Process_Decisions (Condition (Iteration_Scheme (N)), 'W');
end if;
Set_Statement_Entry;
......@@ -986,7 +1054,43 @@ package body Par_SCO is
-- but do not terminate it, even if they have nested decisions.
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
Process_Decisions (N, 'X');
......
gcc/ada/put_scos.adb
......@@ -90,13 +90,30 @@ begin
case T.C1 is
-- Statements, exit
-- Statements
when 'S' | 'T' =>
Write_Info_Char (' ');
Output_Range (T);
when 'S' =>
loop
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' =>
if T.C2 = ' ' then
......
gcc/ada/scos.ads
......@@ -48,10 +48,6 @@ package SCOs is
-- Put_SCO reads the internal tables and generates text lines in the ALI
-- 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 --
--------------------
......@@ -150,8 +146,10 @@ package SCOs is
-- o object declaration
-- r renaming declaration
-- i generic instantiation
-- C CASE statement
-- F FOR loop statement
-- C CASE statement (includes only the expression)
-- 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
-- R extended RETURN statement
......@@ -279,9 +277,9 @@ package SCOs is
-- Statements
-- 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/
-- CASE/FOR/PRAGMA/RETURN/other)
-- CASE/FOR or WHILE/IF/PRAGMA/RETURN/other)
-- From = starting source location
-- To = ending source location
-- Last = False for all but the last entry, True for last entry
......@@ -316,7 +314,7 @@ package SCOs is
-- 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
-- Last = True, indicate the sequence to be output for a complex decision
-- on a single CD decision line.
----------------
......
gcc/ada/sem_eval.adb
......@@ -1911,9 +1911,9 @@ package body Sem_Eval is
Atyp := Designated_Type (Atyp);
end if;
-- If we have an array type (we should have but perhaps there
-- are error cases where this is not the case), then see if we
-- can do a constant evaluation of the array reference.
-- If we have an array type (we should have but perhaps there are
-- error cases where this is not the case), then see if we can do
-- a constant evaluation of the array reference.
if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then
if Ekind (Atyp) = E_String_Literal_Subtype then
......@@ -1983,8 +1983,8 @@ package body Sem_Eval is
-- 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
-- the possibility of turning off the Is_Static_Expression flag after
-- analysis, but before resolution, when integer literals are generated
-- in the expander that do not correspond to static expressions.
-- analysis, but before resolution, when integer literals are generated in
-- the expander that do not correspond to static expressions.
procedure Eval_Integer_Literal (N : Node_Id) is
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