Skip to content

R
riscv-gcc-1
Commit 26e7e1a0 by Arnaud Charlet
Options

[multiple changes] 

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve
	the project path.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* a-coinho.adb: Minor reformatting.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* a-coinho.ads: Minor reformatting.

2011-08-04  Vadim Godunko  <godunko@adacore.com>

	* s-atocou.ads, s-atocou.adb: New files.
	* a-strunb-shared.ads, a-strunb-shared.adb, a-stwiun-shared.ads,
	a-stwiun-shared.adb, a-stzunb-shared.ads, a-stzunb-shared.adb: Remove
	direct use of GCC's atomic builtins and replace them by use of new
	atomic counter package.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_strm.adb: better error message for No_Default_Stream_Attributes.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-tags.adb (Unregister_Tag): Replace the complex address arithmetic
	with a call to Get_External_Tag.
	* exp_ch7.adb (Build_Cleanup_Statements): Update the comment on
	subprogram usage. Remove the guard against package declarations and
	bodies since Build_Cleanup_Statements is no longer invoked in that
	context.
	(Build_Components): Initialize Tagged_Type_Stmts when the context
	contains at least one library-level tagged type.
	(Build_Finalizer): New local variables Has_Tagged_Types and
	Tagged_Type_Stmts along with associated comments on usage. Update the
	logic to include tagged type processing.
	(Create_Finalizer): Insert all library-level tagged type unregistration
	code before the jump block circuitry.
	(Expand_N_Package_Body): Remove the call to Build_Cleanup_Statements.
	(Expand_N_Package_Declaration): Remove the call to
	Build_Cleanup_Statements.
	(Process_Tagged_Type_Declaration): New routine. Generate a call to
	unregister the external tag of a tagged type.
	(Processing_Actions): Reimplemented to handle tagged types.
	(Process_Declarations): Detect the declaration of a library-level
	tagged type and carry out the appropriate actions.
	(Unregister_Tagged_Types): Removed. The machinery has been directly
	merged with Build_Finalizer.

