Adaによるリアルタイムシステムプログラミング ── 優先度・周期・実行時間制御の実践

-- 01_task_priority.ada
-- タスク優先度と FIFO_Within_Priorities の基本形
-- 構成プラグマはコンテキスト条項より前に置く

pragma Task_Dispatching_Policy (FIFO_Within_Priorities);

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

procedure Task_Priority_Demo is

   task High_Priority_Task is
      pragma Priority (Priority'Last);
      pragma Storage_Size (4 * 1024);
   end High_Priority_Task;

   task Low_Priority_Task is
      pragma Priority (Priority'First);
      pragma Storage_Size (4 * 1024);
   end Low_Priority_Task;

   task body High_Priority_Task is
   begin
      Put_Line ("[T=0.0s] High priority task started");
      delay until Clock + Milliseconds (100);
      Put_Line ("[T=0.1s] High priority task completed");
   end High_Priority_Task;

   task body Low_Priority_Task is
   begin
      Put_Line ("[T=0.0s] Low priority task started");
      delay until Clock + Milliseconds (500);
      Put_Line ("[T=0.5s] Low priority task completed");
   end Low_Priority_Task;

begin
   Put_Line ("=== Task Priority Demo (FIFO_Within_Priorities) ===");
   Put_Line ("Main: waiting for tasks to complete...");
   delay until Clock + Milliseconds (800);
   Put_Line ("Main: done");
end Task_Priority_Demo;

-- 02_ceiling_locking.ada
-- Ceiling_Locking プロトコルによる優先度逆転の防止
-- 構成プラグマはコンテキスト条項より前に置く

pragma Locking_Policy (Ceiling_Locking);

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

procedure Ceiling_Locking_Demo is

   Ceiling : constant System.Any_Priority := System.Any_Priority'Last;

   protected Shared_Data is
      pragma Priority (Ceiling);
      procedure Write (V : Integer);
      function Read return Integer;
   private
      Value : Integer := 0;
   end Shared_Data;

   protected body Shared_Data is
      procedure Write (V : Integer) is
      begin
         Value := V;
      end Write;

      function Read return Integer is
      begin
         return Value;
      end Read;
   end Shared_Data;

   task Producer is
      pragma Priority (Priority'Last);
      pragma Storage_Size (4 * 1024);
   end Producer;

   task Consumer is
      pragma Priority (Priority'First);
      pragma Storage_Size (4 * 1024);
   end Consumer;

   task body Producer is
   begin
      Put_Line ("[T=0.0s] Producer (high prio): about to write");
      Shared_Data.Write (42);
      Put_Line ("[T=0.0s] Producer (high prio): write done");
      delay until Clock + Milliseconds (100);
   end Producer;

   task body Consumer is
   begin
      delay until Clock + Milliseconds (10);
      Put_Line ("[T=0.01s] Consumer (low prio): about to read");
      declare
         V : Integer;
      begin
         V := Shared_Data.Read;
         Put_Line ("[T=0.01s] Consumer (low prio): read done, got" &
                     Integer'Image (V));
      end;
      delay until Clock + Milliseconds (100);
   end Consumer;

begin
   Put_Line ("=== Ceiling_Locking Demo ===");
   Put_Line ("Main: producer priority = Last, consumer priority = First");
   Put_Line ("Ceiling = Any_Priority'Last, locking = Ceiling_Locking");
   delay until Clock + Milliseconds (300);
   Put_Line ("Main: done");
end Ceiling_Locking_Demo;

-- 03_periodic_task.ada
-- delay until による周期タスク ── 累積ドリフトを防ぐ

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

procedure Periodic_Task_Demo is

   Period_MS : constant Time_Span := Milliseconds (200);
   Cycles    : constant Positive  := 5;

   task Sensor_Reader is
      pragma Priority (Priority'Last - 2);
      pragma Storage_Size (4 * 1024);
   end Sensor_Reader;

   task body Sensor_Reader is
      Start_Time  : constant Time := Clock;
      Next_Release : Time := Start_Time + Period_MS;
      Cycle_Count  : Natural := 0;
   begin
      Put_Line ("[Sensor] Periodic task starts, period=" &
                To_Duration (Period_MS)'Image & "s, cycles=" &
                Natural'Image (Cycles));

      for I in 1 .. Cycles loop
         delay until Next_Release;

         Cycle_Count := Cycle_Count + 1;
         Put_Line ("[Sensor] Cycle" & Natural'Image (Cycle_Count) &
                   " at" & Duration'Image (To_Duration (Clock - Start_Time)) & "s");

         Next_Release := Next_Release + Period_MS;
      end loop;

      Put_Line ("[Sensor] Periodic task finished. Actual elapsed:" &
                Duration'Image (To_Duration (Clock - Start_Time)) & "s");
   end Sensor_Reader;

begin
   Put_Line ("=== Periodic Task Demo (delay until) ===");
   Put_Line ("Main: waiting for" & Natural'Image (Cycles) & " cycles...");
   delay until Clock + Milliseconds (1500);
   Put_Line ("Main: done");
end Periodic_Task_Demo;

-- 04_ravenscar_profile.ada
-- Ravenscar プロファイルの基本形
-- コンパイル時に gnat.adc で pragma Profile (Ravenscar); を指定する

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

package Ravenscar_State is

   protected Signal is
      pragma Priority (System.Default_Priority + 5);
      entry Wait_For_Release;
      procedure Release;
   private
      Released : Boolean := False;
   end Signal;

   task Periodic_Worker is
      pragma Priority (System.Default_Priority + 1);
      pragma Storage_Size (4 * 1024);
   end Periodic_Worker;

   task Monitor is
      pragma Priority (System.Default_Priority);
      pragma Storage_Size (4 * 1024);
   end Monitor;

end Ravenscar_State;

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

package body Ravenscar_State is

   protected body Signal is
      entry Wait_For_Release when Released is
      begin
         Released := False;
      end Wait_For_Release;

      procedure Release is
      begin
         Released := True;
      end Release;
   end Signal;

   task body Periodic_Worker is
      Start_Time   : constant Time := Clock;
      Next_Release : Time := Start_Time + Milliseconds (100);
      Period       : constant Time_Span := Milliseconds (100);
      Cycle_Count  : Natural := 0;
   begin
      Put_Line ("[Worker] Ravenscar periodic task starts");

      for I in 1 .. 4 loop
         delay until Next_Release;

         Cycle_Count := Cycle_Count + 1;
         Put_Line ("[Worker] Cycle" & Natural'Image (Cycle_Count) &
                   " at" & Duration'Image (To_Duration (Clock - Start_Time)) & "s");
         Signal.Release;
         Next_Release := Next_Release + Period;
      end loop;

       Put_Line ("[Worker] Finished demo, waiting (Ravenscar: No_Task_Termination)");
      loop
         delay until Clock + Seconds (1);
      end loop;
   end Periodic_Worker;

   task body Monitor is
   begin
      Put_Line ("[Monitor] Waiting for signals...");

      for I in 1 .. 4 loop
         Signal.Wait_For_Release;
         Put_Line ("[Monitor] Received signal" & Natural'Image (I));
      end loop;

      Put_Line ("[Monitor] All signals received, waiting (Ravenscar: No_Task_Termination)");
      loop
         delay until Clock + Seconds (1);
      end loop;
   end Monitor;

end Ravenscar_State;

with Ravenscar_State; use Ravenscar_State;
with Ada.Text_IO;     use Ada.Text_IO;
with Ada.Real_Time;   use Ada.Real_Time;

procedure Ravenscar_Demo is
begin
   Put_Line ("=== Ravenscar Profile Demo ===");
   Put_Line ("(compile with: gnatmake -gnatec=gnat.adc ravenscar_demo)");
   Put_Line ("Main: waiting for Ravenscar tasks...");
   delay until Clock + Milliseconds (800);
   Put_Line ("Main: done");
end Ravenscar_Demo;

-- 05_timing_events.ada
-- タイミングイベント (Ada.Real_Time.Timing_Events)
-- 高優先度タスクをポーリングなしで起床させる仕組み

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;
with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events;

package Signal_Pkg is
   protected type Signal_Type is
      pragma Priority (System.Interrupt_Priority'Last);
      entry Wait_For_Event;
      procedure Fire (Event : in out Timing_Event);
   private
      Fired : Boolean := False;
   end Signal_Type;

   S : Signal_Type;
end Signal_Pkg;

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;
with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events;

package body Signal_Pkg is
   protected body Signal_Type is
      entry Wait_For_Event when Fired is
      begin
         Fired := False;
      end Wait_For_Event;

      procedure Fire (Event : in out Timing_Event) is
      begin
         Fired := True;
      end Fire;
   end Signal_Type;
end Signal_Pkg;

with Signal_Pkg; use Signal_Pkg;

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;
with Ada.Real_Time.Timing_Events; use Ada.Real_Time.Timing_Events;

procedure Timing_Events_Demo is

   pragma Priority (29);

   Timer_1 : Timing_Event;
   Timer_2 : Timing_Event;

   task Reactor is
      pragma Priority (System.Default_Priority + 5);
      pragma Storage_Size (4 * 1024);
   end Reactor;

   task body Reactor is
   begin
      Put_Line ("[Reactor] Waiting for timing events...");

      S.Wait_For_Event;
      Put_Line ("[Reactor] Got event #1");

      S.Wait_For_Event;
      Put_Line ("[Reactor] Got event #2");

      Put_Line ("[Reactor] Done");
   end Reactor;

begin
   Put_Line ("=== Timing Events Demo ===");
   Put_Line ("Scheduling two timers at +100ms and +250ms...");

   Set_Handler (Timer_1, Clock + Milliseconds (100), S.Fire'Access);
   Set_Handler (Timer_2, Clock + Milliseconds (250), S.Fire'Access);

   delay until Clock + Milliseconds (500);
   Put_Line ("Main: done");
end Timing_Events_Demo;

-- 06_protected_queue.ada
-- 保護オブジェクトによるリアルタイムデータ共有
-- パイプライン: Producer -> Bounded_Buffer -> Consumer
-- コンパイル時に gnat.adc で pragma Locking_Policy (Ceiling_Locking); を指定する

pragma Locking_Policy (Ceiling_Locking);

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

procedure Protected_Queue_Demo is

   Buffer_Size : constant := 4;

   type Buf_Array is array (1 .. Buffer_Size) of Integer;

   protected Bounded_Buffer is
      pragma Priority (System.Any_Priority'Last);
      entry Put (Item : Integer);
      entry Get (Item : out Integer);
   private
      Buf    : Buf_Array;
      Count  : Natural := 0;
      Head   : Positive := 1;
      Tail   : Positive := 1;
   end Bounded_Buffer;

   protected body Bounded_Buffer is
      entry Put (Item : Integer) when Count < Buffer_Size is
      begin
         Buf (Tail) := Item;
         Tail := (Tail mod Buffer_Size) + 1;
         Count := Count + 1;
      end Put;

      entry Get (Item : out Integer) when Count > 0 is
      begin
         Item := Buf (Head);
         Head := (Head mod Buffer_Size) + 1;
         Count := Count - 1;
      end Get;
   end Bounded_Buffer;

   task Producer is
      pragma Priority (System.Default_Priority + 2);
      pragma Storage_Size (4 * 1024);
   end Producer;

   task Consumer is
      pragma Priority (System.Default_Priority + 1);
      pragma Storage_Size (4 * 1024);
   end Consumer;

   task body Producer is
      Next_Release : Time := Clock + Milliseconds (50);
      Period       : constant Time_Span := Milliseconds (50);
   begin
      for I in 1 .. 6 loop
         Bounded_Buffer.Put (I);
         Put_Line ("[Producer] Put" & Integer'Image (I));
         delay until Next_Release;
         Next_Release := Next_Release + Period;
      end loop;
      Put_Line ("[Producer] Done");
   end Producer;

   task body Consumer is
      Item         : Integer;
      Next_Release : Time := Clock + Milliseconds (80);
      Period       : constant Time_Span := Milliseconds (80);
   begin
      delay until Clock + Milliseconds (30);
      for I in 1 .. 6 loop
         Bounded_Buffer.Get (Item);
         Put_Line ("[Consumer] Got" & Integer'Image (Item));
         delay until Next_Release;
         Next_Release := Next_Release + Period;
      end loop;
      Put_Line ("[Consumer] Done");
   end Consumer;

begin
   Put_Line ("=== Protected Queue Demo (Ceiling_Locking) ===");
   Put_Line ("Buffer size = 4; Producer every 50ms, Consumer every 80ms");
   delay until Clock + Milliseconds (800);
   Put_Line ("Main: done");
end Protected_Queue_Demo;

-- 07_execution_time.ada
-- 実行時間制御 (Execution_Time)
-- タスクごとの CPU 消費時間を計測する

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;
with Ada.Execution_Time;
use type Ada.Execution_Time.CPU_Time;

procedure Execution_Time_Demo is

   package ET renames Ada.Execution_Time;

   task Busy_Worker is
      pragma Priority (System.Default_Priority + 1);
      pragma Storage_Size (4 * 1024);
   end Busy_Worker;

   task body Busy_Worker is
      Wall_Start : Time;
      Cpu_Start  : ET.CPU_Time;
      Dummy      : Integer := 0;
   begin
      Wall_Start := Clock;
      Cpu_Start := ET.Clock;

      Put_Line ("[Worker] Starting compute-bound work...");
for I in 1 .. 20_000_000 loop
          Dummy := Dummy + 1;
      end loop;
      Put_Line ("[Worker] Dummy =" & Integer'Image (Dummy));

      declare
         Wall_Elapsed : constant Duration :=
            To_Duration (Clock - Wall_Start);
         Cpu_Span     : constant Time_Span :=
            ET.Clock - Cpu_Start;
      begin
         Put_Line ("[Worker] Done, wall time:" &
                   Duration'Image (Wall_Elapsed) & "s");
         Put_Line ("[Worker] CPU time consumed:" &
                   Duration'Image (To_Duration (Cpu_Span)) & "s");
      end;
   end Busy_Worker;

   Cpu_Start_Main : constant ET.CPU_Time := ET.Clock;

begin
   Put_Line ("=== Execution Time Demo ===");

   delay until Clock + Milliseconds (500);

   declare
      Cpu_Span : constant Time_Span := ET.Clock - Cpu_Start_Main;
   begin
      Put_Line ("Main: CPU time consumed after 500ms:" &
                Duration'Image (To_Duration (Cpu_Span)) & "s");
   end;

   Put_Line ("Main: done");
end Execution_Time_Demo;

-- 08_multiperiodic.ada
-- マルチ周期リアルタイムシステムの統合デモ
-- 速い周期(100ms)のセンサー読取タスク
-- 遅い周期(400ms)の制御タスク
-- Ceiling_Locking によるデータ共有

pragma Locking_Policy (Ceiling_Locking);

with Ada.Text_IO;               use Ada.Text_IO;
with System;                    use System;
with Ada.Real_Time;             use Ada.Real_Time;

procedure Multiperiodic_Demo is

   package Int_IO is new Ada.Text_IO.Integer_IO (Integer);

   protected Shared_Sensor is
      pragma Priority (System.Any_Priority'Last);
      procedure Write (V : Integer);
      function Read return Integer;
   private
      Value : Integer := 0;
   end Shared_Sensor;

   protected body Shared_Sensor is
      procedure Write (V : Integer) is
      begin
         Value := V;
      end Write;

      function Read return Integer is
      begin
         return Value;
      end Read;
   end Shared_Sensor;

   task Fast_Sensor is
      pragma Priority (System.Default_Priority + 3);
      pragma Storage_Size (4 * 1024);
   end Fast_Sensor;

   task body Fast_Sensor is
      Next_Release : Time := Clock + Milliseconds (100);
      Period       : constant Time_Span := Milliseconds (100);
      Cycle        : Natural := 0;
   begin
      Put_Line ("[Fast] Sensor reader starts (100ms period)");

      for I in 1 .. 12 loop
         delay until Next_Release;
         Cycle := Cycle + 1;
         Shared_Sensor.Write (Cycle * 10);
         Next_Release := Next_Release + Period;
      end loop;
      Put_Line ("[Fast] Done");
   end Fast_Sensor;

   task Slow_Controller is
      pragma Priority (System.Default_Priority + 2);
      pragma Storage_Size (4 * 1024);
   end Slow_Controller;

   task body Slow_Controller is
      Next_Release : Time := Clock + Milliseconds (150);
      Period       : constant Time_Span := Milliseconds (400);
      Cycle        : Natural := 0;
      Raw          : Integer;
   begin
      Put_Line ("[Slow] Controller starts (400ms period)");

      for I in 1 .. 3 loop
         delay until Next_Release;
         Cycle := Cycle + 1;
         Raw := Shared_Sensor.Read;
         Put_Line ("[Slow] Cycle" & Natural'Image (Cycle) &
                   " reads sensor =" & Integer'Image (Raw));
         Next_Release := Next_Release + Period;
      end loop;
      Put_Line ("[Slow] Done");
   end Slow_Controller;

begin
   Put_Line ("=== Multiperiodic Real-Time System Demo ===");
   Put_Line ("Fast sensor (100ms) x 12 + Slow controller (400ms) x 3");
   Put_Line ("Ceiling_Locking prevents priority inversion on shared data");
   delay until Clock + Milliseconds (2000);
   Put_Line ("Main: done");
end Multiperiodic_Demo;