Commit cd38efa5 by Arnaud Charlet

[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
parent d6394e2b
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 $@".
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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);
......
......@@ -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
......
......@@ -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.
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment