Data update

Task/Dining-philosophers/Ada/dining-philosophers-1.adb

@@ -0,0 +1,50 @@
+with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+with Synchronization.Generic_Mutexes_Array;
+
+procedure Test_Dining_Philosophers is
+   type Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
+   package Fork_Arrays is new Synchronization.Generic_Mutexes_Array (Philosopher);
+   use Fork_Arrays;
+
+   Life_Span : constant := 20;    -- In his life a philosopher eats 20 times
+   Forks : aliased Mutexes_Array; -- Forks for hungry philosophers
+
+   function Left_Of (Fork : Philosopher) return Philosopher is
+   begin
+      if Fork = Philosopher'First then
+         return Philosopher'Last;
+      else
+         return Philosopher'Pred (Fork);
+      end if;
+   end Left_Of;
+
+   task type Person (ID : Philosopher);
+   task body Person is
+      Cutlery : aliased Mutexes_Set := ID or Left_Of (ID);
+      Dice    : Generator;
+   begin
+      Reset (Dice);
+      for Life_Cycle in 1..Life_Span loop
+         Put_Line (Philosopher'Image (ID) & " is thinking");
+         delay Duration (Random (Dice) * 0.100);
+         Put_Line (Philosopher'Image (ID) & " is hungry");
+         declare
+            Lock : Set_Holder (Forks'Access, Cutlery'Access);
+         begin
+            Put_Line (Philosopher'Image (ID) & " is eating");
+            delay Duration (Random (Dice) * 0.100);
+         end;
+      end loop;
+      Put_Line (Philosopher'Image (ID) & " is leaving");
+   end Person;
+
+   Ph_1 : Person (Aristotle); -- Start philosophers
+   Ph_2 : Person (Kant);
+   Ph_3 : Person (Spinoza);
+   Ph_4 : Person (Marx);
+   Ph_5 : Person (Russel);
+begin
+   null; -- Nothing to do in the main task, just sit and behold
+end Test_Dining_Philosophers;

Task/Dining-philosophers/Ada/dining-philosophers-2.adb

@@ -0,0 +1,53 @@
+with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+procedure Test_Dining_Philosophers is
+   type Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
+   protected type Fork is
+      entry Grab;
+      procedure Put_Down;
+   private
+      Seized : Boolean := False;
+   end Fork;
+   protected body Fork is
+      entry Grab when not Seized is
+      begin
+         Seized := True;
+      end Grab;
+      procedure Put_Down is
+      begin
+         Seized := False;
+      end Put_Down;
+   end Fork;
+
+   Life_Span : constant := 20;    -- In his life a philosopher eats 20 times
+
+   task type Person (ID : Philosopher; First, Second : not null access Fork);
+   task body Person is
+      Dice : Generator;
+   begin
+      Reset (Dice);
+      for Life_Cycle in 1..Life_Span loop
+         Put_Line (Philosopher'Image (ID) & " is thinking");
+         delay Duration (Random (Dice) * 0.100);
+         Put_Line (Philosopher'Image (ID) & " is hungry");
+         First.Grab;
+         Second.Grab;
+         Put_Line (Philosopher'Image (ID) & " is eating");
+         delay Duration (Random (Dice) * 0.100);
+         Second.Put_Down;
+         First.Put_Down;
+      end loop;
+      Put_Line (Philosopher'Image (ID) & " is leaving");
+   end Person;
+
+   Forks : array (1..5) of aliased Fork; -- Forks for hungry philosophers
+                                         -- Start philosophers
+   Ph_1 : Person (Aristotle, Forks (1)'Access, Forks (2)'Access);
+   Ph_2 : Person (Kant,      Forks (2)'Access, Forks (3)'Access);
+   Ph_3 : Person (Spinoza,   Forks (3)'Access, Forks (4)'Access);
+   Ph_4 : Person (Marx,      Forks (4)'Access, Forks (5)'Access);
+   Ph_5 : Person (Russel,    Forks (1)'Access, Forks (5)'Access);
+begin
+   null; -- Nothing to do in the main task, just sit and behold
+end Test_Dining_Philosophers;

Task/Dining-philosophers/Ada/dining-philosophers-3.adb

@@ -0,0 +1,75 @@
+with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+procedure Test_Dining_Philosophers is
+   type Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
+
+   protected type Fork is
+      entry Grab;
+      procedure Put_Down;
+   private
+      Seized : Boolean := False;
+   end Fork;
+
+   protected Host is
+      entry Greet;
+      procedure Farewell;
+   private
+      Guests : Natural := 0;
+   end Host;
+
+   protected body Fork is
+      entry Grab when not Seized is
+      begin
+         Seized := True;
+      end Grab;
+      procedure Put_Down is
+      begin
+         Seized := False;
+      end Put_Down;
+   end Fork;
+
+   protected body Host is
+      entry Greet when Guests < 5 is
+      begin
+         Guests := Guests + 1;
+      end Greet;
+      procedure Farewell is
+      begin
+         Guests := Guests - 1;
+      end Farewell;
+   end Host;
+
+   Life_Span : constant := 20;    -- In his life a philosopher eats 20 times
+
+   task type Person (ID : Philosopher; Left, Right : not null access Fork);
+   task body Person is
+      Dice : Generator;
+   begin
+      Reset (Dice);
+      for Life_Cycle in 1..Life_Span loop
+         Put_Line (Philosopher'Image (ID) & " is thinking");
+         delay Duration (Random (Dice) * 0.100);
+         Put_Line (Philosopher'Image (ID) & " is hungry");
+         Host.Greet;
+         Left.Grab;
+         Right.Grab;
+         Put_Line (Philosopher'Image (ID) & " is eating");
+         delay Duration (Random (Dice) * 0.100);
+         Left.Put_Down;
+         Right.Put_Down;
+         Host.Farewell;
+      end loop;
+      Put_Line (Philosopher'Image (ID) & " is leaving");
+   end Person;
+
+   Forks : array (1..5) of aliased Fork; -- Forks for hungry philosophers
+                                         -- Start philosophers
+   Ph_1 : Person (Aristotle, Forks (1)'Access, Forks (2)'Access);
+   Ph_2 : Person (Kant,      Forks (2)'Access, Forks (3)'Access);
+   Ph_3 : Person (Spinoza,   Forks (3)'Access, Forks (4)'Access);
+   Ph_4 : Person (Marx,      Forks (4)'Access, Forks (5)'Access);
+   Ph_5 : Person (Russel,    Forks (5)'Access, Forks (1)'Access);
+begin
+   null; -- Nothing to do in the main task, just sit and behold
+end Test_Dining_Philosophers;

Task/Dining-philosophers/Euphoria/dining-philosophers.eu

@@ -0,0 +1,54 @@
+constant FREE = 0, LOCKED = 1
+sequence forks
+forks = repeat(FREE,5)
+
+procedure person(sequence name, integer left_fork, integer right_fork)
+    while 1 do
+        while forks[left_fork] = LOCKED or forks[right_fork] = LOCKED do
+            if forks[left_fork] = FREE then
+                puts(1, name & " hasn't right fork.\n")
+            elsif forks[right_fork] = FREE then
+                puts(1, name & " hasn't left fork.\n")
+            else
+                puts(1, name & " hasn't both forks.\n")
+            end if
+            puts(1, name & " is waiting.\n")
+            task_yield()
+        end while
+
+        puts(1, name & " grabs forks.\n")
+        forks[left_fork] = LOCKED
+        forks[right_fork] = LOCKED
+        for i = 1 to rand(10) do
+            puts(1, name & " is eating.\n")
+            task_yield()
+        end for
+        puts(1, name & " puts forks down and leaves the dinning room.\n")
+        forks[left_fork] = FREE
+        forks[right_fork] = FREE
+
+        for i = 1 to rand(10) do
+            puts(1, name & " is thinking.\n")
+            task_yield()
+        end for
+        puts(1, name & " becomes hungry.\n")
+    end while
+end procedure
+
+integer rid
+atom taskid
+rid = routine_id("person")
+taskid = task_create(rid,{"Aristotle",1,2})
+task_schedule(taskid,{1,2})
+taskid = task_create(rid,{"Kant",2,3})
+task_schedule(taskid,{1,2})
+taskid = task_create(rid,{"Spinoza",3,4})
+task_schedule(taskid,{1,2})
+taskid = task_create(rid,{"Marx",4,5})
+task_schedule(taskid,{1,2})
+taskid = task_create(rid,{"Russell",5,1})
+task_schedule(taskid,{1,2})
+
+while get_key() = -1 do
+    task_yield()
+end while

Task/Dining-philosophers/Fortran/dining-philosophers.f

@@ -0,0 +1,86 @@
+!Deadlock prevented by making one philosopher "left-handed"
+!and making orderly use of omp locks which protect forks by ensuring that only one philosopher can use each fork at a time
+    program dining_philosophers
+    use omp_lib
+    implicit none
+
+    integer, parameter :: N = 5
+    integer(omp_lock_kind) :: forks(N)
+    character(len=20), dimension(N) :: names = [character(len=20) :: &
+        "Aristotle", "Kant", "Spinoza", "Marx", "Russell"]
+    integer :: i
+    integer :: next_thread = 0  ! Shared sequencing variable
+
+    ! Initialize forks (mutexes)
+    do i = 1, N
+        call omp_init_lock(forks(i))
+    end do
+
+    ! Parallel region with N threads
+    !$omp parallel num_threads(N) private(i) shared(next_thread, forks, names)
+        i = omp_get_thread_num() + 1  ! Philosopher IDs: 1 to N
+        call philosopher(i, next_thread, forks, names)
+    !$omp end parallel
+
+    ! Destroy locks
+    do i = 1, N
+        call omp_destroy_lock(forks(i))
+    end do
+
+contains
+
+    subroutine philosopher(id, next_thread, forks, names)
+        integer, intent(in) :: id
+        integer, intent(inout) :: next_thread
+        integer(omp_lock_kind), intent(inout) :: forks(:)
+        character(len=20), intent(in) :: names(:)
+        integer :: left, right, meals
+
+        left = id
+        right = mod(id, size(forks)) + 1  ! Wrap around for right fork
+        !$omp barrier
+        ! Wait for turn to start
+        do while (id - 1 /= next_thread)
+            !$omp flush(next_thread)
+        end do
+
+        print *, trim(names(id)), " sits down at the table."
+
+        !$omp atomic
+        next_thread = next_thread + 1
+        !$omp flush(next_thread)
+
+        ! Philosopher's meal loop
+        do meals = 1, 20
+!            print *, trim(names(id)), " is thinking."
+!            call sleep(1)
+
+            ! Asymmetric fork acquisition to prevent deadlock
+            if (id < size(forks)) then
+                call omp_set_lock(forks(left))
+                print *, trim(names(id)), " picked up left fork ", left
+                call omp_set_lock(forks(right))
+                print *, trim(names(id)), " picked up right fork ", right
+            else
+                call omp_set_lock(forks(right))
+                print *, trim(names(id)), " picked up right fork ", right
+                call omp_set_lock(forks(left))
+                print *, trim(names(id)), " picked up left fork ", left
+            end if
+
+            print *, trim(names(id)), " is eating."
+            call sleep(1)
+
+            call omp_unset_lock(forks(left))
+            call omp_unset_lock(forks(right))
+            print *, trim(names(id)), " put down forks."
+            print *, trim(names(id)), " is thinking."
+            call sleep(1)
+            print *, trim(names(id)), " returns to the table."
+
+        end do
+
+        print *, trim(names(id)), " leaves the table."
+    end subroutine philosopher
+
+end program dining_philosophers