* Code reorganization for GNATProve GPL2014

examples/aadlv2/producer_consumer/producer_consumer.adb

@@ -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

src/Makefile.am

@@ -16,6 +16,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
 
@@ -25,7 +26,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)			\

src/native.adc

 --  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

src/polyorb_hi-messages.ads

@@ -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));

src/polyorb_hi-null_task.adb

@@ -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
 

src/polyorb_hi-null_task.ads

@@ -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;
 

src/polyorb_hi-time_marshallers.ads

@@ -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;

src/polyorb_hi-unprotected_queue.adb

@@ -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

src/polyorb_hi-unprotected_queue.ads

@@ -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;