Re: GNAT (GCC) Profile Guided Compilation

[Keean Schupke <keean.schupke@googlemail.com>]

On Friday, 29 June 2012 11:01:30 UTC+1, Keean Schupke  wrote:
> On Friday, 29 June 2012 10:34:19 UTC+1, Dmitry A. Kazakov  wrote:
> > On Fri, 29 Jun 2012 02:17:19 -0700 (PDT), Keean Schupke wrote:
> > 
> > > Anyone have any ideas why profile guided compilation performs so poorly
> > > with Ada compared to C++?
> > 
> > Probably because you programmed it using low level C-ish stuff like
> > addresses instead of accessing data directly. In general, if you write a C
> > program in Ada (or any other language), you cannot expect it do better than
> > in C. To beat C, the precondition is to design it in Ada way.
> > 
> > -- 
> > Regards,
> > Dmitry A. Kazakov
> > http://www.dmitry-kazakov.de
> 
> I don't think you are right here, but I would be happy to be proved wrong. 
> 
> In general I find the choice of algorithm dominates performance. In this case most of the performance is dominated by a disjoint-set (union-find) algorithm operating on an array of data. The data nominally represents a 2D space (although I am using a 1D array to avoid the cost of multiplication on every access).
> 
> Most operations access the neighbouring cells, hence require a +/- one cell, or +/- one row operations.
> 
> Maintaining the address of the current cell is faster than using indexed addressing (mainly because of the extra parameter that needs to be passed around increasing the pressure on register allocation).
> 
> I would be interested to understand how an algorithm can be implemented in a more Ada way?
> 
> 
> Cheers,
> Keean.

