86 lines
2.9 KiB
Fortran
86 lines
2.9 KiB
Fortran
!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
|