From-SVN: r177401
parent 7483c888
Showing with 261 additions and 171 deletions
gcc/ada/ChangeLog
2011-08-04 Thomas Quinot <quinot@adacore.com>
* gnatls.adb: Use Prj.Env.Initialize_Default_Project_Path to retrieve
the project path.
2011-08-04 Robert Dewar <dewar@adacore.com>
* a-coinho.adb: Minor reformatting.
2011-08-04 Robert Dewar <dewar@adacore.com>
* a-coinho.ads: Minor reformatting.
2011-08-04 Vadim Godunko <godunko@adacore.com>
* s-atocou.ads, s-atocou.adb: New files.
* a-strunb-shared.ads, a-strunb-shared.adb, a-stwiun-shared.ads,
a-stwiun-shared.adb, a-stzunb-shared.ads, a-stzunb-shared.adb: Remove
direct use of GCC's atomic builtins and replace them by use of new
atomic counter package.
2011-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_strm.adb: better error message for No_Default_Stream_Attributes.
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* a-tags.adb (Unregister_Tag): Replace the complex address arithmetic
with a call to Get_External_Tag.
* exp_ch7.adb (Build_Cleanup_Statements): Update the comment on
subprogram usage. Remove the guard against package declarations and
bodies since Build_Cleanup_Statements is no longer invoked in that
context.
(Build_Components): Initialize Tagged_Type_Stmts when the context
contains at least one library-level tagged type.
(Build_Finalizer): New local variables Has_Tagged_Types and
Tagged_Type_Stmts along with associated comments on usage. Update the
logic to include tagged type processing.
(Create_Finalizer): Insert all library-level tagged type unregistration
code before the jump block circuitry.
(Expand_N_Package_Body): Remove the call to Build_Cleanup_Statements.
(Expand_N_Package_Declaration): Remove the call to
Build_Cleanup_Statements.
(Process_Tagged_Type_Declaration): New routine. Generate a call to
unregister the external tag of a tagged type.
(Processing_Actions): Reimplemented to handle tagged types.
(Process_Declarations): Detect the declaration of a library-level
tagged type and carry out the appropriate actions.
(Unregister_Tagged_Types): Removed. The machinery has been directly
merged with Build_Finalizer.
2011-08-04 Robert Dewar <dewar@adacore.com>
* bindgen.ads, gnatlink.adb, sem_ch4.adb, gnatbind.adb, put_alfa.adb,
......
gcc/ada/a-coinho.adb
......@@ -102,7 +102,6 @@ package body Ada.Containers.Indefinite_Holders is
begin
if Source.Element = null then
return (AF.Controlled with null, 0);
else
return (AF.Controlled with new Element_Type'(Source.Element.all), 0);
end if;
......@@ -116,7 +115,6 @@ package body Ada.Containers.Indefinite_Holders is
begin
if Container.Element = null then
raise Constraint_Error with "container is empty";
else
return Container.Element.all;
end if;
......@@ -184,11 +182,9 @@ package body Ada.Containers.Indefinite_Holders is
begin
Process (Container.Element.all);
exception
when others =>
B := B - 1;
raise;
end;
......@@ -201,7 +197,8 @@ package body Ada.Containers.Indefinite_Holders is
procedure Read
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
Container : out Holder) is
Container : out Holder)
is
begin
Clear (Container);
......@@ -215,7 +212,9 @@ package body Ada.Containers.Indefinite_Holders is
---------------------
procedure Replace_Element
(Container : in out Holder; New_Item : Element_Type) is
(Container : in out Holder;
New_Item : Element_Type)
is
begin
if Container.Busy /= 0 then
raise Program_Error with "attempt to tamper with elements";
......@@ -253,11 +252,9 @@ package body Ada.Containers.Indefinite_Holders is
begin
Process (Container.Element.all);
exception
when others =>
B := B - 1;
raise;
end;
......@@ -270,7 +267,8 @@ package body Ada.Containers.Indefinite_Holders is
procedure Write
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
Container : Holder) is
Container : Holder)
is
begin
Boolean'Output (Stream, Container.Element = null);
......
gcc/ada/a-coinho.ads
......@@ -56,7 +56,8 @@ package Ada.Containers.Indefinite_Holders is
function Element (Container : Holder) return Element_Type;
procedure Replace_Element
(Container : in out Holder; New_Item : Element_Type);
(Container : in out Holder;
New_Item : Element_Type);
procedure Query_Element
(Container : Holder;
......
gcc/ada/a-strunb-shared.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
......@@ -50,16 +50,6 @@ package body Ada.Strings.Unbounded is
-- align the returned memory on the maximum alignment as malloc does not
-- know the target alignment.
procedure Sync_Add_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32);
pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
function Sync_Sub_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
function Aligned_Max_Length (Max_Length : Natural) return Natural;
-- Returns recommended length of the shared string which is greater or
-- equal to specified length. Calculation take in sense alignment of the
......@@ -633,12 +623,10 @@ package body Ada.Strings.Unbounded is
function Can_Be_Reused
(Item : Shared_String_Access;
Length : Natural) return Boolean
is
use Interfaces;
Length : Natural) return Boolean is
begin
return
Item.Counter = 1
System.Atomic_Counters.Is_One (Item.Counter)
and then Item.Max_Length >= Length
and then Item.Max_Length <=
Aligned_Max_Length (Length + Length / Growth_Factor);
......@@ -1282,7 +1270,7 @@ package body Ada.Strings.Unbounded is
procedure Reference (Item : not null Shared_String_Access) is
begin
Sync_Add_And_Fetch (Item.Counter'Access, 1);
System.Atomic_Counters.Increment (Item.Counter);
end Reference;
---------------------
......@@ -2082,7 +2070,6 @@ package body Ada.Strings.Unbounded is
-----------------
procedure Unreference (Item : not null Shared_String_Access) is
use Interfaces;
procedure Free is
new Ada.Unchecked_Deallocation (Shared_String, Shared_String_Access);
......@@ -2090,7 +2077,7 @@ package body Ada.Strings.Unbounded is
Aux : Shared_String_Access := Item;
begin
if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
if System.Atomic_Counters.Decrement (Aux.Counter) then
-- Reference counter of Empty_Shared_String must never reach zero
......
gcc/ada/a-strunb-shared.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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 --
......@@ -70,7 +70,7 @@
with Ada.Strings.Maps;
private with Ada.Finalization;
private with Interfaces;
private with System.Atomic_Counters;
package Ada.Strings.Unbounded is
pragma Preelaborate;
......@@ -430,7 +430,7 @@ private
package AF renames Ada.Finalization;
type Shared_String (Max_Length : Natural) is limited record
Counter : aliased Interfaces.Unsigned_32 := 1;
Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter
Last : Natural := 0;
......
gcc/ada/a-stwiun-shared.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
......@@ -50,16 +50,6 @@ package body Ada.Strings.Wide_Unbounded is
-- align the returned memory on the maximum alignment as malloc does not
-- know the target alignment.
procedure Sync_Add_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32);
pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
function Sync_Sub_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
function Aligned_Max_Length (Max_Length : Natural) return Natural;
-- Returns recommended length of the shared string which is greater or
-- equal to specified length. Calculation take in sense alignment of
......@@ -636,12 +626,10 @@ package body Ada.Strings.Wide_Unbounded is
function Can_Be_Reused
(Item : Shared_Wide_String_Access;
Length : Natural) return Boolean
is
use Interfaces;
Length : Natural) return Boolean is
begin
return
Item.Counter = 1
System.Atomic_Counters.Is_One (Item.Counter)
and then Item.Max_Length >= Length
and then Item.Max_Length <=
Aligned_Max_Length (Length + Length / Growth_Factor);
......@@ -1294,7 +1282,7 @@ package body Ada.Strings.Wide_Unbounded is
procedure Reference (Item : not null Shared_Wide_String_Access) is
begin
Sync_Add_And_Fetch (Item.Counter'Access, 1);
System.Atomic_Counters.Increment (Item.Counter);
end Reference;
---------------------
......@@ -2100,7 +2088,6 @@ package body Ada.Strings.Wide_Unbounded is
-----------------
procedure Unreference (Item : not null Shared_Wide_String_Access) is
use Interfaces;
procedure Free is
new Ada.Unchecked_Deallocation
......@@ -2109,7 +2096,7 @@ package body Ada.Strings.Wide_Unbounded is
Aux : Shared_Wide_String_Access := Item;
begin
if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
if System.Atomic_Counters.Decrement (Aux.Counter) then
-- Reference counter of Empty_Shared_Wide_String must never reach
-- zero.
......
gcc/ada/a-stwiun-shared.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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 --
......@@ -42,7 +42,7 @@
with Ada.Strings.Wide_Maps;
private with Ada.Finalization;
private with Interfaces;
private with System.Atomic_Counters;
package Ada.Strings.Wide_Unbounded is
pragma Preelaborate;
......@@ -408,7 +408,7 @@ private
package AF renames Ada.Finalization;
type Shared_Wide_String (Max_Length : Natural) is limited record
Counter : aliased Interfaces.Unsigned_32 := 1;
Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter.
Last : Natural := 0;
......
gcc/ada/a-stzunb-shared.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
......@@ -50,16 +50,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is
-- align the returned memory on the maximum alignment as malloc does not
-- know the target alignment.
procedure Sync_Add_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32);
pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
function Sync_Sub_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
function Aligned_Max_Length (Max_Length : Natural) return Natural;
-- Returns recommended length of the shared string which is greater or
-- equal to specified length. Calculation take in sense alignment of
......@@ -638,12 +628,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is
function Can_Be_Reused
(Item : Shared_Wide_Wide_String_Access;
Length : Natural) return Boolean
is
use Interfaces;
Length : Natural) return Boolean is
begin
return
Item.Counter = 1
System.Atomic_Counters.Is_One (Item.Counter)
and then Item.Max_Length >= Length
and then Item.Max_Length <=
Aligned_Max_Length (Length + Length / Growth_Factor);
......@@ -1304,7 +1292,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is
procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
begin
Sync_Add_And_Fetch (Item.Counter'Access, 1);
System.Atomic_Counters.Increment (Item.Counter);
end Reference;
---------------------
......@@ -2113,7 +2101,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is
-----------------
procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
use Interfaces;
procedure Free is
new Ada.Unchecked_Deallocation
......@@ -2122,7 +2109,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is
Aux : Shared_Wide_Wide_String_Access := Item;
begin
if Sync_Sub_And_Fetch (Aux.Counter'Access, 1) = 0 then
if System.Atomic_Counters.Decrement (Aux.Counter) then
-- Reference counter of Empty_Shared_Wide_Wide_String must never
-- reach zero.
......
gcc/ada/a-stzunb-shared.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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 --
......@@ -42,7 +42,7 @@
with Ada.Strings.Wide_Wide_Maps;
private with Ada.Finalization;
private with Interfaces;
private with System.Atomic_Counters;
package Ada.Strings.Wide_Wide_Unbounded is
pragma Preelaborate;
......@@ -417,7 +417,7 @@ private
package AF renames Ada.Finalization;
type Shared_Wide_Wide_String (Max_Length : Natural) is limited record
Counter : aliased Interfaces.Unsigned_32 := 1;
Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter.
Last : Natural := 0;
......
gcc/ada/a-tags.adb
......@@ -1010,12 +1010,8 @@ package body Ada.Tags is
--------------------
procedure Unregister_Tag (T : Tag) is
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
External_Tag_HTable.Remove (To_Address (TSD.External_Tag));
External_Tag_HTable.Remove (Get_External_Tag (T));
end Unregister_Tag;
------------------------
......
gcc/ada/exp_strm.adb
......@@ -25,6 +25,7 @@
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Util; use Exp_Util;
with Namet; use Namet;
with Nlists; use Nlists;
......@@ -476,6 +477,15 @@ package body Exp_Strm is
begin
Check_Restriction (No_Default_Stream_Attributes, N);
if Restriction_Active (No_Default_Stream_Attributes) then
Error_Msg_NE
("missing user-defined Input for type&", N, Etype (Targ));
if Nkind (Targ) = N_Selected_Component then
Error_Msg_NE
("\which is a component of type&", N, Etype (Prefix (Targ)));
end if;
end if;
-- Check first for Boolean and Character. These are enumeration types,
-- but we treat them specially, since they may require special handling
-- in the transfer protocol. However, this special handling only applies
......@@ -686,6 +696,15 @@ package body Exp_Strm is
begin
Check_Restriction (No_Default_Stream_Attributes, N);
if Restriction_Active (No_Default_Stream_Attributes) then
Error_Msg_NE
("missing user-defined Write for type&", N, Etype (Item));
if Nkind (Item) = N_Selected_Component then
Error_Msg_NE
("\which is a component of type&", N, Etype (Prefix (Item)));
end if;
end if;
-- Compute the size of the stream element. This is either the size of
-- the first subtype or if given the size of the Stream_Size attribute.
......
gcc/ada/gnatls.adb
......@@ -36,6 +36,7 @@ with Opt; use Opt;
with Osint; use Osint;
with Osint.L; use Osint.L;
with Output; use Output;
with Prj.Env; use Prj.Env;
with Rident; use Rident;
with Sdefault;
with Snames;
......@@ -47,12 +48,6 @@ with GNAT.Case_Util; use GNAT.Case_Util;
procedure Gnatls is
pragma Ident (Gnat_Static_Version_String);
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
-- Names of the env. variables that contains path name(s) of directories
-- where project files may reside. If GPR_PROJECT_PATH is defined, its
-- value is used, otherwise ADA_PROJECT_PATH is used, if defined.
-- NOTE : The following string may be used by other tools, such as GPS. So
-- it can only be modified if these other uses are checked and coordinated.
......@@ -60,7 +55,7 @@ procedure Gnatls is
-- Label displayed in verbose mode before the directories in the project
-- search path. Do not modify without checking NOTE above.
No_Project_Default_Dir : constant String := "-";
Prj_Path : Prj.Env.Project_Search_Path;
Max_Column : constant := 80;
......@@ -223,7 +218,7 @@ procedure Gnatls is
end if;
end Add_Lib_Dir;
-- -----------------
--------------------
-- Add_Source_Dir --
--------------------
......@@ -1614,27 +1609,16 @@ begin
Write_Str (" <Current_Directory>");
Write_Eol;
-- The code below reproduces Prj.Env.Initialize_Default_Project_Path,
-- shouldn't we reuse that instead???
Initialize_Default_Project_Path
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
declare
Project_Path : String_Access := Getenv (Gpr_Project_Path);
Lib : constant String :=
Directory_Separator & "lib" & Directory_Separator;
First : Natural;
Last : Natural;
Add_Default_Dir : Boolean := True;
Prefix_Name_Len : Integer;
Project_Path : String_Access;
First : Natural;
Last : Natural;
begin
-- If there is a project path, display each directory in the path
if Project_Path.all = "" then
Project_Path := Getenv (Ada_Project_Path);
end if;
Get_Path (Prj_Path, Project_Path);
if Project_Path.all /= "" then
First := Project_Path'First;
......@@ -1654,13 +1638,7 @@ begin
Last := Last + 1;
end loop;
-- If the directory is No_Default_Project_Dir, set
-- Add_Default_Dir to False.
if Project_Path (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
elsif First /= Last or else Project_Path (First) /= '.' then
if First /= Last or else Project_Path (First) /= '.' then
-- If the directory is ".", skip it as it is the current
-- directory and it is already the first directory in the
......@@ -1668,73 +1646,15 @@ begin
Write_Str (" ");
Write_Str
(To_Host_Dir_Spec
(Project_Path (First .. Last), True).all);
(Normalize_Pathname
(To_Host_Dir_Spec
(Project_Path (First .. Last), True).all));
Write_Eol;
end if;
First := Last + 1;
end loop;
end if;
-- Add the default dir, except if "-" was one of the "directories"
-- specified in ADA_PROJECT_DIR.
if Add_Default_Dir then
Name_Len := 0;
Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all);
-- On Windows, make sure that all directory separators are '\'
if Directory_Separator /= '/' then
for J in 1 .. Name_Len loop
if Name_Buffer (J) = '/' then
Name_Buffer (J) := Directory_Separator;
end if;
end loop;
end if;
-- Find the sequence "/lib/"
while Name_Len >= Lib'Length
and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib
loop
Name_Len := Name_Len - 1;
end loop;
-- If the sequence "/lib"/ was found, display the default
-- directories <prefix>/<target>/lib/gnat and <prefix>/lib/gnat/.
if Name_Len >= 5 then
Prefix_Name_Len := Name_Len - 4;
Name_Len := Prefix_Name_Len;
Name_Len := Prefix_Name_Len;
Add_Str_To_Name_Buffer (Sdefault.Target_Name.all);
Name_Len := Name_Len - 1;
Add_Str_To_Name_Buffer (Directory_Separator
& "lib" & Directory_Separator
& "gnat" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
Name_Len := Prefix_Name_Len;
Add_Str_To_Name_Buffer ("share" & Directory_Separator
& "gpr" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
Name_Len := Prefix_Name_Len;
Add_Str_To_Name_Buffer ("lib" & Directory_Separator
& "gnat" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
end if;
end if;
end;
Write_Eol;
......
gcc/ada/s-atocou.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . A T O M I C _ C O U N T E R S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2011, AdaCore --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides implementation of atomic counter for platforms where
-- GCC supports __sync_add_and_fetch_4 and __sync_sub_and_fetch_4 builtins.
package body System.Atomic_Counters is
procedure Sync_Add_And_Fetch
(Ptr : access Unsigned_32;
Value : Unsigned_32);
pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
function Sync_Sub_And_Fetch
(Ptr : access Unsigned_32;
Value : Unsigned_32) return Unsigned_32;
pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
---------------
-- Decrement --
---------------
function Decrement (Item : in out Atomic_Counter) return Boolean is
begin
return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
end Decrement;
---------------
-- Increment --
---------------
procedure Increment (Item : in out Atomic_Counter) is
begin
Sync_Add_And_Fetch (Item.Value'Access, 1);
end Increment;
------------
-- Is_One --
------------
function Is_One (Item : Atomic_Counter) return Boolean is
begin
return Item.Value = 1;
end Is_One;
end System.Atomic_Counters;
gcc/ada/s-atocou.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . A T O M I C _ C O U N T E R S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, AdaCore --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides atomic counter on platforms where it is supported.
package System.Atomic_Counters is
pragma Preelaborate;
type Atomic_Counter is limited private;
-- Type for atomic counter objects. Note, initial value of the counter is
-- one. This allows to use atomic counter as member of record types when
-- object of these types are created at library level on preelaboratable
-- compilation units.
--
-- Atomic counter is declared as private limited type to provide highest
-- level of protection from unexpected use. All available operations are
-- declared below, and this set should be as small as possible.
procedure Increment (Item : in out Atomic_Counter);
pragma Inline_Always (Increment);
-- Increments value of atomic counter.
function Decrement (Item : in out Atomic_Counter) return Boolean;
pragma Inline_Always (Decrement);
-- Decrements value of atomic counter, returns True when value reach zero.
function Is_One (Item : Atomic_Counter) return Boolean;
pragma Inline_Always (Is_One);
-- Returns True when value of the atomic counter is one.
private
type Unsigned_32 is mod 2 ** 32;
type Atomic_Counter is limited record
Value : aliased Unsigned_32 := 1;
pragma Atomic (Value);
pragma Volatile (Value);
end record;
end System.Atomic_Counters;
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