in-process-locks, would someone pls take a look?

[KlausPeterVDL]

Code: Select all

'iLock and iUnLock are single level locks using integers as workbuffers
'they are threadsafe and highly efficient.

' if iLock(fThisLock) then try
' finally
'   iUnlock(fThisLock);
'   end;

' InterlockedDecrement == __sync_sub_and_fetch()
' InterlockedIncrement == __sync_add_and_fetch()
' sleep == sleep?

type bBool as integer

sub iUnlock pascal(ByRef Flag as Integer)
'in-eax- [flag], ecx,edx free
asm	
	'reset the signal	
	push eax
	call InterlockedDecrement
end asm
end sub

function iLock pascal(ByRef Flag as Integer) as bBool
'in-eax- [flag], ecx,edx free
asm
	' <signal> is a signal to this block of code being in use
	cmp eax,0                 'nil pointer?
	jz @nowork                'trapped; returns false
	'
	push ebx                  'save original
	mov ebx, eax              'sleep will reuse eax,ecx,edx
@AquireLock:
	cmp [ebx],0               'ok.. is the Flag=0?
	jz @GotLock               'it is, oh joy
	'give up the time-slice and wait for the number to become 0.
	push $00000000
	call sleep
	jmp @AquireLock
@GotLock:                     'we got the lock
	push ebx                  'pass the var pointer
	call InterlockedIncrement ' increment the value
	'
@InsanityCheck:               'trap is the var is now <> 1 for some reason
	cmp [ebx],1               'ok.. is the Flag set to 1?
	je @done                  'good. that's as it should be.
@InsanityFixup:               'decrement, wait randomly, try again
	push ebx                  'pass the var pointer
	call InterlockedDecrement ' reset the signal to make up for the attempt
	'
	push ebx                  'save the var pointer
	mov eax, esi              'pick up the value of the stack as most random
	and eax,$1F               'limit the range to 5 bits
	push eax                  'push the parameter 0..31 ms delay
	call sleep                'sleep for some random period so we dont deadlock
	pop ebx                   'restore the var pointer
	'
	push ebx                  'and push it again before reentering the loop
	jmp @AquireLock           'start over
@done:                        'really done.
	pop ebx                   'restore the original
	mov eax,1                 'return true
@nowork:
end asm
end function

could someone please help me and tweak this code for FB?

[AGS]

The code looks close enough to fb to (almost) use it as-is. Couple of things are missing.
This should be at the top

Code: Select all

#include "windows.bi"

windows.bi is needed to gain access to the synchronization functions (Interlocked*).

The @ must be removed (all instances). Example (@ removed)

Code: Select all

AquireLock:
    cmp [ebx],0               'ok.. is the Flag=0?
    jz GotLock               'it is, oh joy

pascal as a calling convention could be replaced with stdcall. That's what
windows uses. FreeBASIC uses stdcall by default so you can remove the pascal if you
want (unless you want to mix FreeBASIC with pascal?).

That was the easy part. Now for the less easy part.
iUnlock calls a windows function that decrements it's only argument and returns.
The use of asm... end asm seems unnecessary.

Code: Select all

sub iUnlock pascal(ByRef alock Integer)
'in --> alock 
    InterlockedDecrement(@alock)
end sub

The call to InterlockedDecrement will put @alock on the stack meaning
that alock is used in the same way as eax.
I tried the above and it works (compiles/executes).

The other function (iLock) uses eax in the same manner as iUnlock. I am assuming Flag
is the only variable in use (every occurence of eax can be replaced with an occurence
of Flag). Here is the code in FreeBASIC (includes code for iUnlock)

Code: Select all

#include "windows.bi"

type bBool as integer

sub iUnlock (ByRef Flag as Integer)
'in-eax- [flag], ecx,edx free
    InterlockedDecrement(@Flag)
end sub


function iLock (ByRef Flag as Integer) as bBool

    dim tmp as integer
    
    ' <signal> is a signal to this block of code being in use
    if @Flag = 0 then goto nowork                'nil pointer?

AquireLock:
    if Flag = 0 then goto GotLock              'ok.. is the Flag=0? it is 
    'give up the time-slice and wait for the number to become 0.
    sleep_(0)
    goto AquireLock
GotLock:                        'we got the lock
    InterlockedIncrement(@Flag) ' increment the value
    '
InsanityCheck:               'trap is the var is now <> 1 for some reason
    if Flag = 1 then goto done          'ok.. is the Flag set to 1? good. that's as it should be.
InsanityFixup:                'decrement, wait randomly, try again
    InterlockedDecrement(@Flag) ' reset the signal to make up for the attempt
    '
asm
    mov [tmp],esi              'pick up the value of the stack as most random
