Commit f0a3e164 authored by yoogx's avatar yoogx

* Code reorganization for GNATProve GPL2014

parent 22b47903
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, GET-Telecom Paris. -- -- Copyright (C) 2009 Telecom ParisTech, 2010-2014 ESA & ISAE. --
-- -- -- --
-- PolyORB HI is free software; you can redistribute it and/or modify it -- -- PolyORB HI is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free -- -- under terms of the GNU General Public License as published by the Free --
...@@ -26,7 +26,8 @@ ...@@ -26,7 +26,8 @@
-- however invalidate any other reasons why the executable file might be -- -- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. -- -- covered by the GNU Public License. --
-- -- -- --
-- PolyORB HI is maintained by GET Telecom Paris -- -- PolyORB-HI/Ada is maintained by the TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -61,6 +62,11 @@ package body Producer_Consumer is ...@@ -61,6 +62,11 @@ package body Producer_Consumer is
procedure Produce_Spg (Data_Source : out Alpha_Type) is procedure Produce_Spg (Data_Source : out Alpha_Type) is
begin begin
Data_Source := The_Data; Data_Source := The_Data;
if The_Data > 1000 then
The_Data := 1;
end if;
The_Data := The_Data + 1; The_Data := The_Data + 1;
Put_Line (Normal, Get_Node Put_Line (Normal, Get_Node
......
...@@ -16,6 +16,7 @@ ADA_SPECS_WITH_BODY = $(srcdir)/polyorb_hi-aperiodic_task.ads \ ...@@ -16,6 +16,7 @@ ADA_SPECS_WITH_BODY = $(srcdir)/polyorb_hi-aperiodic_task.ads \
$(srcdir)/polyorb_hi-suspenders.ads \ $(srcdir)/polyorb_hi-suspenders.ads \
$(srcdir)/polyorb_hi-thread_interrogators.ads \ $(srcdir)/polyorb_hi-thread_interrogators.ads \
$(srcdir)/polyorb_hi-scheduler.ads \ $(srcdir)/polyorb_hi-scheduler.ads \
$(srcdir)/polyorb_hi-time_marshallers.ads \
$(srcdir)/polyorb_hi-unprotected_queue.ads \ $(srcdir)/polyorb_hi-unprotected_queue.ads \
$(srcdir)/polyorb_hi-utils.ads $(srcdir)/polyorb_hi-utils.ads
...@@ -25,7 +26,6 @@ ADA_SPECS = $(ADA_SPECS_WITH_BODY) $(srcdir)/polyorb_hi.ads \ ...@@ -25,7 +26,6 @@ ADA_SPECS = $(ADA_SPECS_WITH_BODY) $(srcdir)/polyorb_hi.ads \
$(srcdir)/polyorb_hi-output_low_level.ads \ $(srcdir)/polyorb_hi-output_low_level.ads \
$(srcdir)/polyorb_hi-port_type_marshallers.ads \ $(srcdir)/polyorb_hi-port_type_marshallers.ads \
$(srcdir)/polyorb_hi-streams.ads \ $(srcdir)/polyorb_hi-streams.ads \
$(srcdir)/polyorb_hi-time_marshallers.ads \
$(srcdir)/polyorb_hi-transport_low_level.ads $(srcdir)/polyorb_hi-transport_low_level.ads
ADA_BODIES = $(ADA_SPECS_WITH_BODY:.ads=.adb) \ ADA_BODIES = $(ADA_SPECS_WITH_BODY:.ads=.adb) \
......
-- Ada restrictions to be supported by PolyORB HI, for native targets -- Ada restrictions to be supported by PolyORB HI, for native targets
-- pragma Profile_Warnings (Ravenscar); -- D.13.1 pragma Profile_Warnings (Ravenscar); -- D.13.1
...@@ -118,8 +118,9 @@ private ...@@ -118,8 +118,9 @@ private
end record; end record;
function Valid (Message : Message_Type) return Boolean is function Valid (Message : Message_Type) return Boolean is
(Message.First >= Message.Content'First and then Message.First < Message.Last (Message.First >= Message.Content'First
and then Message.Last <= Message.Content'Last); and then Message.First < Message.Last
and then Message.Last <= Message.Content'Last);
function Payload (M : Message_Type) return Stream_Element_Array is function Payload (M : Message_Type) return Stream_Element_Array is
(M.Content (M.First .. M.Last)); (M.Content (M.First .. M.Last));
......
...@@ -31,19 +31,14 @@ ...@@ -31,19 +31,14 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Synchronous_Task_Control;
with PolyORB_HI.Output; with PolyORB_HI.Output;
with PolyORB_HI.Suspenders;
package body PolyORB_HI.Null_Task is package body PolyORB_HI.Null_Task is
use PolyORB_HI.Errors; use PolyORB_HI.Errors;
use PolyORB_HI.Output; use PolyORB_HI.Output;
use PolyORB_HI_Generated.Deployment; use PolyORB_HI_Generated.Deployment;
use PolyORB_HI.Suspenders;
use Ada.Real_Time; use Ada.Real_Time;
use Ada.Synchronous_Task_Control;
------------------- -------------------
-- The_Null_Task -- -- The_Null_Task --
...@@ -51,11 +46,15 @@ package body PolyORB_HI.Null_Task is ...@@ -51,11 +46,15 @@ package body PolyORB_HI.Null_Task is
procedure The_Null_Task is procedure The_Null_Task is
Error : Error_Kind; Error : Error_Kind;
Initialized : Boolean := True;
begin begin
-- Run the initialize entrypoint (if any) -- Run the initialize entrypoint (if any)
Activate_Entrypoint; if not Initialized then
Activate_Entrypoint;
Initialized := True;
end if;
-- Wait for the network initialization to be finished -- Wait for the network initialization to be finished
......
...@@ -31,6 +31,13 @@ ...@@ -31,6 +31,13 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Define a "null" task as a job to be scheduled by a
-- software-defined scheduler in place of a OS scheduler. Its
-- interface mimics the one of a periodic task.
--
-- Expected usage is for a Round-Robin non-preemptive scheduler
-- defined through a cyclic function.
with System; with System;
with Ada.Real_Time; with Ada.Real_Time;
with PolyORB_HI_Generated.Deployment; with PolyORB_HI_Generated.Deployment;
...@@ -65,6 +72,13 @@ generic ...@@ -65,6 +72,13 @@ generic
-- detected. -- detected.
package PolyORB_HI.Null_Task is package PolyORB_HI.Null_Task is
-- The following parameters are not used for now. The usage is
-- reserved for future extensions.
pragma Unreferenced (Task_Priority);
pragma Unreferenced (Task_Stack_Size);
pragma Unreferenced (Task_Period);
pragma Unreferenced (Task_Deadline);
procedure The_Null_Task; procedure The_Null_Task;
......
This diff is collapsed.
...@@ -32,7 +32,18 @@ ...@@ -32,7 +32,18 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Real_Time; with Ada.Real_Time;
with PolyORB_HI.Marshallers_G; with PolyORB_HI.Messages;
package PolyORB_HI.Time_Marshallers is package PolyORB_HI.Time_Marshallers is
new PolyORB_HI.Marshallers_G (Ada.Real_Time.Time);
procedure Marshall
(R : Ada.Real_Time.Time;
M : in out Messages.Message_Type);
-- Marshall a data R in message M
procedure Unmarshall
(R : out Ada.Real_Time.Time;
M : in out Messages.Message_Type);
-- Unmarshall a data R from message M
end PolyORB_HI.Time_Marshallers;
...@@ -32,16 +32,11 @@ ...@@ -32,16 +32,11 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with PolyORB_HI.Output; with PolyORB_HI.Output;
with PolyORB_HI.Utils;
package body PolyORB_HI.Unprotected_Queue is package body PolyORB_HI.Unprotected_Queue is
use type PolyORB_HI.Streams.Stream_Element_Offset;
use PolyORB_HI.Port_Kinds; use PolyORB_HI.Port_Kinds;
use Ada.Real_Time;
use PolyORB_HI_Generated.Deployment;
use PolyORB_HI.Output; use PolyORB_HI.Output;
use PolyORB_HI.Utils;
---------------- ----------------
-- Read_Event -- -- Read_Event --
...@@ -372,9 +367,11 @@ package body PolyORB_HI.Unprotected_Queue is ...@@ -372,9 +367,11 @@ package body PolyORB_HI.Unprotected_Queue is
Frst := Frst - 1; Frst := Frst - 1;
end loop; end loop;
end if; end if;
when Error => when Error =>
raise Program_Error with Put_Line (Verbose,
CE + ": Store_In: FIFO is full"; CE + ": Store_In: FIFO is full");
-- XXX SHould raise an exception there !
end case; end case;
-- Remove event in the history and shift -- Remove event in the history and shift
......
...@@ -33,12 +33,9 @@ ...@@ -33,12 +33,9 @@
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
With Ada.Real_Time; With Ada.Real_Time;
With System;
with PolyORB_HI_Generated.Deployment; with PolyORB_HI_Generated.Deployment;
with PolyORB_HI.Errors;
with PolyORB_HI.Messages;
with PolyORB_HI.Port_Kinds; with PolyORB_HI.Port_Kinds;
with PolyORB_HI.Streams; with PolyORB_HI.Streams;
...@@ -58,9 +55,6 @@ generic ...@@ -58,9 +55,6 @@ generic
PolyORB_HI_Generated.Deployment.Port_Sized_String; PolyORB_HI_Generated.Deployment.Port_Sized_String;
-- An array type to specify the image of each port. -- An array type to specify the image of each port.
type Address_Array is array (Port_Type) of System.Address;
-- An array to specify a list of arrays of various sizes.
type Overflow_Protocol_Array is array (Port_Type) of type Overflow_Protocol_Array is array (Port_Type) of
Port_Kinds.Overflow_Handling_Protocol; Port_Kinds.Overflow_Handling_Protocol;
-- An array to specify the overflow_handling_protocol of each port -- An array to specify the overflow_handling_protocol of each port
...@@ -116,25 +110,6 @@ generic ...@@ -116,25 +110,6 @@ generic
-- deducing it from Thread_Fifo_Sizes is done to guarantee static -- deducing it from Thread_Fifo_Sizes is done to guarantee static
-- allocation of the global message queue of the thread. -- allocation of the global message queue of the thread.
N_Destinations : in Integer_Array;
-- For each OUT port, we give the number of destinations. This
-- will be used to know the length of each element of the array
-- below.
Destinations : in Address_Array;
-- For each OUT port, we give the address of an constant
-- Entity_Type array containing the list of all the destination of
-- the port. For IN ports, we give Null_Address.
with procedure Marshall
(R : Thread_Interface_Type;
M : in out PolyORB_Hi.Messages.Message_Type);
-- A procedure that marshalls a Thread port content into a message.
with function Next_Deadline return Ada.Real_Time.Time;
-- To indicate when does the next deadline of the thread occur (in
-- absolute time).
package PolyORB_HI.Unprotected_Queue is package PolyORB_HI.Unprotected_Queue is
use Ada.Real_Time; use Ada.Real_Time;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment