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> 2013-09-25 Tom Tromey <tromey@redhat.com>
* gcc-interface/Makefile.in (OUTPUT_OPTION): Define as "-o $@". * gcc-interface/Makefile.in (OUTPUT_OPTION): Define as "-o $@".
......
...@@ -8669,7 +8669,8 @@ static expression. The result is that such an expression can be ...@@ -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 used in contexts (e.g.@: preelaborable packages) which require a
static expression and where the function call could not be used static expression and where the function call could not be used
(since the function call is always non-static, even if its (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 @node Attribute Type_Class
@unnumberedsec Attribute Type_Class @unnumberedsec Attribute Type_Class
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -41,6 +41,7 @@ package System.Storage_Pools is ...@@ -41,6 +41,7 @@ package System.Storage_Pools is
type Root_Storage_Pool is abstract type Root_Storage_Pool is abstract
new Ada.Finalization.Limited_Controlled with private; new Ada.Finalization.Limited_Controlled with private;
pragma Preelaborable_Initialization (Root_Storage_Pool);
procedure Allocate procedure Allocate
(Pool : in out Root_Storage_Pool; (Pool : in out Root_Storage_Pool;
......
...@@ -5101,12 +5101,14 @@ package body Sem_Ch3 is ...@@ -5101,12 +5101,14 @@ package body Sem_Ch3 is
if Nkind (Def) = N_Access_Definition then if Nkind (Def) = N_Access_Definition then
if Present (Access_To_Subprogram_Definition (Def)) then if Present (Access_To_Subprogram_Definition (Def)) then
Set_Etype (Def, Set_Etype
(Def,
Replace_Anonymous_Access_To_Protected_Subprogram Replace_Anonymous_Access_To_Protected_Subprogram
(Spec)); (Spec));
else else
Find_Type (Subtype_Mark (Def)); Find_Type (Subtype_Mark (Def));
end if; end if;
else else
Find_Type (Def); Find_Type (Def);
end if; end if;
......
...@@ -13736,10 +13736,13 @@ package body Sem_Prag is ...@@ -13736,10 +13736,13 @@ package body Sem_Prag is
Check_Arg_Is_Library_Level_Local_Name (Arg1); Check_Arg_Is_Library_Level_Local_Name (Arg1);
Check_Arg_Is_Static_Expression (Arg2, Standard_String); 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 if not Is_Object (Entity (Get_Pragma_Arg (Arg1)))
Error_Pragma_Arg ("pragma% applies only to objects", 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; end if;
-- The only processing required is to link this item on to the -- The only processing required is to link this item on to the
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -68,7 +68,8 @@ package body Sinput.C is ...@@ -68,7 +68,8 @@ package body Sinput.C is
if X = Source_File.First then if X = Source_File.First then
Lo := First_Source_Ptr; Lo := First_Source_Ptr;
else 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; end if;
Name_Len := Path'Length; Name_Len := Path'Length;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -62,7 +62,9 @@ package body Sinput.D is ...@@ -62,7 +62,9 @@ package body Sinput.D is
Loc : out Source_Ptr) Loc : out Source_Ptr)
is is
begin 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)); Source_File.Append (Source_File.Table (Source));
Dfile := Source_File.Last; Dfile := Source_File.Last;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -112,7 +112,6 @@ package body Sinput.L is ...@@ -112,7 +112,6 @@ package body Sinput.L is
procedure Complete_Source_File_Entry is procedure Complete_Source_File_Entry is
CSF : constant Source_File_Index := Current_Source_File; CSF : constant Source_File_Index := Current_Source_File;
begin begin
Trim_Lines_Table (CSF); Trim_Lines_Table (CSF);
Source_File.Table (CSF).Source_Checksum := Checksum; Source_File.Table (CSF).Source_Checksum := Checksum;
...@@ -158,7 +157,6 @@ package body Sinput.L is ...@@ -158,7 +157,6 @@ package body Sinput.L is
Snew.Inlined_Call := Sloc (Inst_Node); Snew.Inlined_Call := Sloc (Inst_Node);
else else
-- If the spec has been instantiated already, and we are now -- If the spec has been instantiated already, and we are now
-- creating the instance source for the corresponding body now, -- creating the instance source for the corresponding body now,
-- retrieve the instance id that was assigned to the spec, which -- retrieve the instance id that was assigned to the spec, which
...@@ -167,10 +165,10 @@ package body Sinput.L is ...@@ -167,10 +165,10 @@ package body Sinput.L is
Inst_Spec := Instance_Spec (Inst_Node); Inst_Spec := Instance_Spec (Inst_Node);
if Present (Inst_Spec) then if Present (Inst_Spec) then
declare declare
Inst_Spec_Ent : Entity_Id; Inst_Spec_Ent : Entity_Id;
-- Instance spec entity -- Instance spec entity
Inst_Spec_Sloc : Source_Ptr; Inst_Spec_Sloc : Source_Ptr;
-- Virtual sloc of the spec instance source -- Virtual sloc of the spec instance source
Inst_Spec_Inst_Id : Instance_Id; Inst_Spec_Inst_Id : Instance_Id;
...@@ -188,12 +186,13 @@ package body Sinput.L is ...@@ -188,12 +186,13 @@ package body Sinput.L is
-- The specification of the instance entity has a virtual -- The specification of the instance entity has a virtual
-- sloc within the instance sloc range. -- sloc within the instance sloc range.
-- ??? But the Unit_Declaration_Node has the sloc of the -- ??? But the Unit_Declaration_Node has the sloc of the
-- instantiation, which is somewhat of an oddity. -- instantiation, which is somewhat of an oddity.
Inst_Spec_Sloc := Inst_Spec_Sloc :=
Sloc (Specification (Unit_Declaration_Node Sloc
(Inst_Spec_Ent))); (Specification (Unit_Declaration_Node (Inst_Spec_Ent)));
Inst_Spec_Inst_Id := Inst_Spec_Inst_Id :=
Source_File.Table Source_File.Table
(Get_Source_File_Index (Inst_Spec_Sloc)).Instance; (Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
...@@ -209,11 +208,16 @@ package body Sinput.L is ...@@ -209,11 +208,16 @@ package body Sinput.L is
end if; end if;
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 -- Source_Last and adjust the source file pointer to have the
-- correct virtual origin for the new range of values. -- 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; A.Adjust := Snew.Source_First - A.Lo;
Snew.Source_Last := A.Hi + A.Adjust; Snew.Source_Last := A.Hi + A.Adjust;
...@@ -398,10 +402,13 @@ package body Sinput.L is ...@@ -398,10 +402,13 @@ package body Sinput.L is
Source_File.Increment_Last; Source_File.Increment_Last;
X := Source_File.Last; X := Source_File.Last;
-- Compute starting index, respecting alignment requirement
if X = Source_File.First then if X = Source_File.First then
Lo := First_Source_Ptr; Lo := First_Source_Ptr;
else 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; end if;
Osint.Read_Source_File (N, Lo, Hi, Src, T); Osint.Read_Source_File (N, Lo, Hi, Src, T);
......
...@@ -434,44 +434,9 @@ package body Sinput is ...@@ -434,44 +434,9 @@ package body Sinput is
-- Get_Source_File_Index -- -- 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 function Get_Source_File_Index (S : Source_Ptr) return Source_File_Index is
begin begin
if S in Source_Cache_First .. Source_Cache_Last then return Source_File_Index_Table (Int (S) / Source_Align);
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;
end Get_Source_File_Index; end Get_Source_File_Index;
---------------- ----------------
...@@ -480,9 +445,6 @@ package body Sinput is ...@@ -480,9 +445,6 @@ package body Sinput is
procedure Initialize is procedure Initialize is
begin begin
Source_Cache_First := 1;
Source_Cache_Last := 0;
Source_Cache_Index := No_Source_File;
Source_gnat_adc := No_Source_File; Source_gnat_adc := No_Source_File;
First_Time_Around := True; First_Time_Around := True;
...@@ -724,15 +686,13 @@ package body Sinput is ...@@ -724,15 +686,13 @@ package body Sinput is
Ind : Int; Ind : Int;
SP : Source_Ptr; SP : Source_Ptr;
SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last; SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last;
begin begin
SP := (Source_File.Table (Xnew).Source_First + Chunk_Size - 1) SP := Source_File.Table (Xnew).Source_First;
/ Chunk_Size * Chunk_Size; pragma Assert (SP mod Source_Align = 0);
Ind := Int (SP) / Chunk_Size; Ind := Int (SP) / Source_Align;
while SP <= SL loop while SP <= SL loop
Source_File_Index_Table (Ind) := Xnew; Source_File_Index_Table (Ind) := Xnew;
SP := SP + Chunk_Size; SP := SP + Source_Align;
Ind := Ind + 1; Ind := Ind + 1;
end loop; end loop;
end Set_Source_File_Index_Table; end Set_Source_File_Index_Table;
...@@ -921,19 +881,14 @@ package body Sinput is ...@@ -921,19 +881,14 @@ package body Sinput is
end loop; end loop;
end if; 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 -- Read in source file table and instance table
Source_File.Tree_Read; Source_File.Tree_Read;
Instances.Tree_Read; Instances.Tree_Read;
-- The pointers we read in there for the source buffer and lines -- The pointers we read in there for the source buffer and lines table
-- table pointers are junk. We now read in the actual data that -- pointers are junk. We now read in the actual data that is referenced
-- is referenced by these two fields. -- by these two fields.
for J in Source_File.First .. Source_File.Last loop for J in Source_File.First .. Source_File.Last loop
declare declare
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -342,36 +342,17 @@ package Sinput is ...@@ -342,36 +342,17 @@ package Sinput is
-- The Get_Source_File_Index function is called very frequently. Earlier -- The Get_Source_File_Index function is called very frequently. Earlier
-- versions cached a single entry, but then reverted to a serial search, -- versions cached a single entry, but then reverted to a serial search,
-- and this proved to be a significant source of inefficiency. To get -- and this proved to be a significant source of inefficiency. We then
-- around this, we use the following directly indexed array. The space -- switched to using a table with a start point followed by a serial
-- of possible input values is a value of type Source_Ptr which is simply -- search. Now we make sure source buffers are on a reasonable boundary
-- an Int value. The values in this space are allocated sequentially as -- (see Types.Source_Align), and we can just use a direct look up in the
-- new units are loaded. -- following table.
-- 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.
-- Note that this array is pretty large, but in most operating systems -- 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. -- 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 : 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); procedure Set_Source_File_Index_Table (Xnew : Source_File_Index);
-- Sets entries in the Source_File_Index_Table for the newly created -- Sets entries in the Source_File_Index_Table for the newly created
...@@ -605,6 +586,7 @@ package Sinput is ...@@ -605,6 +586,7 @@ package Sinput is
-- value is the physical line number in the source being compiled. -- value is the physical line number in the source being compiled.
function Get_Source_File_Index (S : Source_Ptr) return Source_File_Index; 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 -- Return file table index of file identified by given source pointer
-- value. This call must always succeed, since any valid source pointer -- value. This call must always succeed, since any valid source pointer
-- value belongs to some previously loaded source file. -- value belongs to some previously loaded source file.
......
...@@ -183,11 +183,17 @@ package Types is ...@@ -183,11 +183,17 @@ package Types is
No_Column_Number : constant Column_Number := 0; No_Column_Number : constant Column_Number := 0;
-- Special value used to indicate no column number -- 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; subtype Source_Buffer is Text_Buffer;
-- Type used to store text of a source file. The buffer for the main -- 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 -- source (the source specified on the command line) has a lower bound
-- starting at zero. Subsequent subsidiary sources have lower bounds -- 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); 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 -- 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