From 1e8878861c684fa8695bd09bf585c44ed59c3801 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Tue, 27 May 2008 11:20:48 +0200 Subject: [PATCH] 2008-05-27 Vincent Celier * makeutl.ads, makeutl.adb: (Set_Location): New procedure (Get_Location): New function (Update_Main): New procedure From-SVN: r135993 --- gcc/ada/makeutl.adb | 48 ++++++++++++++++++++++++++++++++++++++++++--- gcc/ada/makeutl.ads | 10 ++++++++++ 2 files changed, 55 insertions(+), 3 deletions(-) diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 63b975c36f6..71e207a55f8 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -481,8 +481,13 @@ package body Makeutl is package body Mains is + type File_And_Loc is record + File_Name : File_Name_Type; + Location : Source_Ptr := No_Location; + end record; + package Names is new Table.Table - (Table_Component_Type => File_Name_Type, + (Table_Component_Type => File_And_Loc, Table_Index_Type => Integer, Table_Low_Bound => 1, Table_Initial => 10, @@ -502,7 +507,7 @@ package body Makeutl is Name_Len := 0; Add_Str_To_Name_Buffer (Name); Names.Increment_Last; - Names.Table (Names.Last) := Name_Find; + Names.Table (Names.Last) := (Name_Find, No_Location); end Add_Main; ------------ @@ -515,6 +520,20 @@ package body Makeutl is Mains.Reset; end Delete; + ------------------ + -- Get_Location -- + ------------------ + + function Get_Location return Source_Ptr is + begin + if Current < Names.First or else Current > Names.Last then + return No_Location; + + else + return Names.Table (Current).Location; + end if; + end Get_Location; + --------------- -- Next_Main -- --------------- @@ -526,7 +545,7 @@ package body Makeutl is else Current := Current + 1; - return Get_Name_String (Names.Table (Current)); + return Get_Name_String (Names.Table (Current).File_Name); end if; end Next_Main; @@ -548,6 +567,29 @@ package body Makeutl is Current := 0; end Reset; + ------------------ + -- Set_Location -- + ------------------ + + procedure Set_Location (Location : Source_Ptr) is + begin + if Names.Last > 0 then + Names.Table (Names.Last).Location := Location; + end if; + end Set_Location; + + ----------------- + -- Update_Main -- + ----------------- + + procedure Update_Main (Name : String) is + begin + if Current >= Names.First and then Current <= Names.Last then + Name_Len := 0; + Add_Str_To_Name_Buffer (Name); + Names.Table (Current).File_Name := Name_Find; + end if; + end Update_Main; end Mains; ---------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 9672744a1ac..b6483f3e520 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -103,6 +103,10 @@ package Makeutl is procedure Add_Main (Name : String); -- Add one main to the table + procedure Set_Location (Location : Source_Ptr); + -- Set the location of the last main added. By default, the location is + -- No_Location. + procedure Delete; -- Empty the table @@ -113,6 +117,12 @@ package Makeutl is -- Increase the index and return the next main. -- If table is exhausted, return an empty string. + function Get_Location return Source_Ptr; + -- Get the location of the current main + + procedure Update_Main (Name : String); + -- Update the file name of the current main + function Number_Of_Mains return Natural; -- Returns the number of mains added with Add_Main since the last call -- to Delete. -- 2.30.2