Threadsafe Singleton
lazarus / 62-General

----------------------------------------------------------------------
Trenatos · 2020-01-06 16:31

I initially looked into semaphores but they're deprecated.

Looking at https://wiki.freepascal.org/Singleton_Pattern there's a
line towards the end that says "The implementations have a problem
with multi-threading and synchronization"

So on that note, can someone point me to an example of a threadsafe
singleton?

Ultimately my goal is a threadsafe database connection pool.

--

I did find http://www.nickhodges.com/MultiThreadingInDelphi/ToC.html,
recommended by Thaddy in a different thread, checking that out.

And I also found this thread talking about syncobjs
https://forum.lazarus.freepascal.org/index.php?topic=36540.0

----------------------------------------------------------------------
Thaddy · 2020-01-06 17:04

I would advise against simple singletons in database applications, but
under windows it is quite easy using a named event.
Otherwise, write a small Daemon/Service and poll that.

*****
Warning: the current example on wikipedia is incorrect: https://en.wik
ipedia.org/wiki/Singleton_pattern#Delphi_and_Free_Pascal_implementatio
n so do not use that.
The case is the initialization and finalization handling: that should
not be there. I will put it on my todo list to write a
better/working/real one.
*****

----------------------------------------------------------------------
Trenatos · 2020-01-06 17:11

This is for a webserver running under Linux with threaded
fphttpserver.

I need a way to set up and manage a pool of database connections. A
threadsafe singleton seems like the way to go, what would you suggest
instead?

----------------------------------------------------------------------
Thaddy · 2020-01-06 17:21

Usually the webserver itself can handle such issues quite well based
on the internal workings of the sockets.  And most databases can
handle this too, just not lightweight embedded ones.

----------------------------------------------------------------------
BeniBela · 2020-01-06 18:07

For multi-threading you need some synchronization.

Take the last example

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  class
function TSingleton.Create: TSingleton; begin   if Singleton = nil
then     Singleton := TSingleton.Init;   Result := Singleton; end;
and change it to:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  class
function TSingleton.Create: TSingleton;var temp: TSingleton;begin  if
Singleton = nil then begin   temp := TSingleton.Init;   
 WriteBarrier;   if InterlockedCompareExchange(pointer(Singleton),
pointer(temp), nil) <> nil then     temp.free;  end;  Result :=
Singleton;end; 
Now I am not sure about the barriers. InterlockedCompareExchange might
already add a write barrier, and you probably do not need the write
barrier anyways on x86. Perhaps you also need a read barrier for arm
or alpha in case Singleton is not nil

----------------------------------------------------------------------
Trenatos · 2020-01-06 18:20

Thaddy, I could have each webserver client connection get its own
database connection, but that's a pretty heavy process so I'd like to
offload it to a pool manager to lower the overall response time per
web-request.

Thanks BeniBela, I'll take a look at that as soon as I'm off work.
Generally this will run on x64 Linux, but the more systems supported
the better.

----------------------------------------------------------------------
avk · 2020-01-17 10:20

Just curious, is this the correct implementation of Singleton?
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i type  
TSingleton = class  strict private  class var    FInstance:
TSingleton;    class constructor Init;    class destructor Done;  var 
  FExistFlag: LongInt;  protected    function AlreadyExists: Boolean; 
public    class function NewInstance: TObject; override;   
constructor Create; virtual;    procedure FreeInstance; override; 
end;  //// class constructor TSingleton.Init;begin  FInstance :=
nil;end; class destructor TSingleton.Done;begin  if FInstance <> nil
then    begin      FInstance.FExistFlag := 0;     
FreeAndNil(FInstance);    end;end; function TSingleton.AlreadyExists:
Boolean;begin  Result := InterlockedCompareExchange(FExistFlag, 1, 0)
<> 0;end; class function TSingleton.NewInstance: TObject;var  Inst:
TObject;begin  if FInstance = nil then    begin      Inst := inherited
NewInstance;      WriteBarrier;      if
InterlockedCompareExchange(Pointer(FInstance), Pointer(Inst), nil) <>
nil then        Inst.Free;    end;  Result :=
FInstance;end; constructor TSingleton.Create;begin  if AlreadyExists
then    exit;  inherited;end; procedure TSingleton.FreeInstance;begin 
if FExistFlag = 0 then    inherited;end; 
Or maybe this one will be better?
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i type 
TSingleton = class abstract  strict private  class var    FInstance:
TSingleton;    class constructor Init;    class destructor Done;  var 
  FLock: LongInt;    FExists: Boolean;  protected    procedure Lock;
