rtyler
/
ada-playground
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add the rest of the echo multitasking example, now without leaking tasks!

This commit is contained in:
R. Tyler Croy 2013-03-09 12:17:54 -08:00
parent 740677b54e
commit 889546daab
7 changed files with 175 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -10,3 +10,4 @@ vectors
runtests
/build
/obj
echomultitask

2
Makefile
View File

@ -24,7 +24,7 @@ vectors:
$(GNATMAKE) vectors.adb
echomultitask:
$(GNATMAKE) echomultitask.adb
$(GNATMAKE) echomultitask_main.adb -o echomultitask
clean:
rm -f *.o *.ali

86
echomultitask-worker.adb Normal file
View File

@ -0,0 +1,86 @@
private with Ada.Streams,
Ada.Strings.Hash,
Ada.Text_IO,
GNAT.Sockets;
package body EchoMultitask.Worker is
use Ada.Text_IO,
GNAT.Sockets;
-- We need a Hash function to make sure our Hashed_Maps.Map container can
-- proeprly create the hash map. This function will just rely on the
-- Ada.Strings.Hash function and pass in the string representation of the
-- Task_Id
function Hash (Key : Ada.Task_Identification.Task_Id) return Ada.Containers.Hash_Type is
begin
return Ada.Strings.Hash (Ada.Task_Identification.Image (Key));
end Hash;
task body Worker is
use Ada.Streams;
Client_Sock : Socket_Type;
begin
accept Serve (Sock : Socket_Type) do
Client_Sock := Sock;
end Serve;
declare
Channel : Stream_Access := Stream (Client_Sock);
Data : Ada.Streams.Stream_Element_Array (1 .. 1);
Offset : Ada.Streams.Stream_Element_Count;
begin
while true loop
Ada.Streams.Read (Channel.All, Data, Offset);
exit when Offset = 0;
Put (Character'Val (Data (1)));
end loop;
Put_Line (".. closing connection");
Close_Socket (Client_Sock);
end;
end Worker;
protected body Coordinator is
procedure Last_Wish (C : Ada.Task_Termination.Cause_Of_Termination;
T : Ada.Task_Identification.Task_Id;
X : Ada.Exceptions.Exception_Occurrence) is
W : Worker_Ptr := Tasks.Element (T);
begin
-- First, let's make sure we remove the task object from our Tasks
-- map
Tasks.Delete (Key => T);
-- Then we deallocate it
Free_Worker (W);
Put_Line ("Task (" & Ada.Task_Identification.Image (T) & ") deallocated");
end Last_Wish;
procedure Track (Ptr : in Worker_Ptr) is
-- THe Task_Id for a task can be found in the Identity attribute,
-- but since we're receiving a Worker_Ptr type, we first need to
-- dereference it into a Worker again
Key : constant Ada.Task_Identification.Task_Id := Ptr.all'Identity;
begin
Put_Line ("Adding task (" & Ada.Task_Identification.Image (Key) & ") to Coordinator.Tasks");
-- Add our Worker pointer into our hash map to hold onto it for
-- later
Tasks.Insert (Key => Key,
New_Item => Ptr);
-- We need to set a task termination handler (introduced in Ada
-- 2005) in order to get called when the Worker (W) terminates
Ada.Task_Termination.Set_Specific_Handler (Key, Last_Wish'Access);
end Track;
end Coordinator;
end EchoMultitask.Worker;

36
echomultitask-worker.ads Normal file
View File

@ -0,0 +1,36 @@
with Ada.Containers,
Ada.Containers.Indefinite_Hashed_Maps,
Ada.Exceptions,
Ada.Task_Identification,
Ada.Task_Termination,
Ada.Unchecked_Deallocation,
GNAT.Sockets;
package EchoMultitask.Worker is
task type Worker is
entry Serve (Sock : GNAT.Sockets.Socket_Type);
end Worker;
--- Declare a pointer type for pointers to Worker objects
type Worker_Ptr is access all Worker;
-- Procedure to properly deallocate a heap-allocated Worker task
procedure Free_Worker is new Ada.Unchecked_Deallocation (Object => Worker,
Name => Worker_Ptr);
function Hash (Key : Ada.Task_Identification.Task_Id) return Ada.Containers.Hash_Type;
package Worker_Containers is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => Ada.Task_Identification.Task_id,
Element_Type => Worker_Ptr,
Hash => Hash,
Equivalent_Keys => Ada.Task_Identification."=");
protected Coordinator is
procedure Track (Ptr : in Worker_Ptr);
private
Tasks : Worker_Containers.Map;
end Coordinator;
end EchoMultitask.Worker;

66
echomultitask.adb
View File

@ -1,66 +0,0 @@
with Ada.Text_IO,
Ada.Task_Identification,
Ada.Streams,
GNAT.Sockets;
procedure EchoMultitask is
task type Connection_Worker is
entry Serve (Sock : GNAT.Sockets.Socket_Type);
end Connection_Worker;
ServerSock : GNAT.Sockets.Socket_Type;
ServerAddr : GNAT.Sockets.Sock_Addr_Type;
task body Connection_Worker is
use Ada.Streams,
Ada.Text_IO;
Client_Sock : GNAT.Sockets.Socket_Type;
begin
accept Serve (Sock : GNAT.Sockets.Socket_Type) do
Client_Sock := Sock;
end Serve;
declare
Channel : GNAT.Sockets.Stream_Access := GNAT.Sockets.Stream (Client_Sock);
Data : Ada.Streams.Stream_Element_Array (1 .. 1);
Offset : Ada.Streams.Stream_Element_Count;
begin
while true loop
Ada.Streams.Read (Channel.All, Data, Offset);
exit when Offset = 0;
Put (Character'Val (Data (1)));
end loop;
Put_Line (".. closing connection");
GNAT.Sockets.Close_Socket (Client_Sock);
end;
end Connection_Worker;
use Ada.Text_IO;
begin
ServerAddr.Addr := GNAT.Sockets.Inet_Addr ("0.0.0.0");
ServerAddr.Port := GNAT.Sockets.Port_Type (2046);
GNAT.Sockets.Create_Socket (ServerSock);
GNAT.Sockets.Set_Socket_Option (ServerSock, GNAT.Sockets.Socket_Level, (GNAT.Sockets.Reuse_Address, True));
GNAT.Sockets.Bind_Socket (ServerSock, ServerAddr);
GNAT.Sockets.Listen_Socket (ServerSock);
Put_Line ("Listening on port 2046");
-- Keep the daemon running forever for now
loop
Put (".");
declare
ClientSock : GNAT.Sockets.Socket_Type;
Worker : access Connection_Worker := new Connection_Worker;
begin
GNAT.Sockets.Accept_Socket (ServerSock, ClientSock, ServerAddr);
Put_Line ("accepted connection");
Worker.all.Serve (ClientSock);
end;
end loop;
end EchoMultitask;

3
echomultitask.ads Normal file
View File

@ -0,0 +1,3 @@
package EchoMultitask is
end EchoMultitask;

48
echomultitask_main.adb Normal file
View File

@ -0,0 +1,48 @@
with Ada.Containers,
Ada.Containers.Indefinite_Hashed_Maps,
Ada.Exceptions,
Ada.Text_IO,
Ada.Streams,
Ada.Strings.Hash,
Ada.Unchecked_Deallocation,
GNAT.Sockets;
with EchoMultitask.Worker;
procedure EchoMultitask_Main is
use Ada.Text_IO,
GNAT.Sockets,
EchoMultitask.Worker;
ServerSock : Socket_Type;
ServerAddr : Sock_Addr_Type;
begin
ServerAddr.Addr := Inet_Addr ("0.0.0.0");
ServerAddr.Port := Port_Type (2046);
Create_Socket (ServerSock);
Set_Socket_Option (ServerSock, Socket_Level, (Reuse_Address, True));
Bind_Socket (ServerSock, ServerAddr);
Listen_Socket (ServerSock);
Put_Line ("Listening on port 2046");
-- Keep the daemon running forever for now
loop
Put_Line ("Waiting for a connection..");
declare
ClientSock : Socket_Type;
W : Worker_Ptr := new Worker;
begin
Accept_Socket (ServerSock, ClientSock, ServerAddr);
Put_Line ("accepted connection");
-- Dereference the pointer and call Server() on the Worker object
W.all.Serve (ClientSock);
Coordinator.Track (W);
end;
end loop;
end EchoMultitask_Main;