From 9dbf1c3e7f70bf9ecdf8a61340c9f76ff04251d3 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 26 Jan 2010 10:30:04 +0000 Subject: [PATCH] par_sco.adb (Traverse_Declarations_Or_Statments): Implement new format of statement sequence SCO entries (one location/statement). 2010-01-26 Robert Dewar * 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 --- gcc/ada/ChangeLog | 8 ++ gcc/ada/par_sco.adb | 172 ++++++++++++++++++++++++++++++++++--------- gcc/ada/put_scos.adb | 27 +++++-- gcc/ada/scos.ads | 16 ++-- gcc/ada/sem_eval.adb | 10 +-- 5 files changed, 180 insertions(+), 53 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4c9f2cd7e5f..3914678a7e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2010-01-26 Robert Dewar + + * 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 * par_sco.ads, par_sco.adb (Set_Statement_Entry): New handling of exits diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index b4953b3e4bf..bee56cd540a 100644 --- a/gcc/ada/par_sco.adb +++ b/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'); diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index bca3f698815..3be6d8b3b3a 100644 --- a/gcc/ada/put_scos.adb +++ b/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 diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index b1a61b25ec5..e9c1d159215 100644 --- a/gcc/ada/scos.ads +++ b/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. ---------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index f38e0595e45..c9054f387a8 100644 --- a/gcc/ada/sem_eval.adb +++ b/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); -- 2.30.2