end asm        
    tmp and= &h1F            'limit the range to 5 bits
    sleep_(tmp)                'sleep for some random period so we dont deadlock
    goto AquireLock           'start over
done:                        'really done.
    return 1
nowork:
    return 0
end function

The assembler code did some pushing of ebx (ebx used as an argument to the Interlocked* procs).
When not using an asm block there is no reason for code to contain instructions for pushing parameters
onto the stack (the fbc will generate code that will do that for you).

The only assembler left is the use of esi to get a random value. You could use
rnd() but that's going to be slow. So I kept the esi bit in.

The check at the start for @Flag not being NIL seems odd. I could not come
up with a way to pass a variable that has a @ equal to NIL? I must be missing
something here. And then there is the missing return statement at nowork.
If all goes well eax contains a 1 (iLock returns 1).

But what if things go wrong? nowork did not specify a return value.
So if code jumps from the start of iLock to nowork then the function
would without setting a return value. I changed that so the function
now always returns a value.

The code uses sleep_ instead of sleep as I am not sure whether sleep is thread
safe (I think not?).

I tested the code and it worked when used like so

Code: Select all

dim lockvar as integer
iLock(lockvar)
print lockvar
iUnlock(lockvar)
print lockvar

The repeated pushing- and popping of ebx is mostly function call related (ebx
used as argument on stack). But at the end of the code there is a pop(ebx). Which
I didn't get.

I tested the multithread behaviour of the code using the sample from the
fb manual (producer->consumer). I simply replaced MutexLock with iLock and MutexUnlock with
iUnlock. It worked as expected which means that deadlock did not occur (which is good I guess).

You can find the example at
FB_INSTALLATION_PATH/examples/manual/threads/threads3.bas

[MichaelW]

It looks like the procedures were intended to be called with the Borland fastcall convention.

The code does not make sense to me. To pick just one problem, the instruction sequence:

Code: Select all

    cmp [ebx],0               'ok.. is the Flag=0?
    jz @GotLock               'it is, oh joy

Is not atomic, so between the comparison and the conditional jump, another thread could have changed the value of the flag.

See Interlocked Variable Access.

And note that InterlockedIncrement and InterlockedDecrement return the resulting value.

[AGS]

It looks like the procedures were intended to be called with the Borland fastcall convention.

The code does not make sense to me. To pick just one problem, the instruction sequence:

Code: Select all

    cmp [ebx],0               'ok.. is the Flag=0?
    jz @GotLock               'it is, oh joy

Is not atomic, so between the comparison and the conditional jump, another thread could have changed the value of the flag.

See Interlocked Variable Access.

And note that InterlockedIncrement and InterlockedDecrement return the resulting value.

I was wondering about atomicity as well. My first reaction when I saw the code was: compare-and-swap, it must be code that tries to implement compare-and-swap using windows api. The code looks quite a bit like the code described at http://en.wikipedia.org/wiki/Compare-and-swap

I did not get the translation right. In the original code two variables are mentioned: flag and var. My code only
uses flag (var is... gone?). That cannot be right.

In - process locking can be done using other win32 api calls. I looked into the issue of interprocess locking some time ago and found that a critical section is quite fast (it cannot be used if you want to lock a thread that can be accessed from other
processes).

MSDN example

Code: Select all

'' Global variable
dim shared CriticalSection as CRITICAL_SECTION

function mymain()

    '' Initialize the critical section one time only.
    if (InitializeCriticalSectionAndSpinCount(@CriticalSection,&h00000400) = 0) then
        return -1
   end if

    '' Release resources used by the critical section object.
    DeleteCriticalSection(@CriticalSection)
    return 0
end function

function ThreadProc(byval lpParameter as any ptr) as DWORD


    '' Request ownership of the critical section.
    EnterCriticalSection(@CriticalSection) 

    '' Access the shared resource.

    '' Release ownership of the critical section.
    LeaveCriticalSection(@CriticalSection)

    
   return 1
end function

var err_ = mymain
if err_ then ''something went wrong

You could do the same using FreeBASIC commands (CondCreate,CondWait etc...) but CondWait relies on the use of a locked Mutex object. On win32 MutexLock is implemented using WaitForSingleObject. And a call to WaitForSingleObject is very, very expensive (which is why you want to use Enter/LeaveCriticalSection).

MSDN has this to says about critical sections

After a critical section object is initialized, the threads of the process can specify the object in the EnterCriticalSection, TryEnterCriticalSection, or LeaveCriticalSection function to provide mutually exclusive access to a shared resource. For similar synchronization between the threads of different processes, use a mutex object.

[MichaelW]

In - process locking can be done using other win32 api calls.

Or ultimately without any API calls. This code calls the API Sleep function to limit CPU usage, but the locking will work without the call.