program Project1;

{$APPTYPE CONSOLE}
{$O+,W-}

uses
  Generics.Defaults,
  SysUtils, Threading;

type
  ILock = interface
    ['{F499E73B-6F7C-4740-9550-F34ED5655272}']
    procedure Enter;
    procedure Leave;
  end;

  PMonitorRec = ^TMonitorRec;
  TMonitorRec = record
    Vtable: Pointer;
    RefCount: Integer;
    Instance: TObject;
  end;

function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE;
end;

function MemAddRef(inst: PMonitorRec): Integer; stdcall;
begin
  Result := AtomicIncrement(inst.RefCount);
end;

function MemRelease(inst: PMonitorRec): Integer; stdcall;
begin
  Result := AtomicDecrement(inst.RefCount);
  if Result = 0 then
  begin
    System.MonitorExit(inst.Instance);
    FreeMem(inst);
  end;
end;

procedure MonitorEnter(inst: PMonitorRec);
begin
  System.MonitorEnter(inst.Instance);
end;

procedure MonitorLeave(inst: PMonitorRec);
begin
  System.MonitorExit(inst.Instance);
end;

const
  Monitor_Vtable: array[0..4] of Pointer =
  (
    @NopQueryInterface,
    @MemAddref,
    @MemRelease,
    @MonitorEnter,
    @MonitorLeave
  );

function Lock(const instance: TObject): ILock;
begin
  System.MonitorEnter(instance);
  GetMem(Pointer(Result), SizeOf(TMonitorRec));
  PMonitorRec(Result).Vtable := @Monitor_Vtable;
  PMonitorRec(Result).RefCount := 1;
  PMonitorRec(Result).Instance := instance;
end;

var
  o: TObject;
  i: Integer;
begin
  o := TObject.Create;
  i := 0;
  TParallel.&For(1, 1000,
    procedure(x: Integer)
    begin
      Lock(o);
      Inc(i);
      Sleep(1);
      Dec(i);
      Assert(i = 0);
    end);
  o.Free;
end.