Ada_Ru форум

Обсуждение языка Ада

Semaphore/Murex

Оставить новое сообщение

Сообщения

Dmitriy Anisimkov
Semaphore/Murex
2006-04-24 06:42:26

Код приведенный ниже работает не так как я ожидал, ни в GNAT ни в ObjectAda spec edition 7.2.2

Смысл этого кода реализовать синхронизирующий объект, который

запирается/отпирается одной задачей неограниченное сбалансированное количесво раз.

То есть, если я его захватил (Lock) в одной задаче, все другие задачи должны ждать пока я его не разблокирую.

Кроме того, в одной задаче я могу его запирать любое количество раз, и отпирать потом надо будет столько же.

Именно так работают мутексы в Win32.

 

Если эта реализация не работает в 2-х компиляторах, то может это я не верно понимаю использование аттрибута 'Caller внутри entry и

Current_Task в entry барьере ?

 

Или это оба компилера глючут ?

 

------------

with Ada.Exceptions;

with Ada.Text_IO;

with Ada.Task_Identification;

 

procedure TP2 is

 

use Ada.Task_Identification;

 

-- Simple semaphore

 

protected Semaphore is

entry Lock;

procedure Unlock;

private

TID : Task_Id := Null_Task_Id;

Lock_Count : Natural := 0;

end Semaphore;

 

----------

-- Lock --

----------

 

procedure Lock is

begin

Semaphore.Lock;

end Lock;

 

---------------

-- Semaphore --

---------------

 

protected body Semaphore is

 

----------

-- Lock --

----------

 

entry Lock when Lock_Count = 0 or else TID = Current_Task is begin

if not (Lock_Count = 0 or else TID = Lock'Caller) then

Ada.Text_IO.Put_Line

("Barier leak" & Integer'Image (Lock_Count)

& ' ' & Image (TID)

& ' ' & Image (Lock'Caller));

end if;

 

Lock_Count := Lock_Count + 1;

TID := Lock'Caller;

end Lock;

 

------------

-- Unlock --

------------

 

procedure Unlock is

begin

if TID = Current_Task then

Lock_Count := Lock_Count - 1;

else

raise Tasking_Error;

end if;

end Unlock;

 

end Semaphore;

 

------------

-- Unlock --

------------

 

procedure Unlock is

begin

Semaphore.Unlock;

end Unlock;

 

task type Secondary is

entry Start;

end Secondary;

 

procedure Parse (P1 : Positive);

 

-----------

-- Parse --

-----------

 

procedure Parse (P1 : Positive) is

begin

Lock;

delay 0.01;

 

if P1 mod 2 = 0 then

Lock;

delay 0.01;

Unlock;

end if;

 

Unlock;

end Parse;

 

---------------

-- Secondary --

---------------

 

task body Secondary is

begin

accept Start;

 

for K in Positive'Range loop

Parse (K);

end loop;

 

exception

when E : others =>

Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E)); end Secondary;

 

TS : array (1 .. 2) of Secondary;

 

begin

Parse (1);

 

for J in TS'Range loop

TS (J).Start;

end loop;

end TP2;

----------------------------

Dmitriy Anisimkov wrote:

 

Если эта реализация не работает в 2-х компиляторах, то может это я не

верно понимаю использование аттрибута 'Caller внутри entry и

Current_Task в entry барьере ?

 

Или это оба компилера глючут ?

 

Эту задачу можно решить с использованием requeue на вход, заблокированный счетчиком если вошедшая нить отличается от нити, завладевшей объектом. ;)

 

 

-- Vadim Godunko

 

Technoserv A/S

Rostov-on-Don, Russia

Vadim Godunko wrote:

 

>Dmitriy Anisimkov wrote:

 

 

>Если эта реализация не работает в 2-х компиляторах, то может это я не >верно понимаю использование аттрибута 'Caller внутри entry и

>Current_Task в entry барьере ?

 

>Или это оба компилера глючут ?

 

 

 

