Commit 0db16b1e by Arnaud Charlet

[multiple changes]

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

	* a-synbar.ads, a-synbar.adb, a-synbar-posix.adb,
	a-synbar-posix.ads: Minor reformatting.

2011-08-29  Yannick Moy  <moy@adacore.com>

	* snames.ads-tmpl: Add name Force.

From-SVN: r178202
parent 978ffe02
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-synbar.ads, a-synbar.adb, a-synbar-posix.adb,
a-synbar-posix.ads: Minor reformatting.
2011-08-29 Yannick Moy <moy@adacore.com>
* snames.ads-tmpl: Add name Force.
2011-08-29 Pascal Obry <obry@adacore.com> 2011-08-29 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb: Minor reformatting. * prj-nmsc.adb: Minor reformatting.
......
...@@ -46,8 +46,7 @@ package body Ada.Synchronous_Barriers is ...@@ -46,8 +46,7 @@ package body Ada.Synchronous_Barriers is
function pthread_barrier_init function pthread_barrier_init
(barrier : not null access pthread_barrier_t; (barrier : not null access pthread_barrier_t;
attr : System.Address := System.Null_Address; attr : System.Address := System.Null_Address;
count : unsigned) count : unsigned) return int;
return int;
pragma Import (C, pthread_barrier_init, "pthread_barrier_init"); pragma Import (C, pthread_barrier_init, "pthread_barrier_init");
-- Initialize barrier with the attributes in attr. The barrier is opened -- Initialize barrier with the attributes in attr. The barrier is opened
-- when count waiters arrived. If attr is null the default barrier -- when count waiters arrived. If attr is null the default barrier
...@@ -70,7 +69,6 @@ package body Ada.Synchronous_Barriers is ...@@ -70,7 +69,6 @@ package body Ada.Synchronous_Barriers is
overriding procedure Finalize (Barrier : in out Synchronous_Barrier) is overriding procedure Finalize (Barrier : in out Synchronous_Barrier) is
Result : int; Result : int;
begin begin
Result := pthread_barrier_destroy (Barrier.POSIX_Barrier'Access); Result := pthread_barrier_destroy (Barrier.POSIX_Barrier'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -78,7 +76,6 @@ package body Ada.Synchronous_Barriers is ...@@ -78,7 +76,6 @@ package body Ada.Synchronous_Barriers is
overriding procedure Initialize (Barrier : in out Synchronous_Barrier) is overriding procedure Initialize (Barrier : in out Synchronous_Barrier) is
Result : int; Result : int;
begin begin
Result := pthread_barrier_init Result := pthread_barrier_init
(barrier => Barrier.POSIX_Barrier'Access, (barrier => Barrier.POSIX_Barrier'Access,
...@@ -93,7 +90,7 @@ package body Ada.Synchronous_Barriers is ...@@ -93,7 +90,7 @@ package body Ada.Synchronous_Barriers is
procedure Wait_For_Release procedure Wait_For_Release
(The_Barrier : in out Synchronous_Barrier; (The_Barrier : in out Synchronous_Barrier;
Notified : out Boolean) Notified : out Boolean)
is is
Result : int; Result : int;
......
...@@ -47,8 +47,9 @@ package Ada.Synchronous_Barriers is ...@@ -47,8 +47,9 @@ package Ada.Synchronous_Barriers is
type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
limited private; limited private;
procedure Wait_For_Release (The_Barrier : in out Synchronous_Barrier; procedure Wait_For_Release
Notified : out Boolean); (The_Barrier : in out Synchronous_Barrier;
Notified : out Boolean);
private private
-- POSIX barrier data type -- POSIX barrier data type
...@@ -56,8 +57,8 @@ private ...@@ -56,8 +57,8 @@ private
SIZEOF_PTHREAD_BARRIER_T : constant := SIZEOF_PTHREAD_BARRIER_T : constant :=
(if System.Word_Size = 64 then 32 else 20); (if System.Word_Size = 64 then 32 else 20);
-- Value defined according to the linux definition in pthreadtypes.h. On -- Value defined according to the linux definition in pthreadtypes.h. On
-- other system, MIPS IRIX, the object is smaller, so it works correctly -- other system, e.g. MIPS IRIX, the object is smaller, so it works
-- although we are wasting some space. -- correctly although we are wasting some space.
type pthread_barrier_t_view is (size_based, align_based); type pthread_barrier_t_view is (size_based, align_based);
...@@ -74,9 +75,9 @@ private ...@@ -74,9 +75,9 @@ private
type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
new Ada.Finalization.Limited_Controlled with new Ada.Finalization.Limited_Controlled with
record record
POSIX_Barrier : aliased pthread_barrier_t; POSIX_Barrier : aliased pthread_barrier_t;
end record; end record;
overriding procedure Initialize (Barrier : in out Synchronous_Barrier); overriding procedure Initialize (Barrier : in out Synchronous_Barrier);
overriding procedure Finalize (Barrier : in out Synchronous_Barrier); overriding procedure Finalize (Barrier : in out Synchronous_Barrier);
......
...@@ -36,6 +36,7 @@ ...@@ -36,6 +36,7 @@
package body Ada.Synchronous_Barriers is package body Ada.Synchronous_Barriers is
protected body Synchronous_Barrier is protected body Synchronous_Barrier is
-- The condition "Wait'Count = Release_Threshold" opens the barrier when -- The condition "Wait'Count = Release_Threshold" opens the barrier when
-- the required number of tasks is reached. The condition "Keep_Open" -- the required number of tasks is reached. The condition "Keep_Open"
-- leaves the barrier open while there are queued tasks. While there are -- leaves the barrier open while there are queued tasks. While there are
...@@ -43,19 +44,21 @@ package body Ada.Synchronous_Barriers is ...@@ -43,19 +44,21 @@ package body Ada.Synchronous_Barriers is
-- barrier will remain open only for those tasks already inside. -- barrier will remain open only for those tasks already inside.
entry Wait (Notified : out Boolean) entry Wait (Notified : out Boolean)
when Wait'Count = Release_Threshold or else Keep_Open is when Wait'Count = Release_Threshold or else Keep_Open
is
begin begin
-- If we are executing the entry it means that the required number -- If we are executing the entry it means that the required number of
-- of tasks have been queued in the entry. Keep_Open barrier will -- tasks have been queued in the entry. Keep_Open barrier will remain
-- remain true until all queued tasks are out. -- true until all queued tasks are out.
Keep_Open := Wait'Count > 0; Keep_Open := Wait'Count > 0;
-- The last released task will close the barrier and get the -- The last released task will close the barrier and get the Notified
-- Notified token. -- token.
Notified := Wait'Count = 0; Notified := Wait'Count = 0;
end Wait; end Wait;
end Synchronous_Barrier; end Synchronous_Barrier;
---------------------- ----------------------
...@@ -64,8 +67,10 @@ package body Ada.Synchronous_Barriers is ...@@ -64,8 +67,10 @@ package body Ada.Synchronous_Barriers is
procedure Wait_For_Release procedure Wait_For_Release
(The_Barrier : in out Synchronous_Barrier; (The_Barrier : in out Synchronous_Barrier;
Notified : out Boolean) is Notified : out Boolean)
is
begin begin
The_Barrier.Wait (Notified); The_Barrier.Wait (Notified);
end Wait_For_Release; end Wait_For_Release;
end Ada.Synchronous_Barriers; end Ada.Synchronous_Barriers;
...@@ -41,8 +41,9 @@ package Ada.Synchronous_Barriers is ...@@ -41,8 +41,9 @@ package Ada.Synchronous_Barriers is
type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
limited private; limited private;
procedure Wait_For_Release (The_Barrier : in out Synchronous_Barrier; procedure Wait_For_Release
Notified : out Boolean); (The_Barrier : in out Synchronous_Barrier;
Notified : out Boolean);
private private
protected type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is protected type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
......
...@@ -631,8 +631,8 @@ package Snames is ...@@ -631,8 +631,8 @@ package Snames is
Name_Entry_Count : constant Name_Id := N + $; Name_Entry_Count : constant Name_Id := N + $;
Name_External_Name : constant Name_Id := N + $; Name_External_Name : constant Name_Id := N + $;
Name_First_Optional_Parameter : constant Name_Id := N + $; Name_First_Optional_Parameter : constant Name_Id := N + $;
Name_Force : constant Name_Id := N + $;
Name_Form : constant Name_Id := N + $; Name_Form : constant Name_Id := N + $;
Name_Formal_Proof : constant Name_Id := N + $;
Name_G_Float : constant Name_Id := N + $; Name_G_Float : constant Name_Id := N + $;
Name_Gcc : constant Name_Id := N + $; Name_Gcc : constant Name_Id := N + $;
Name_Gnat : constant Name_Id := N + $; Name_Gnat : constant Name_Id := N + $;
......
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