From cd38efa560f565cb02cba62fe919e591dc110b74 Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Thu, 10 Oct 2013 12:37:53 +0200
Subject: [multiple changes]
2013-10-10 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting.
2013-10-10 Robert Dewar <dewar@adacore.com>
* sinput-c.adb (Load_File): Ensure Source_Align alignment.
* sinput-d.adb (Create_Debug_Source): Ensure Source_Align alignment.
* sinput-l.adb (Create_Instantiation_Source): Ensure Source_Align
alignment.
(Load_File): Ditto.
* sinput.ads, sinput.adb (Get_Source_File_Index): New optimized (single
line) version.
* types.ads (Source_Align): New definition.
(Source_Buffer): Document new alignment requirement.
2013-10-10 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Linker_Section): Allow
this for types.
2013-10-10 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor adjustment to doc for To_Address attribute.
2013-10-10 Vadim Godunko <godunko@adacore.com>
* s-stopoo.ads (Root_Storage_Pool): Add pragma
Preelaborable_Initialization.
From-SVN: r203343
---
gcc/ada/ChangeLog | 30 ++++++++++++++++++++++++++
gcc/ada/gnat_rm.texi | 3 ++-
gcc/ada/s-stopoo.ads | 3 ++-
gcc/ada/sem_ch3.adb | 4 +++-
gcc/ada/sem_prag.adb | 9 +++++---
gcc/ada/sinput-c.adb | 5 +++--
gcc/ada/sinput-d.adb | 6 ++++--
gcc/ada/sinput-l.adb | 29 +++++++++++++++----------
gcc/ada/sinput.adb | 61 +++++++---------------------------------------------
gcc/ada/sinput.ads | 34 +++++++----------------------
gcc/ada/types.ads | 8 ++++++-
11 files changed, 91 insertions(+), 101 deletions(-)
(limited to 'gcc/ada')
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 61d8a4c..d0658b9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb: Minor reformatting.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * sinput-c.adb (Load_File): Ensure Source_Align alignment.
+ * sinput-d.adb (Create_Debug_Source): Ensure Source_Align alignment.
+ * sinput-l.adb (Create_Instantiation_Source): Ensure Source_Align
+ alignment.
+ (Load_File): Ditto.
+ * sinput.ads, sinput.adb (Get_Source_File_Index): New optimized (single
+ line) version.
+ * types.ads (Source_Align): New definition.
+ (Source_Buffer): Document new alignment requirement.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma, case Linker_Section): Allow
+ this for types.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Minor adjustment to doc for To_Address attribute.
+
+2013-10-10 Vadim Godunko <godunko@adacore.com>
+
+ * s-stopoo.ads (Root_Storage_Pool): Add pragma
+ Preelaborable_Initialization.
+
2013-09-25 Tom Tromey <tromey@redhat.com>
* gcc-interface/Makefile.in (OUTPUT_OPTION): Define as "-o $@".
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index c1109b9..74acbb3 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -8669,7 +8669,8 @@ static expression. The result is that such an expression can be
used in contexts (e.g.@: preelaborable packages) which require a
static expression and where the function call could not be used
(since the function call is always non-static, even if its
-argument is static).
+argument is static). The argument must be in the range 0 .. 2**m-1,
+where m is the memory size (typically 32 or 64).
@node Attribute Type_Class
@unnumberedsec Attribute Type_Class
diff --git a/gcc/ada/s-stopoo.ads b/gcc/ada/s-stopoo.ads
index e2d66ff..d6153ac 100644
--- a/gcc/ada/s-stopoo.ads
+++ b/gcc/ada/s-stopoo.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -41,6 +41,7 @@ package System.Storage_Pools is
type Root_Storage_Pool is abstract
new Ada.Finalization.Limited_Controlled with private;
+ pragma Preelaborable_Initialization (Root_Storage_Pool);
procedure Allocate
(Pool : in out Root_Storage_Pool;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ea41423..4965288 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5101,12 +5101,14 @@ package body Sem_Ch3 is
if Nkind (Def) = N_Access_Definition then
if Present (Access_To_Subprogram_Definition (Def)) then
- Set_Etype (Def,
+ Set_Etype
+ (Def,
Replace_Anonymous_Access_To_Protected_Subprogram
(Spec));
else
Find_Type (Subtype_Mark (Def));
end if;
+
else
Find_Type (Def);
end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8d716aa..165df61 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -13736,10 +13736,13 @@ package body Sem_Prag is
Check_Arg_Is_Library_Level_Local_Name (Arg1);
Check_Arg_Is_Static_Expression (Arg2, Standard_String);
- -- This pragma applies only to objects
+ -- This pragma applies to objects and types
- if not Is_Object (Entity (Get_Pragma_Arg (Arg1))) then
- Error_Pragma_Arg ("pragma% applies only to objects", Arg1);
+ if not Is_Object (Entity (Get_Pragma_Arg (Arg1)))
+ and then not Is_Type (Entity (Get_Pragma_Arg (Arg1)))
+ then
+ Error_Pragma_Arg
+ ("pragma% applies only to objects and types", Arg1);
end if;
-- The only processing required is to link this item on to the
diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb
index 4ad212b..83dadaf 100644
--- a/gcc/ada/sinput-c.adb
+++ b/gcc/ada/sinput-c.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -68,7 +68,8 @@ package body Sinput.C is
if X = Source_File.First then
Lo := First_Source_Ptr;
else
- Lo := Source_File.Table (X - 1).Source_Last + 1;
+ Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) /
+ Source_Align) * Source_Align;
end if;
Name_Len := Path'Length;
diff --git a/gcc/ada/sinput-d.adb b/gcc/ada/sinput-d.adb
index a860058..f150ebf 100644
--- a/gcc/ada/sinput-d.adb
+++ b/gcc/ada/sinput-d.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2013, 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- --
@@ -62,7 +62,9 @@ package body Sinput.D is
Loc : out Source_Ptr)
is
begin
- Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
+ Loc :=
+ ((Source_File.Table (Source_File.Last).Source_Last + Source_Align) /
+ Source_Align) * Source_Align;
Source_File.Append (Source_File.Table (Source));
Dfile := Source_File.Last;
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index 64a7cdb..b722788 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -112,7 +112,6 @@ package body Sinput.L is
procedure Complete_Source_File_Entry is
CSF : constant Source_File_Index := Current_Source_File;
-
begin
Trim_Lines_Table (CSF);
Source_File.Table (CSF).Source_Checksum := Checksum;
@@ -158,7 +157,6 @@ package body Sinput.L is
Snew.Inlined_Call := Sloc (Inst_Node);
else
-
-- If the spec has been instantiated already, and we are now
-- creating the instance source for the corresponding body now,
-- retrieve the instance id that was assigned to the spec, which
@@ -167,10 +165,10 @@ package body Sinput.L is
Inst_Spec := Instance_Spec (Inst_Node);
if Present (Inst_Spec) then
declare
- Inst_Spec_Ent : Entity_Id;
+ Inst_Spec_Ent : Entity_Id;
-- Instance spec entity
- Inst_Spec_Sloc : Source_Ptr;
+ Inst_Spec_Sloc : Source_Ptr;
-- Virtual sloc of the spec instance source
Inst_Spec_Inst_Id : Instance_Id;
@@ -188,12 +186,13 @@ package body Sinput.L is
-- The specification of the instance entity has a virtual
-- sloc within the instance sloc range.
+
-- ??? But the Unit_Declaration_Node has the sloc of the
-- instantiation, which is somewhat of an oddity.
- Inst_Spec_Sloc :=
- Sloc (Specification (Unit_Declaration_Node
- (Inst_Spec_Ent)));
+ Inst_Spec_Sloc :=
+ Sloc
+ (Specification (Unit_Declaration_Node (Inst_Spec_Ent)));
Inst_Spec_Inst_Id :=
Source_File.Table
(Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
@@ -209,11 +208,16 @@ package body Sinput.L is
end if;
end if;
- -- Now we need to compute the new values of Source_First,
+ -- Now we need to compute the new values of Source_First and
-- Source_Last and adjust the source file pointer to have the
-- correct virtual origin for the new range of values.
- Snew.Source_First := Source_File.Table (Xnew - 1).Source_Last + 1;
+ -- Source_First must be greater than the last Source_Last value
+ -- and also must be a multiple of Source_Align
+
+ Snew.Source_First :=
+ ((Source_File.Table (Xnew - 1).Source_Last + Source_Align) /
+ Source_Align) * Source_Align;
A.Adjust := Snew.Source_First - A.Lo;
Snew.Source_Last := A.Hi + A.Adjust;
@@ -398,10 +402,13 @@ package body Sinput.L is
Source_File.Increment_Last;
X := Source_File.Last;
+ -- Compute starting index, respecting alignment requirement
+
if X = Source_File.First then
Lo := First_Source_Ptr;
else
- Lo := Source_File.Table (X - 1).Source_Last + 1;
+ Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) /
+ Source_Align) * Source_Align;
end if;
Osint.Read_Source_File (N, Lo, Hi, Src, T);
diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb
index a01c045..7bd0a69 100644
--- a/gcc/ada/sinput.adb
+++ b/gcc/ada/sinput.adb
@@ -434,44 +434,9 @@ package body Sinput is
-- Get_Source_File_Index --
---------------------------
- Source_Cache_First : Source_Ptr := 1;
- Source_Cache_Last : Source_Ptr := 0;
- -- Records the First and Last subscript values for the most recently
- -- referenced entry in the source table, to optimize the common case of
- -- repeated references to the same entry. The initial values force an
- -- initial search to set the cache value.
-
- Source_Cache_Index : Source_File_Index := No_Source_File;
- -- Contains the index of the entry corresponding to Source_Cache
-
function Get_Source_File_Index (S : Source_Ptr) return Source_File_Index is
begin
- if S in Source_Cache_First .. Source_Cache_Last then
- return Source_Cache_Index;
-
- else
- pragma Assert (Source_File_Index_Table (Int (S) / Chunk_Size)
- /=
- No_Source_File);
- for J in Source_File_Index_Table (Int (S) / Chunk_Size)
- .. Source_File.Last
- loop
- if S in Source_File.Table (J).Source_First ..
- Source_File.Table (J).Source_Last
- then
- Source_Cache_Index := J;
- Source_Cache_First :=
- Source_File.Table (Source_Cache_Index).Source_First;
- Source_Cache_Last :=
- Source_File.Table (Source_Cache_Index).Source_Last;
- return Source_Cache_Index;
- end if;
- end loop;
- end if;
-
- -- We must find a matching entry in the above loop!
-
- raise Program_Error;
+ return Source_File_Index_Table (Int (S) / Source_Align);
end Get_Source_File_Index;
----------------
@@ -480,9 +445,6 @@ package body Sinput is
procedure Initialize is
begin
- Source_Cache_First := 1;
- Source_Cache_Last := 0;
- Source_Cache_Index := No_Source_File;
Source_gnat_adc := No_Source_File;
First_Time_Around := True;
@@ -724,15 +686,13 @@ package body Sinput is
Ind : Int;
SP : Source_Ptr;
SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last;
-
begin
- SP := (Source_File.Table (Xnew).Source_First + Chunk_Size - 1)
- / Chunk_Size * Chunk_Size;
- Ind := Int (SP) / Chunk_Size;
-
+ SP := Source_File.Table (Xnew).Source_First;
+ pragma Assert (SP mod Source_Align = 0);
+ Ind := Int (SP) / Source_Align;
while SP <= SL loop
Source_File_Index_Table (Ind) := Xnew;
- SP := SP + Chunk_Size;
+ SP := SP + Source_Align;
Ind := Ind + 1;
end loop;
end Set_Source_File_Index_Table;
@@ -921,19 +881,14 @@ package body Sinput is
end loop;
end if;
- -- Reset source cache pointers to force new read
-
- Source_Cache_First := 1;
- Source_Cache_Last := 0;
-
-- 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.
+ -- 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
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index f678ff6..b5b2d74 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -342,36 +342,17 @@ package Sinput is
-- The Get_Source_File_Index function is called very frequently. Earlier
-- versions cached a single entry, but then reverted to a serial search,
- -- and this proved to be a significant source of inefficiency. To get
- -- around this, we use the following directly indexed array. The space
- -- of possible input values is a value of type Source_Ptr which is simply
- -- an Int value. The values in this space are allocated sequentially as
- -- new units are loaded.
-
- -- The following table has an entry for each 4K range of possible
- -- Source_Ptr values. The value in the table is the lowest value
- -- Source_File_Index whose Source_Ptr range contains value in the
- -- range.
-
- -- For example, the entry with index 4 in this table represents Source_Ptr
- -- values in the range 4*4096 .. 5*4096-1. The Source_File_Index value
- -- stored would be the lowest numbered source file with at least one byte
- -- in this range.
-
- -- The algorithm used in Get_Source_File_Index is simply to access this
- -- table and then do a serial search starting at the given position. This
- -- will almost always terminate with one or two checks.
+ -- and this proved to be a significant source of inefficiency. We then
+ -- switched to using a table with a start point followed by a serial
+ -- search. Now we make sure source buffers are on a reasonable boundary
+ -- (see Types.Source_Align), and we can just use a direct look up in the
+ -- following table.
-- Note that this array is pretty large, but in most operating systems
-- it will not be allocated in physical memory unless it is actually used.
- Chunk_Power : constant := 12;
- Chunk_Size : constant := 2 ** Chunk_Power;
- -- Change comments above if value changed. Note that Chunk_Size must
- -- be a power of 2 (to allow for efficient access to the table).
-
Source_File_Index_Table :
- array (Int range 0 .. Int'Last / Chunk_Size) of Source_File_Index;
+ array (Int range 0 .. 1 + (Int'Last / Source_Align)) of Source_File_Index;
procedure Set_Source_File_Index_Table (Xnew : Source_File_Index);
-- Sets entries in the Source_File_Index_Table for the newly created
@@ -605,6 +586,7 @@ package Sinput is
-- value is the physical line number in the source being compiled.
function Get_Source_File_Index (S : Source_Ptr) return Source_File_Index;
+ pragma Inline (Get_Source_File_Index);
-- Return file table index of file identified by given source pointer
-- value. This call must always succeed, since any valid source pointer
-- value belongs to some previously loaded source file.
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 4bbaa6b..19e633a 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -183,11 +183,17 @@ package Types is
No_Column_Number : constant Column_Number := 0;
-- Special value used to indicate no column number
+ Source_Align : constant := 2 ** 12;
+ -- Alignment requirement for source buffers (by keeping source buffers
+ -- aligned, we can optimize the implementation of Get_Source_File_Index.
+ -- See this routine in Sinput for details.
+
subtype Source_Buffer is Text_Buffer;
-- Type used to store text of a source file. The buffer for the main
-- source (the source specified on the command line) has a lower bound
-- starting at zero. Subsequent subsidiary sources have lower bounds
- -- which are one greater than the previous upper bound.
+ -- which are one greater than the previous upper bound, rounded up to
+ -- a multiple of Source_Align.
subtype Big_Source_Buffer is Text_Buffer (0 .. Text_Ptr'Last);
-- This is a virtual type used as the designated type of the access type
--
cgit v1.1