Source code in the basic programming language

REM Sacado del forum de FreeBASIC (https://www.freebasic.net/forum/viewtopic.php?t=20432)

Type singleton
    Public :
    Declare Static Function crearInstancia() As singleton Ptr
    Declare Destructor ()
    Dim i As Integer
    Private :
    Declare Constructor()
    Declare Constructor(Byref rhs As singleton)
    Declare Static Function instancia(Byval crear As Integer) As singleton Ptr
End Type

Static Function singleton.crearInstancia() As singleton Ptr
    Return singleton.instancia(1)
End Function

Static Function singleton.instancia(Byval crear As Integer) As singleton Ptr
    Static ref As singleton Ptr = 0
    Function = 0
    If crear = 0 Then
        ref = 0
    Elseif ref = 0 Then
        ref = New singleton
        Function = ref
    End If
End Function

Constructor singleton ()
End Constructor

Destructor singleton()
singleton.instancia(0)
End Destructor

'-----------------------------------------------------------------------------
Dim As singleton Ptr ps1 = singleton.crearinstancia()
ps1->i = 1234
Print ps1, ps1->i

Dim As singleton Ptr ps2 = singleton.crearinstancia()
Print ps2

Delete ps1

Dim As singleton Ptr ps3 = singleton.crearinstancia()
Print ps3, ps3->i
Delete ps3
Sleep

Class Singleton
  static sys inst 'private
  int instantiated() { return inst }
  void constructor(){ if not inst then inst=@this }
  
  'all other methods start with @this=inst
end class

'if not singleton.instantiated
  new Singleton MySingleton
'endif

Global SingletonSemaphore=CreateSemaphore(1)

Interface OO_Interface    ; Interface for any value of this type 
  Get.i()        
  Set(Value.i) 
  Destroy()
EndInterface 

Structure OO_Structure ; The *VTable structure  
  Get.i
  Set.i
  Destroy.i
EndStructure 

Structure OO_Var  
  *VirtualTable.OO_Structure
  Value.i 
EndStructure 

Procedure OO_Get(*Self.OO_Var)
  ProcedureReturn *Self\Value
EndProcedure

Procedure OO_Set(*Self.OO_Var, n)
  *Self\Value = n
EndProcedure

Procedure CreateSingleton()
  If TrySemaphore(SingletonSemaphore)
    *p.OO_Var = AllocateMemory(SizeOf(OO_Var))
    If *p
      *p\VirtualTable = ?VTable
    EndIf
  EndIf
  ProcedureReturn *p
EndProcedure

Procedure OO_Destroy(*Self.OO_Var)
  FreeMemory(*Self)
  SignalSemaphore(SingletonSemaphore)
EndProcedure

DataSection
  VTable:
  Data.i @OO_Get()
  Data.i @OO_Set()
  Data.i @OO_Destroy()
EndDataSection

Singleton Class Demo
  BeginPrivate
    Name$
    X.i
  EndPrivate
  
  Public Method Init(Name$)
    This\Name$ = Name$
  EndMethod
  
  Public Method GetX()
    MethodReturn This\X
  EndMethod
  
  Public Method SetX(n)
    This\X = n
  EndMethod
  
  Public Method Hello()
    MessageRequester("Hello!", "I'm "+This\Name$)
  EndMethod
  
EndClass