Commit fff5ef42 authored by hugues.jerome's avatar hugues.jerome
Browse files

* Move code for all drivers in src/drivers directory



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/po-hi-ada@1038 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent 10a3e8e1
......@@ -186,6 +186,7 @@ AC_OUTPUT([
share/Makefile
share/make/Makefile
src/Makefile
src/drivers/Makefile
src/polyorb_hi.gpr
examples/Makefile
examples/aadlv1/Makefile
......
# BEGIN: DO NOT DELETE THIS LINE
ADA_SPECS_WITH_BODY = $(srcdir)/ping.ads $(srcdir)/pinged.ads \
$(srcdir)/tcp_ip.ads $(srcdir)/uart.ads
ADA_SPECS_WITH_BODY = $(srcdir)/ping.ads $(srcdir)/pinged.ads
ADA_SPECS = $(ADA_SPECS_WITH_BODY)
......@@ -8,8 +7,7 @@ ADA_BODIES = $(ADA_SPECS_WITH_BODY:.ads=.adb)
AADL_SOURCES = $(srcdir)/beeper.aadl $(srcdir)/generic_native.aadl \
$(srcdir)/software.aadl $(srcdir)/system_demo.aadl \
$(srcdir)/tcp_protocol.aadl $(srcdir)/scenario.aadl \
$(srcdir)/uart_line.aadl
$(srcdir)/tcp_protocol.aadl $(srcdir)/scenario.aadl
# END: DO NOT DELETE THIS LINE
......
......@@ -5,8 +5,7 @@
system delayed_connections
properties
Ocarina_Config::AADL_Files => ("beeper.aadl", "generic_native.aadl",
"software.aadl", "system_demo.aadl", "tcp_protocol.aadl",
"uart_line.aadl");
"software.aadl", "system_demo.aadl", "tcp_protocol.aadl");
Ocarina_Config::Generator => polyorb_hi_ada;
Ocarina_Config::Needed_Property_Sets =>
(value (Ocarina_Config::Data_Model),
......
......@@ -87,32 +87,25 @@ end Pingee.Impl;
process Pinger_Process
features
Out_Port : out event data port Software::Simple_Type;
Out_Port_2 : out event data port Software::Simple_Type;
end Pinger_Process;
process implementation Pinger_Process.Impl
subcomponents
Pinger : thread Software::Pinger.Impl;
Pinger_2 : thread Software::Pinger.Impl;
connections
port Pinger.Data_Source -> Out_Port;
port Pinger_2.Data_Source -> Out_Port_2;
end Pinger_Process.Impl;
process Pingee_Process
features
In_Port : in event data port Software::Simple_Type;
In_Port_2 : in event data port Software::Simple_Type;
end Pingee_Process;
process implementation Pingee_Process.Impl
subcomponents
Ping_Me : thread Software::Pingee.Impl;
Ping_Me_2 : thread Software::Pingee.Impl;
connections
port In_Port-> Ping_Me.Data_Sink;
port In_Port_2 -> Ping_Me_2.Data_Sink;
end Pingee_Process.Impl;
end Software;
......@@ -8,7 +8,6 @@ public
with Generic_Native; -- Generic hardware
with TCP_IP_Protocol; -- TCP/IP protocol stack, as an AADL device
with UART_Line; -- UART device, as an AADL device
with Beeper; -- Beeper device
with Software; -- Software part for this demo
......@@ -27,11 +26,6 @@ public
Bus_TCP : bus Generic_Native::Generic_Bus.impl;
-- DB9 serial line, it is shared by Node_1 and Node_2 to support
-- communication through the serial line.
Bus_DB9 : bus Generic_Native::Generic_Bus.impl;
------------------------------------------------------------------
-- Node #1 hardware components
......@@ -39,15 +33,9 @@ public
Memory_1 : memory Generic_Native::Memory_Segment.impl;
TCP_IP_Cnx_1 : device TCP_IP_Protocol::TCP_IP_Device.impl
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 1234; };
UART_Cnx_1 : device UART_Line::UART_Device.impl
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 12341; };
-- { Deployment::Location => "/dev/ttyS0";
-- Deployment::Port_Number => 0; };
-- Beeper_1 : device Beeper::Beeper_Device.impl;
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 1234; };
-- Beeper_1 : device Beeper::Beeper_Device.impl;
-- Node #1 software components
......@@ -61,11 +49,6 @@ public
TCP_IP_Cnx_2 : device TCP_IP_Protocol::TCP_IP_Device.impl
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 2345; };
UART_Cnx_2 : device UART_Line::UART_Device.impl
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 23451; };
-- { Deployment::Location => "/dev/ttyS1";
-- Deployment::Port_Number => 0; };
-- Node #2 software components
......@@ -84,11 +67,6 @@ public
port Node_1.Out_Port -> Node_2.In_Port
{ Actual_Connection_Binding => (reference (Bus_TCP)); };
bus access Bus_DB9 -> UART_Cnx_1.Serial_Wire;
bus access Bus_DB9 -> UART_Cnx_2.Serial_Wire;
port Node_1.Out_Port_2 -> Node_2.In_Port_2
{ Actual_Connection_Binding => (reference (Bus_DB9)); };
properties
-- By binding the device to the processor, we specify that the
......@@ -98,14 +76,10 @@ public
Actual_Processor_Binding => (reference (Processor_1)) applies to Node_1;
Actual_Processor_Binding => (reference (Processor_1))
applies to TCP_IP_Cnx_1;
Actual_Processor_Binding => (reference (Processor_1))
applies to UART_Cnx_1;
Actual_Processor_Binding => (reference (Processor_2)) applies to Node_2;
Actual_Processor_Binding => (reference (Processor_2))
applies to TCP_IP_Cnx_2;
Actual_Processor_Binding => (reference (Processor_2))
applies to UART_Cnx_2;
end The_Demo.impl;
end System_Demo;
\ No newline at end of file
end System_Demo;
......@@ -60,8 +60,8 @@ public
-- event.
properties
Initialize_Entrypoint
=> classifier (TCP_IP_Protocol::Initialize_Receiver);
-- Initialize_Entrypoint
-- => classifier (TCP_IP_Protocol::Initialize_Receiver);
Dispatch_Protocol => Background;
end Driver_TCP_IP_Protocol_thread_receiver;
......@@ -86,7 +86,7 @@ public
-- variables to configure the stack.
properties
Source_Name => "TCP_IP.Initialize";
Source_Name => "POlyORB_HI_Drivers_Native_TCP_IP.Initialize";
Source_Language => Ada;
end Initialize;
......@@ -97,7 +97,7 @@ public
-- Initialize the receiver thread
properties
Source_Name => "TCP_IP.Initialize_Receiver";
Source_Name => "POlyORB_HI_Drivers_Native_TCP_IP.Initialize_Receiver";
Source_Language => Ada;
end Initialize_Receiver;
......@@ -110,7 +110,7 @@ public
-- defined in the AADL model.
properties
Source_Name => "TCP_IP.Receive";
Source_Name => "POlyORB_HI_Drivers_Native_TCP_IP.Receive";
Source_Language => Ada;
end Receive;
......@@ -123,7 +123,7 @@ public
-- model.
properties
Source_Name => "TCP_IP.Send";
Source_Name => "POlyORB_HI_Drivers_Native_TCP_IP.Send";
Source_Language => Ada;
end Send;
......
with Ada.Streams;
with Ada.Exceptions;
with Ada.Real_Time;
with Interfaces;
with Ada.Unchecked_Conversion;
with GNAT.Sockets;
with PolyORB_HI.Output;
with PolyORB_HI.Messages;
with PolyORB_HI_Generated.Transport;
-- XXX
package body UART is
pragma Suppress (Elaboration_Check, PolyORB_HI_Generated.Transport);
-- We do not want a pragma Elaborate_All to be implicitely
-- generated for Transport.
package AS renames Ada.Streams;
use Ada.Real_Time;
use Interfaces;
use GNAT.Sockets;
use PolyORB_HI.Messages;
use PolyORB_HI.Utils;
use PolyORB_HI.Output;
type Node_Record is record
Address : Sock_Addr_Type;
Socket_Send : Socket_Type;
Socket_Receive : Socket_Type;
end record;
pragma Warnings (Off);
Nodes : array (Node_Type) of Node_Record;
pragma Warnings (On);
subtype AS_One_Element_Stream is AS.Stream_Element_Array (1 .. 1);
subtype AS_Message_Length_Stream is AS.Stream_Element_Array
(1 .. Message_Length_Size);
subtype Message_Length_Stream is Stream_Element_Array
(1 .. Message_Length_Size);
subtype AS_Full_Stream is AS.Stream_Element_Array (1 .. PDU_Size);
subtype Full_Stream is Stream_Element_Array (1 .. PDU_Size);
function To_PO_HI_Message_Length_Stream is new Ada.Unchecked_Conversion
(AS_Message_Length_Stream, Message_Length_Stream);
function To_PO_HI_Full_Stream is new Ada.Unchecked_Conversion
(AS_Full_Stream, Full_Stream);
----------------
-- Initialize --
----------------
procedure Initialize (Name_Table : PolyORB_HI.Utils.Naming_Table_Type) is
SEC : AS_One_Element_Stream;
SEO : AS.Stream_Element_Offset;
Next_Time : Time;
Node : Node_Type;
Socket : Socket_Type;
Address : Sock_Addr_Type;
begin
pragma Warnings (Off);
-- XXX shutdown warning on this now obscoleted function
GNAT.Sockets.Initialize;
pragma Warnings (On);
for J in Name_Table'Range loop
if Name_Table (J).Location.L = 0 then
Nodes (J).Address := (GNAT.Sockets.Family_Inet,
GNAT.Sockets.No_Inet_Addr,
GNAT.Sockets.No_Port);
else
Nodes (J).Address := (GNAT.Sockets.Family_Inet,
GNAT.Sockets.Inet_Addr
(PolyORB_HI.Utils.To_String
(Name_Table (J).Location)),
GNAT.Sockets.Port_Type
(Name_Table (J).Port));
end if;
end loop;
-- Create the local socket if the node is remote-callable
if Nodes (My_Node).Address.Addr /= No_Inet_Addr then
Create_Socket (Nodes (My_Node).Socket_Receive);
Set_Socket_Option
(Nodes (My_Node).Socket_Receive,
Socket_Level,
(Reuse_Address, True));
-- Since we always send small bursts of data and we do not
-- get reponse (all communications are asynchronous), we
-- disable the TCP "Nagle" algorithm and send ACK packets
-- immediately.
Set_Socket_Option
(Nodes (My_Node).Socket_Receive,
IP_Protocol_For_TCP_Level,
(No_Delay, True));
Bind_Socket
(Nodes (My_Node).Socket_Receive,
Nodes (My_Node).Address);
Listen_Socket (Nodes (My_Node).Socket_Receive);
pragma Debug (Put_Line
(Verbose,
"Local socket created for "
& Image (Nodes (My_Node).Address)));
end if;
-- Connect to other nodes and send my node id
for N in Nodes'Range loop
if N /= My_Node
and then Nodes (N).Address.Addr /= No_Inet_Addr
then
loop
Create_Socket (Nodes (N).Socket_Send);
Next_Time := Clock + Milliseconds (200);
begin
pragma Debug
(Put_Line
(Verbose,
"Try to connect to " & Image (Nodes (N).Address)));
delay until Next_Time;
Connect_Socket (Nodes (N).Socket_Send, Nodes (N).Address);
exit;
exception
when Socket_Error =>
Close_Socket (Nodes (N).Socket_Send);
end;
end loop;
-- Send my node number
SEC (1) := AS.Stream_Element (Node_Type'Pos (My_Node));
Send_Socket (Nodes (N).Socket_Send, SEC, SEO);
pragma Debug (Put_Line
(Verbose,
"Connected to " & Image (Nodes (N).Address)));
end if;
end loop;
-- Wait for the connection of all the other nodes.
-- XXX is this OK to do this here ????
if Nodes (My_Node).Address.Addr /= No_Inet_Addr then
pragma Debug (Put_Line
(Verbose, "Waiting on "
& Image (Nodes (My_Node).Address)));
for N in Nodes'Range loop
if N /= My_Node then
Address := No_Sock_Addr;
Socket := No_Socket;
Accept_Socket (Nodes (My_Node).Socket_Receive, Socket, Address);
Receive_Socket (Socket, SEC, SEO);
-- Identify peer node
Node := Node_Type'Val (SEC (1));
Nodes (Node).Socket_Receive := Socket;
pragma Debug (Put_Line (Verbose, "Connection from node "
& Node_Type'Image (Node)));
end if;
end loop;
end if;
pragma Debug (Put_Line (Verbose, "Initialization of socket subsystem"
& " is complete"));
end Initialize;
-------------
-- Receive --
-------------
procedure Receive is
use type AS.Stream_Element_Offset;
SEL : AS_Message_Length_Stream;
SEA : AS_Full_Stream;
SEO : AS.Stream_Element_Offset;
R_Sockets : Socket_Set_Type;
W_Sockets : Socket_Set_Type;
Selector : Selector_Type;
Status : Selector_Status;
begin
-- Wait on several descriptors at a time
Create_Selector (Selector);
Empty (W_Sockets);
Main_Loop :
loop
pragma Debug (Put_Line (Verbose, "****"));
-- Build the socket descriptor set
Empty (R_Sockets);
for N in Node_Type'Range loop
if N /= My_Node then
Set (R_Sockets, Nodes (N).Socket_Receive);
end if;
end loop;
Put_Line ("Using user-provided TCP/IP stack to receive");
Check_Selector (Selector, R_Sockets, W_Sockets, Status);
for N in Node_Type'Range loop
pragma Debug (Put_Line (Verbose, "Check mailboxes"));
-- If there is something to read on a node different from
-- the current node.
if N /= My_Node
and then Is_Set (R_Sockets, Nodes (N).Socket_Receive)
then
-- Receive message length
Receive_Socket (Nodes (N).Socket_Receive, SEL, SEO);
-- Receive zero bytes means that peer is dead
if SEO = 0 then
pragma Debug (Put_Line
(Verbose,
"Node " & Node_Type'Image (N)
& " is dead"));
exit Main_Loop;
end if;
SEO := AS.Stream_Element_Offset
(To_Length (To_PO_HI_Message_Length_Stream (SEL)));
pragma Debug (Put_Line
(Verbose,
"received"
& AS.Stream_Element_Offset'Image (SEO)
& " bytes from node " & Node_Type'Image (N)));
-- Get the message and preserve message length to keep
-- compatible with a local message delivery.
SEA (1 .. Message_Length_Size) := SEL;
Receive_Socket (Nodes (N).Socket_Receive,
SEA (Message_Length_Size + 1 .. SEO + 1), SEO);
-- Deliver to the peer handler
PolyORB_HI_Generated.Transport.Deliver
(Corresponding_Entity
(Integer_8 (SEA (Message_Length_Size + 1))),
To_PO_HI_Full_Stream (SEA)
(1 .. Stream_Element_Offset (SEO)));
end if;
end loop;
end loop Main_Loop;
exception
when E : others =>
pragma Debug (Put_Line
(Normal, "Exception "
& Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line
(Normal, "Message "
& Ada.Exceptions.Exception_Message (E)));
null;
end Receive;
----------
-- Send --
----------
function Send
(Node : Node_Type;
Message : Stream_Element_Array;
Size : Stream_Element_Offset)
return Error_Kind
is
L : AS.Stream_Element_Offset;
pragma Unreferenced (L);
-- Note: we cannot cast both array types using
-- Ada.Unchecked_Conversion because they are unconstrained
-- types. We cannot either use direct casting because component
-- types are incompatible. The only time efficient manner to do
-- the casting is to use representation clauses.
Msg : AS.Stream_Element_Array (1 .. AS.Stream_Element_Offset (Size));
pragma Import (Ada, Msg);
for Msg'Address use Message'Address;
begin
Put_Line ("Using user-provided TCP/IP stack to send");
Send_Socket (Nodes (Node).Socket_Send, Msg, L);
return Error_Kind'(Error_None);
exception
when E : others =>
pragma Debug (Put_Line
(Normal, "Exception "
& Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line
(Normal, "Message "
& Ada.Exceptions.Exception_Message (E)));
return Error_Kind'(Error_Transport);
end Send;
end UART;
with PolyORB_HI.Errors;
with PolyORB_HI_Generated.Deployment;
with PolyORB_HI.Streams;
with PolyORB_HI.Utils;
package UART is
use PolyORB_HI.Errors;
use PolyORB_HI_Generated.Deployment;
use PolyORB_HI.Streams;
procedure Initialize (Name_Table : PolyORB_HI.Utils.Naming_Table_Type);
procedure Receive;
pragma Warnings (Off);
function Send
(Node : Node_Type;
Message : Stream_Element_Array;
Size : Stream_Element_Offset)
return Error_Kind;
pragma Export (C, Send, "uart_device.impl_send");
pragma Warnings (On);
end UART;
package UART_Line
-- This package models a serial line (UART) based protocol layer for
-- the PolyORB-HI/Ada AADL runtime. It defines the subprograms and
-- threads to be integrated with the runtime low level interface.
public
with Generic_Native;
------------
-- DEVICE --
------------
-- The main entrypoint for this package is this device, it relies
-- on the 'Implement_As' feature that defines its full
-- specification.
device UART_Device
features
Serial_Wire : requires bus access Generic_Native::Generic_Bus.impl;
-- Connection to the remote node
end UART_Device;
device implementation UART_Device.impl
properties
Implemented_As =>
classifier (UART_Line::Driver_UART_Line.impl);
Initialize_Entrypoint => classifier (UART_Line::Initialize);
end UART_Device.impl;
------------
-- DRIVER --
------------
-- In AADLv2, we can model the actual implementation of a driver
-- using an abstract component.
abstract Driver_UART_Line
end Driver_UART_Line;
abstract implementation Driver_UART_Line.impl
subcomponents
receiver : thread Driver_UART_Line_thread_receiver.impl;
end Driver_UART_Line.impl;
-------------
-- THREADS --
-------------
-- This thread handles the execution logic of the protocol
-- stack. It relies on the previous subprograms to receive
-- messages.
thread Driver_UART_Line_thread_receiver
-- This thread is dispatched when an event is detected on the
-- real hardware. It then calls receive to handle the incoming
-- event.
properties
Dispatch_Protocol => Background;
end Driver_UART_Line_thread_receiver;
thread implementation Driver_UART_Line_thread_receiver.impl
calls
call1 : { pspg : subprogram receive; };