fpc/rtl/wasm32/wasmsem.pas

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2025 by Michael Van Canneyt

    This unit contains a webassembly-specific semaphore implementation.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$IFNDEF FPC_DOTTEDUNITS}
unit WasmSem;
{$ENDIF}

{$mode objfpc}{$H+}
{$codepage utf8}

interface

uses
{$IFDEF FPC_DOTTEDUNITS}
  Wasm.Api;
{$ELSE}  
  WebAssembly;
{$ENDIF}

type
  PWasmSemaphore = ^TWasmSemaphore;
  TWasmSemaphore = packed record
    counter: longint;     // Current counter value
    max_count: longint;   // Maximum count allowed
  end;

// Initialize a semaphore with initial count and maximum count
procedure semaphore_init(var sem: TWasmSemaphore; initial_count, max_count: longint);

// Wait (acquire) operation with timeout - decrements counter, blocks if counter would go negative
// timeout_ms: timeout in milliseconds (-1 for infinite timeout)
// Returns true if acquired successfully, false if timeout occurred
function semaphore_wait(var sem: TWasmSemaphore; timeout_ms: int64): boolean;

// Wait (acquire) operation without timeout - blocks indefinitely until semaphore is available
// Returns true when acquired successfully
function semaphore_wait_infinite(var sem: TWasmSemaphore): boolean;

// Signal (release) operation - increments counter up to max and notifies waiters
// Returns true if signaled successfully, false if at max count
function semaphore_signal(var sem: TWasmSemaphore): boolean;

// Get current semaphore count (read-only)
function semaphore_count(var sem: TWasmSemaphore): longint;

// Get maximum semaphore count (read-only)
function semaphore_max_count(var sem: TWasmSemaphore): longint;

implementation

procedure semaphore_init(var sem: TWasmSemaphore; initial_count, max_count: longint);
begin
  AtomicStore(sem.counter, initial_count);
  AtomicStore(sem.max_count, max_count);
end;

function semaphore_wait(var sem: TWasmSemaphore; timeout_ms: int64): boolean;
var
  current_count: longint;
  new_count: longint;
  expected: longint;
  wait_result: longint;
  timeout_ns: int64;
begin
  if timeout_ms = -1 then
    timeout_ns := awtInfiniteTimeout
  else
    timeout_ns := timeout_ms * 1000000;

  repeat
    current_count := AtomicLoad(sem.counter);

    if current_count > 0 then
      begin
      new_count := current_count - 1;
      expected := current_count;

      if AtomicCompareExchange(sem.counter, expected, new_count) = expected then
        exit(true);
      // Failed CAS, retry immediately
      end
    else
      begin
      wait_result := AtomicWait(sem.counter, current_count, timeout_ns);
      if wait_result = awrTimedOut then
        exit(false);
      // Either woke up (awrOk) or not-equal (awrNotEqual), retry the acquisition
      end;
  until false;
  // Should never reach here
  result := false;
end;

function semaphore_wait_infinite(var sem: TWasmSemaphore): boolean;
begin
  result := semaphore_wait(sem, -1);
end;

function semaphore_signal(var sem: TWasmSemaphore): boolean;
var
  current_count: longint;
  max_count: longint;
  new_count: longint;
  expected: longint;
  woken_count: longword;
begin
  max_count := AtomicLoad(sem.max_count);

  repeat
    current_count := AtomicLoad(sem.counter);
    if current_count >= max_count then
      exit(false);

    new_count := current_count + 1;
    expected := current_count;

    // Try atomic compare-and-swap
    if AtomicCompareExchange(sem.counter, expected, new_count) = expected then
      begin
      woken_count := AtomicNotify(sem.counter, 1);
      exit(true);
      end;
    // Failed CAS, retry
  until false;
  // Should never reach here
  result := false;
end;

function semaphore_count(var sem: TWasmSemaphore): longint;
begin
  result := AtomicLoad(sem.counter);
end;

function semaphore_max_count(var sem: TWasmSemaphore): longint;
begin
  result := AtomicLoad(sem.max_count);
end;

end.