Code: Select all
''=============================================================================
#include "windows.bi"
''=============================================================================
#define USELOCK
''=============================================================================
'' Operation of CMPXCHG DEST, SRC with 32-bit operands:
'' IF EAX = DEST THEN
'' ZF = 1
'' DEST = SRC
'' ELSE
'' ZF = 0
'' EAX = DEST
'' END IF
'' With a lock prefix the instruction will execute atomically.
''=============================================================================
''-------------------------------------------------------------------
'' These functions return the previous value for debugging purposes.
''-------------------------------------------------------------------
function Lock32 naked( byref semaphore as integer ) as integer
''-----------------------------------------------------------------
'' This code compares the value of semaphore to 0, and if it is 0
'' sets it to 1 and returns the previous value, or otherwise waits
'' indefinitely for the value to become 0.
''
'' Sleep_ is the Windows function, selected here because it will
'' suspend the calling thread during the sleep period.
''-----------------------------------------------------------------
asm
push ebx
mov ebx, [esp+8]
0:
xor eax, eax
mov ecx, 1
lock cmpxchg [ebx], ecx
jz 1f
push 10
call Sleep_
jmp 0b
1:
pop ebx
ret 4
end asm
end function
''=============================================================================
function Unlock32 naked( byref semaphore as integer ) as integer
''-------------------------------------------------
'' This code sets the value of semaphore to 0, if
'' the value is 1, and returns the previous value.
''-------------------------------------------------
asm
mov ecx, [esp+4]
mov eax, 1
xor edx, edx
lock cmpxchg [ecx], edx
ret 4
end asm
end function
''=============================================================================
Const MAX_THREADS = 10
dim shared as integer g_lock
''=============================================================================
Sub teletype( ByRef text As String, ByVal x As Integer, ByVal y As Integer )
#ifdef USELOCK
Lock32( g_lock )
#endif
For i As Integer = 0 To (Len(text) - 1)
Locate x, y + i
Print Chr(text[i])
Sleep 25
Next
#ifdef USELOCK
Unlock32( g_lock )
#endif
End Sub
''=============================================================================
Sub thread( ByVal userdata As Any Ptr )
Dim As Integer id = CInt(userdata)
teletype "Thread (" & id & ").........", 1 + id, 1
End Sub
''=============================================================================
Dim As Any Ptr handles(0 To MAX_THREADS-1)
For i As Integer = 0 To MAX_THREADS-1
handles(i) = ThreadCreate(@thread, CPtr(Any Ptr, i))
If handles(i) = 0 Then
Print "Error creating thread:"; i
Exit For
End If
Next
For i As Integer = 0 To MAX_THREADS-1
If handles(i) <> 0 Then
ThreadWait(handles(i))
End If
Next
sleep