Record aggregate with dynamic choice - ada

Question

I need to write a value consisting of all 0 except for bit Bit in a hardware register, where the register is somewhat like
type Bit_Number is range 0 .. 31;
type Bits_1 is array (Bit_Number) of Boolean
with
Component_Size => 1,
Size => 32;
Register_1 : Bits_1
with
Volatile,
Address => System'To_Address (16#1234_5678#);
Register_1 (typical of registers in Atmel's ATSAM3X8E, as in the Arduino Due) is defined as write-only, and it's unspecified what you get back if you read it, and it's unspecified what access widths are legal; all we are told is that when we write to the register only the 1 bits have any effect. (Incidentally, this means that the GNAT-specific aspect Volatile_Full_Access or the changes proposed in AI12-0128 won't help).
Enabling a pin in a GPIO peripheral involves setting its Bit in several registers. For reasons which I can't change (AdaCore's SVD2Ada), each register has its own equivalent of the Bits_1 array type above.
I want to write
procedure Set_Bit (Bit : Bit_Number) is
begin
Register_1 := (Bit => True, others => False);
Register_2 := (Bit => True, others => False);
...
end Set_Bit;
but the compiler says
19. procedure Set_Bit (Bit : Bit_Number) is
20. begin
21. Register_1 := (Bit => True, others => False);
|
>>> dynamic or empty choice in aggregate must be the only choice
which is a reference to ARM 4.3.3(17),
The discrete_choice_list of an array_component_association is allowed to have a discrete_choice that is a nonstatic choice_expression or that is a subtype_indication or range that defines a nonstatic or null range, only if it is the single discrete_choice of its discrete_choice_list, and there is only one array_component_association in the array_aggregate.
I can work round this,
procedure Set_Bit (Bit : Bit_Number) is
begin
declare
B : Bits_1 := (others => False);
begin
B (Bit) := True;
Register_1 := B;
end;
... ad nauseam
end Set_Bit;
but this seems very clumsy! Any other suggestions?

Answer 1

Does it have to be an array?
An alternative could be:
with Interfaces;
procedure Set_Bit is
Register : Interfaces.Unsigned_32;
begin
for J in 0..31 loop
Register := 2**J;
end loop;
end Set_Bit;

Answer 2

I think that this can be a little cumbersome , but if you need an array you could initialize it as a whole using concatenated sliced aggregates:
for J in 0 .. 31 loop
Register := Bits'(others => False)(0..J-1) &
True & Bits'(others => False)(J+1..31);
end loop;

Answer 3

It looks like a candidate for a function:
function Single_Bit (Set : in Bit_Number) return Bits_1 is
begin
return Result : Bits_1 := (others => False) do
Result (Set) := True;
end return;
end Single_Bit;
And then:
Register_1 := Single_Bit (Set => Some_Bit);
Register_2 := Single_Bit (Set => Another_Bit);

Answer 4

Example 1
This uses the Shift_Left operation.
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
procedure Main_Test is
function One_Bit (Index : Natural) return Unsigned_32 is (Shift_Left (1, Index));
type Bit_Array_32_Index is range 0 .. 31;
type Bit_Array_17_Index is range 0 .. 16;
type Bit_Array_32 is array (Bit_Array_32_Index) of Boolean with Component_Size => 1, Size => 32;
type Bit_Array_17 is array (Bit_Array_17_Index) of Boolean with Component_Size => 1, Size => 17;
-- For every new array type instantiate a convert function.
function Convert is new Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_32);
function Convert is new Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_17);
B32 : Bit_Array_32 with Volatile;
B17 : Bit_Array_17 with Volatile;
begin
B17 := Convert (One_Bit (2)) or Convert (One_Bit (5));
B32 := Convert (One_Bit (2) or One_Bit (5));
for E of B17 loop
Put (Boolean'Pos (E), 1);
end loop;
New_Line;
for E of B32 loop
Put (Boolean'Pos (E), 1);
end loop;
end;
Result
00100100000000000
00100100000000000000000000000000
Warnings
main.adb:21:04: warning: types for unchecked conversion have different sizes
main.adb:21:04: warning: size of "Unsigned_32" is 32, size of "Bit_Array_17" is 17
main.adb:21:04: warning: 15 high order bits of source will be ignored
Example generics
This uses the Shift_Left operation but with generics.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
procedure Main is
package Unsigned_32_IO is new Ada.Text_IO.Modular_IO (Unsigned_32);
type Bit_Array_32_Index is range 0 .. 31;
type Bit_Array_17_Index is range 0 .. 16;
type Bit_Array_32 is array (Bit_Array_32_Index) of Boolean with Component_Size => 1, Size => 32;
type Bit_Array_17 is array (Bit_Array_17_Index) of Boolean with Component_Size => 1, Size => 32;
generic
type I is (<>);
type T is array (I) of Boolean;
procedure Generic_Put (Item : T; Width : Field; Base : Number_Base);
procedure Generic_Put (Item : T; Width : Field; Base : Number_Base) is
function Convert_To_Unsigned_32 is new Ada.Unchecked_Conversion (T, Unsigned_32);
begin
Unsigned_32_IO.Put (Convert_To_Unsigned_32 (Item), Width, Base);
end;
generic
type I is (<>);
type T is array (I) of Boolean;
function Generic_Shift_Left (Value : Unsigned_32; Amount : Natural) return T;
function Generic_Shift_Left (Value : Unsigned_32; Amount : Natural) return T is
function Convert_To_Bit_Array_32 is new Ada.Unchecked_Conversion (Unsigned_32, T);
begin
return Convert_To_Bit_Array_32 (Interfaces.Shift_Left (Value, Amount));
end;
function Shift_Left is new Generic_Shift_Left (Bit_Array_32_Index, Bit_Array_32);
function Shift_Left is new Generic_Shift_Left (Bit_Array_17_Index, Bit_Array_17);
procedure Put is new Generic_Put (Bit_Array_32_Index, Bit_Array_32);
procedure Put is new Generic_Put (Bit_Array_17_Index, Bit_Array_17);
B32 : Bit_Array_32 with Volatile;
B17 : Bit_Array_17 with Volatile;
begin
B32 := Shift_Left (1, 2) or Shift_Left (1, 5);
B17 := Shift_Left (1, 2) or Shift_Left (1, 5);
Put (B17, 0, 2);
New_Line;
Put (B32, 0, 2);
end;
Result
2#100100#
2#100100#
gprbuild -v
GPRBUILD GPL 2015 (20150428) (i686-pc-mingw32)
Questions
Does it work on big-endian machine?
I haven't tested. See does bit-shift depend on endianness?