inline;    procedure Unlock; inline;    procedure InternalCreate;
virtual; abstract;    property  AlreadyExists: Boolean read FExists; 
public    class function NewInstance: TObject; override;   
constructor Create;    procedure FreeInstance; override; 
end; //// class constructor TSingleton.Init;begin  FInstance :=
nil;end; class destructor TSingleton.Done;begin  if FInstance <> nil
then    begin      FInstance.FExists := False;     
FreeAndNil(FInstance);    end;end; procedure TSingleton.Lock;begin 
while Boolean(InterlockedExchange(FLock, 1)) do   
ThreadSwitch;end; procedure TSingleton.Unlock;begin 
InterlockedExchange(FLock, 0);end; class function
TSingleton.NewInstance: TObject;var  Inst: TObject;begin  if FInstance
= nil then    begin      Inst := inherited NewInstance;     
WriteBarrier;      if InterlockedCompareExchange(Pointer(FInstance),
Pointer(Inst), nil) <> nil then        Inst.Free;    end;  Result :=
FInstance;end; constructor TSingleton.Create;begin  Lock;  try    if
AlreadyExists then      exit;    FExists := True;    InternalCreate; 
finally    Unlock;  end;end; procedure TSingleton.FreeInstance;begin 
if AlreadyExists then    exit;  inherited;end;

----------------------------------------------------------------------
BeniBela · 2020-01-17 22:34

The second is better. I doubt the first one will work.

However, I was trying  to avoid the lock, hence the use of
Interlocked....  if you use a lock, you should use a critical section,
and forget about Interlocked...

A lock/critical section is the most reliable way to implement a
threadsafe singleton. But it is also the slowest. It can be made
faster with double-checked locking, which only uses the lock, if the
singleton has not been created.

But i want to do the entire initialization with only one global
variable, FInstance. (then the code can also be used for other objects
than singletons. One lock for one singleton is not a big issue, but
imagine you want to lazily initialize thousands of objects, then you
might need to have thousands of locks)

Hence, InterlockedCompareExchange. It only has the disadvantage that
multiple threads might create a TSingleton instance, and then all
threads except one thread free their own instance again

----------------------------------------------------------------------
argb32 · 2020-01-17 22:53

Every unit is a ready to use singleton.
Other singletons are antipattern.

----------------------------------------------------------------------
avk · 2020-01-18 05:28

@BeniBela, thank you.
@argb32, could you please give a little more detail?

----------------------------------------------------------------------
Thaddy · 2020-01-18 09:12

@BeniBela
Maybe drop the locking and use a TEventObject instead?

----------------------------------------------------------------------
argb32 · 2020-01-18 12:47

Quote from: avk on January 18, 2020, 06:28:49 am@argb32, could you
please give a little more detail?

A Pascal unit can contain stuff, does initialize once and is
accessible anywhere. Just as singleton. And that all is threadsafe.
Why need to reimplement all these properties with classes?

----------------------------------------------------------------------
avk · 2020-01-18 13:57

Just out of curiosity. I've never seen any good Singleton
implementation in Pascal.

----------------------------------------------------------------------
BeniBela · 2020-01-18 23:19

The unit always would create the singleton. The classes could only
create the singleton, when it is actually used, so the program starts
faster.

And I plan to use this function for non-singletons.

----------------------------------------------------------------------
jamie · 2020-01-19 02:04

Nice fancy new age terminology , "Singleton" , Is that anything
related to a Simpleton ?

----------------------------------------------------------------------
winni · 2020-01-19 02:35

Maybe!?

I thought about electro pop: Single Tone

----------------------------------------------------------------------
avk · 2020-01-19 04:29

@jamie, this "new age terminology" is about 25 years old. Is your
watch stopped?

----------------------------------------------------------------------
dsiders · 2020-01-19 07:25

Quote from: avk on January 19, 2020, 05:29:55 am@jamie, this "new age
terminology" is about 25 years old. Is your watch stopped?

Even a broken watch is right twice per day.

----------------------------------------------------------------------
440bx · 2020-01-19 07:38

Quote from: dsiders on January 19, 2020, 08:25:59 amEven a broken
watch is right twice per day.
How many times is it right per night ?