>Эту задачу можно решить с использованием requeue на вход,

>заблокированный счетчиком если вошедшая нить отличается от нити, >завладевшей объектом. ;)

 

 

Было решение и с requeue, но оно требует иметь еще один entry c True барьером. Выглядит некрасиво.

Да и вопрос то не в том что бы реализовать, а в том, кто не прав, я или компилятор.

Dmitriy Anisimkov wrote:

 

>Vadim Godunko wrote:

 

 

 

>Dmitriy Anisimkov wrote:

 

 

 

 

>Если эта реализация не работает в 2-х компиляторах, то может это я не >верно понимаю использование аттрибута 'Caller внутри entry и

>Current_Task в entry барьере ?

 

>Или это оба компилера глючут ?

 

 

 

 

 

>Эту задачу можно решить с использованием requeue на вход,

>заблокированный счетчиком если вошедшая нить отличается от нити, >завладевшей объектом. ;)

 

 

 

 

>Было решение и с requeue, но оно требует иметь еще один entry c True >барьером. Выглядит некрасиво.

 

 

Вот такое оно, и работает в обоих компиляторах. Но предыдущее выглядит лучше.

---------------------------

with Ada.Exceptions;

with Ada.Text_IO;

with Ada.Task_Identification;

 

procedure TP3 is

 

use Ada.Task_Identification;

 

-- Simple semaphore

 

protected Semaphore is

entry Lock;

procedure Unlock;

private

entry Lock_Internal;

TID : Task_Id := Null_Task_Id;

Lock_Count : Natural := 0;

end Semaphore;

 

---------------

-- Semaphore --

---------------

 

protected body Semaphore is

 

----------

-- Lock --

----------

 

entry Lock when True is

begin

if TID = Lock'Caller then

Lock_Count := Lock_Count + 1;

else

requeue Lock_Internal;

end if;

end Lock;

 

-------------------

-- Lock_Internal --

-------------------

 

entry Lock_Internal when Lock_Count = 0 is

begin

TID := Lock_Internal'Caller;

Lock_Count := 1;

end Lock_Internal;

 

------------

-- Unlock --

------------

 

procedure Unlock is

begin

if TID = Current_Task then

Lock_Count := Lock_Count - 1;

else

raise Tasking_Error;

end if;

end Unlock;

 

end Semaphore;

 

task type Secondary is

entry Start;

end Secondary;

 

procedure Parse (P1 : Positive);

 

-----------

-- Parse --

-----------

 

procedure Parse (P1 : Positive) is

begin

Semaphore.Lock;

delay 0.01;

 

if P1 mod 2 = 0 then

Semaphore.Lock;

Ada.Text_IO.Put ('~');

delay 0.01;

Semaphore.Unlock;

end if;

 

Semaphore.Unlock;

end Parse;

 

---------------

-- Secondary --

---------------

 

task body Secondary is

begin

accept Start;

 

for K in Positive'Range loop

Parse (K);

end loop;

 

exception

when E : others =>

Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E)); end Secondary;

 

TS : array (1 .. 2) of Secondary;

 

begin

Parse (1);

 

for J in TS'Range loop

TS (J).Start;

end loop;

end TP3;

Dmitriy Anisimkov wrote:

 

Вот такое оно, и работает в обоих компиляторах. Но предыдущее выглядит

лучше.

Выглыдит лучше, но там типовая ошибка, связанная с моментом вычисления условия барьера. А оно вычисляется при изменении состояния объекта, т.е. фактически при покидании процедуры или входа. Но это лично мо ёмнени еоснованно еещ ён Ada83. аГоворя, тчт Ada95 одопускал а идруги еслуча, ин оточн он ескаж.

 

 

-- Vadim Godunko

 

Technoserv A/S

Rostov-on-Don, Russia

Новое сообщение:
Страницы: 1

Чтобы оставить новое сообщение необходимо Зарегистрироваться и Войти