diff options
Diffstat (limited to 'gcc/ada/sinput.adb')
| -rw-r--r-- | gcc/ada/sinput.adb | 167 |
1 files changed, 11 insertions, 156 deletions
diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index dbd7fe7..9f2669e 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2020, 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- -- @@ -37,7 +37,6 @@ with Debug; use Debug; with Opt; use Opt; with Output; use Output; with Scans; use Scans; -with Tree_IO; use Tree_IO; with Widechar; use Widechar; with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark; @@ -938,6 +937,8 @@ package body Sinput is procedure Sloc_Range (N : Node_Id; Min, Max : out Source_Ptr) is + Indx : constant Source_File_Index := Get_Source_File_Index (Sloc (N)); + function Process (N : Node_Id) return Traverse_Result; -- Process function for traversing the node tree @@ -951,6 +952,14 @@ package body Sinput is Orig : constant Node_Id := Original_Node (N); begin + -- Skip nodes that may have been added during expansion and + -- that originate in other units, such as code for contracts + -- in subprogram bodies. + + if Get_Source_File_Index (Sloc (Orig)) /= Indx then + return Skip; + end if; + if Sloc (Orig) < Min then if Sloc (Orig) > No_Location then Min := Sloc (Orig); @@ -1004,160 +1013,6 @@ package body Sinput is return Oldloc; end Top_Level_Location; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - -- First we must free any old source buffer pointers - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - begin - if S.Instance = No_Instance_Id then - Free_Source_Buffer (S.Source_Text); - - if S.Lines_Table /= null then - Memory.Free (To_Address (S.Lines_Table)); - S.Lines_Table := null; - end if; - - if S.Logical_Lines_Table /= null then - Memory.Free (To_Address (S.Logical_Lines_Table)); - S.Logical_Lines_Table := null; - end if; - - else - Free_Dope (S.Source_Text'Address); - S.Source_Text := null; - end if; - end; - end loop; - - -- Read in source file table and instance table - - Source_File.Tree_Read; - Instances.Tree_Read; - - -- The pointers we read in there for the source buffer and lines table - -- pointers are junk. We now read in the actual data that is referenced - -- by these two fields. - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - begin - -- Normal case (non-instantiation) - - if S.Instance = No_Instance_Id then - S.Lines_Table := null; - S.Logical_Lines_Table := null; - Alloc_Line_Tables (S, Int (S.Last_Source_Line)); - - for J in 1 .. S.Last_Source_Line loop - Tree_Read_Int (Int (S.Lines_Table (J))); - end loop; - - if S.Num_SRef_Pragmas /= 0 then - for J in 1 .. S.Last_Source_Line loop - Tree_Read_Int (Int (S.Logical_Lines_Table (J))); - end loop; - end if; - - -- Allocate source buffer and read in the data - - declare - T : constant Source_Buffer_Ptr_Var := - new Source_Buffer (S.Source_First .. S.Source_Last); - begin - Tree_Read_Data (T (S.Source_First)'Address, - Int (S.Source_Last) - Int (S.Source_First) + 1); - S.Source_Text := T.all'Access; - end; - - -- For the instantiation case, we do not read in any data. Instead - -- we share the data for the generic template entry. Since the - -- template always occurs first, we can safely refer to its data. - - else - declare - ST : Source_File_Record renames - Source_File.Table (S.Template); - - begin - -- The lines tables are copied from the template entry - - S.Lines_Table := ST.Lines_Table; - S.Logical_Lines_Table := ST.Logical_Lines_Table; - - -- The Source_Text of the instance is the same data as that - -- of the template, but with different bounds. - - declare - Dope : constant Dope_Ptr := - new Dope_Rec'(S.Source_First, S.Source_Last); - begin - S.Source_Text := ST.Source_Text; - Set_Dope (S.Source_Text'Address, Dope); - end; - end; - end if; - end; - - Set_Source_File_Index_Table (J); - end loop; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Source_File.Tree_Write; - Instances.Tree_Write; - - -- The pointers we wrote out there for the source buffer and lines - -- table pointers are junk, we now write out the actual data that - -- is referenced by these two fields. - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - - begin - -- For instantiations, there is nothing to do, since the data is - -- shared with the generic template. When the tree is read, the - -- pointers must be set, but no extra data needs to be written. - -- For the normal case, write out the data of the tables. - - if S.Instance = No_Instance_Id then - -- Lines table - - for J in 1 .. S.Last_Source_Line loop - Tree_Write_Int (Int (S.Lines_Table (J))); - end loop; - - -- Logical lines table if present - - if S.Num_SRef_Pragmas /= 0 then - for J in 1 .. S.Last_Source_Line loop - Tree_Write_Int (Int (S.Logical_Lines_Table (J))); - end loop; - end if; - - -- Source buffer - - Tree_Write_Data - (S.Source_Text (S.Source_First)'Address, - Int (S.Source_Last) - Int (S.Source_First) + 1); - end if; - end; - end loop; - end Tree_Write; - -------------------- -- Write_Location -- -------------------- |