unit SYSV_Shared_Memory;

{$MODE OBJFPC}
{$M+}

interface
uses type_fixes, BaseUNIX{TSize}, SYSV;

type
  TSharedMemory = class(TInterfacedObject, ISharedMemory, IInterface)
  private
    fBOwnsObject : TBoolean;
    fID : TInteger;
    fAddress : Pointer;
  published
    constructor Reuse(aID : TInteger; aBOwnsObject : TBoolean);
    constructor Create(aSize : TSize);
  public
    destructor Destroy; override;
  protected
    function GetID : TInteger;
    procedure Attach;
  public
    // doesn't work. property Address : Pointer read GetAddress;
  published
    function Address : Pointer;
    property ID : TInteger read GetID;
  end;

implementation
uses sysutils, ipc;

constructor TSharedMemory.Reuse(aID : TInteger; aBOwnsObject : TBoolean);
begin
  fBOwnsObject := aBOwnsObject;  
  fID := aID;

  if aID = -1 then  
    raise EOSError.Create('invalid SHM ID.');

  Attach;
end;

constructor TSharedMemory.Create(aSize : TSize);
begin
  Reuse(shmget(IPC_PRIVATE, aSize, IPC_CREAT or $1B6 {0666}), true);
end;
                                  
destructor TSharedMemory.Destroy;
begin
  if Assigned(fAddress) then begin
    shmdt(fAddress);
    fAddress := nil;
  end;
    
  if fBOwnsObject and (fID <> -1) then begin
    shmctl(fID, IPC_RMID, nil);
    fID := -1;
  end;
  
  inherited Destroy;
end;

function TSharedMemory.GetID : TInteger;
begin
  Result := fID;
end;

function TSharedMemory.Address : Pointer;
begin
  Result := fAddress;
end;

procedure TSharedMemory.Attach;
begin
  fAddress := shmat(fID, nil, 0);
end;

end.