Limit number of running threads with NewNamedSemaphore and GetSemaphore example

Tags: #<Tag:0x00007fc0db1a99f8>

To limit the number of running threads in a application, this code can be used.

Please not that some templates and derived WindowManager classes don’t like being terminated by RETURN LEVEL:Notify from the Init() method. That is why this example is contained in a helper source procedure

Semaphore names must be unique, they share a system wide namespace.

#AT Global Embeds \ Inside Global Map

  MODULE('API')
    GetCurrentProcessId(),UNSIGNED,PASCAL
  END

Inside application Main (Frame) procedure:

#AT Local Data \ Generated Declarations

EmplLock             &ISemaphore
LOC:OpenLimit        LONG

#AT Local Objects \ Abc Objects \ Window Manager \ Init () DATA

LockErr             LONG

#AT Local Objects \ Abc Objects \ Window Manager \ Init () CODE, priority 7800

LOC:OpenLimit = 3 ! Or fetch from database
EmplLock &= NewNamedSemaphore('MyApp_' & GetCurrentProcessID() & '_MaximumThreads', LOC:OpenLimit, LOC:OpenLimit, LockErr)
IF EmplLock &= NULL THEN
    MESSAGE('Error NULL object preparing thread limit')
END
IF LockErr > WAIT:OK THEN
  MESSAGE('Error ' & LockErr & ' preparing thread limit')
  EmplLock.Kill()
  EmplLock &= NULL
ELSE
  EmplLock.Release(LOC:OpenLimit) ! Make 3 available
END

#AT Local Objects \ Abc Objects \ Window Manager \ Kill () CODE, priority 5050

IF NOT EmplLock&= NULL THEN
  EmplLock.Kill()
  EmplLock&= NULL
END

Inside helper thread start (Source) procedure:

MyApp_ProcedureLimit PROCEDURE()           ! Declare Procedure
EmplLock            &ISemaphore
LockErr             LONG

  CODE
  GlobalErrors.SetProcedureName('MyApp_ProcedureLimit')
  
  EmplLock &= GetSemaphore('MyApp_' & GetCurrentProcessID() & '_MaximumThreads', LockErr)
  IF EmplLock &= NULL THEN
    MESSAGE('Thread limit has not been initialized')
    DO ProcedureReturn
  END
  IF LockErr > WAIT:OK THEN
    MESSAGE('Error ' & LockErr & ' checking threadlimiet')
    DO ProcedureReturn
  END
  IF EmplLock.TryWait(100) = 1 THEN ! Reserve one
    EmplLock.Kill()
    EmplLock &= NULL
    MESSAGE('Maximum number of threads has been reached.|Close another thread first.')
    DO ProcedureReturn
  END
  
  MyApp_Procedure()

  IF NOT EmplLock &= NULL THEN ! Release one
    EmplLock.Release()
    EmplLock.Kill()
    EmplLock &= NULL
  END
  
  DO ProcedureReturn

ProcedureReturn     ROUTINE
  GlobalErrors.SetProcedureName()
  RETURN
1 Like