Re: Problem using Ada.Text_IO.Modular_IO

[Georg Bauhaus <rm.plus-bug.tsoh@maps.futureapps.de>]

On Sun, 2008-07-13 at 00:51 +0000, anon wrote:

> Plus, when a programmer defines their own type in Ada, Ada adds 
> extra set of routines that are not based in hardware checks but software,
> which slows a program down.

I'm not sure there is some real context here.  There is no loss
in speed and no cost in terms of additional checks for using
either Unsigned_64 or "mod 2**64". (Or "mod 2**(something smaller)".)
Below is an example to serve as one of many (really unnecessary)
proofs that there is no overhead stemming from user defined types
"mod 2**N".  (And no overhead stemming from user defined types
in general---they are there for a reason in this real-time
systems programming language, I should think.)

Hardware will in the end fetch words from memory etc., but what
does this have to do with using a type mod 2**64 instead
of using Unsigned_64? The compiler produces the code, just the
compiler.  Will a 64bit compiler use different intrinsic
routines (such as "+") when the arguments are not Unsigned_64 
but of type mod 2**64? It does *not* seem to be the case, see
below.  No magically different checks either.  Turning checks
on/off is in the hands of the compiler operator.

For the code appended, I get not a single difference
in object code when using "mod 2**64" or Unsigned_64.
With or without optimization, neither the representation
nor the instructions differ at all. Not a bit.

Even using a packed array of 64 Booleans gives the very same
code with -O, and a very small difference results with -O0
between the boolean array code and the scalar types code.

I would have expected exactly this to be the case.

Here is the machine code of subprogram Predefined which
is using Unsigned_64 as an "in out" Parameter, then
followed by machine code of subprogram Programmer_Defined
which uses "mod 2**64".

First the case with some optimization.
The Ada subprogram is, basically,

procedure P(Item: in out T) is
begin
   Item := not Item;
end P;

where T stands for Unsigned_64  and "mod 2**64", resp.

$ gnatmake -gnata -gnato -gnatwa -O -fno-inline  speed.adb

0000000000000000 <speed__predefined.1692>:
   0:   48 89 f8                mov    %rdi,%rax
   3:   48 f7 d0                not    %rax
   6:   c3                      retq   
   7:   90                      nop    

0000000000000008 <speed__programmer_defined.1700>:
   8:   48 89 f8                mov    %rdi,%rax
   b:   48 f7 d0                not    %rax
   e:   c3                      retq   
   f:   90                      nop    

No difference. (And no checks.)

Next with no optimization at all:

$ gnatmake -gnata -gnato -gnatwa -O0 -fno-inline  speed.adb

00000000000003c6 <speed__programmer_defined.1700>:
 3c6:   55                      push   %rbp
 3c7:   48 89 e5                mov    %rsp,%rbp
 3ca:   48 89 7d f8             mov    %rdi,-0x8(%rbp)
 3ce:   4c 89 55 f0             mov    %r10,-0x10(%rbp)
 3d2:   48 f7 55 f8             notq   -0x8(%rbp)
 3d6:   48 8b 45 f8             mov    -0x8(%rbp),%rax
 3da:   c9                      leaveq 
 3db:   c3                      retq   

00000000000003dc <speed__predefined.1692>:
 3dc:   55                      push   %rbp
 3dd:   48 89 e5                mov    %rsp,%rbp
 3e0:   48 89 7d f8             mov    %rdi,-0x8(%rbp)
 3e4:   4c 89 55 f0             mov    %r10,-0x10(%rbp)
 3e8:   48 f7 55 f8             notq   -0x8(%rbp)
 3ec:   48 8b 45 f8             mov    -0x8(%rbp),%rax
 3f0:   c9                      leaveq 
 3f1:   c3                      retq   

No difference. (And no checks.)

with Interfaces;  use Interfaces;
with Ada.Text_IO;   use Ada.Text_IO;

procedure Speed2 is

   --
   -- Case 1:
   -- reusing predefined type from Interfaces:
   --

   procedure Predefined(Item: in out Unsigned_64) is
   begin
      Item := not Item;
   end Predefined;

   --
   -- Case 2:
   -- using a programmer defind modular type:
   --

   type B_Set is mod 2**64;

   procedure Programmer_Defined(Item: in out B_Set) is
   begin
      Item := not Item;
   end Programmer_Defined;

   --
   -- Case 3:
   -- using a different programmer defined type:
   --

   type Bit_List is array(Positive range <>) of Boolean;
   pragma Pack(Bit_List);

   subtype B_List is Bit_List(1 .. 64);


   procedure Really_Programmer_Defined(Item: in out B_List) is
   begin
      Item := not Item;
   end Really_Programmer_Defined;


   --
   -- IO of inputs and results
   --

   package IO_U64 is new Ada.Text_IO.Modular_IO(Unsigned_64);
   package IO_B is new Ada.Text_IO.Modular_IO(B_Set);
   package IO_L is

      -- a fake IO package for hex output of boolean array `B_List`

      Default_Width : Ada.Text_IO.Field := Unsigned_64'Width;
      Default_Base  : Ada.Text_IO.Number_Base := 10;

      procedure Put(Item: B_List;
                    Base: Number_Base := Default_Base;
                    Width: Field := Default_Width);
   end IO_L;
   package body IO_L is separate;

