### ネイティブスレッドかな？

```with Ada.Text_IO;
with Windows;
entry Rendezvous;
begin
delay 0.1;
Put(Integer(Windows.GetCurrentThreadId), Base => 16);
New_Line;
accept Rendezvous do
Put("Rendezvous");
Put(Integer(Windows.GetCurrentThreadId), Base => 16);
New_Line;
end Rendezvous;
begin
Put("Main");
Put(Integer(Windows.GetCurrentThreadId), Base => 16);
New_Line;
```
```...>task_units
Main    16#1F8#
Rendezvous    16#40C#

...>
```

### タイムアウト

```with Ada.Text_IO;
procedure Select_Then_Abort is
subtype Real is Long_Long_Float;
function F(X: in Real) return Real is
begin
return (X * X * X) - X * 5.0 - 7.0;
end F;
function F_D(X: in Real) return Real is
begin
return (X * X) * 3.0 - 5.0;
end F_D;
X: Real := 3.0;
begin
select
delay 1.0;
then abort
Newton: loop
Abortable: declare
New_X: Real;
begin
pragma Abort_Defer;
New_X := (X - F(X) / F_D(X));
exit Newton when New_X = X;
X := New_X;
end Abortable;
end loop Newton;
end select;
Put(X);
New_Line;
Put(F(X));
end Select_Then_Abort;
```
```...>select_then_abort
2.74734654030721085E+00
0.00000000000000000E+00

...>
```

428さんの書き込みではっとなって、実装してみたのがこれです。 ニュートン法で、Long_Long_Float精度の限界までいくか、1秒経つかまで答えを求め続ける。 pragmaが要るあたりがあまり嬉しくないです。pragmaを書いたステートメント並びの間にチェックルーチンを挟んでいる感じ…恐らく他の関数なんか呼んだりすると意図通り動いてくれない予感。 pragma書かない場合は`delay 0.0`とか挟む。

### protectedのentry, procedure, function

```-- http://www.seas.gwu.edu/~adagroup/sigada-website/barnes-html/intro.html
procedure Semaphore is
protected type Counting_Semaphore(Start_Count: Integer := 1) is
entry Secure;
procedure Release;
function Count return Integer;
private
Current_Count: Integer := Start_Count;
end Counting_Semaphore;
protected body Counting_Semaphore is
entry Secure when Current_Count > 0 is
begin
Current_Count := Current_Count - 1;
end Secure;
procedure Release is
begin
Current_Count := Current_Count + 1;
end Release;
function Count return Integer is
begin
return Current_Count;
end Count;
end Counting_Semaphore;
Section: Counting_Semaphore(2);
begin
loop
Section.Secure;
Put_Line(Name & " enter.");
delay 1.0;
Put_Line(Name & " leave.");
Section.Release;
delay 1.0;
end loop;
begin
null;
end Semaphore;
```
```...>semaphore
A enter.
B enter.
A leave.
C enter.
B leave.
C leave.
A enter.
B enter.
B leave.
C enter.
A leave.
^C
...>
```

### protectedのrequeue

```-- http://www.seas.gwu.edu/~adagroup/sigada-website/barnes-html/intro.html
procedure Event is
protected type Event is
entry Wait;
entry Signal;
private
entry Reset;
Occurred: Boolean := False;
end Event;
protected body Event is
entry Wait when Occurred is
begin
null;
end Wait;
entry Signal when True is
begin
if Wait'Count > 0 then
Occurred := True;
requeue Reset;
end if;
end Signal;
entry Reset when Wait'Count = 0 is
begin
Occurred := False;
end Reset;
end Event;
task type Waiting(Flag: access Event; Name: Character; Time: Integer);
task body Waiting is
begin
loop
Put_Line(Name & " begin.");
Flag.Wait;
Put_Line(Name & " end.");
delay Duration(Time);
end loop;
end Waiting;
Flag: aliased Event;
A: Waiting(Flag'Access, 'A',  3);
B: Waiting(Flag'Access, 'B', 11);
begin
delay 1.0;
loop
Flag.Signal;
delay 7.0;
end loop;
end Event;
```

### 仕様では…

```with Ada.Text_IO;
---- clone of Delphi's library
protected type TMultiReadExclusiveWriteSynchronizer is
entry BeginWrite;
procedure EndWrite;
private
Writer_Count: Integer := 0;
Reader_Count: Integer := 0;
protected body TMultiReadExclusiveWriteSynchronizer is
entry BeginWrite when Writer_Count = 0 and Reader_Count = 0 is
begin
Writer_Count := Writer_Count + 1;
end BeginWrite;
procedure EndWrite is
begin
Writer_Count := Writer_Count - 1;
end EndWrite;
entry BeginRead when Writer_Count = 0 is
begin
begin
---- Ada's way ???
--   procedure Lock_Read_Only (Object : Protection_Access);
--   --  ...
--   --  Note: we are not currently using this interface, it is provided
--   --  for possible future use. At the current time, everyone uses Lock
--   --  for both read and write locks.
-- Oh! No!
protected type Sample is
procedure Write(C: Character);
function Read(Name: Character) return Character;
private
end Sample;
protected body Sample is
procedure Write(C: Character) is
begin
Put_Line("begin write");
Buffer := Buffer & C;
Put_Line("end write");
end Write;
function Read(Name: Character) return Character is
Result: Character;
begin
Put_Line("begin read " & Name);
Put_Line("end read " & Name);
return Result;
end Sample;
task type Writer(S: access Sample);
task body Writer is
subtype Upper is Character range 'A'..'Z';
begin
for C in Upper'Range loop
S.Write(C);
end loop;
end Writer;
task type Reader(S: access Sample; Name: Character);
C: Character;
begin
loop
Put_Line(C & "");
end loop;
-- S: aliased Sample;
-- W: Writer(S'Access);
-- A: Reader(S'Access, '?');
-- B: Reader(S'Access, '!');
---- D_A_K_Y_O_U
task body Writer2 is
subtype Upper is Character range 'A'..'Z';
begin
for C in Upper'Range loop
S.BeginWrite;
Put_Line("begin write");
Buffer := Buffer & C;
Put_Line("end write");
S.EndWrite;
end loop;
end Writer2;
C: Character;
begin
loop
Put_Line("begin read " & Name);
delay 0.1;
Put_Line("end read " & Name);
Put_Line(C & "");
end loop;