1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138 | with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
with Ada.Task_Identification;
package body Task_Coroutines.Coroutine is
-----------
-- Yield --
-----------
procedure Yield (This : in out Inner_Control) is
begin
Set_False (This.Suspend);
-- Wake up the outer task
Set_True (This.Outer.Suspend);
-- Wait until the outer task wakes us up
Suspend_Until_True (This.Suspend);
end Yield;
-----------
-- Clock --
-----------
function Clock (This : Inner_Control) return Duration is
begin
return This.Time;
end Clock;
-------------------
-- Delay_Seconds --
-------------------
procedure Delay_Seconds (This : in out Inner_Control; Dur : Duration) is
Expire_Time : constant Duration := This.Clock + Dur;
begin
while This.Clock < Expire_Time loop
This.Yield;
end loop;
end Delay_Seconds;
--------------
-- Wait_For --
--------------
procedure Wait_For (This : in out Inner_Control) is
begin
while not Wait_Cond loop
This.Yield;
end loop;
end Wait_For;
-----------
-- Start --
-----------
procedure Start (This : aliased in out Instance;
Proc : not null Coro_Proc)
is
begin
Set_False (This.Suspend);
This.Inner.Outer := This'Unchecked_Access;
This.T.Start (This.Inner'Unchecked_Access, Proc);
Suspend_Until_True (This.Suspend);
end Start;
----------
-- Stop --
----------
procedure Stop (This : in out Instance) is
begin
Ada.Task_Identification.Abort_Task (This.T'Identity);
This.Is_Done := True;
end Stop;
----------
-- Poll --
----------
procedure Poll (This : in out Instance; Dt : Duration := 0.0) is
begin
if This.Done then
return;
end if;
This.Inner.Time := This.Inner.Time + Dt;
Set_True (This.Inner.Suspend);
Suspend_Until_True (This.Suspend);
end Poll;
----------
-- Done --
----------
function Done (This : Instance) return Boolean is
begin
return This.Is_Done;
end Done;
---------------
-- Coro_Task --
---------------
task body Coro_Task is
Ctrl : Inner_Acc;
Proc : Coro_Proc := null;
begin
Ctrl := null;
Proc := null;
select
accept Start (Inner : not null Inner_Acc;
Proc : not null Coro_Proc) do
Ctrl := Inner;
Coro_Task.Proc := Start.Proc;
end Start;
or
terminate;
end select;
Ctrl.Time := 0.0;
declare
begin
Proc (Ctrl.all);
exception
when others =>
null;
end;
Ctrl.Outer.Is_Done := True;
Set_True (Ctrl.Outer.Suspend);
end Coro_Task;
end Task_Coroutines.Coroutine;
|