begin  -- Speed

   -- Starting with case 3. The bit values are set for position
   -- numbered ranges.  These will become bit positions in the other
   -- cases.

   -- pragma Volatile appears to help prevent Constraint_Error for
   -- non-static universal integer in `Value = 16#...#` with current
   -- GNAT.

   -- case 3:

   Packed_Arrays: declare
      Value: B_List;
   begin
      Value := B_List'
        (1 .. 10 => True,
         11 .. 27 => False,
         28 .. 40 => True,
         41 .. 42 => False,
         43 .. 63 => True,
         64 => False);
      Put("     As B_List: "); IO_L.Put(Value, Base => 16); New_Line;
      Really_Programmer_Defined(Value);
      Put("     As B_List: "); IO_L.Put(Value, Base => 16); New_Line;
   end Packed_Arrays;


   -- case 2:

   User_Mod_Types: declare
      Value: B_Set;
      pragma Volatile(Value);
   begin
      Value :=
2#1111111111_00000000000000000_1111111111111_00_111111111111111111111_0#;
      pragma Assert(Value = 16#FFC0001FFF3FFFFE#);
      Put("      As B_Set: "); IO_B.Put(Value, Base => 16); New_Line;
      Programmer_Defined(Value);
      Put("      As B_Set: "); IO_B.Put(Value, Base => 16); New_Line;
   end User_Mod_Types;


   -- case 1:

   Interface_Types: declare
      Value: Unsigned_64;
      pragma Volatile(Value);
   begin
      Value :=
2#1111111111_00000000000000000_1111111111111_00_111111111111111111111_0#;
      pragma Assert(Value = 16#FFC0001FFF3FFFFE#);
      Put("As Unsigned_64: "); IO_U64.Put(Value, Base => 16); New_Line;
      Predefined(Value);
      Put("As Unsigned_64: "); IO_U64.Put(Value, Base => 16); New_Line;
   end Interface_Types;


end Speed2;

separate(Speed2)
package body IO_L is


   Four : constant Positive := 4;
   subtype B_List4 is Bit_List(1 .. Four);


   function To_Char(Item: B_List4) return Character is
      -- Character representing the `Item` as a hex digit

      type N8 is range 0 .. 2**Four - 1;

      function As_N8(Omit_First: Boolean) return N8 is
         -- compute `Item`'s value from bits [1,]2,3,4 independent of
         -- bit order
         Result: N8;
         First_Bit: constant Positive := 1 + Boolean'Pos(Omit_First);
      begin
         Result := 0;
         for K in First_Bit .. Four loop
            Result := Result + 2**(Four - K) * Boolean'Pos(Item(K));
         end loop;
         return Result;
      end As_N8;

   begin -- To_Char
      if Item(1) and then (Item(2) or Item(3)) then
         -- hex digit A, B, ...
         return Character'Val(Character'Pos('A') +
                                As_N8(Omit_First => True) - 2);
      else
         -- decimal digit
         return Character'Val(Character'Pos('0') +
                                As_N8(Omit_First => False));
      end if;
   end To_Char;



   procedure Put(Item: B_List;
                 Base: Number_Base := Default_Base;
                 Width: Field := Default_Width)
   is
      Num_Half_Bytes : constant Positive := B_List'Size / Four;
      Result: String(1 .. Num_Half_Bytes);
   begin
      case Base is
          when 16 =>
             for J in 0 .. Num_Half_Bytes - 1 loop
                Result(J + 1) :=
                  To_Char(Item((J) * Four + 1 .. (J + 1) * Four));
             end loop;
             declare
                Extra_Spaces: constant Natural :=
                  Positive'Max(Width - Num_Half_Bytes - 4, 0);
             begin
                Ada.Text_IO.Put(String'(1 .. Extra_Spaces => ' ')
                                  &"16#" & Result & "#");
             end;
          when others =>
             -- not supported
             raise Program_Error;
      end case;
   end Put;

end IO_L;