如何使用锁定例程和睡眠功能来摆脱同步的显式障碍？

Posted 2023-02-19

【中文标题】如何使用锁定例程和睡眠功能来摆脱同步的显式障碍？

【英文标题】：How to use the lock routines and the sleep function in order to get rid of the explicite barriers of synchronization?

【发布时间】：2021-11-23 03:12:25

【问题描述】：

我实现了以下测试代码：

program test
  use OMP_LIB
  implicit none
  integer::num_thread,nthreads
  integer::a=1
  integer(kind = OMP_lock_kind) :: lck !< a lock
  call omp_init_lock(lck)
  !$OMP PARALLEL SHARED(a,lck) PRIVATE(num_thread,nthreads)
  num_thread=OMP_GET_THREAD_NUM() !< le rang du thread 
  nthreads=OMP_GET_NUM_THREADS() !< le nombre de threads

  if (num_thread==0) then
     call omp_set_lock(lck)
     a=a+5
     a=a+7
     call omp_unset_lock(lck)
  end if
  
  !$OMP BARRIER 
  
  if (num_thread == 1) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 2) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 3) then
     a=a+1
  end if

  !$OMP END PARALLEL
  call omp_destroy_lock(lck)
  
  print*,'a is equal to: ',a
  
contains
  recursive subroutine system_sleep(wait)
    use,intrinsic :: iso_c_binding, only: c_int
    integer,intent(in) :: wait
    integer(kind=c_int):: waited
    interface
       function c_usleep(msecs) bind (C,name="usleep")
         import
         integer(c_int) :: c_usleep
         integer(c_int),intent(in),VALUE :: msecs
       end function c_usleep
    end interface
    if(wait.gt.0)then
       waited=c_usleep(int(wait,kind=c_int))
    endif
  end subroutine system_sleep

  recursive subroutine wait(full)
    logical,intent(in)::full
    do
       call system_sleep(1)
       if (full .eqv. .true.) EXIT

    end do
  end subroutine wait
end program test

如您所见，线程仅更新整数a 的值。 我想摆脱第一个同步障碍并用一段代码替换它。为此，我考虑使用sleep 函数和锁定例程以避免并发问题。 通过执行这段代码，我得到： a is equal to: 16.

以下代码是没有第一个同步屏障的实现：

program test
  use OMP_LIB
  implicit none
  integer::num_thread,nthreads
  integer::a=1
  integer(kind = OMP_lock_kind) :: lck !< a lock
  call omp_init_lock(lck)
  !$OMP PARALLEL SHARED(a,lck) PRIVATE(num_thread,nthreads)
  num_thread=OMP_GET_THREAD_NUM() !< le rang du thread 
  nthreads=OMP_GET_NUM_THREADS() !< le nombre de threads

  if (num_thread==0) then
     call omp_set_lock(lck)
     a=a+5
     a=a+7
     call omp_unset_lock(lck)
  end if

  if (num_thread .ne. 0) then  
     do
        call omp_set_lock(lck)
        if (a==13) then
           exit
        else
           call omp_unset_lock(lck)
           call system_sleep(1)
        end if            
     end do 
     call omp_unset_lock(lck)
  end if


  if (num_thread == 1) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 2) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 3) then
     a=a+1
  end if

  !$OMP END PARALLEL
  call omp_destroy_lock(lck)
  
  print*,'a is equal to: ',a
  
contains
  recursive subroutine system_sleep(wait)
    use,intrinsic :: iso_c_binding, only: c_int
    integer,intent(in) :: wait
    integer(kind=c_int):: waited
    interface
       function c_usleep(msecs) bind (C,name="usleep")
         import
         integer(c_int) :: c_usleep
         integer(c_int),intent(in),VALUE :: msecs
       end function c_usleep
    end interface
    if(wait.gt.0)then
       waited=c_usleep(int(wait,kind=c_int))
    endif
  end subroutine system_sleep

  recursive subroutine wait(full)
    logical,intent(in)::full
    do
       call system_sleep(1)
       if (full .eqv. .true.) EXIT

    end do
  end subroutine wait
end program test

当我运行此代码时，我得到一个闪烁的光标并且没有显示任何结果。

我不明白线程为何以及如何处理此代码。 我想提一下条件a==13是由于线程号0（主线程）会将12添加到a的初始值1。我们只有在主线程完成计算时才离开循环并将 a 设置为值 13。

我希望你能帮助我使这段代码工作。

【问题讨论】：

你有一个死锁，因为执行exit 的第一个线程没有通过调用omp_unset_lock(lck) 来释放锁。 （使用 2 个线程，您的代码可以工作，但使用 3 个线程会开始中断。）无论如何，您所做的并不是真正的建议，当然也不应该在生产代码中使用。不过，了解这些是可以的。

@MichaelKlemm 是的，这是为了教育目的。你能告诉我为什么在end do 之后添加call omp_unset_lock(lck) 不能解决问题（我编辑了我的代码）？

@MichaelKlemm 为什么它只适用于 2 个线程？

如果一个线程执行EXIT 语句，它仍然持有锁并且不会再释放它（没有代码这样做）。现在请考虑一下 2 个线程和 3 个线程的可能执行情况。您将看到 ID 为 1 或 2 的线程将始终阻塞，因为它们将等待相应的其他线程释放锁（由于DO 的EXIT 的编写方式，它不会这样做)。

“在结束后调用 omp_unset_lock(lck) 并不能解决问题”，这似乎没问题，但第二个竞争条件：线程 1，如果先执行，将 a=a+1 设置为 14（对于严格一致性机器，因为a修改没有omp_set_lock()/omp_set_unlock())

【参考方案1】：

问题在于代码

if (num_thread == 1) then
  a=a+1
end if

没有任何障碍，因此它可能发生在一个线程上，而另一个线程正在循环中休眠。这意味着当循环中的线程被唤醒时，a 大于13，因此循环不能被打破。这反过来意味着陷入循环的线程永远不会到达!$OMP BARRIER，因此程序将永远挂起。

这可以通过在 a=a+1 部分之前放置一个障碍来解决，或者通过将退出循环的条件 (if (a==13) then) 替换为更宽松的 if (a>=13) then。

您可以使用调试器或通过在整个代码中添加 write 语句来识别这些类型的问题，例如作为

if (num_thread==0) then
  call omp_set_lock(lck)
  a=a+5
  a=a+7
  write(*,*) 'a+=12 done'
  call omp_unset_lock(lck)
end if

和

write(*,*) 'Thread ', num_thread, ' of ', nthreads, ' at barrier 1'
!$OMP BARRIER