[fpc-devel] Why FreeBSD sem_init() works different to Linux?

[Ewald]

Hello,

You can use some structure to lock an integer. `Some structure` can for
example be a mutex, a critical section, some busy waiting loop based on
CMPXCH, etc... Say that you lock the integer by calling `Lock;` and you
unlock it by calling `UnLock;`. Then you can define a class TSemaphore
like this:

===> Code Begin <===

Type
    TSemaphore = Class
    Private
        DaValue: Integer;
        Lock: TLockType;

    Public
        Constructor Create;        // sem_init

        Function GetValue: Integer;    // sem_getvalue
        Procedure Post;       // sem_post

        Function TryWait: Boolean; //sem_trywait
    End;


Constructor TSemaphore.Create;
Begin
    inherited Create;

    DaValue:= 0;

    //Initialize lock here to unlocked state.
End;

Function TSemaphore.GetValue;
Begin
    Lock;

    Result:= DaValue;

    UnLock;
End;

Procedure TSemaphore.Post;
Begin
    Lock;
   
    DaValue+= 1;

    UnLock;
End;

// True if the semaphore is hereby decremented; false otherwise
Function TSemaphore.TryWait: Boolean;
Begin
    Lock;

    If DaValue > 0 Then
    Begin
        DaValue-= 1;
        Result:= True;
    End Else
        Result:= False;

    UnLock;
End;

//True if this function returned immediately, false otherwise.
Function TSemaphore.Wait: Boolean;
Begin
    Result:= True;
    While True Do
    Begin
        Lock;

        If DaValue > 0 Then
        Begin
            DaValue-= 1;
            Break;
        End;

        Result:= False;
        UnLock;
    End;
End;

===> Code End <===

The only function missing is sem_timedwait, but this could easily be
implemented by combining `nanosleep`, `trywait` and `timeofday`.

NOTE: The above code is not tested, it more of a thing which I just
wrote, so you will probably find some syntax errors and possible race
conditions; altough I doubt the latter.

Concerning the locking mechanism, you can uses mutex(en/es/ii) or you
can do this by a busy waiting loop with an integer (of course there are
other possibilities). To elaborate on the latter a bit more:

*  TLockType = Integer;
*  Initialization: `Lock:= 0;`
*  Lock & unlock:

===> Code Begin <===

Procedure WaitLockVar(var aLock: Integer);
Begin
    Repeat
    Until InterLockedCompareExchange(aLock, 1, 0) = 0;
End;

Procedure UnlockVar(var aLock: Integer);
Begin
    InterlockedExchange(aLock, 0);
End;

===> Code End <===

This last code is tested and works.

Hope it is of any use.

Once upon a time, on 02/06/2013 08:24 PM to be precise, Graeme
Geldenhuys said:
>
> It case I'm overlooking something critical, has anybody else done
> something like this. If so, anybody willing to share that code - saving
> me some time in developing, unit testing and debugging my own Object
> Pascal based semaphore.
>

-- 
Ewald