Re: Portable memory barrier?

["Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de>]

On 16/05/2017 00:53, Randy Brukardt wrote:
> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message
> news:of174q$13o7$1@gioia.aioe.org...
>> On 11/05/2017 02:35, Randy Brukardt wrote:
>>
>>> Still, it would be nice to try something in this area. One could imagine
>>> creating an Annex C test that implemented a lock-free algorithm and just
>>> tried to see if it worked properly.
>>
>> The real application used socked communication. The problem I suspect is
>> that artificial tests would not show problems full-size application have.
>> Maybe, a better strategy could be specific low-level tests for atomic
>> objects used in lock-free algorithms.
> 
> That's what I was thinking. But I'm not really the person to propose such
> tests, I know just enough to be dangerous. ;-) I'd be much better served
> being just an editor on such tests, as I wouldn't have too much trouble
> seeing things that need to be more portable (I have a lot of experience
> doing that).
> 
>> And we really should extend the Annex C with some basic atomic operations
>> like atomic increment, test-then-increment, test-then-exchange etc, all
>> falling back to protected objects if the machine lacks corresponding
>> instructions.
> 
> I think you are right about that. Supposedly, implementations are supposed
> to provide access to such things via machine code insertions, but that is
> never going to be portable (even to other implementations for the same
> target). So that's not really helpful.
> 
> Perhaps you could to send a problem statement and brief proposal to
> Ada-Comment? There's still time to make suggestions for Ada 2020, and
> tasking issues of all kinds are right in the wheelhouse of what we're hoping
> to accomplish. (As always, the ARG can find ways to solve problems, the real
> issue is knowing what the problems are. I believe that you are saying that
> creating portable lock-free algorithms are harder than necessary because of
> limitations in what can be atomic and what can be safely done with atomic
> objects. That seems like an important problem for the ARG to spend some time
> on.)

I was thinking about something slightly higher level than tedious CAS. 
E.g. predefined generic package:

generic
    type Value_Type is (<>);
    Initial_Value : Value_Type'Base;
package Atomic_Object is
--
-- Holder_Type -- Type of the atomic object to keep Value_Type'Base
--
    type Holder_Type is private;
    pragma Atomic (Holder_Type); -- It is a private type,
                                 -- so it must be safe to assign
--
-- Get actual value
--
    function Load (Item : Holder_Type) return Value_Type'Base;
--
-- Set new value
--
    procedure Store (Item : in out Holder_Type;
                     New_Value : Value_Type'Base);
    procedure Store (Item : in out Holder;
                     New_Value : Value_Type'Base;
                     Old_Value : out Value_Type'Base);
--
-- Compare old value to the barrier and if successful
-- store new value
--
    procedure Store_If_Greater (Item : in out Holder_Type;
                                Barrier : Value_Type'Base;
                                New_Value : Value_Type'Base);
    procedure Store_If_Greater (Item : in out Holder_Type;
                                Barrier : Value_Type'Base;
                                New_Value : Value_Type'Base;
                                Old_Value : out Value_Type'Base);
    procedure Store_If_Equal ...
    procedure Store_If_Inequal ...
    procedure Store_If_Less ...
    procedure Store_If_Greater ...
--
-- Increment value
--
    procedure Increment (Item : in out Holder;
                         Increment : Value_Type'Base);
    procedure Increment (Item : in out Holder;
                         Increment : Value_Type'Base;
                         Old_Value : out Value_Type'Base);
--
-- Compare old value to the barrier and if successful increment
--
    procedure Increment_If_Greater (Item : in out Holder_Type;
                                    Barrier : Value_Type'Base;
                                    Increment : Value_Type'Base);
    procedure Increment_If_Greater (Item : in out Holder_Type;
                                    Barrier : Value_Type'Base;
                                    Increment : Value_Type'Base;
                                    Old_Value : out Value_Type'Base);
    procedure Increment_If_Equal ...
    procedure Increment_If_Inequal ...
    procedure Increment_If_Less ...
    procedure Increment_If_Greater ...

end Atomic_Object;

The implementation should be free to use machine instructions, a 
spin-lock, or a protected object.

Example: reference counted object:

type Count_Type is mod 2**32;
package Atomic_Counters is new Atomic_Object (Count_Type, 0);

type Reference_Counted is record
    Use_Count : Atomic_Counters.Holder_Type;
    ...
end record;

type Reference_Counted_Ptr is access all Reference_Counted;
procedure Free is new Ada.Unchecked_Deallocation (Reference_Counted,
                                                 Reference_Counted_Ptr);
type Handle is new Ada.Finalization.Controlled with record
    Target : Reference_Counted_Ptr;
end record;

procedure Adjust (Pointer : in out Handle) is
begin -- Could check overflows using Increment_If_Less
    Atomic_Counters.Increment (Pointer.Target.Use_Count, 1);
end Adjust;

procedure Finalize (Pointer : in out Handle) is
    Old_Value : Count_Type;
begin
    if Pointer.Target /= null then
       Atomic_Counters.Increment_If_Greater
       (  Item      => Pointer.Target.Use_Count,
          Barrier   => 0,
          Increment => 0 - 1, -- Decrement by 1
          Old_Value => Old_Value
       );
       case Old_Value is
          when 0 => -- Use count is unexpectedly 0
             raise Program_Error;
          when 1 => -- Going to destroy the target
             Free (Pointer.Target);
          when others =>
             null;
       end case;
    end if;
end Finalize;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de