OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sinput.ads, sinput.adb (Build_Location_String): Take a parameter instead of using a global variable. 

2016-04-18  Bob Duff  <duff@adacore.com>

	* sinput.ads, sinput.adb (Build_Location_String): Take a
	parameter instead of using a global variable.  The function
	version no longer destroys the Name_Buffer.
	* stringt.ads, stringt.adb (String_From_Name_Buffer): Take a
	parameter, which defaults to the Global_Name_Buffer, so some
	calls can avoid the global.
	* exp_ch11.adb, exp_intr.adb: Use new interfaces above
	to avoid using globals. All but one call to Build_Location_String
	avoids the global. Only one call to String_From_Name_Buffer
	avoids it.

From-SVN: r235126
This commit is contained in:
Bob Duff 2016-04-18 10:48:33 +00:00 committed by Arnaud Charlet
parent bd717ec9b7
commit ea1027992d
7 changed files with 49 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2016-04-18 Bob Duff <duff@adacore.com>
* sinput.ads, sinput.adb (Build_Location_String): Take a
parameter instead of using a global variable. The function
version no longer destroys the Name_Buffer.
* stringt.ads, stringt.adb (String_From_Name_Buffer): Take a
parameter, which defaults to the Global_Name_Buffer, so some
calls can avoid the global.
* exp_ch11.adb, exp_intr.adb: Use new interfaces above
to avoid using globals. All but one call to Build_Location_String
avoids the global. Only one call to String_From_Name_Buffer
avoids it.
2016-04-18 Hristian Kirtchev <kirtchev@adacore.com>
* namet.adb, namet.ads, exp_unst.adb: Minor reformatting.

14
gcc/ada/exp_ch11.adb
View File

@ -1658,10 +1658,10 @@ package body Exp_Ch11 is
if Present (Name (N)) then
declare
Id : Entity_Id := Entity (Name (N));
Buf : Bounded_String;
begin
Name_Len := 0;
Build_Location_String (Loc);
Build_Location_String (Buf, Loc);
-- If the exception is a renaming, use the exception that it
-- renames (which might be a predefined exception, e.g.).
@ -1679,19 +1679,17 @@ package body Exp_Ch11 is
-- Suppress_Exception_Locations is set for this unit.
if Opt.Exception_Locations_Suppressed then
Name_Len := 1;
else
Name_Len := Name_Len + 1;
Buf.Length := 0;
end if;
Name_Buffer (Name_Len) := ASCII.NUL;
Append (Buf, ASCII.NUL);
end if;
if Opt.Exception_Locations_Suppressed then
Name_Len := 0;
Buf.Length := 0;
end if;
Str := String_From_Name_Buffer;
Str := String_From_Name_Buffer (Buf);
-- Convert raise to call to the Raise_Exception routine

2
gcc/ada/exp_intr.adb
View File

@ -145,7 +145,7 @@ package body Exp_Intr is
(Reference_Name (Get_Source_File_Index (Loc)));
when Name_Source_Location =>
Build_Location_String (Loc);
Build_Location_String (Global_Name_Buffer, Loc);
when Name_Enclosing_Entity =>

28
gcc/ada/sinput.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -221,33 +221,31 @@ package body Sinput is
-- Build_Location_String --
---------------------------
procedure Build_Location_String (Loc : Source_Ptr) is
Ptr : Source_Ptr;
procedure Build_Location_String
(Buf : in out Bounded_String;
Loc : Source_Ptr)
is
Ptr : Source_Ptr := Loc;
begin
-- Loop through instantiations
Ptr := Loc;
loop
Get_Name_String_And_Append
(Reference_Name (Get_Source_File_Index (Ptr)));
Add_Char_To_Name_Buffer (':');
Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (Ptr)));
Append (Buf, Reference_Name (Get_Source_File_Index (Ptr)));
Append (Buf, ':');
Append (Buf, Nat (Get_Logical_Line_Number (Ptr)));
Ptr := Instantiation_Location (Ptr);
exit when Ptr = No_Location;
Add_Str_To_Name_Buffer (" instantiated at ");
Append (Buf, " instantiated at ");
end loop;
Name_Buffer (Name_Len + 1) := NUL;
return;
end Build_Location_String;
function Build_Location_String (Loc : Source_Ptr) return String is
Buf : Bounded_String;
begin
Name_Len := 0;
Build_Location_String (Loc);
return Name_Buffer (1 .. Name_Len);
Build_Location_String (Buf, Loc);
return +Buf;
end Build_Location_String;
-------------------

15
gcc/ada/sinput.ads
View File

@ -536,18 +536,17 @@ package Sinput is
-- The caller has checked that a Line_Terminator character precedes P so
-- that there definitely is a previous line in the source buffer.
procedure Build_Location_String (Loc : Source_Ptr);
procedure Build_Location_String
(Buf : in out Bounded_String;
Loc : Source_Ptr);
-- This function builds a string literal of the form "name:line", where
-- name is the file name corresponding to Loc, and line is the line number.
-- In the event that instantiations are involved, additional suffixes of
-- the same form are appended after the separating string " instantiated at
-- ". The returned string is appended to the Name_Buffer, terminated by
-- ASCII.NUL, with Name_Length indicating the length not including the
-- terminating Nul.
-- If instantiations are involved, additional suffixes of the same form are
-- appended after the separating string " instantiated at ". The returned
-- string is appended to Buf.
function Build_Location_String (Loc : Source_Ptr) return String;
-- Functional form returning a string, which does not include a terminating
-- null character. The contents of Name_Buffer is destroyed.
-- Functional form returning a String
procedure Check_For_BOM;
-- Check if the current source starts with a BOM. Scan_Ptr needs to be at

12
gcc/ada/stringt.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -30,7 +30,6 @@
------------------------------------------------------------------------------
with Alloc;
with Namet; use Namet;
with Output; use Output;
with Table;
@ -307,14 +306,11 @@ package body Stringt is
-- String_From_Name_Buffer --
-----------------------------
function String_From_Name_Buffer return String_Id is
function String_From_Name_Buffer
(Buf : Bounded_String := Global_Name_Buffer) return String_Id is
begin
Start_String;
for J in 1 .. Name_Len loop
Store_String_Char (Get_Char_Code (Name_Buffer (J)));
end loop;
Store_String_Chars (+Buf);
return End_String;
end String_From_Name_Buffer;

10
gcc/ada/stringt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with System; use System;
with Types; use Types;
@ -131,10 +132,9 @@ package Stringt is
function String_Chars_Address return System.Address;
-- Return address of String_Chars table (used by Back_End call to Gigi)
function String_From_Name_Buffer return String_Id;
-- Given a name stored in Namet.Name_Buffer (length in Namet.Name_Len),
-- returns a string of the corresponding value. The value in Name_Buffer
-- is unchanged, and the cases of letters are unchanged.
function String_From_Name_Buffer
(Buf : Bounded_String := Global_Name_Buffer) return String_Id;
-- Given a name stored in Buf, returns a string of the corresponding value.
function Strings_Address return System.Address;
-- Return address of Strings table (used by Back_End call to Gigi)