WorkerPool - OOP

[StarBootics]

Hello everyone,

The source code about the WorkerPool is vaguely based on Env's Load-Balanced Worker Threads.

For safety reasons the KillThread() is not used to stop the already running task handlers. You have to wait for their completion. See the provided example to learn how to program your handler procedure.

Please note that this code is still experimental, the thread stuff is pretty new and scary to me.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project Name : WorkerPool
; FileName : WorkerPool - OOP.pb
; File Version : 1.0.0
; Programmation : OK
; Programmed by : Guillaume Saumure
; AKA : StarBootics
; Date : March 11th, 2022
; Updated : March 14th, 2022
; Coded for PureBasic : V6.00 Beta 5
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming Notes
;
; Vaguely based on Env's Load-Balanced Worker Threads original
; source code.
;
; https://www.purebasic.fr/english/viewtopic.php?p=532688
;
; For safety reasons the KillThread() is not used to stop the
; already running task handlers. You have to wait for their 
; completion. See the provided example to learn how to program
; your handler procedure.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; The MIT License (MIT)
; 
; Copyright (c) 2022 Guillaume Saumure
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy of this software and 
; associated documentation files (the "Software"), to deal in the Software without restriction, including 
; without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
; copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the 
; following conditions:
; 
; The above copyright notice and this permission notice shall be included in all copies or substantial 
; portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT 
; LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO 
; EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 
; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR 
; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule TaskInfo

  Interface TaskInfo
    
    GetKeepGoing.i()
    GetCompleted.i()
    GetWorkerID.i()
    GetTaskID.i()
    GetType.i()
    GetObjectAddress.i()
    GetHandler.i()
    SetKeepGoing(KeepGoing.i)
    SetCompleted(Completed.i)
    SetWorkerID(WorkerID.i)
    SetTaskID(TaskID.i)
    SetType(Type.i)
    SetObjectAddress(*ObjectAddress)
    SetHandler(*Handler)
    Free()
    
  EndInterface
  
  Declare.i New(TaskID.i, Type.i, *ObjectAddress, *Handler)
  
EndDeclareModule

Module TaskInfo
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Déclaration de la Structure <<<<<
  
  Structure Private_Members
    
    VirtualTable.i
    KeepGoing.i
    Completed.i
    WorkerID.i
    TaskID.i
    Type.i
    *ObjectAddress
    *Handler
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Les observateurs <<<<<
  
  Procedure.i GetKeepGoing(*This.Private_Members)
    
    ProcedureReturn *This\KeepGoing
  EndProcedure
  
  Procedure.i GetCompleted(*This.Private_Members)
    
    ProcedureReturn *This\Completed
  EndProcedure
    
  Procedure.i GetWorkerID(*This.Private_Members)
    
    ProcedureReturn *This\WorkerID
  EndProcedure
  
  Procedure.i GetTaskID(*This.Private_Members)
    
    ProcedureReturn *This\TaskID
  EndProcedure
  
  Procedure.i GetType(*This.Private_Members)
    
    ProcedureReturn *This\Type
  EndProcedure
  
  Procedure.i GetObjectAddress(*This.Private_Members)
    
    ProcedureReturn *This\ObjectAddress
  EndProcedure

  Procedure.i GetHandler(*This.Private_Members)
    
    ProcedureReturn *This\Handler
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Les mutateurs <<<<<
  
  Procedure SetKeepGoing(*This.Private_Members, KeepGoing.i)
    
    *This\KeepGoing = KeepGoing
    
  EndProcedure
  
  Procedure SetCompleted(*This.Private_Members, Completed.i)
    
    *This\Completed = Completed
    
  EndProcedure
  
  Procedure SetWorkerID(*This.Private_Members, WorkerID.i)
    
    *This\WorkerID = WorkerID
    
  EndProcedure
  
  Procedure SetTaskID(*This.Private_Members, TaskID.i)
    
    *This\TaskID = TaskID
    
  EndProcedure
  
  Procedure SetType(*This.Private_Members, Type.i)
    
    *This\Type = Type
    
  EndProcedure
  
  Procedure SetObjectAddress(*This.Private_Members, *ObjectAddress)
    
    *This\ObjectAddress = *ObjectAddress
    
  EndProcedure
  
  Procedure SetHandler(*This.Private_Members, *Handler)
    
    *This\Handler = *Handler
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Le Destructeur <<<<<
  
  Procedure Free(*This.Private_Members)
    
    FreeStructure(*This)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Le Constructeur <<<<<
  
  Procedure.i New(TaskID.i, Type.i, *ObjectAddress, *Handler)
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    *This\KeepGoing = #True
    *This\Completed = #False
    *This\TaskID = TaskID
    *This\Type = Type
    *This\ObjectAddress = *ObjectAddress
    *This\Handler = *Handler
    
    ProcedureReturn *This
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Les entrées de la table virtuelle <<<<<
  
  DataSection
    START_METHODS:
    Data.i @GetKeepGoing()
    Data.i @GetCompleted()
    Data.i @GetWorkerID()
    Data.i @GetTaskID()
    Data.i @GetType()
    Data.i @GetObjectAddress()
    Data.i @GetHandler()
    Data.i @SetKeepGoing()
    Data.i @SetCompleted()
    Data.i @SetWorkerID()
    Data.i @SetTaskID()
    Data.i @SetType()
    Data.i @SetObjectAddress()
    Data.i @SetHandler()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
