Snippets

Stefan Glienke Interfaced monitor lock

Updated by Stefan Glienke
View revision

File snippet.txt Modified

  • Ignore whitespace
  • Hide word diff 
 {$O+,W-}
 
 uses
-  Generics.Defaults,
   SysUtils, Threading;
 
 type
Updated by Stefan Glienke
View revision

File snippet.txt Modified

  • Ignore whitespace
  • Hide word diff 
 program Project1;
 
 {$APPTYPE CONSOLE}
+{$O+,W-}
 
 uses
   Generics.Defaults,
 
 type
   ILock = interface
+    ['{F499E73B-6F7C-4740-9550-F34ED5655272}']
     procedure Enter;
     procedure Leave;
   end;
     @MonitorLeave
   );
 
-
 function Lock(const instance: TObject): ILock;
-var
-  inst: PMonitorRec;
 begin
   System.MonitorEnter(instance);
-  GetMem(inst, SizeOf(TMonitorRec));
-  inst.Vtable := @Monitor_Vtable;
-  inst.RefCount := 0;
-  inst.Instance := instance;
-  Result := ILock(inst);
+  GetMem(Pointer(Result), SizeOf(TMonitorRec));
+  PMonitorRec(Result).Vtable := @Monitor_Vtable;
+  PMonitorRec(Result).RefCount := 1;
+  PMonitorRec(Result).Instance := instance;
 end;
 
 var
Updated by Stefan Glienke
View revision

File snippet.txt Modified

  • Ignore whitespace
  • Hide word diff 
 {$APPTYPE CONSOLE}
 
 uses
+  Generics.Defaults,
   SysUtils, Threading;
 
 type
   ILock = interface
-    ['{F499E73B-6F7C-4740-9550-F34ED5655272}']
     procedure Enter;
     procedure Leave;
   end;
 
-  TInterfacedMonitor = class(TInterfacedObject, ILock)
-  private
-    fInstance: TObject;
-  public
-    constructor Create(const instance: TObject);
-    destructor Destroy; override;
-
-    procedure Enter;
-    procedure Leave;
+  PMonitorRec = ^TMonitorRec;
+  TMonitorRec = record
+    Vtable: Pointer;
+    RefCount: Integer;
+    Instance: TObject;
   end;
 
-{ TInterfacedMonitor }
+function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
+begin
+  Result := E_NOINTERFACE;
+end;
 
-constructor TInterfacedMonitor.Create(const instance: TObject);
+function MemAddRef(inst: PMonitorRec): Integer; stdcall;
 begin
-  inherited Create;
-  fInstance := instance;
-  Enter;
+  Result := AtomicIncrement(inst.RefCount);
 end;
 
-destructor TInterfacedMonitor.Destroy;
+function MemRelease(inst: PMonitorRec): Integer; stdcall;
 begin
-  Leave;
-  inherited;
+  Result := AtomicDecrement(inst.RefCount);
+  if Result = 0 then
+  begin
+    System.MonitorExit(inst.Instance);
+    FreeMem(inst);
+  end;
 end;
 
-procedure TInterfacedMonitor.Enter;
+procedure MonitorEnter(inst: PMonitorRec);
 begin
-  MonitorEnter(fInstance);
+  System.MonitorEnter(inst.Instance);
 end;
 
-procedure TInterfacedMonitor.Leave;
+procedure MonitorLeave(inst: PMonitorRec);
 begin
-  MonitorExit(fInstance);
+  System.MonitorExit(inst.Instance);
 end;
 
+const
+  Monitor_Vtable: array[0..4] of Pointer =
+  (
+    @NopQueryInterface,
+    @MemAddref,
+    @MemRelease,
+    @MonitorEnter,
+    @MonitorLeave
+  );
+
+
 function Lock(const instance: TObject): ILock;
+var
+  inst: PMonitorRec;
 begin
-  Result := TInterfacedMonitor.Create(instance);
+  System.MonitorEnter(instance);
+  GetMem(inst, SizeOf(TMonitorRec));
+  inst.Vtable := @Monitor_Vtable;
+  inst.RefCount := 0;
+  inst.Instance := instance;
+  Result := ILock(inst);
 end;
 
 var
Updated by Stefan Glienke
View revision

File snippet.txt Modified

  • Ignore whitespace
  • Hide word diff 
 begin
   o := TObject.Create;
   i := 0;
-  TParallel.&For(1, 10000,
+  TParallel.&For(1, 1000,
     procedure(x: Integer)
     begin
       Lock(o);
Created by Stefan Glienke
View revision

File snippet.txt Added

  • Ignore whitespace
  • Hide word diff 
+program Project1;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils, Threading;
+
+type
+  ILock = interface
+    ['{F499E73B-6F7C-4740-9550-F34ED5655272}']
+    procedure Enter;
+    procedure Leave;
+  end;
+
+  TInterfacedMonitor = class(TInterfacedObject, ILock)
+  private
+    fInstance: TObject;
+  public
+    constructor Create(const instance: TObject);
+    destructor Destroy; override;
+
+    procedure Enter;
+    procedure Leave;
+  end;
+
+{ TInterfacedMonitor }
+
+constructor TInterfacedMonitor.Create(const instance: TObject);
+begin
+  inherited Create;
+  fInstance := instance;
+  Enter;
+end;
+
+destructor TInterfacedMonitor.Destroy;
+begin
+  Leave;
+  inherited;
+end;
+
+procedure TInterfacedMonitor.Enter;
+begin
+  MonitorEnter(fInstance);
+end;
+
+procedure TInterfacedMonitor.Leave;
+begin
+  MonitorExit(fInstance);
+end;
+
+function Lock(const instance: TObject): ILock;
+begin
+  Result := TInterfacedMonitor.Create(instance);
+end;
+
+var
+  o: TObject;
+  i: Integer;
+begin
+  o := TObject.Create;
+  i := 0;
+  TParallel.&For(1, 10000,
+    procedure(x: Integer)
+    begin
+      Lock(o);
+      Inc(i);
+      Sleep(1);
+      Dec(i);
+      Assert(i = 0);
+    end);
+  o.Free;
+end.
HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.