new files

2013-04-10 12:38:42 -07:00 · 2013-04-10 12:38:42 -07:00 · 86c034bb8b
commit 86c034bb8b
parent 3af7344581
1364 changed files with 21352 additions and 0 deletions
--- a/Task/Checkpoint-synchronization/Ada/checkpoint-synchronization.ada
+++ b/Task/Checkpoint-synchronization/Ada/checkpoint-synchronization.ada
@ -0,0 +1,101 @@
+with Ada.Calendar;               use Ada.Calendar;
+with Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+procedure Test_Checkpoint is
+
+   package FR renames Ada.Numerics.Float_Random;
+   No_Of_Cubicles: constant Positive := 3;
+     -- That many workers can work in parallel
+   No_Of_Workers: constant Positive := 6;
+     -- That many workers are potentially available
+     -- some will join the team when others quit the job
+
+   type Activity_Array is array(Character) of Boolean;
+     -- we want to know who is currently working
+
+   protected Checkpoint is
+      entry Deliver;
+      entry Join (Label : out Character; Tolerance: out Float);
+      entry Leave(Label : in Character);
+   private
+      Signaling     : Boolean   := False;
+      Ready_Count   : Natural   := 0;
+      Worker_Count  : Natural   := 0;
+      Unused_Label  : Character := 'A';
+      Likelyhood_To_Quit: Float := 1.0;
+      Active        : Activity_Array := (others => false);
+      entry Lodge;
+   end Checkpoint;
+
+   protected body Checkpoint is
+      entry Join (Label : out Character; Tolerance: out Float)
+      when not Signaling and Worker_Count < No_Of_Cubicles is
+      begin
+         Label        := Unused_Label;
+         Active(Label):= True;
+         Unused_Label := Character'Succ (Unused_Label);
+         Worker_Count := Worker_Count + 1;
+         Likelyhood_To_Quit := Likelyhood_To_Quit / 2.0;
+         Tolerance    := Likelyhood_To_Quit;
+      end Join;
+
+      entry Leave(Label: in Character) when not Signaling is
+      begin
+         Worker_Count  := Worker_Count - 1;
+         Active(Label) := False;
+      end Leave;
+
+      entry Deliver when not Signaling is
+      begin
+         Ready_Count := Ready_Count + 1;
+         requeue Lodge;
+      end Deliver;
+
+      entry Lodge when Ready_Count = Worker_Count or Signaling is
+      begin
+         if Ready_Count = Worker_Count then
+            Put("---Sync Point [");
+            for C in Character loop
+               if Active(C) then
+                  Put(C);
+               end if;
+            end loop;
+            Put_Line("]---");
+         end if;
+         Ready_Count := Ready_Count - 1;
+         Signaling   := Ready_Count /= 0;
+      end Lodge;
+   end Checkpoint;
+
+   task type Worker;
+
+   task body Worker is
+      Dice      : FR.Generator;
+      Label     : Character;
+      Tolerance : Float;
+      Shift_End : Time := Clock + 2.0;
+        -- Trade unions are hard!
+   begin
+      FR.Reset (Dice);
+      Checkpoint.Join (Label, Tolerance);
+      Put_Line(Label & " joins the team");
+      loop
+         Put_Line (Label & " is working");
+         delay Duration (FR.Random (Dice) * 0.500);
+         Put_Line (Label & " is ready");
+         Checkpoint.Deliver;
+         if FR.Random(Dice) < Tolerance then
+            Put_Line(Label & " leaves the team");
+            exit;
+         elsif Clock >= Shift_End then
+            Put_Line(Label & " ends shift");
+            exit;
+         end if;
+      end loop;
+      Checkpoint.Leave(Label);
+   end Worker;
+   Set : array (1..No_Of_Workers) of Worker;
+begin
+   null; -- Nothing to do here
+end Test_Checkpoint;