Commit 48e718ad authored by hugues.jerome's avatar hugues.jerome Committed by yoogx

* Implement correct configuration parameter parsing, update

	  the models to reflect new configuration requirements.



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/po-hi-ada@1349 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent dbfd810f
......@@ -33,8 +33,7 @@ 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; };
{ Deployment::Location => "ip 127.0.0.1 1233"; };
-- Beeper_1 : device Beeper::Beeper_Device.impl;
-- Node #1 software components
......@@ -47,8 +46,7 @@ public
Processor_2 : processor Generic_Native::Generic_Processor.impl;
Memory_2 : memory Generic_Native::Memory_Segment.impl;
TCP_IP_Cnx_2 : device TCP_IP_Protocol::TCP_IP_Device.impl
{ Deployment::Location => "127.0.0.1";
Deployment::Port_Number => 2345; };
{ Deployment::Location => "ip 127.0.0.1 2345"; };
-- Node #2 software components
......
......@@ -3,6 +3,15 @@ package TCP_IP_Protocol
-- This package models a TCP/IP 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.
--
-- To configure this interface, you should use the
-- Deployment::Configuration property with the following format:
-- "ip <ipv4_addresse> <ipv4_port>"
--
-- e.g.
--
-- netif : device TCP_IP_Protocol::TCP_IP_Device
-- {Deployment::Configuration => "ip 192.168.0.10 45678";}:
public
......
......@@ -19,7 +19,7 @@ package GR_RASTA_FPGA is
Message : Stream_Element_Array;
Size : Stream_Element_Offset)
return Error_Kind;
pragma Export (C, Send, "gr_rasta_fpga_device.impl_send");
pragma Export (C, Send, "grrastafpga_device.impl_send");
pragma Warnings (On);
end GR_RASTA_FPGA;
package GR_RASTA_FPGA
package GRRASTAFPGA
-- This package models a SpaceWire-based protocol layer for the
-- PolyORB-HI/Ada AADL runtime, based on the XXX. It defines the
......@@ -18,19 +18,19 @@ public
-- on the 'Implement_As' feature that defines its full
-- specification.
device GR_RASTA_FPGA_Device
device GRRASTAFPGA_Device
features
CPCI_Slot : requires bus access Generic_Bus::Generic_Bus.impl;
-- Connection to the remote node
end GR_RASTA_FPGA_Device;
end GRRASTAFPGA_Device;
device implementation GR_RASTA_FPGA_Device.impl
device implementation GRRASTAFPGA_Device.impl
properties
Implemented_As =>
classifier (GR_RASTA_FPGA::Driver_GR_RASTA_FPGA.impl);
Initialize_Entrypoint => classifier (GR_RASTA_FPGA::Initialize);
end GR_RASTA_FPGA_Device.impl;
classifier (GRRASTAFPGA::Driver_GRRASTAFPGA.impl);
Initialize_Entrypoint => classifier (GRRASTAFPGA::Initialize);
end GRRASTAFPGA_Device.impl;
------------
-- DRIVER --
......@@ -39,13 +39,13 @@ public
-- In AADLv2, we can model the actual implementation of a driver
-- using an abstract component.
abstract Driver_GR_RASTA_FPGA
end Driver_GR_RASTA_FPGA;
abstract Driver_GRRASTAFPGA
end Driver_GRRASTAFPGA;
abstract implementation Driver_GR_RASTA_FPGA.impl
abstract implementation Driver_GRRASTAFPGA.impl
subcomponents
receiver : thread Driver_GR_RASTA_FPGA_thread_receiver.impl;
end Driver_GR_RASTA_FPGA.impl;
receiver : thread Driver_GRRASTAFPGA_thread_receiver.impl;
end Driver_GRRASTAFPGA.impl;
-------------
-- THREADS --
......@@ -55,7 +55,7 @@ public
-- stack. It relies on the previous subprograms to receive
-- messages.
thread Driver_GR_RASTA_FPGA_thread_receiver
thread Driver_GRRASTAFPGA_thread_receiver
-- This thread is dispatched when an event is detected on the
-- real hardware. It then calls receive to handle the incoming
......@@ -64,12 +64,12 @@ public
properties
Dispatch_Protocol => Background;
Priority => 12;
end Driver_GR_RASTA_FPGA_thread_receiver;
end Driver_GRRASTAFPGA_thread_receiver;
thread implementation Driver_GR_RASTA_FPGA_thread_receiver.impl
thread implementation Driver_GRRASTAFPGA_thread_receiver.impl
calls
call1 : { pspg : subprogram receive; };
end Driver_GR_RASTA_FPGA_thread_receiver.impl;
end Driver_GRRASTAFPGA_thread_receiver.impl;
-----------------
-- SUBPROGRAMS --
......@@ -117,4 +117,4 @@ public
Source_Language => Ada;
end Send;
end GR_RASTA_FPGA;
end GRRASTAFPGA;
package GRSPW_Protocol
package GRSPW
-- This package models a SpaceWire-based protocol layer for the
-- PolyORB-HI/Ada AADL runtime, based on the GRSPW chipset from
-- AEROFlex Gaisler. It defines the subprograms and threads to be
-- integrated with the runtime low level interface.
--
-- To configure this interface, you should use the
-- Deployment::Configuration property with the following format:
-- "spacewire Sender_Core_id Receiver_Core_Id"
--
-- e.g.
--
-- spw : device GRSPW::GRSPW_Device
-- {Deployment::Configuration => "spacewire 1 2"};
--
public
......@@ -28,8 +38,8 @@ public
device implementation GRSPW_Device.impl
properties
Implemented_As =>
classifier (GRSPW_Protocol::Driver_GRSPW_Protocol.impl);
Initialize_Entrypoint => classifier (GRSPW_Protocol::Initialize);
classifier (GRSPW::Driver_GRSPW_Protocol.impl);
Initialize_Entrypoint => classifier (GRSPW::Initialize);
end GRSPW_Device.impl;
------------
......@@ -117,4 +127,4 @@ public
Source_Language => Ada;
end Send;
end GRSPW_Protocol;
end GRSPW;
package GRUART_Protocol
package GRUART
-- This package models a UART-based protocol layer for the
-- PolyORB-HI/Ada AADL runtime, based on the GRUART chipset from
-- AEROFlex Gaisler. It defines the subprograms and threads to be
-- integrated with the runtime low level interface.
--
-- To configure this interface, you should use the
-- Deployment::Configuration property with the following format:
-- "serial DEVICE BAUDS DATA_BITS PARITY STOP_BIT"
--
-- e.g.
--
-- uart : device GRUART::GRUART_Device
-- {Deployment::Configuration => "serial /dev/ttyS0 9600 8 N 1"
--
public
......@@ -28,8 +38,8 @@ public
device implementation GRUART_Device.impl
properties
Implemented_As =>
classifier (GRUART_Protocol::Driver_GRUART_Protocol.impl);
Initialize_Entrypoint => classifier (GRUART_Protocol::Initialize);
classifier (GRUART::Driver_GRUART_Protocol.impl);
Initialize_Entrypoint => classifier (GRUART::Initialize);
end GRUART_Device.impl;
------------
......@@ -118,4 +128,4 @@ public
Source_Language => Ada;
end Send;
end GRUART_Protocol;
end GRUART;
package Native_UART_Protocol
package Native_UART
-- This package models a UART protocol layer for the PolyORB-HI/Ada
-- AADL runtime.
-- AADL runtime. It defines the subprograms and threads to be
-- integrated with the runtime low level interface.
--
-- To configure this interface, you should use the
-- Deployment::Configuration property with the following format:
-- "serial DEVICE BAUDS DATA_BITS PARITY STOP_BIT"
--
-- e.g.
--
-- uart : device GRUART::GRUART_Device
-- {Deployment::Configuration => "serial /dev/ttyS0 9600 8 N 1"
--
public
......@@ -25,8 +36,8 @@ public
device implementation Native_UART_Device.impl
properties
Implemented_As =>
classifier (Native_UART_Protocol::Driver_Native_UART_Protocol.impl);
Initialize_Entrypoint => classifier (Native_UART_Protocol::Initialize);
classifier (Native_UART::Driver_Native_UART_Protocol.impl);
Initialize_Entrypoint => classifier (Native_UART::Initialize);
end Native_UART_Device.impl;
------------
......@@ -115,4 +126,4 @@ public
Source_Language => Ada;
end Send;
end Native_UART_Protocol;
end Native_UART;
......@@ -9,11 +9,11 @@ public
with GR_CPCI_X4CV; -- GR_CPCI_X4CV board
with GRSPW_Protocol; -- SpaceWire protocol stack, as an AADL device
with GRUART_Protocol; -- GRUART protocol stack, as an AADL device
with GR_RASTA_FPGA;
with GRSPW; -- SpaceWire protocol stack, as an AADL device
with GRUART; -- GRUART protocol stack, as an AADL device
with GRRASTAFPGA;
with Generic_Native;
with Native_UART_Protocol;
with Native_UART;
with Software; -- Software part for this demo
......@@ -95,11 +95,11 @@ public
Processor_1 : processor GR_CPCI_X4CV::LEON2.impl;
Memory_1 : memory GR_CPCI_X4CV::Memory_Segment.impl;
GRSPW_Cnx_1 : device GRSPW_Protocol::GRSPW_Device.impl
{ Deployment::Location => "1:2";
GRSPW_Cnx_1 : device GRSPW::GRSPW_Device.impl
{ Deployment::Location => "spacewire 1 2";
-- Configure SpaceWire core #1 to send, #2 to receive
};
GRUART_Cnx_1 : device GRUART_Protocol::GRUART_Device.impl
GRUART_Cnx_1 : device GRUART::GRUART_Device.impl
{ Deployment::Location => "1:2";
-- Configure UART port #1 to send, #2 to receive
};
......@@ -146,8 +146,8 @@ public
Processor_1 : processor GR_CPCI_X4CV::LEON2.impl;
Memory_1 : memory GR_CPCI_X4CV::Memory_Segment.impl;
GRSPW_Cnx_1 : device GRSPW_Protocol::GRSPW_Device.impl
{ Deployment::Location => "1:2";
GRSPW_Cnx_1 : device GRSPW::GRSPW_Device.impl
{ Deployment::Location => "spacewire 1 2";
-- Configure SpaceWire core #1 to send, #2 to receive
};
......@@ -188,7 +188,7 @@ public
Memory_1 : memory GR_CPCI_X4CV::Memory_Segment.impl;
GRUART_Cnx_1 : device GRUART_Protocol::GRUART_Device.impl
GRUART_Cnx_1 : device GRUART::GRUART_Device.impl
{ Deployment::Location => "1:2";
-- Configure UART port #1 to send, #2 to receive
};
......@@ -227,11 +227,8 @@ public
Memory_1 : memory Generic_Native::Memory_Segment.impl;
UART_Cnx_1 : device Native_UART_Protocol::Native_UART_Device.impl
{ Deployment::Location => "1:2";
-- Configure UART port #1 to send, #2 to receive
};
UART_Cnx_1 : device Native_UART::Native_UART_Device.impl
{ Deployment::Location => "serial /dev/ttyS0 19200 8 N 1"; };
-- Node #1 software components
......@@ -270,7 +267,7 @@ public
Memory_1 : memory GR_CPCI_X4CV::Memory_Segment.impl;
GRUART_Cnx_1 : device GRUART_Protocol::GRUART_Device.impl
GRUART_Cnx_1 : device GRUART::GRUART_Device.impl
{ Deployment::Location => "1:2";
-- Configure UART port #1 to send, #2 to receive
};
......@@ -285,7 +282,7 @@ public
Memory_2 : memory Generic_Native::Memory_Segment.impl;
GRUART_Cnx_2 : device Native_UART_Protocol::Native_UART_Device.impl
GRUART_Cnx_2 : device Native_UART::Native_UART_Device.impl
{ Deployment::Location => "1:2";
-- Configure UART port #1 to send, #2 to receive
};
......@@ -383,7 +380,7 @@ public
Memory_1 : memory GR_CPCI_X4CV::Memory_Segment.impl;
GR_RASTA_FPGA_Cnx_1 : device GR_RASTA_FPGA::GR_RASTA_FPGA_Device.impl
GRRASTAFPGA_Cnx_1 : device GRRASTAFPGA::GRRASTAFPGA_Device.impl
{ Deployment::Location => "XXX";
-- Dummy configuration
};
......@@ -394,7 +391,7 @@ public
connections
bus access Bus_RASTA_FPGA -> GR_RASTA_FPGA_Cnx_1.CPCI_Slot;
bus access Bus_RASTA_FPGA -> GRRASTAFPGA_Cnx_1.CPCI_Slot;
port Node_1.Out_Port -> Node_1.In_Port
{ Actual_Connection_Binding => (reference (Bus_RASTA_FPGA)); };
......@@ -402,7 +399,7 @@ public
Actual_Processor_Binding => (reference (Processor_1)) applies to Node_1;
Actual_Processor_Binding => (reference (Processor_1))
applies to GR_RASTA_FPGA_Cnx_1;
applies to GRRASTAFPGA_Cnx_1;
end The_Demo.RASTA_FPGA;
......
......@@ -62,23 +62,45 @@ package body PolyORB_HI_Drivers_GRSPW is
end if;
for J in Name_Table'Range loop
Nodes (J).SpaceWire_Core_Send
:= SpaceWire.HLInterface.SpaceWire_Device'Value
(To_String (Name_Table (J).Location) (1 .. 1));
-- The structure of the location information is
-- "spacewire Sender_Core_id Receiver_Core_Id"
Nodes (J).SpaceWire_Core_Receive
:= SpaceWire.HLInterface.SpaceWire_Device'Value
(To_String (Name_Table (J).Location) (3 .. 3));
declare
S : constant String := PolyORB_HI.Utils.To_String
(Name_Table (J).Location);
First, Last : Integer;
SpaceWire.HLInterface.Set_Node_Address
(Nodes (J).SpaceWire_Core_Send,
Interfaces.Unsigned_8 (Nodes (J).SpaceWire_Core_Receive));
end loop;
begin
-- First parse the prefix "spacewire"
First := S'First;
Last := Parse_String (S, First, ' ');
if S (First .. Last) /= "spacewire" then
raise Program_Error with "Invalid configuration";
end if;
-- Then the sender_core_id
-- XXX remove code below
First := Last + 2;
Last := Parse_String (S, First, ' ');
Nodes (J).SpaceWire_Core_Send
:= SpaceWire.HLInterface.SpaceWire_Device'Value
(S (First .. Last));
SpaceWire.HLInterface.Set_Node_Address (1, 1);
SpaceWire.HLInterface.Set_Node_Address (2, 2);
-- Finally the receiver_core_id
First := Last + 2;
Last := Parse_String (S, First, ' ');
Nodes (J).SpaceWire_Core_Receive
:= SpaceWire.HLInterface.SpaceWire_Device'Value
(S (First .. Last));
SpaceWire.HLInterface.Set_Node_Address
(Nodes (J).SpaceWire_Core_Send,
Interfaces.Unsigned_8 (Nodes (J).SpaceWire_Core_Receive));
end;
end loop;
pragma Debug (Put_Line (Normal, "Initialization of SpaceWire subsystem"
& " is complete"));
......
......@@ -63,6 +63,7 @@ package body PolyORB_HI_Drivers_GRUART is
if not Success then
Put_Line (Normal,
"Initialization failure: cannot find UART cores");
raise Program_Error;
end if;
for J in Name_Table'Range loop
......
......@@ -6,8 +6,8 @@ with Ada.Unchecked_Conversion;
with GNAT.Sockets;
with PolyORB_HI.Output;
with PolyORB_HI.Messages;
with PolyORB_HI.Output;
with PolyORB_HI_Generated.Transport;
......@@ -70,12 +70,46 @@ package body PolyORB_HI_Drivers_Native_TCP_IP is
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));
-- The structure of the location information is
-- "ip address port"
declare
S : constant String := PolyORB_HI.Utils.To_String
(Name_Table (J).Location);
Addr_First, Addr_Last : Integer;
Port : Integer;
First : Integer;
Last : Integer;
begin
First := S'First;
-- First parse the prefix "ip"
Last := Parse_String (S, First, ' ');
if S (First .. Last) /= "ip" then
raise Program_Error with "Invalid configuration";
end if;
-- Then, parse the address
First := Last + 2;
Last := Parse_String (S, First, ' ');
Addr_First := First;
Addr_Last := Last;
-- Finally the port
First := Last + 2;
Last := Parse_String (S, First, ' ');
Port := Integer'Value (S (First .. Last));
Nodes (J).Address := (GNAT.Sockets.Family_Inet,
GNAT.Sockets.Inet_Addr
(S (Addr_First .. Addr_Last)),
GNAT.Sockets.Port_Type (Port));
end;
end if;
end loop;
......@@ -149,6 +183,15 @@ package body PolyORB_HI_Drivers_Native_TCP_IP is
Initialize_Receiver;
pragma Debug (Put_Line (Verbose, "Initialization of socket subsystem"
& " is complete"));
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 Initialize;
-------------------------
......
......@@ -28,8 +28,8 @@ package body PolyORB_HI_Drivers_Native_UART is
-- UART is a simple protocol, we use one port to send, another
-- to receive.
UART_Port_Send : GNAT.Serial_Communications.Serial_Port;
UART_Port_Receive : GNAT.Serial_Communications.Serial_Port;
UART_Port_Send : GNAT.Serial_Communications.Serial_Port;
UART_Port_Receive : GNAT.Serial_Communications.Serial_Port;
end record;
Nodes : array (Node_Type) of Node_Record;
......@@ -52,43 +52,125 @@ package body PolyORB_HI_Drivers_Native_UART is
----------------
procedure Initialize (Name_Table : PolyORB_HI.Utils.Naming_Table_Type) is
pragma Unreferenced (Name_Table);
begin
begin
GNAT.Serial_Communications.Open
(Port => Nodes (My_Node).UART_Port_Send,
Name => "/dev/ttyS0");
exception
when E : others =>
Put_Line (Ada.Exceptions.Exception_Information (E));
end;
begin
GNAT.Serial_Communications.Open
(Port => Nodes (My_Node).UART_Port_Receive,
Name => "/dev/ttyUSB0");
exception
when E : others =>
Put_Line (Ada.Exceptions.Exception_Information (E));
end;
GNAT.Serial_Communications.Set
(Port => Nodes (My_Node).UART_Port_Send,
Parity => GNAT.Serial_Communications.Even,
Rate => GNAT.Serial_Communications.B19200);
GNAT.Serial_Communications.Set
(Port => Nodes (My_Node).UART_Port_Receive,
Parity => GNAT.Serial_Communications.Even,
Rate => GNAT.Serial_Communications.B19200,
Block => True);
Put_Line (Normal, "Initialization of UART subsystem"
& " is complete");
exception
when others =>
Put_Line (Normal, "Initialization of UART subsystem"
& " dead");
for J in Name_Table'Range loop
-- The structure of the location information is
-- "serial DEVICE BAUDS DATA_BITS PARITY STOP_BIT"
declare
S : constant String := PolyORB_HI.Utils.To_String
(Name_Table (J).Location);
Device_First, Device_Last : Integer;
Bauds : GNAT.Serial_Communications.Data_Rate;
Bits : GNAT.Serial_Communications.Data_Bits;
Parity : GNAT.Serial_Communications.Parity_Check;
Stop_Bits : GNAT.Serial_Communications.Stop_Bits_Number;
First, Last : Integer;
begin
First := S'First;
-- First parse the prefix "serial"
Last := Parse_String (S, First, ' ');
if S (First .. Last) /= "serial" then
raise Program_Error with "Invalid configuration";
end if;
-- Then, parse the device
First := Last + 2;
Last := Parse_String (S, First, ' ');
Device_First := First;
Device_Last := Last;
-- Then, parse the baud rate
First := Last + 2;
Last := Parse_String (S, First, ' ');
begin
Bauds := GNAT.Serial_Communications.Data_Rate'Value
('B' & S (First .. Last));
exception
when others =>
Put_Line (Normal, "Wrong baud rate: " & S (First .. Last));
raise;
end;
-- Then, parse the data bits
First := Last + 2;
Last := Parse_String (S, First, ' ');
if S (First) = '8' then
Bits := GNAT.Serial_Communications.CS8;
elsif S (First) = '7' then
Bits := GNAT.Serial_Communications.CS7;
else
raise Program_Error with "Wrong bits: " & S (First);
end if;
-- Then, parse the parity
First := Last + 2;
Last := Parse_String (S, First, ' ');
if S (First) = 'N' then
Parity := GNAT.Serial_Communications.None;
elsif S (First) = 'E' then
Parity := GNAT.Serial_Communications.Even;
elsif S (First) = 'O' then
Parity := GNAT.Serial_Communications.Odd;
else
raise Program_Error with "Wrong parity: " & S (First);
end if;
-- Finally, parse the stop_bits
First := Last + 2;
Last := Parse_String (S, First, ' ');
if S (First) = '1' then
Stop_Bits := GNAT.Serial_Communications.One;
elsif S (First) = '2' then
Stop_Bits := GNAT.Serial_Communications.Two;
else
raise Program_Error with "Wrong stop bits: " & S (First);
end if;
GNAT.Serial_Communications.Open
(Port => Nodes (My_Node).UART_Port_Send,
Name => GNAT.Serial_Communications.Port_Name
(S (Device_First .. Device_Last)));
GNAT.Serial_Communications.Set
(Port => Nodes (My_Node).UART_Port_Send,
Rate => Bauds,
Bits => Bits,
Stop_Bits => Stop_Bits,
Parity => Parity,
Block => True);
-- XXX should correct the rest
GNAT.Serial_Communications.Open
(Port => Nodes (My_Node).UART_Port_Receive,
Name => "/dev/ttyUSB0");
GNAT.Serial_Communications.Set
(Port => Nodes (My_Node).UART_Port_Receive,
Parity => GNAT.Serial_Communications.Even,
Rate => GNAT.Serial_Communications.B19200,
Block => True);
exception
when others =>
Put_Line (Normal, "Initialization of UART subsystem dead");
end;
end loop;
Put_Line (Normal, "Initialization of UART subsystem is complete");
end Initialize;
-------------
......
......@@ -38,8 +38,8 @@ package body PolyORB_HI.Utils is
-- To_HI_String --
------------------
function To_Hi_String (S : String) return HI_String is
R : String (1 .. 16) := (others => ' ');
function To_HI_String (S : String) return HI_String is
R : String (1 .. 32) := (others => ' ');
begin
R (1 .. S'Length) := S;
return HI_String'(S => R,
......@@ -102,4 +102,25 @@ package body PolyORB_HI.Utils is
return To_Corresponding_Port (Swap_Bytes (I));
end Corresponding_Port;
------------------
-- Parse_String --
------------------
function Parse_String (S : String; First : Integer; Delimiter : Character)
return Integer
is
Last : Integer;
begin
for J in First .. S'Last loop
if S (J) = Delimiter then
Last := J - 1;
exit;
elsif J = S'Last then
Last := J;
end if;
end loop;
return Last;
end Parse_String;
end PolyORB_HI.Utils;
......@@ -82,13 +82,17 @@ package PolyORB_HI.Utils is
------------
type HI_String is record
S : String (1 .. 16);
S : String (1 .. 32);
L : Natural;
end record;
function To_Hi_String (S : String) return HI_String;
function To_String (H : HI_String) return String;
function Parse_String (S : String; First : Integer; Delimiter : Character)
return Integer;
-- XXX