Commit 20a3bf44 authored by yoogx's avatar yoogx

* Rework blocking/release of tasks at startup to abide to

          SPARK2014 elaboration and tasking restrictions.

          For issue #4
parent be7f5f02
......@@ -29,17 +29,34 @@
-- --
------------------------------------------------------------------------------
with PolyORB_HI.Output;
pragma SPARK_Mode (Off);
with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
pragma Elaborate_All (Ada.Synchronous_Task_Control);
package body PolyORB_HI.Suspenders is
use Ada.Real_Time;
use PolyORB_HI.Output;
Task_Suspension_Objects : array (Entity_Type'Range) of Suspension_Object;
-- This array is used so that each task waits on its corresponding
-- suspension object until the transport layer initialization is
-- complete. We are obliged to do so since Ravenscar forbids that
-- more than one task wait on a protected object entry.
-- The_Suspender : Suspension_Object;
-- XXX: we cannot use the suspension object because of
-- gnatforleon 2.0w5
----------------
-- Block_Task --
----------------
procedure Block_Task (Entity : Entity_Type) is
begin
Suspend_Until_True (Task_Suspension_Objects (Entity));
end Block_Task;
---------------------
-- Suspend_Forever --
---------------------
......@@ -61,27 +78,12 @@ package body PolyORB_HI.Suspenders is
-----------------------
procedure Unblock_All_Tasks is
pragma Suppress (Range_Check);
begin
System_Startup_Time :=
Ada.Real_Time.Clock + Ada.Real_Time.Milliseconds (1_000);
pragma Debug
(Put_Line
(Verbose, "Initialization finished, system startup in 1 second(s)"));
for J in Task_Suspension_Objects'Range loop
pragma Debug
(Put_Line
(Verbose, "Unblocking task "
+ PolyORB_HI_Generated.Deployment.Entity_Image (J)));
Set_True (Task_Suspension_Objects (J));
pragma Debug
(Put_Line
(Verbose, "Task "
+ PolyORB_HI_Generated.Deployment.Entity_Image (J)
+ " unblocked"));
for Obj of Task_Suspension_Objects loop
Set_True (Obj);
end loop;
end Unblock_All_Tasks;
......
......@@ -29,31 +29,26 @@
-- --
------------------------------------------------------------------------------
-- This package holds a routine to suspend the main application task
-- This package implements routines to suspend application tasks
with Ada.Synchronous_Task_Control;
with Ada.Real_Time;
with PolyORB_HI_Generated.Deployment;
pragma Elaborate_All (PolyORB_HI_Generated.Deployment);
package PolyORB_HI.Suspenders is
use Ada.Synchronous_Task_Control;
use PolyORB_HI_Generated.Deployment;
use type Ada.Real_Time.Time;
procedure Suspend_Forever;
-- Suspends for ever each task that call it
Task_Suspension_Objects : array (Entity_Type'Range) of Suspension_Object;
-- This array is used so that each task waits on its corresponding
-- suspension object until the transport layer initialization is
-- complete. We are obliged to do so since Ravenscar forbids that
-- more than one task wait on a protected object entry.
System_Startup_Time : Ada.Real_Time.Time := Ada.Real_Time.Time_First;
-- Startup time of user tasks
procedure Block_Task (Entity : Entity_Type);
-- Block a task until Unblock_All_Tasks is called.
procedure Unblock_All_Tasks;
-- Unblocks all the tasks waiting on the suspension objects of
-- Task_Suspension_Objects.
......
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