EndModule

DeclareModule WorkerPool
  
  Enumeration WorkerPoolEvent
    
    #Event_None
    #Event_Task_Started
    #Event_Task_Ended
    #Event_Task_Aborted
    
  EndEnumeration
  
  Interface WorkerPool
    
    GetMaxWorkers.i()
    GetTrackEvents.i()
    GetKeepGoing.i()
    SetMaxWorkers(MaxWorkers.i)
    SetTrackEvents(TrackEvents.i)
    SetKeepGoing(KeepGoing.i)
    AddTask(*TaskInfo.TaskInfo::TaskInfo)
    Update()
    TasksRemaining.i()
    CurrentEvent.i()
    CurrentTaskID.i()
    CurrentTaskCompleted.i()
    Free()
    
  EndInterface
  
  Declare.i New(MaxWorkers.i = 1, TrackEvents.i = #True)
  
EndDeclareModule

Module WorkerPool
  
  #MaximumEvents = 10000
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Structures Declaration <<<<<
  
  Structure Task
    
    TaskInfoPtr.TaskInfo::TaskInfo
    Pending.i
    *Thread
    
  EndStructure
  
  Structure Worker
    
    WorkerIndex.i
    List Tasks.Task()
    
  EndStructure
  
  Structure WorkerEvent
    
    EventType.i
    TaskID.i
    Completed.i
    
  EndStructure
  
  Structure Private_Members
    
    VirtualTable.i
    Mutex.i
    MaxWorkers.i
    TrackEvents.i
    KeepGoing.i
    CurrentEvent.WorkerEvent
    List EventQueue.WorkerEvent()
    List Worker.Worker()
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Private method <<<<<
  
  Procedure Private_AddEvent(*This.Private_Members, EventType.i, EventTaskID.i, EventTaskCompleted.i)
    
    If *This\TrackEvents = #True
      If ListSize(*This\EventQueue()) < #MaximumEvents
        LastElement(*This\EventQueue())
        AddElement(*This\EventQueue())
        *This\EventQueue()\EventType = EventType
        *This\EventQueue()\TaskID = EventTaskID
        *This\EventQueue()\Completed = EventTaskCompleted
      EndIf
    EndIf
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Getters <<<<<
  
  Procedure.i GetMaxWorkers(*This.Private_Members)
    
    ProcedureReturn *This\MaxWorkers
  EndProcedure
  
  Procedure.i GetTrackEvents(*This.Private_Members)
    
    ProcedureReturn *This\TrackEvents
  EndProcedure
  
  Procedure.i GetKeepGoing(*This.Private_Members)
    
    ProcedureReturn *This\KeepGoing
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Setters <<<<<
  
  Procedure SetMaxWorkers(*This.Private_Members, MaxWorkers.i)
    
    *This\MaxWorkers = MaxWorkers
    
  EndProcedure
  
  Procedure SetTrackEvents(*This.Private_Members, TrackEvents.i)
    
    *This\TrackEvents = TrackEvents
    
  EndProcedure
  
  Procedure SetKeepGoing(*This.Private_Members, KeepGoing.i)
    
    *This\KeepGoing = KeepGoing
    
    If *This\KeepGoing = #False
      
      LockMutex(*This\Mutex)
      
      ForEach *This\Worker()
        
        ForEach *This\Worker()\Tasks()
          
          If IsThread(*This\Worker()\Tasks()\Thread) <> 0 
            *This\Worker()\Tasks()\TaskInfoPtr\SetKeepGoing(#False)
          EndIf
          
        Next
        
      Next
      
      UnlockMutex(*This\Mutex)
      
    EndIf
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The AddTask operator <<<<<
  
  Procedure AddTask(*This.Private_Members, *TaskInfo.TaskInfo::TaskInfo)
    
    LockMutex(*This\Mutex)
    
    If ListSize(*This\Worker()) < *This\MaxWorkers
      
      AddElement(*This\Worker())
      
      *This\Worker()\WorkerIndex = ListIndex(*This\Worker())
      LastElement(*This\Worker()\Tasks())
      AddElement(*This\Worker()\Tasks())
      
      *This\Worker()\Tasks()\TaskInfoPtr = *TaskInfo
      *This\Worker()\Tasks()\TaskInfoPtr\SetWorkerID(*This\Worker()\WorkerIndex)
      *This\Worker()\Tasks()\Pending = #True
      
    Else
      
      Define WorkerID.i, MinTaskCount.i = 10000000, LessBusyWorkerID.i, Workers.i
      
      If *This\MaxWorkers < ListSize(*This\Worker())
        Workers = *This\MaxWorkers
      Else
        Workers = ListSize(*This\Worker())
      EndIf   
      
      For WorkerID = 0 To Workers - 1
        
        SelectElement(*This\Worker(), WorkerID)
        
        If ListSize(*This\Worker()\Tasks()) < MinTaskCount
          MinTaskCount = ListSize(*This\Worker()\Tasks())
          LessBusyWorkerID = WorkerID
        EndIf
        
      Next
      
      SelectElement(*This\Worker(), LessBusyWorkerID)
      LastElement(*This\Worker()\Tasks())
      AddElement(*This\Worker()\Tasks())
      
      *This\Worker()\Tasks()\TaskInfoPtr = *TaskInfo
      *This\Worker()\Tasks()\TaskInfoPtr\SetWorkerID(LessBusyWorkerID)
      *This\Worker()\Tasks()\Pending = #True
      
    EndIf
    
    UnlockMutex(*This\Mutex)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Update operator <<<<<
  
  Procedure Update(*This.Private_Members)
    
    LockMutex(*This\Mutex)
    
    If *This\KeepGoing = #True
      
      ForEach *This\Worker()
        
        If ListSize(*This\Worker()\Tasks()) > 0
          
          FirstElement(*This\Worker()\Tasks())
          
          If *This\Worker()\Tasks()\Pending = #True 
            *This\Worker()\Tasks()\Pending = #False
            Private_AddEvent(*This, #Event_Task_Started, *This\Worker()\Tasks()\TaskInfoPtr\GetTaskID(), #False)
            *This\Worker()\Tasks()\Thread = CreateThread(*This\Worker()\Tasks()\TaskInfoPtr\GetHandler(), *This\Worker()\Tasks()\TaskInfoPtr)
          Else
            
            If IsThread(*This\Worker()\Tasks()\Thread) = 0
              Private_AddEvent(*This, #Event_Task_Ended, *This\Worker()\Tasks()\TaskInfoPtr\GetTaskID(), *This\Worker()\Tasks()\TaskInfoPtr\GetCompleted())
              DeleteElement(*This\Worker()\Tasks())
            EndIf
            
          EndIf
          
        EndIf
        
      Next
      
    Else
      
      ForEach *This\Worker()
        
        ForEach *This\Worker()\Tasks()
          
          If *This\Worker()\Tasks()\Pending = #True
            Private_AddEvent(*This, #Event_Task_Aborted, *This\Worker()\Tasks()\TaskInfoPtr\GetTaskID(), #False)
            DeleteElement(*This\Worker()\Tasks())
          Else
            
            If IsThread(*This\Worker()\Tasks()\Thread) = 0
              Private_AddEvent(*This, #Event_Task_Ended, *This\Worker()\Tasks()\TaskInfoPtr\GetTaskID(), *This\Worker()\Tasks()\TaskInfoPtr\GetCompleted())
              DeleteElement(*This\Worker()\Tasks())
            EndIf
            
          EndIf 
          
        Next
        
      Next
      
    EndIf
    
    UnlockMutex(*This\Mutex)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The TasksRemaining operator <<<<<
  
  Procedure.i TasksRemaining(*This.Private_Members)
    
    Protected.i count
    
    LockMutex(*This\Mutex)
    
    ForEach *This\Worker()
      count + ListSize(*This\Worker()\Tasks())
    Next
    
    UnlockMutex(*This\Mutex)
    
    ProcedureReturn count
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The CurrentEvent operator <<<<<
  
  Procedure.i CurrentEvent(*This.Private_Members)
    
    LockMutex(*This\Mutex)
    
    If ListSize(*This\EventQueue()) > 0
      FirstElement(*This\EventQueue())
      *This\CurrentEvent\EventType = *This\EventQueue()\EventType
      *This\CurrentEvent\TaskID = *This\EventQueue()\TaskID
      *This\CurrentEvent\Completed = *This\EventQueue()\Completed
      DeleteElement(*This\EventQueue())
    Else
      *This\CurrentEvent\EventType = #Event_None
      *This\CurrentEvent\TaskID = -1
      *This\CurrentEvent\Completed = #False
    EndIf
    
    UnlockMutex(*This\Mutex)
    
    ProcedureReturn *This\CurrentEvent\EventType
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The CurrentTaskID operator <<<<<
  
  Procedure.i CurrentTaskID(*This.Private_Members)
    
    ProcedureReturn *This\CurrentEvent\TaskID
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The CurrentTaskCompleted operator <<<<<
  
  Procedure.i CurrentTaskCompleted(*This.Private_Members)
    
    ProcedureReturn *This\CurrentEvent\Completed
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Destructor <<<<<
  
  Procedure Free(*This.Private_Members)
    
    FreeMutex(*This\Mutex)
    FreeStructure(*This)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Constructor <<<<<
  
  Procedure.i New(MaxWorkers.i = 1, TrackEvents.i = #True)
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    *This\Mutex = CreateMutex()
    *This\MaxWorkers = MaxWorkers
    *This\TrackEvents = TrackEvents
    *This\KeepGoing = #True
    
    ProcedureReturn *This
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Virtual table entries <<<<<
  
  DataSection
    START_METHODS:
    Data.i @GetMaxWorkers()
    Data.i @GetTrackEvents()
    Data.i @GetKeepGoing()
    Data.i @SetMaxWorkers()
    Data.i @SetTrackEvents()
    Data.i @SetKeepGoing()
    Data.i @AddTask()
    Data.i @Update()
    Data.i @TasksRemaining()
    Data.i @CurrentEvent()
    Data.i @CurrentTaskID()
    Data.i @CurrentTaskCompleted()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  CompilerIf #PB_Compiler_Thread = #False
    CompilerError "Please compile with ThreadSafe enabled."
  CompilerEndIf
  
  DeclareModule Sphere
    
    Interface Sphere
      
      GetVolume.d()
      GetRadius.d()
      SetVolume(Volume.d)
      SetRadius(Radius.d)
      ComputeVolume()
      Free()
      
    EndInterface
    
    Declare Free(*This)
    Declare.i New(Radius.d = 0.0)
    
  EndDeclareModule
  
  Module Sphere
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Déclaration de la Structure <<<<<
    
    Structure Private_Members
      
      VirtualTable.i
      Volume.d
      Radius.d
      
    EndStructure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les observateurs <<<<<
    
    Procedure.d GetVolume(*This.Private_Members)
      
      ProcedureReturn *This\Volume
    EndProcedure
    
    Procedure.d GetRadius(*This.Private_Members)
      
      ProcedureReturn *This\Radius
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les mutateurs <<<<<
    
    Procedure SetVolume(*This.Private_Members, Volume.d)
      
      *This\Volume = Volume
      
    EndProcedure
    
    Procedure SetRadius(*This.Private_Members, Radius.d)
      
      *This\Radius = Radius
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Nom de la procédure <<<<<
    
    Procedure ComputeVolume(*This.Private_Members)
      
      *This\Volume = *This\Radius * *This\Radius * *This\Radius * (4.0/3.0) * #PI
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Destructeur <<<<<
    
    Procedure Free(*This.Private_Members)
      
      FreeStructure(*This)
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Constructeur <<<<<
    
    Procedure.i New(Radius.d = 0.0)
      
      *This.Private_Members = AllocateStructure(Private_Members)
      *This\VirtualTable = ?START_METHODS
      
      *This\Radius = Radius
      
      ProcedureReturn *This
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les entrées de la table virtuelle <<<<<
    
    DataSection
      START_METHODS:
      Data.i @GetVolume()
      Data.i @GetRadius()
      Data.i @SetVolume()
      Data.i @SetRadius()
      Data.i @ComputeVolume()
      Data.i @Free()
      END_METHODS:
    EndDataSection
    
  EndModule
  
  DeclareModule Cube
    
    Interface Cube
      
      GetVolume.d()
      GetSize.d()
      SetVolume(Volume.d)
      SetSize(Size.d)
      ComputeVolume()
      Free()
      
    EndInterface
    
    Declare Free(*This)
    Declare.i New(Size.d = 0.0)
    
  EndDeclareModule
  
  Module Cube
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Déclaration de la Structure <<<<<
    
    Structure Private_Members
      
      VirtualTable.i
      Volume.d
      Size.d
      
    EndStructure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les observateurs <<<<<
    
    Procedure.d GetVolume(*This.Private_Members)
      
      ProcedureReturn *This\Volume
    EndProcedure
    
    Procedure.d GetSize(*This.Private_Members)
      
      ProcedureReturn *This\Size
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les mutateurs <<<<<
    
    Procedure SetVolume(*This.Private_Members, Volume.d)
      
      *This\Volume = Volume
      
    EndProcedure
    
    Procedure SetSize(*This.Private_Members, Size.d)
      
      *This\Size = Size
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Nom de la procédure <<<<<
    
    Procedure ComputeVolume(*This.Private_Members)
      
      *This\Volume = *This\Size * *This\Size * *This\Size
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Destructeur <<<<<
    
    Procedure Free(*This.Private_Members)
      
      FreeStructure(*This)
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Constructeur <<<<<
    
    Procedure.i New(Size.d = 0.0)
      
      *This.Private_Members = AllocateStructure(Private_Members)
      *This\VirtualTable = ?START_METHODS
      
      *This\Size = Size
      
      ProcedureReturn *This
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les entrées de la table virtuelle <<<<<
    
    DataSection
      START_METHODS:
      Data.i @GetVolume()
      Data.i @GetSize()
      Data.i @SetVolume()
      Data.i @SetSize()
      Data.i @ComputeVolume()
      Data.i @Free()
      END_METHODS:
    EndDataSection
    
  EndModule
  
  DeclareModule Hook
    
    Interface Hook
      
      GetTag.l()
      GetPointer.i()
      SetTag(P_Tag.l)
      SetPointer(P_Pointer.i, P_DestructorAddress.i = #Null)
      Free()
      
    EndInterface
    
    Declare.i New(P_Tag.l = 0, P_Pointer.i = 0, P_DestructorAddress.i = #Null)
    
  EndDeclareModule
  
  Module Hook
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Déclaration de la Structure <<<<<
    
    Structure Private_Members
      
      VirtualTable.i
      Tag.l
      Pointer.i
      DestructorAddress.i
      
    EndStructure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< The Object Destructor prototype <<<<<
    
    Prototype DestructorFunction(*ObjectPtr)
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les observateurs <<<<<
    
    Procedure.l GetTag(*This.Private_Members)
      
      ProcedureReturn *This\Tag
    EndProcedure
    
    Procedure.i GetPointer(*This.Private_Members)
      
      ProcedureReturn *This\Pointer
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les mutateurs <<<<<
    
    Procedure SetTag(*This.Private_Members, P_Tag.l)
      
      *This\Tag = P_Tag
      
    EndProcedure
    
    Procedure SetPointer(*This.Private_Members, P_Pointer.i, P_DestructorAddress.i = #Null)
      
      If *This\Pointer <> #Null
        
        If *This\DestructorAddress <> #Null
          Destructor.DestructorFunction = *This\DestructorAddress
          Destructor(*This\Pointer)
        Else
          FreeStructure(*This\Pointer)
        EndIf
        
      EndIf
      
      *This\Pointer = P_Pointer
      *This\DestructorAddress = P_DestructorAddress
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Destructeur <<<<<
    
    Procedure Free(*This.Private_Members)
      
      If *This\Pointer <> #Null
        
        If *This\DestructorAddress <> #Null
          Destructor.DestructorFunction = *This\DestructorAddress
          Destructor(*This\Pointer)
        Else
          FreeStructure(*This\Pointer)
        EndIf
        
      EndIf
      
      FreeStructure(*This)
      
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Le Constructeur <<<<<
    
    Procedure.i New(P_Tag.l = 0, P_Pointer.i = 0, P_DestructorAddress.i = #Null)
      
      *This.Private_Members = AllocateStructure(Private_Members)
      *This\VirtualTable = ?START_METHODS
      
      *This\Tag = P_Tag
      *This\Pointer = P_Pointer
      *This\DestructorAddress = P_DestructorAddress
      
      ProcedureReturn *This
    EndProcedure
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Les entrées de la table virtuelle <<<<<
    
    DataSection
      START_METHODS:
      Data.i @GetTag()
      Data.i @GetPointer()
      Data.i @SetTag()
      Data.i @SetPointer()
      Data.i @Free()
      END_METHODS:
    EndDataSection
    
  EndModule
  
  
  Procedure ComputeSphereVolume(*TaskInfo.TaskInfo::TaskInfo)
    
    Exit_Condition = #False
    Max.i = Random(300, 100)
    
    While Exit_Condition = #False
      
      If *TaskInfo\GetKeepGoing() = #False
        Exit_Condition = #True
      ElseIf Counter = Max
        Exit_Condition = #True
        *Sphere.Sphere::Sphere = *TaskInfo\GetObjectAddress()
        *Sphere\ComputeVolume()
        *TaskInfo\SetCompleted(#True)
        Debug "ComputeSphereVolume = " + StrD(*Sphere\GetVolume())
        Debug "Computation done by WorkerID = " + Str(*TaskInfo\GetWorkerID()) + " (TaskID = " + Str(*TaskInfo\GetTaskID()) + ")"
      Else
        Counter + 1
        Delay(1)
      EndIf
      
    Wend
    
  EndProcedure
  
  Procedure ComputeCubeVolume(*TaskInfo.TaskInfo::TaskInfo)
    
    Exit_Condition = #False
    Max.i = Random(300, 100)
    
    While Exit_Condition = #False
      
      If *TaskInfo\GetKeepGoing() = #False
        Exit_Condition = #True
      ElseIf Counter = Max
        Exit_Condition = #True
        *Cube.Cube::Cube = *TaskInfo\GetObjectAddress()
        *Cube\ComputeVolume()
        *TaskInfo\SetCompleted(#True)
        Debug "ComputeCubeVolume = " + StrD(*Cube\GetVolume())
        Debug "Computation done by WorkerID = " + Str(*TaskInfo\GetWorkerID()) + " (TaskID = " + Str(*TaskInfo\GetTaskID()) + ")"
      Else
        Counter + 1
        Delay(1)
      EndIf
      
    Wend
    
  EndProcedure
  
  Procedure ComputeVolume(*TaskInfo.TaskInfo::TaskInfo)
    
    Exit_Condition = #False
    Max.i = Random(300, 100)
    
    While Exit_Condition = #False
      
      If *TaskInfo\GetKeepGoing() = #False
        
        Exit_Condition = #True
        
      ElseIf Counter = Max
        
        Exit_Condition = #True
        
        Select *TaskInfo\GetType()
            
          Case 0
            *Sphere.Sphere::Sphere = *TaskInfo\GetObjectAddress()
            *Sphere\ComputeVolume()
            Debug "ComputeVolume (Sphere) = " + StrD(*Sphere\GetVolume())
            
          Case 1
            *Cube.Cube::Cube = *TaskInfo\GetObjectAddress()
            *Cube\ComputeVolume()
            Debug "ComputeVolume (Cube) = " + StrD(*Cube\GetVolume())
            
        EndSelect
        
        *TaskInfo\SetCompleted(#True)
        
        Debug "Computation done by WorkerID = " + Str(*TaskInfo\GetWorkerID()) + " (TaskID = " + Str(*TaskInfo\GetTaskID()) + ")"
        
      Else
        Counter + 1
        Delay(1)
      EndIf
      
    Wend
    
  EndProcedure
  
  Enumeration
    
    #Shape_Type_Sphere
    #Shape_Type_Cube
    
  EndEnumeration
  
  NewList Shapes.Hook::Hook()
  NewList TaskInfos.TaskInfo::TaskInfo()
  
  WP.WorkerPool::WorkerPool = WorkerPool::New(10, #True)
  
  For W = 1 To 20
    
    AddElement(Shapes())
    AddElement(TaskInfos())
    
    If W % 2
      Shapes() = Hook::New(-1, Sphere::New(Random(5, 3)), Sphere::@Free())
      TaskInfos() = TaskInfo::New(W, Shapes()\GetTag(), Shapes()\GetPointer(), @ComputeSphereVolume())
      WP\AddTask(TaskInfos())
    Else
      Shapes() = Hook::New(-1, Cube::New(Random(5, 3)), Cube::@Free())
      TaskInfos() = TaskInfo::New(W, Shapes()\GetTag(), Shapes()\GetPointer(), @ComputeCubeVolume())
      WP\AddTask(TaskInfos())
    EndIf
    
  Next
  
  For W = 21 To 40
    
    AddElement(Shapes())
    AddElement(TaskInfos())
    
    If W % 2
      Shapes() = Hook::New(#Shape_Type_Sphere, Sphere::New(Random(5, 3)), Sphere::@Free())
      TaskInfos() = TaskInfo::New(W, Shapes()\GetTag(), Shapes()\GetPointer(), @ComputeVolume())
      WP\AddTask(TaskInfos())
    Else
      Shapes() = Hook::New(#Shape_Type_Cube, Cube::New(Random(5, 3)), Cube::@Free())
      TaskInfos() = TaskInfo::New(W, Shapes()\GetTag(), Shapes()\GetPointer(), @ComputeVolume())
      WP\AddTask(TaskInfos())
    EndIf
    
  Next
  
  
  While Round < 2
    
    Debug ""
    Debug "RoundID = " + Str(Round)
    Debug ""
    
    ; Main loop - Handle until no tasks remain 
    
    While WP\TasksRemaining() > 0
      
      WP\Update()
      
      ; Event Handling
      
      Exit_Condition = #False
      
      While Exit_Condition = #False
        
        Select WP\CurrentEvent()
            
          Case WorkerPool::#Event_None
            Exit_Condition = #True
            
          Case WorkerPool::#Event_Task_Started
            Debug "[Event] Task " + Str(WP\CurrentTaskID()) + " has started."
            
          Case WorkerPool::#Event_Task_Ended
            If WP\CurrentTaskCompleted() = #True
              
              Debug "[Event] Task " + Str(WP\CurrentTaskID()) + " has completed."
              
              TaskCompleted + 1
              
              If TaskCompleted = 19
                WP\SetKeepGoing(#False)
                Debug "KeepGoing = False (Abort)"
              EndIf 
              
            Else
              Debug "[Event] Task " + Str(WP\CurrentTaskID()) + " has not completed."
            EndIf
         
          Case WorkerPool::#Event_Task_Aborted
            Debug "[Event] Task " + Str(WP\CurrentTaskID()) + " has aborted."
             
        EndSelect
        
      Wend
      
;       Delay(1)
      
    Wend
    
    Round + 1
    
    ForEach TaskInfos()
      TaskInfos()\SetKeepGoing(#True)
      TaskInfos()\SetCompleted(#False)
      WP\AddTask(TaskInfos())
    Next
    
    WP\SetKeepGoing(#True)
    
  Wend
  
  Debug ""
  
  ForEach Shapes()
    Shapes()\Free()
  Next
  
  ForEach TaskInfos()
    TaskInfos()\Free()
  Next
  
  WP\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<