Semaphores

In this section I demonstrate an implementation of the traditional counting semaphore for controlling access to a shared resource[1]. This example demonstrates the use of the CML.withNack function.

A counting semaphore has a value that can be interpreted as the number of copies of some resource that are available to be acquired. After the value falls to zero, clients that attempt to acquire a copy of the resource will be blocked until some become free.

A client will block waiting for a semaphore but may want to time-out while waiting. If it times-out then the semaphore must know that the client has given up on the semaphore. It mustn't allocate the resource to a client that has gone away. In a previous section I had a counter that sent a reply in response to a simple query. The reply was sent asynchronously from an auxillary thread. There was no way for the counter to know if the reply was received. If the client did not accept the reply then it was silently dropped. That was fine for the counter but the semaphore needs to know. This is handled with the CML.withNack function.

The CML.withNack function creates a negative acknowledgment (Nack) event that is associated with an event in a call to the select function in the client. The Nack event is enabled when the select does not choose the associated event. The semaphore can detect the Nack event and respond.

To get things started here is the interface for a semaphore.

signature SEMAPHORE =
sig
    type Sema

    val new:        int -> Sema 
    val acquireEvt: Sema -> unit CML.event
    val acquire:    Sema -> unit
    val value:      Sema -> int
    val release:    Sema -> unit

end

The new function creates a semaphore with an initial value which is the number of resource copies available, typically 1. The acquire function will acquire one copy. The acquireEvt version returns an event which is enabled when the resource is granted. The value function returns the current value of the semaphore. The release function returns one copy of the resource to the semaphore.

Here are the data types for the messages and objects.

structure Sema: SEMAPHORE =
struct
    structure SV = SyncVar

    (*  A reply channel and a nack event. *)
    type Client = (unit CML.chan * unit CML.event)

    datatype Request = 
            ReqIsAcq of Client
        |   ReqIsRel
        |   ReqIsGet of int SV.ivar

    and Sema = Sema of Request CML.chan

The semaphore proxy only needs to contain the channel for sending requests to the semaphore. Each client must have its own reply channel since replies are delivered asynchronously and concurrently. I must use a channel, not an I-variable, since the semaphore must get an event when the client accepts the grant. The Client type is used within the semaphore to represent a client with an outstanding Acquire request. It holds a copy of the reply channel and an event that will be enabled if the client abandons the request.

Here is the implementation of acquireEvt. I'll call the event it returns the "acquire" event.

fun acquireEvt (Sema req_chan) =
let
    fun sender nack_evt =
    let
        val rpl_chan = CML.channel()
    in
        CML.spawn(fn () =>
            CML.send(req_chan, ReqIsAcq (rpl_chan, nack_evt)));
        CML.recvEvt rpl_chan
    end
in
    CML.withNack sender
end

fun acquire l = CML.sync(acquireEvt l)

The sender function is a guard function that will be called when the client synchronises on the acquire event. Since the grant reply is just the unit value, matching acquireEvt, there is no need to wrap the receive event here. Here is an example of how to use acquireEvt.

CML.select[
    CML.wrap(Sema.acquireEvt sema, hold),
    time_out t
    ]

When the select starts, the sender function in acquireEvt will be called. It will be passed a newly generated event value for the Nack. (Something similar will happen within the time-out code.) The sender function spawns a thread which sends off the Acquire request along with the Nack event to the semaphore. Then it produces an event with recvEvt that is enabled when the grant is returned. Here is the implementation of the acquire message in the semaphore.

