问题描述
我正在尝试为两个密切相关的不同设备定义一个硬件接口，但是其中一个的功能要比另一个更强。
作为问题的非常简化的版本，我们说：
- 设备A有2个寄存器：R0未使用，R1已使用
- 设备B有2个寄存器：同时使用R0和R1
我试图通过多态定义来重用代码和定义，如：
Tag_Length : constant := Standard'Address_Size / System.Storage_Unit;
type A_IO is tagged record
-- RO precedes,is unused but the space is reserved
R1 : Byte;
end record;
for A_IO use record
R1 at Tag_Length + 1 range 0 .. 7;
end record;
type B_IO is new A_IO with record
R0 : Byte;
-- R1 would follow as defined by the parent record
end record;
for B_IO use record
R0 at Tag_Length + 0 range 0 .. 7;
end record;
这会导致在大多数情况下有意义的编译器错误：component overlaps parent field of "B_IO"（GNAT社区2019）。
我对此有其他选择，其中包括：
- 为每个设备使用相同的类型（ con：设备A将看到不可见的组件）
- 使用完全不同的类型，在使用共享代码时，通过访问类型依赖于Unchecked Conversion来更改对象的视图（ con：将涉及多次重新定义某些相同的组件）
我想知道如果没有任何上述缺点，是否有可行的方法。
解决方法
我不知道那是不是bug。在7.1和7.2系列中，它可以很好地编译，但是在8.2和9.1中，它不能编译。
由于您愿意使用带标签的记录并让标签在位布局中占用空间，因此一种潜在的解决方法是使用不带标签的变体记录，并用变体替换标签。考虑：
type Record_Select is (A_IO,B_IO);
type Shared_Record(S : Record_Select) is record
R1 : Byte;
case S is
when A_IO => null;
when B_IO => R0 : Byte;
end case;
end record;
for Shared_Record use record
S at 0 range 0 .. 15;
R0 at 2 range 0 .. 7;
R1 at 3 range 0 .. 7;
end record;
for Shared_Record'Size use 32;
您可以调整大小以匹配您的实际标签大小。我只是输入了一些值。这将为您提供与标记记录类似的布局（当然要减去大小差异）。
此外，如果您将variant参数设置为具有默认值，则可以在两个变量之间进行复制，而无需进行未经检查的转换，只要您在类型中没有变量约束的情况下定义它们即可。
type Record_Select is (A_IO,B_IO);
-- Note the default value for S
type Shared_Record(S : Record_Select := B_IO) is record
R1 : Byte;
case S is
when A_IO => null;
when B_IO => R0 : Byte;
end case;
end record;
for Shared_Record use record
S at 0 range 0 .. 15;
R0 at 2 range 0 .. 7;
R1 at 3 range 0 .. 7;
end record;
for Shared_Record'Size use 32;
-- Note the unconstrained type definitions
A : Shared_Record := (S => A_IO,R1 => 3);
B : Shared_Record := (S => B_IO,R0 => 1,R1 => 2);
begin
Put_Line(B.R1'Image);
B := A;
Put_Line(B.R1'Image);
输出：
2
3
以下是一些从Jere's answer汲取灵感并以此为基础的方法：
使用访问类型限制视图
- 就像Jere一样，它使用一条记录，该记录将与依赖于变体的两个实现共享，以定义重叠字段。
- 使用Unchecked_Union方面来消除存储变体的需要。
- 将硬件IO定义封装在带标记的记录中，从而允许在两个设备的实现之间进行继承和OO。不管某种形式的设备的软件实现需要保持内部状态，而不仅仅是IO结构，都需要某种封装。
- 使用访问类型来确保每个设备实现只能访问正确的组件（无需依赖未经检查的转换）。
package Devices is
type Record_Select is (A_IO,B_IO);
type Shared_IO (S : Record_Select) is record
R1 : Byte;
case S is
when A_IO => null;
when B_IO => R0 : Byte;
end case;
end record with Unchecked_Union;
for Shared_IO use record
R0 at 0 range 0 .. 7;
R1 at 1 range 0 .. 7;
end record;
type Root is abstract tagged private;
type IO_Access is access all Shared_IO;
function Get_IO_Access (R : in out Root) return IO_Access;
private
type Root is abstract tagged record
IO : aliased Shared_IO (B_IO); -- Could be either A_IO/B_IO
end record;
end Devices;
package A is
type Device is new Devices.Root with private;
procedure Test (Dev : in out Device);
private
type A_IO_Access is access all Devices.Shared_IO (Devices.A_IO);
type Device is new Devices.Root with record
IO : A_IO_Access;
end record;
end A;
package B is
type Device is new A.Device with private;
overriding
procedure Test (Dev : in out Device);
private
type B_IO_Access is access all Devices.Shared_IO (Devices.B_IO);
type Device is new A.Device with record
IO : B_IO_Access;
end record;
end B;
package body Devices is
function Get_IO_Access (R : in out Root) return IO_Access is
begin
return R.IO'Unchecked_Access;
end Get_IO_Access;
end Devices;
package body A is
procedure Test (Dev : in out Device) is
begin
-- This assignment would typically be done upon object initialization
Dev.IO := A_IO_Access (Get_IO_Access (Dev));
-- Visibility tests
Dev.IO.R0 := 0; -- Triggers compiler warning (GOOD! Unsure why that wouldn't be a compile time error though)
Dev.IO.R1 := 1; -- Legal
end Test;
end A;
package body B is
overriding
procedure Test (Dev : in out Device) is
begin
-- This assignment would typically be done upon object initialization
Dev.IO := B_IO_Access (Get_IO_Access (Dev));
-- Visibility tests
Dev.IO.R0 := 0; -- Legal
Dev.IO.R1 := 1; -- Legal
end Test;
end B;
我不太相信这是一种好方法，但这是一种。
使用泛型来限制视图
使用泛型，我们只需访问某些视图即可，而无需涉及繁琐且可能有问题的访问类型（无需担心初始化或意外覆盖它们）。
type IO_Select is (A_IO,B_IO);
type Shared_IO (S : IO_Select) is record
R1 : Byte;
case S is
when A_IO => null;
when B_IO => R0 : Byte;
end case;
end record with Unchecked_Union;
for Shared_IO use record
R0 at 2 range 0 .. 7;
R1 at 3 range 0 .. 7;
end record;
generic
S : IO_Select;
package Common is
type Common_Device is tagged record
IO : Shared_IO (S);
end record;
procedure Test (Dev : in out Common_Device);
end Common;
package body Common is
procedure Test (Dev : in out Common_Device) is
begin
Dev.IO.R0 := 0; -- Will trigger warning upon generic instantiation with IO_Select (A_IO)
Dev.IO.R1 := 0; -- Will work fine on either generic instantiation
end Test;
end Common;
package A is
package Common_A is new Common (A_IO);
type Device_A is new Common_A.Common_Device with null record;
overriding procedure Test (Dev : in out Device_A);
end A;
package body A is
overriding procedure Test (Dev : in out Device_A) is
begin
Dev.IO.R0 := 0; -- Triggers compiler warning
Dev.IO.R1 := 0; -- Works fine
end Test;
end A;
package B is
package Common_B is new Common (B_IO);
type Device_B is new Common_B.Common_Device with null record;
overriding procedure Test (Dev : in out Device_B);
end B;
package body B is
overriding procedure Test (Dev : in out Device_B) is
begin
Dev.IO.R0 := 0; -- Works fine
Dev.IO.R1 := 0; -- Works fine
end Test;
end B;