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
139
140
141
142
143
144
145
146
147 | -- This is a demo of multiple instances of HAC running in parallel.
-- Run as: hac_multi >res_multi.csv
-- and open the CSV file in your preferred spreadsheet software.
--
-- See HAC for the full version of the command-line tool.
with HAC_Sys.Builder,
HAC_Sys.Defs,
HAC_Sys.PCode.Interpreter;
with HAT;
with Ada.Calendar,
Ada.Command_Line,
Ada.Numerics.Float_Random,
Ada.Streams.Stream_IO,
Ada.Text_IO;
procedure HAC_Multi is
procedure Launch_Tasks is
use Ada.Text_IO;
sep : constant Character := ';';
task type HAC_Instance is
entry Start (id : Positive);
end HAC_Instance;
task body HAC_Instance is
use HAC_Sys.Builder, HAC_Sys.PCode.Interpreter;
procedure No_Put (Item : Character) is null;
procedure No_New_Line (Spacing : Positive_Count := 1) is null;
package Current_IO_Console is new
Console_Traits
(Ada.Text_IO.End_Of_File,
Ada.Text_IO.End_Of_Line,
Current_IO_Get_Needs_Skip_Line,
HAC_Sys.Defs.IIO.Get,
HAC_Sys.Defs.RIO.Get,
Ada.Text_IO.Get,
Ada.Text_IO.Get_Immediate,
Ada.Text_IO.Get_Line,
Ada.Text_IO.Skip_Line,
HAC_Sys.Defs.IIO.Put,
HAC_Sys.Defs.RIO.Put,
HAC_Sys.Defs.BIO.Put,
No_Put, -- Ada.Text_IO.Put
Ada.Text_IO.Put,
No_New_Line -- Ada.Text_IO.New_Line
);
package Custom_System_Calls is new
System_Calls_Traits
(Ada.Command_Line.Argument_Count,
Ada.Command_Line.Argument,
Ada.Command_Line.Command_Name, -- Wrong but not used anyway in this demo.
HAT.Shell_Execute,
HAT.Shell_Execute, -- This profile has an Output parameter.
HAT.Directory_Separator
);
use Ada.Calendar, Ada.Numerics.Float_Random, Ada.Streams.Stream_IO;
task_id : Positive;
tick : Time;
gen : Generator;
procedure Multi_Feedback (
Stack_Current, Stack_Total : in Natural;
Wall_Clock : in Ada.Calendar.Time;
User_Abort : out Boolean
)
is
pragma Unreferenced (Stack_Current, Stack_Total);
begin
User_Abort := False;
if Wall_Clock - tick >= 0.005 then
if Random (gen) > 0.999 then
User_Abort := True;
Put_Line
("A1" & sep & " Task" & sep &
Integer'Image (task_id) & sep
& " wants to abort the HAC VM.");
end if;
tick := Wall_Clock;
end if;
end Multi_Feedback;
procedure Interpret_for_Multi is new
Interpret
(Multi_Feedback,
Current_IO_Console,
Custom_System_Calls
);
Ada_file_name : constant String := "exm/mandelbrot.adb";
--
f : Ada.Streams.Stream_IO.File_Type;
BD : Build_Data;
post_mortem : Post_Mortem_Data;
begin
accept Start (id : Positive) do
task_id := id;
end Start;
tick := Clock;
Reset (gen);
--
Open (f, In_File, Ada_file_name);
Set_Main_Source_Stream (BD, Stream (f), Ada_file_name);
Build_Main (BD);
Close (f);
--
if Build_Successful (BD) then
Put_Line
("S" & sep & " Task" & sep &
Integer'Image (task_id) & sep &
" successful compilation. Running the VM.");
Interpret_for_Multi (BD, post_mortem);
if Image (post_mortem.Unhandled) = "User_Abort" then
Put_Line
("A2" & sep & " Task" & sep &
Integer'Image (task_id) & sep &
" got ""User_Abort"" exception from HAC VM.");
else
Put_Line
("D" & sep & " Task" & sep &
Integer'Image (task_id) & sep & " is done.");
end if;
end if;
end HAC_Instance;
hacs : array (1 .. 20) of HAC_Instance;
begin
Put_Line ("Event" & sep & " Task #" & sep & " Message");
for T in hacs'Range loop
hacs (T).Start (T);
delay 0.01;
end loop;
end Launch_Tasks;
begin
Launch_Tasks;
end HAC_Multi;
|