fun sema() =
let
    fun loop (value, pending: Client list) =
    (
        case CML.recv req_chan of
          ReqIsAcq client =>
            let         (* FIFO order *)
                val new_pending = pending @ [client]
            in
                if value <= 0
                then
                    loop (value, new_pending)
                else
                    loop (grant value new_pending)
            end

The semaphore's state consists of the current value and a list of clients that are waiting to acquire the semaphore. When a new Acquire request comes in I immediately append it to the list of pending clients. Even though appending to a list is expensive I decided to do it so that requests are granted in the order in which they arrive. This is an intuitively reasonable fairness condition. (If the pending queue is likely to be long then a more efficient implementation can be found in the Queue module of the section called Queues and Fifos in Chapter 5). I unconditionally add the new client to the pending list even if the semaphore is available because it makes the code neater. The list should usually be empty and appending a value to an empty list is not expensive.

Next, if the value is positive then I can grant a resource copy to a client. The grant function attempts the grant and returns an updated state for the semaphore.

(*  Look for a pending client that will accept the grant.
    Return the decremented value and the remaining pending 
    clients if a client accepts the grant.
*)
and grant value [] = (value, [])        (* no pending clients *)

|   grant value ((rpl_chan, nack_evt) :: rest) =
let
    fun accepted() = (value-1, rest)
    fun nacked()   = (print "Got a nack\n"; grant value rest)
in
    CML.select [
        CML.wrap(CML.sendEvt(rpl_chan, ()), accepted),
        CML.wrap(nack_evt, nacked)
        ]
end

In the grant function I look at the first pending client. I attempt to send a grant reply to the client which would satisy the client's select call in acquireEvt if it hasn't timed-out yet. This attempt cannot block since the client must have started to wait on the grant to cause the Acquire request to be sent. So the client must either be still waiting or the Nack event will be enabled.

If the grant is accepted by the client then the accepted function will be run which will return the updated state for the semaphore, namely a decremented value and the rest of the pending clients.

If there is a time-out in a client then the select call in its acquireEvt will choose the time-out event. This will enable the Nack events associated with the other events that it didn't choose, namely the receive event for the grant. The Nack will propagate back to the select call in the grant function which will choose the Nack event and run the nacked wrapper function. This loops to try granting to one of the rest of the pending clients. I've also got a debug message in there to show what happens.

The other requests to the semaphore are simpler.

        | ReqIsRel => loop (grant (value+1) pending)

        | ReqIsGet rpl_var =>
        (
            SV.iPut(rpl_var, value);
            loop (value, pending)
        )

A Release request first increments the value. Then I call grant to see if the newly released copy can be granted to some pending client. The Get request just sends a copy of the value with no change of state. An I-variable is neatest for this. Here is the implementation of the client side of these requests.

fun release (Sema req_chan) = CML.send(req_chan, ReqIsRel)


fun value (Sema req_chan) =
let
    val rpl_var = SV.iVar()
in
    CML.send(req_chan, ReqIsGet rpl_var);
    SV.iGet rpl_var
end

Because of the complexity of the semaphore I've included more testing code in the demonstration program. The first test just demonstrates the value changing from the acquire and release. The initial value is 1 so that it is a binary semaphore or mutex. The check function prints the semaphore's value.

fun test1() =
let
    val sema = Sema.new 1
in
    print "Test 1\n";
    check sema "1";
    Sema.acquire sema;
    check sema "1";
    Sema.release sema;
    check sema "1";
    ()
end

and check sema n =
(
    print(concat[
        "Client ", n, ": the sema value is ",
        Int.toString(Sema.value sema),
        "\n"])
)

The second test demonstrates contention between two clients.

fun test2() =
let
    val sema = Sema.new 1
in
    print "Test 2\n";
    Sema.acquire sema;
    check sema "1";
    grab sema "2" 2;
    delay 1;
    Sema.release sema;
    check sema "1";
    delay 4;
    check sema "1";
    ()
end

and grab sema n t =
let
    fun hold() =
    (
        check sema n;
        delay 3;
        Sema.release sema;
        check sema n
    )

    fun timedout() = print(concat["Client ", n, " timed out\n"])
in
    CML.spawn(fn () =>
        CML.select[
            CML.wrap(Sema.acquireEvt sema, hold),
            CML.wrap(time_out t, timedout)
            ]
        )
end

and time_out t = CML.timeOutEvt(Time.fromSeconds t)
and delay t    = CML.sync(time_out t)

The thread running the test2 function is client number 1. It acquires the semaphore and calls the grab function which spawns a thread for client number 2 to also try to acquire the semaphore but with a time-out. In this test there will be no time-out. Instead when client 1 releases the semaphore it will be granted to client 2 which will run the hold function. It will hold the semaphore for 3 seconds and release it again. Figure 6-7 shows the timing of this interaction. The heavy lines show the times during which each client holds the semaphore. (Client 2 is spawned from client 1 and terminates at t=4).

Figure 6-7. The Timing of Semaphore Test 2

Test 3 is similar to test 2 but it delays long enough for client 2 to time-out.

fun test3() =
let
    val sema = Sema.new 1
in
    print "Test 3\n";
    Sema.acquire sema;
    check sema "1";
    grab sema "2" 2;
    delay 3;                (* client 2 times out *)
    Sema.release sema;      (* sema attempts to grant *)
    check sema "1"
end

This test produces the following debugging messages which show the time-out. You can also see that the Nack is not delivered to the semaphore until client 1 releases and the semaphore tries to grant to client 2.

Test 3
Client 1: the sema value is 0
Client 2 timed out
Got a nack
Client 1: the sema value is 1

Notes

[1]

It is based on the lock server example in section 4.2.6 of [Reppy].