package body Safe_Pointers.On_Definite_Types is

  function Null_Pointer return Safe_Pointer is
  begin
    return (Ada.Finalization.Controlled with
            Track => Null_Track);
  end Null_Pointer;

  function "=" (Left, Right: Safe_Pointer) return Boolean is
  begin
    return Left.Track.Object = Right.Track.Object;
  end "=";

  procedure Adjust (Pointer: in out Safe_Pointer) is
  begin
   if Pointer.Track /= Null_Track then
      Pointer.Track.Count := Pointer.Track.Count + 1;
    end if;
  end Adjust;

  procedure Finalize (Pointer: in out Safe_Pointer) is
  begin
    if Pointer.Track /= Null_Track then
      Pointer.Track.Count := Pointer.Track.Count - 1;
      if Pointer.Track.Count = 0 then  -- last pointer
        Free (Pointer.Track.Object);
        Free (Pointer.Track);
      end if;
      Pointer.Track := Null_Track;  -- idempotent
    end if;
  end Finalize;

  procedure Allocate (Pointer: in out Safe_Pointer) is
  begin
    Finalize (Pointer);
    Pointer.Track := new Track'(new Object, 1);
  end Allocate;

  procedure Allocate (Pointer: in out Safe_Pointer; Value: in Object) is
  begin
    Finalize (Pointer);
    Pointer.Track := new Track'(new Object'(Value), 1);
  end Allocate;

  procedure Deallocate (Pointer: in out Safe_Pointer) is
  begin
    if Pointer.Track = Null_Track then
      return;
    end if;
    Free (Pointer.Track.Object);
    Pointer.Track.Count := Pointer.Track.Count - 1;
    if Pointer.Track.Count = 0 then  -- last pointer
      Free (Pointer.Track);
    end if;
    Pointer.Track := Null_Track;
  end Deallocate;

  procedure Assign (Pointer: in Safe_Pointer; Value: in Object) is
  begin
    Pointer.Track.Object.all := Value;
  end Assign;

  function Value (Pointer: Safe_Pointer) return Object is
  begin
    return Pointer.Track.Object.all;
  end Value;

  function Reference (Pointer: Safe_Pointer) return Accessor is ...;

end Safe_Pointers.On_Definite_Types;

Back to text.