MUTEXLOCK

• 来源: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgMutexLock
• 最后更新: 2022-03-27

---

获取互斥锁

语法

declare sub Mutexlock ( byval id as any ptr )

用法

Mutexlock( id )

参数

id

要加锁的互斥锁的 any ptr 句柄。

说明

Mutexlock 使用由 Mutexcreate 生成的互斥锁"句柄"，阻塞所有其他使用该句柄的线程，直到该句柄被 Mutexunlock 解锁。

被阻塞的线程将被挂起执行，在互斥锁被解锁之前不会消耗任何 CPU 时间。

有关互斥锁的更多常规信息，请参见 Mutexcreate。

示例

另请参见 Mutexcreate 和 Threadcreate 中的示例。

'仅使用 2 个互斥锁实现两个线程间同步互斥的示例
'（通过自锁和互解锁）：
'生产者工作一次，然后消费者工作一次。
'
'通过互斥实现同步的原理
'（初始条件：mut#A 和 mut#B 均已加锁）
'
'          线程#A              XORs              线程#B
'带互斥的操作#A                          MutexLock(mut#A)
'MutexUnlock(mut#A)                       带互斥的操作#B
'.....                                  MutexUnlock(mut#B)
'MutexLock(mut#B)                       .....

'----------------------------------------------------------------------

Dim Shared produced As Any Ptr
Dim Shared consumed As Any Ptr
Dim consumer_id As Any Ptr
Dim producer_id As Any Ptr

Sub consumer ( ByVal param As Any Ptr )
    For i As Integer = 0 To 9
        MutexLock produced
        Print , ",consumer gets:" ; i
        MutexUnlock consumed
        Sleep 5, 1
    Next i
End Sub

Sub producer ( ByVal param As Any Ptr )
    For i As Integer = 0 To 9
        Print "Producer puts:" ; i;
        MutexUnlock produced
        MutexLock consumed
    Sleep 5, 1
Next i
End Sub

produced = MutexCreate
consumed = MutexCreate
If ( produced = 0 ) Or ( consumed = 0 ) Then
    Print "Error creating mutexes! Exiting..."
    Sleep
    End
End If

MutexLock produced
MutexLock consumed

consumer_id = ThreadCreate ( @ consumer )
producer_id = ThreadCreate ( @ producer )
If ( producer_id = 0 ) Or ( consumer_id = 0 ) Then
    Print "Error creating threads! Exiting..."
    Sleep
    End
End If

ThreadWait consumer_id
ThreadWait producer_id

MutexDestroy consumed
MutexDestroy produced

Sleep

' 'Threadcreate' 在独立的执行线程中启动用户定义的子程序一次
'    （该线程与主代码的其余部分同时运行）。
' 如果想从线程中周期性地输出显示，
'    必须在线程中放置一个带有 'Sleep x, 1' 的 [Do...Loop] 块来调整显示周期，
'    以及一个退出循环（并终止线程）的标志。
'
' 注意：
' - 每个线程没有自己的光标位置记忆，因此出于这个原因和其他原因，
'      必须对主代码（主线程）和用户线程的显示应用互斥，
'      使用 'Mutex'（[Mutexlock...Mutexunlock] 块）。
'   在主线程和用户线程的每个显示块的开始，
'      还必须重新初始化初始光标位置。
' - 输入关键字（如键盘、鼠标）在屏幕加锁时不能安全运行，
'      因此此类关键字必须在任何 [Screenlock...Screenunlock] 块之外
'      （在其自身线程的该块之外，
'      并由 'Mutex' 保护以防另一个线程的块）。
'
' 以下是一个简单的程序，展示了所有这些约束：

Dim Shared As Any Ptr sync   '' 指向互斥锁的指针
Dim Shared As Byte quit = 0  '' 结束用户线程的标志
Dim As Any Ptr handle        '' 指向线程句柄的指针

Sub ProcedureThread (ByVal param As Any Ptr)  '' param 在线程体中未使用
    Do
        MutexLock(sync)       '' 用于显示互斥的互斥锁
            ScreenLock        '' 在 Mutexlock 之后的关键字
                Locate 1, 70  '' 重新初始化光标位置
                Print Date
                Locate , 71
                Print Time;
            ScreenUnlock      '' 在 Mutexunlock 之前的关键字
        MutexUnlock(sync)     '' 结束互斥
        Sleep 100, 1          '' 调整显示周期
    Loop Until quit <> 0      '' 测试退出线程
End Sub

Screen 12
Locate 1, 62
Print "Date:"
Locate , 62
Print "Time:";
Locate 15, 20
Print "Mouse (position):"
Locate , 20
Print "Mouse (buttons) :";
Locate 30, 2
Print "`<any_key>` or `<click on window close button>`: exit";

sync = MutexCreate                          '' 创建互斥锁（在 Threadcreate 之前）
handle = ThreadCreate(@ProcedureThread, 0)  '' 启动线程

Dim As String s
Do
    MutexLock(sync)                     '' 用于显示互斥的互斥锁
        Dim As Long x, y, b
        GetMouse x, y , , b             '' 在 [Screenlock...Screenunlock] 之外且由互斥锁保护的关键字
        ScreenLock                      '' 在 Mutexlock 之后的关键字
            Locate 15, 37               '' 重新初始化光标位置
            Print Using "######"; x; y
            Locate , 43
            Print Using "##"; b;
        ScreenUnlock                    '' 在 Mutexunlock 之前的关键字
        s = Inkey                       '' 在 [Screenlock...Screenunlock] 之外且由互斥锁保护的关键字
    MutexUnlock(sync)                   '' 结束互斥
    Sleep 10, 1                         '' 调整显示周期
Loop Until s <> ""
 
quit = Not quit     '' 命令线程结束
ThreadWait(handle)  '' 等待线程结束
MutexDestroy(sync)  '' 释放互斥锁

方言差异

• 在 -lang qb 方言中不允许使用线程。

平台差异

• FreeBASIC 的 DOS 版本不支持线程，因为操作系统不支持。
• 在 Linux 中，线程始终按创建顺序启动，这在 Win32 中无法保证。这是操作系统的问题，而非 FreeBASIC 的问题。

与 QB 的区别

• FreeBASIC 新增功能

另请参见

• Mutexcreate
• Mutexdestroy
• Mutexunlock
• Threadcreate
• Threadwait

返回 目录