This change ensures proper processing for a packed array of 4-bit records
specified with reverse scalar storage order.

The following program must compile quietly and execute as shown:

$ gnatmake -q reduced_pkd_array_small_rec
$ ./reduced_pkd_array_small_rec
Config 0 =  1
Config 1 =  3
Config 2 =  5
Config 3 =  7
Bit pattern:  19  87

with Ada.Text_Io; use Ada.Text_IO;
with System.Storage_Elements; use System.Storage_Elements;

procedure reduced_pkd_array_small_rec is

    type Int3 is range 0 .. 7;
    for Int3'Size use 3;

    type Small_Rec is record
       B : Boolean := False;
       I : Int3    := 0;
    end record;

    pragma pack (Small_Rec);

    for Small_Rec'Size use 4;
    for Small_Rec'Bit_Order use System.High_Order_First;
    for Small_Rec'Scalar_Storage_Order use System.High_Order_First;

    for Small_Rec use record
        B at 0 range 0 .. 0;
        I at 0 range 1 .. 3;
    end record;

    type Pakd_Array is array (Integer range 0 .. 3) of Small_Rec;
    pragma pack (Pakd_Array);
    for Pakd_Array'Scalar_Storage_Order use System.High_Order_First;

    Config : Pakd_Array;

    SA : Storage_Array (1 .. Config'Size / 8);
    for SA'Address use Config'Address;
    pragma Import (Ada, SA);

begin
    Config(0).I := 1;
    Config(1).I := 3;
    Config(2).I := 5;
    Config(3).I := 7;

    Put_Line ("Config 0 = " & Config(0).I'Img);
    Put_Line ("Config 1 = " & Config(1).I'Img);
    Put_Line ("Config 2 = " & Config(2).I'Img);
    Put_Line ("Config 3 = " & Config(3).I'Img);

    Put ("Bit pattern:");
    for J in SA'Range loop
       Put (" " & SA (J)'Img);
    end loop;
    New_Line;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-05-21  Thomas Quinot  <qui...@adacore.com>

        * exp_pakd.adb (Byte_Swap): Handle the case of a sub-byte
        component. No byte swapping occurs, but this procedure also takes
        care of appropriately justifying the argument.

Index: exp_pakd.adb
===================================================================
--- exp_pakd.adb        (revision 210703)
+++ exp_pakd.adb        (working copy)
@@ -576,20 +576,26 @@
       Shift   : Uint;
 
    begin
-      pragma Assert (T_Size > 8);
+      if T_Size <= 8 then
+         Swap_F := Empty;
+         Swap_T := RTE (RE_Unsigned_8);
 
-      if T_Size <= 16 then
-         Swap_RE := RE_Bswap_16;
+      else
+         if T_Size <= 16 then
+            Swap_RE := RE_Bswap_16;
 
-      elsif T_Size <= 32 then
-         Swap_RE := RE_Bswap_32;
+         elsif T_Size <= 32 then
+            Swap_RE := RE_Bswap_32;
 
-      else pragma Assert (T_Size <= 64);
-         Swap_RE := RE_Bswap_64;
+         else pragma Assert (T_Size <= 64);
+            Swap_RE := RE_Bswap_64;
+         end if;
+
+         Swap_F := RTE (Swap_RE);
+         Swap_T := Etype (Swap_F);
+
       end if;
 
-      Swap_F := RTE (Swap_RE);
-      Swap_T := Etype (Swap_F);
       Shift := Esize (Swap_T) - T_Size;
 
       Arg := RJ_Unchecked_Convert_To (Swap_T, N);
@@ -601,10 +607,14 @@
              Right_Opnd => Make_Integer_Literal (Loc, Shift));
       end if;
 
-      Swapped :=
-        Make_Function_Call (Loc,
-          Name                   => New_Occurrence_Of (Swap_F, Loc),
-          Parameter_Associations => New_List (Arg));
+      if Present (Swap_F) then
+         Swapped :=
+           Make_Function_Call (Loc,
+             Name                   => New_Occurrence_Of (Swap_F, Loc),
+             Parameter_Associations => New_List (Arg));
+      else
+         Swapped := Arg;
+      end if;
 
       if Right_Justify and then Shift > Uint_0 then
          Swapped :=

Reply via email to