Commit f557688d authored by yoogx's avatar yoogx

* Code reorganization for GNATProve GPL2014

parent 729092a2
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- under terms of the GNU General Public License as published by the Free --
......@@ -26,7 +26,8 @@
-- however invalidate any other reasons why the executable file might be --
-- 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
procedure Produce_Spg (Data_Source : out Alpha_Type) is
begin
Data_Source := The_Data;
if The_Data > 1000 then
The_Data := 1;
end if;
The_Data := The_Data + 1;
Put_Line (Normal, Get_Node
......
......@@ -17,6 +17,7 @@ ADA_SPECS_WITH_BODY = $(srcdir)/polyorb_hi-aperiodic_task.ads \
$(srcdir)/polyorb_hi-suspenders.ads \
$(srcdir)/polyorb_hi-thread_interrogators.ads \
$(srcdir)/polyorb_hi-scheduler.ads \
$(srcdir)/polyorb_hi-time_marshallers.ads \
$(srcdir)/polyorb_hi-unprotected_queue.ads \
$(srcdir)/polyorb_hi-utils.ads
......@@ -26,7 +27,6 @@ ADA_SPECS = $(ADA_SPECS_WITH_BODY) $(srcdir)/polyorb_hi.ads \
$(srcdir)/polyorb_hi-output_low_level.ads \
$(srcdir)/polyorb_hi-port_type_marshallers.ads \
$(srcdir)/polyorb_hi-streams.ads \
$(srcdir)/polyorb_hi-time_marshallers.ads \
$(srcdir)/polyorb_hi-transport_low_level.ads
ADA_BODIES = $(ADA_SPECS_WITH_BODY:.ads=.adb) \
......
-- 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
end record;
function Valid (Message : Message_Type) return Boolean is
(Message.First >= Message.Content'First and then Message.First < Message.Last
and then Message.Last <= Message.Content'Last);
(Message.First >= Message.Content'First
and then Message.First < Message.Last
and then Message.Last <= Message.Content'Last);
function Payload (M : Message_Type) return Stream_Element_Array is
(M.Content (M.First .. M.Last));
......
......@@ -31,19 +31,14 @@
-- --
------------------------------------------------------------------------------
with Ada.Synchronous_Task_Control;
with PolyORB_HI.Output;
with PolyORB_HI.Suspenders;
package body PolyORB_HI.Null_Task is
use PolyORB_HI.Errors;
use PolyORB_HI.Output;
use PolyORB_HI_Generated.Deployment;
use PolyORB_HI.Suspenders;
use Ada.Real_Time;
use Ada.Synchronous_Task_Control;
-------------------
-- The_Null_Task --
......@@ -51,11 +46,15 @@ package body PolyORB_HI.Null_Task is
procedure The_Null_Task is
Error : Error_Kind;
Initialized : Boolean := True;
begin
-- 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
......
......@@ -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 Ada.Real_Time;
with PolyORB_HI_Generated.Deployment;
......@@ -65,6 +72,13 @@ generic
-- detected.
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;
......
This diff is collapsed.
......@@ -32,7 +32,18 @@
------------------------------------------------------------------------------
with Ada.Real_Time;
with PolyORB_HI.Marshallers_G;
with PolyORB_HI.Messages;
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 @@
------------------------------------------------------------------------------
with PolyORB_HI.Output;
with PolyORB_HI.Utils;
package body PolyORB_HI.Unprotected_Queue is
use type PolyORB_HI.Streams.Stream_Element_Offset;
use PolyORB_HI.Port_Kinds;
use Ada.Real_Time;
use PolyORB_HI_Generated.Deployment;
use PolyORB_HI.Output;
use PolyORB_HI.Utils;
----------------
-- Read_Event --
......@@ -372,9 +367,11 @@ package body PolyORB_HI.Unprotected_Queue is
Frst := Frst - 1;
end loop;
end if;
when Error =>
raise Program_Error with
CE + ": Store_In: FIFO is full";
Put_Line (Verbose,
CE + ": Store_In: FIFO is full");
-- XXX SHould raise an exception there !
end case;
-- Remove event in the history and shift
......
......@@ -33,12 +33,9 @@
with Ada.Unchecked_Conversion;
With Ada.Real_Time;
With System;
with PolyORB_HI_Generated.Deployment;
with PolyORB_HI.Errors;
with PolyORB_HI.Messages;
with PolyORB_HI.Port_Kinds;
with PolyORB_HI.Streams;
......@@ -58,9 +55,6 @@ generic
PolyORB_HI_Generated.Deployment.Port_Sized_String;
-- 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
Port_Kinds.Overflow_Handling_Protocol;
-- An array to specify the overflow_handling_protocol of each port
......@@ -116,25 +110,6 @@ generic
-- deducing it from Thread_Fifo_Sizes is done to guarantee static
-- 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
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