To facilitate the discussion I will post the core packages from the implementation. First the slower version using array indexing (this is the 32k simulations per second version). As my application is lookup dominated, this algorithm (the eager disjoint set algorithm) is faster than the WQUPC (Weighted Quick Union with Path Compression) algorithm for my application.



    -- (C)2011 Keean Schupke, all rights reserved.
    generic
        type Element_Type is limited private;
        type Element_Access is not null access all Element_Type;
        type Set_Index is range <>;
    package Eager_Disjointsets is
        type Set_Type is limited private;
        type Set_Access is not null access all Set_Type;
        function Find(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Set_Index;
        pragma Inline_Always(Find);

        procedure Makeset(
            Set : in Set_Access;
            Index : in Set_Index
        );
        pragma Inline_Always(Makeset);

        procedure Link(
            Set : in Set_Access;
            Left, Right : in out Set_Index
        );
        pragma Inline_Always(Link);

        function Get(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Element_Access;
        pragma Inline_Always(Get);

        function Next(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Set_Index;
        pragma Inline_Always(Next);

        procedure Set_Next(
            Set : in Set_Access;
            Index : in Set_Index;
            Next : in Set_Index
        );
        pragma Inline_Always(Set_Next);

    private
        type Node_Type is limited record
            Canonical : Set_Index;
            Successor : Set_Index;
            Size : Natural;
            Value : aliased Element_Type;
        end record;
        type Set_Type is array (Set_Index) of Node_Type;
    end Eager_Disjointsets;

    package body Eager_Disjointsets is
        procedure Makeset(
            Set : in Set_Access;
            Index : in Set_Index
        ) is begin
            Set(Index).Canonical := Index;
            Set(Index).Size := 1;
        end Makeset;

        function Find(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Set_Index is begin
            return Set(Index).Canonical;
        end Find;

        procedure Swap_Indexes is new Swap(Set_Index);

        procedure Link(
            Set : in Set_Access;
            Left, Right : in out Set_Index) is
        begin
            if Set(Left).Size <= Set(Right).Size then
                Swap_Indexes(Left, Right);
            end if;

            declare
                Index : Set_Index := Right;
            begin
                Link_Loop : loop
                    Set(Index).Canonical := Left;
                    Index := Set(Index).Successor;
                    exit Link_Loop when Index = Right;
                end loop Link_Loop;
            end;

            Add(Set(Left).Size, Set(Right).Size);

            Swap_Indexes(Set(Left).Successor, Set(Right).Successor);
        end Link;

        function Get(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Element_Access is begin
            return Set(Index).Value'Access;
        end Get;

        function Next(
            Set : in Set_Access;
            Index : in Set_Index
        ) return Set_Index is begin
            return Set(Index).Successor;
        end Next;

        procedure Set_Next(
            Set : in Set_Access;
            Index : in Set_Index;
            Next : in Set_Index
        ) is begin
            Set(Index).Successor := Next;
        end Set_Next;
    end Eager_Disjointsets;



And this is the faster 40k simulations per second version:



    -- (C)2011 Keean Schupke, all rights reserved.
    generic
        Size : Int;
        type Element_Type is limited private;
        type Element_Access is not null access all Element_Type;
    package Eager_Disjointsets is
        type Set_Type is limited private;
        type Set_Access is not null access all Set_Type;
        type Node_Type is limited private;
        type Cursor is access all Node_Type;

        function Find(Node : in Cursor) return Cursor;
        pragma Inline_Always(Find);
        procedure Makeset(Node : in Cursor);
        pragma Inline_Always(Makeset);
        procedure Link(Left, Right : in out Cursor);
        pragma Inline_Always(Link);

        function Succ(Node : in Cursor) return Cursor;
        pragma Inline_Always(Succ);
        procedure Set_Succ(Node, Succ : in Cursor);
        pragma Inline_Always(Set_Succ);

        function First(Set : in Set_Access) return Cursor;
        pragma Inline_Always(First);
        function Element(Node : in Cursor) return Element_Access;
        pragma Inline_Always(Element);
        function Index(Set : in Set_Access; Node : in Cursor) return Int;
        pragma Inline_Always(Index);
        procedure Next(Node : in out Cursor);
        pragma Inline_Always(Next);

        function Step return Int;
        pragma Inline_Always(Step);
        function "+" (Left : in Cursor; Right : in Int) return Cursor;
        pragma Inline_Always("+");
        function "-" (Left : in Cursor; Right : in Int) return Cursor;
        pragma Inline_Always("-");
    private
        type Node_Type is limited record
            Canonical : Cursor;
            Successor : Cursor;
            Size : Int;
            Value : aliased Element_Type;
        end record;
        type Set_Type is array (0 .. Size - 1) of aliased Node_Type;

        package Node_Address is new System.Address_To_Access_Conversions(Node_Type);

        Node_Size : Storage_Offset := Node_Type'Object_Size
            / System.Storage_Elements.Storage_Element'Size;
    end Eager_Disjointsets;

    package body Eager_Disjointsets is
        function To_Cursor(A : System.Address) return Cursor is
        begin
            return Cursor(Node_Address.To_Pointer(A));
        end To_Cursor;
        pragma Inline_Always(To_Cursor);

        function To_Address(C : Cursor) return System.Address is
        begin
            return Node_Address.To_Address(Node_Address.Object_Pointer(C));
        end To_Address;
        pragma Inline_Always(To_Address);

        procedure Makeset(
            Node : in Cursor
        ) is begin
            Node.Canonical := Node;
            Node.Size := 1;
        end Makeset;

        function Find(
            Node : in Cursor
        ) return Cursor is begin
            return Cursor(Node.Canonical);
        end Find;

        procedure Swap_Cursors is new Swap(Cursor);

        procedure Link(
            Left, Right : in out Cursor) is
        begin
            if Left.Size <= Right.Size then
                Swap_Cursors(Cursor(Left), Cursor(Right));
            end if;

            declare
                Node : Cursor := Right;
            begin
                Link_Loop : loop
                    Node.Canonical := Left;
                    Node := Cursor(Node.Successor);
                    exit Link_Loop when Node = Right;
                end loop Link_Loop;
            end;

            Add(Left.Size, Right.Size);
            Swap_Cursors(Cursor(Left.Successor), Cursor(Right.Successor));
        end Link;

        function Succ(
            Node : in Cursor
        ) return Cursor is begin
            return Cursor(Node.Successor);
        end Succ;
        procedure Set_Succ(
            Node, Succ : in Cursor
        ) is begin
            Node.Successor := Succ;
        end Set_Succ;

        function First(
            Set : in Set_Access
        ) return Cursor is begin
            return Set(Set_Type'First)'Access;
        end First;

        function Element(
            Node : in Cursor
        ) return Element_Access is begin
            return Node.Value'Access;
        end Element;

        function Index(
            Set : in Set_Access;
            Node : in Cursor
        ) return Int is begin
            return Int((To_Address(Node) - To_Address(First(Set))) / Node_Size);
        end Index;

        procedure Next(
            Node : in out Cursor
        ) is begin
            Node := To_Cursor(To_Address(Node) + Node_Size);
        end Next;

        function Step return Int is
        begin
            return Int(Node_Size);
        end Step;

        function "+" (Left : in Cursor; Right : in Int) return Cursor is
        begin
            return To_Cursor(To_Address(Left) + Storage_Offset(Right));
        end "+";

        function "-" (Left : in Cursor; Right : in Int) return Cursor is
        begin
            return To_Cursor(To_Address(Left) - Storage_Offset(Right));
        end "-";
    end Eager_Disjointsets;



Would appreciate any advice on how this could be implemented in a more Ada friendly way, or any general performance tips.



Cheers,
Keean.