1. -- 
  2. -- Uwe R. Zimmer, Australia, 2013 
  3. -- 
  4.  
  5. -- Not all policies need to be supported when executing on top of a desktop-operating system 
  6. pragma Task_Dispatching_Policy (FIFO_Within_Priorities); -- default policy 
  7. --  pragma Task_Dispatching_Policy (Non_Preemptive_Within_Priorities); 
  8. --  pragma Task_Dispatching_Policy (EDF_Across_Priorities); 
  9. --  pragma Task_Dispatching_Policy (Round_Robin_Within_Priorities); 
  10.  
  11. pragma Queuing_Policy (FIFO_Queuing); -- default policy 
  12. --  pragma Queuing_Policy (Priority_Queuing); -- does this change the behaviour of this program? 
  13.  
  14. with Ada.Dynamic_Priorities;                use Ada.Dynamic_Priorities; 
  15. with Ada.Text_IO;                           use Ada.Text_IO; 
  16. with Exceptions;                            use Exceptions; 
  17. with Queues_Pack_Protected_Ordered_Generic; 
  18. with System;                                use System; 
  19.  
  20. procedure Queues_Test_Priorities is 
  21.    pragma Priority (Priority'Last); 
  22.  
  23.    type Sequence         is (Ready, Set, Go); 
  24.    type Modules          is (Startup, Taxi, Takeoff, Climb, Cruise, Avoid, 
  25.                              Acrobatics, Looping, Inverted, Glidepath, Landing); 
  26.  
  27.    package Avionics_Queue_Pack is 
  28.      new Queues_Pack_Protected_Ordered_Generic 
  29.        (Element => Sequence, Queue_Enum => Modules, Queue_Size => 2); 
  30.    use Avionics_Queue_Pack; 
  31.  
  32.    Queue : Protected_Queue; 
  33.  
  34.    task type Avionics_Module is 
  35.       entry Provide_Id (Id : Modules); 
  36.    end Avionics_Module; 
  37.  
  38.    Avionics : array (Modules) of Avionics_Module; 
  39.  
  40.    protected type Synchronizer (No_of_tasks : Positive) is 
  41.       -- holds all tasks before letting them proceed 
  42.       -- and prints out their reported priorities on release. 
  43.       entry Wait_for_all (P : Priority); 
  44.    private 
  45.       Everybody_ready : Boolean := False; 
  46.    end Synchronizer; 
  47.  
  48.    protected body Synchronizer is 
  49.  
  50.       entry Wait_for_all  (P : Priority) 
  51.          when Wait_for_all'Count = No_of_tasks or else Everybody_ready is 
  52.  
  53.       begin 
  54.          Put_Line ("Some task released on priority: " & Priority'Image (P)); 
  55.          Everybody_ready := Wait_for_all'Count /= 0; 
  56.       end Wait_for_all; 
  57.  
  58.    end Synchronizer; 
  59.  
  60.    Avionics_Synchronizer : Synchronizer (Avionics'Length + 1); 
  61.    -- "+ 1" in order to synchronize the main task too. 
  62.  
  63.    task body Avionics_Module is 
  64.  
  65.       Module : Modules; 
  66.  
  67.    begin 
  68.       accept Provide_Id (Id : Modules) do 
  69.          Module := Id; 
  70.       end Provide_Id; 
  71.       -- Spread the available priorities over the defined modules 
  72.       Set_Priority (Priority => Priority (Priority'First + Priority (Float (Modules'Pos (Module) - Modules'Pos (Modules'First)) 
  73.                     * Float (Priority'Last - Priority'First) / Float (Modules'Pos (Modules'Last) - Modules'Pos (Modules'First))))); 
  74.  
  75.       Avionics_Synchronizer.Wait_for_all (Get_Priority); 
  76.  
  77.       declare 
  78.          Accumulator : Natural := Natural (Get_Priority); 
  79.       begin 
  80.          for i in 1 .. 10_000 loop -- burn some CPU time here by incrementing by one 
  81.             for j in 1 .. 10_000 loop -- in a slightly clumsy way. 
  82.                Accumulator := Accumulator + Natural'Min (i / 10_000, j / 10_000); 
  83.             end loop; 
  84.          end loop; 
  85.          Put_Line ("Task " & Modules'Image (Module) & " on priority: " & Priority'Image (Get_Priority) 
  86.                    & " accumulates: " & Natural'Image (Accumulator)); 
  87.       end; 
  88.  
  89.       declare 
  90.          Item : Sequence; 
  91.       begin 
  92.          for Order in Sequence loop 
  93.             Queue.Dequeue (Module) (Item); 
  94.             Put_Line (Modules'Image (Module) & " removed " & Sequence'Image (Item) & " from queue."); 
  95.          end loop; 
  96.       end; 
  97.  
  98.       Avionics_Synchronizer.Wait_for_all (Get_Priority); 
  99.  
  100.    exception 
  101.       when Exception_Id : others => Show_Exception (Exception_Id); 
  102.    end Avionics_Module; 
  103.  
  104. begin 
  105.    for Module in Modules loop 
  106. --     for Module in reverse Modules loop -- will starting the tasks in reverse will have an effect? 
  107.       Avionics (Module).Provide_Id (Module); 
  108.    end loop; 
  109.  
  110.    Avionics_Synchronizer.Wait_for_all (Get_Priority); 
  111.  
  112.    declare 
  113.       Accumulator : Natural := Natural (Get_Priority); 
  114.    begin 
  115.       for i in 1 .. 10_000 loop -- burn some CPU time here by incrementing by one 
  116.          for j in 1 .. 10_000 loop -- in a slightly clumsy way. 
  117.             Accumulator := Accumulator + Natural'Min (i / 10_000, j / 10_000); 
  118.          end loop; 
  119.       end loop; 
  120.       Put_Line ("Main task on priority: " & Priority'Image (Get_Priority) 
  121.                 & " accumulates: " & Natural'Image (Accumulator)); 
  122.    end; 
  123.  
  124.    for Order in Sequence loop 
  125.       Queue.Enqueue (Order); 
  126.       Put_Line (Sequence'Image (Order) & " added to queue."); 
  127.    end loop; 
  128.  
  129.    Avionics_Synchronizer.Wait_for_all (Get_Priority); 
  130.  
  131. exception 
  132.    when Exception_Id : others => Show_Exception (Exception_Id); 
  133. end Queues_Test_Priorities;