diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-08-10 16:55:22 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-08-10 16:55:22 +0200 |
commit | 4d14b77ce02b89b1a22718ce607b16d823d95c74 (patch) | |
tree | 6090f74b784e4768a6c1d7f8da9890f6da129f93 /testsuite/gna/issue2166 | |
parent | 8a3922778cd92df96aaf5771f24d650bb8290559 (diff) | |
download | ghdl-4d14b77ce02b89b1a22718ce607b16d823d95c74.tar.gz ghdl-4d14b77ce02b89b1a22718ce607b16d823d95c74.tar.bz2 ghdl-4d14b77ce02b89b1a22718ce607b16d823d95c74.zip |
testsuite/gna: add a reproducer for #2166
Diffstat (limited to 'testsuite/gna/issue2166')
-rw-r--r-- | testsuite/gna/issue2166/repro1.vhdl | 28 | ||||
-rw-r--r-- | testsuite/gna/issue2166/repro2.vhdl | 33 | ||||
-rw-r--r-- | testsuite/gna/issue2166/repro3.vhdl | 27 | ||||
-rw-r--r-- | testsuite/gna/issue2166/sram.vhdl | 44 | ||||
-rw-r--r-- | testsuite/gna/issue2166/taggr.vhdl | 17 | ||||
-rw-r--r-- | testsuite/gna/issue2166/taggr2.vhdl | 19 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb.vhdl | 23 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb2.vhdl | 35 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb3.vhdl | 69 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb4.vhdl | 314 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb5.vhdl | 114 | ||||
-rw-r--r-- | testsuite/gna/issue2166/tb6.vhdl | 90 | ||||
-rwxr-xr-x | testsuite/gna/issue2166/testsuite.sh | 60 |
13 files changed, 873 insertions, 0 deletions
diff --git a/testsuite/gna/issue2166/repro1.vhdl b/testsuite/gna/issue2166/repro1.vhdl new file mode 100644 index 000000000..c44faf7dc --- /dev/null +++ b/testsuite/gna/issue2166/repro1.vhdl @@ -0,0 +1,28 @@ +entity repro1 is +end; + +architecture behav of repro1 is + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return (1 to Size => 0); + end InitMemoryBaseType; + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; +begin + process + variable MemArr : MemBlockPtrType; + variable BlockWidth : natural := 4; + begin + MemArr := new MemBlockType (0 to BlockWidth - 1)(0 to 31); + report natural'image(memarr'length); +--KO report natural'image(memarr'element'length); + report natural'image(memarr(0)'length); + MemArr.all := (others => InitMemoryBaseType(32)) ; +--KO MemArr.all := (0 to BlockWidth-1 => InitMemoryBaseType(32)) ; +--KO: MemArr(0 to BlockWidth-1) := +-- (0 to BlockWidth-1 => InitMemoryBaseType(32)) ; + wait; + end process; +end; diff --git a/testsuite/gna/issue2166/repro2.vhdl b/testsuite/gna/issue2166/repro2.vhdl new file mode 100644 index 000000000..9c587a932 --- /dev/null +++ b/testsuite/gna/issue2166/repro2.vhdl @@ -0,0 +1,33 @@ +entity repro2 is +end; + +architecture behav of repro2 is + function id(v : natural) return natural is + begin + return v; + end id; + + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return (1 to Size => 0); + end InitMemoryBaseType; + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type MemArrayPtrType is access MemArrayType ; + +begin + process + variable MemArr : MemArrayPtrType; + variable BlockWidth : natural; + begin + BlockWidth := 4; + MemArr := new MemArrayType (0 to 7); + MemArr(0) := new MemBlockType (0 to BlockWidth - 1)(0 to 31); + MemArr(0)(0 to BlockWidth-1) := + (0 to BlockWidth-1 => InitMemoryBaseType(32)) ; + wait; + end process; +end; diff --git a/testsuite/gna/issue2166/repro3.vhdl b/testsuite/gna/issue2166/repro3.vhdl new file mode 100644 index 000000000..24475db7b --- /dev/null +++ b/testsuite/gna/issue2166/repro3.vhdl @@ -0,0 +1,27 @@ +entity repro3 is +end; + +architecture behav of repro3 is + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return (1 to Size => 0); + end InitMemoryBaseType; + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; +begin + process + variable MemArr : MemBlockPtrType; + variable BlockWidth : natural := 4; + begin + MemArr := new MemBlockType (0 to BlockWidth - 1)(0 to 31); + report natural'image(memarr'length); +--KO report natural'image(memarr'element'length); + report natural'image(memarr(0)'length); + MemArr.all := (0 to BlockWidth-1 => InitMemoryBaseType(32)) ; +--KO: MemArr(0 to BlockWidth-1) := +-- (0 to BlockWidth-1 => InitMemoryBaseType(32)) ; + wait; + end process; +end; diff --git a/testsuite/gna/issue2166/sram.vhdl b/testsuite/gna/issue2166/sram.vhdl new file mode 100644 index 000000000..ac8b7ae8a --- /dev/null +++ b/testsuite/gna/issue2166/sram.vhdl @@ -0,0 +1,44 @@ +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +library OSVVM ; +use OSVVM.MemoryPkg.all; + +Entity SRAM is + port ( + Address : in std_logic_vector (19 downto 0) ; + Data : inout std_logic_vector (15 downto 0) ; + nCE :in std_logic; + nOE :in std_logic; + nWE :in std_logic + ); +end SRAM ; + +Architecture model of SRAM is + signal MemoryID : MemoryIDType ; + signal WriteEnable, ReadEnable : std_logic ; +begin + MemoryID <= NewID( + Name => SRAM'instance_name, + AddrWidth => Address'length, + DataWidth => Data'length) ; + WriteEnable <= not nWE and not nCE ; + + RamWriteProc : process + begin + wait until falling_edge(WriteEnable) ; + MemWrite(MemoryID, Address, Data) ; + end process RamWriteProc ; + + ReadEnable <= not nCE and not nOE ; + + ReadProc : process + begin + wait on Address, ReadEnable ; + case ReadEnable is + when '1' => Data <= MemRead(MemoryID, Address) ; + when '0' => Data <= (Data'range => 'Z') ; + when others => Data <= (Data'range => 'X') ; + end case ; + end process ReadProc ; +end model ; diff --git a/testsuite/gna/issue2166/taggr.vhdl b/testsuite/gna/issue2166/taggr.vhdl new file mode 100644 index 000000000..478602ca7 --- /dev/null +++ b/testsuite/gna/issue2166/taggr.vhdl @@ -0,0 +1,17 @@ +entity taggr is +end; + +architecture behav of taggr is + procedure set (v : out string) is + begin + v := (others => ' '); + end set; +begin + process + variable s : string (1 to 8); + begin + set (s); + report '<' & s & '>'; + wait; + end process; +end; diff --git a/testsuite/gna/issue2166/taggr2.vhdl b/testsuite/gna/issue2166/taggr2.vhdl new file mode 100644 index 000000000..721f57628 --- /dev/null +++ b/testsuite/gna/issue2166/taggr2.vhdl @@ -0,0 +1,19 @@ +entity taggr2 is +end; + +architecture behav of taggr2 is + procedure set (v : inout string; l, r : positive) is + begin + v (l to r) := (others => ' '); + end set; +begin + process + variable s : string (1 to 8); + begin + s(1) := 'A'; + s(8) := 'Z'; + set (s, 2, 7); + report s; + wait; + end process; +end; diff --git a/testsuite/gna/issue2166/tb.vhdl b/testsuite/gna/issue2166/tb.vhdl new file mode 100644 index 000000000..e35b336be --- /dev/null +++ b/testsuite/gna/issue2166/tb.vhdl @@ -0,0 +1,23 @@ +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +library OSVVM ; +use OSVVM.MemoryPkg.all; + +entity tb is +end; + +architecture behav of tb is +begin + process + variable MemoryID : MemoryIDType; + begin + MemoryID := NewID( + Name => "my_sram", + AddrWidth => 20, + DataWidth => 16); + + MemWrite(MemoryId, x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/tb2.vhdl b/testsuite/gna/issue2166/tb2.vhdl new file mode 100644 index 000000000..f08f5d659 --- /dev/null +++ b/testsuite/gna/issue2166/tb2.vhdl @@ -0,0 +1,35 @@ +library OSVVM ; + +use OSVVM.MemorySupportPkg.all ; + +package MemoryPkg is new OSVVM.MemoryGenericPkg + generic map ( +-- MemoryBaseType => MemoryBaseType_X, + SizeMemoryBaseType => SizeMemoryBaseType_X, + ToMemoryBaseType => ToMemoryBaseType_X, + FromMemoryBaseType => FromMemoryBaseType_X, + InitMemoryBaseType => InitMemoryBaseType_X + ) ; + +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +use work.MemoryPkg.all; + +entity tb2 is +end; + +architecture behav of tb2 is +begin + process + variable MemoryID : MemoryIDType; + begin + MemoryID := NewID( + Name => "my_sram", + AddrWidth => 20, + DataWidth => 16); + + MemWrite(MemoryId, x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/tb3.vhdl b/testsuite/gna/issue2166/tb3.vhdl new file mode 100644 index 000000000..b5c3dbf0e --- /dev/null +++ b/testsuite/gna/issue2166/tb3.vhdl @@ -0,0 +1,69 @@ +library ieee ; +use ieee.std_logic_1164.all ; + +entity tb3 is +end; + +architecture behav of tb3 is +begin + process + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return ((Size + 31) / 32 downto 1 => 0); + end; + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type MemArrayPtrType is access MemArrayType ; + + type MemStructType is record + MemArrayPtr : MemArrayPtrType ; + AddrWidth : integer ; + DataWidth : natural ; + BlockWidth : natural ; + MemoryBaseTypeWidth : natural ; + end record MemStructType ; + + variable MemStructPtr : MemStructType := (NULL, -1, 1, 0, 0); + + procedure MemInit (AddrWidth, DataWidth : integer ) is + constant ADJ_BLOCK_WIDTH : integer := 10; + begin + MemStructPtr.AddrWidth := AddrWidth ; + MemStructPtr.DataWidth := DataWidth ; + MemStructPtr.MemoryBaseTypeWidth := (DataWidth + 31) / 32; + MemStructPtr.BlockWidth := ADJ_BLOCK_WIDTH ; + MemStructPtr.MemArrayPtr := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ; + end procedure MemInit ; + + ------------------------------------------------------------ + procedure MemWrite ( + ------------------------------------------------------------ + Addr : std_logic_vector ; + Data : std_logic_vector + ) is + variable BlockWidth : integer ; + variable MemoryBaseTypeWidth : integer ; + variable BlockAddr, WordAddr : integer ; + begin + BlockWidth := MemStructPtr.BlockWidth ; + MemoryBaseTypeWidth := MemStructPtr.MemoryBaseTypeWidth ; + BlockAddr := 0 ; + + assert MemoryBaseTypeWidth = 1; + + -- If empty, allocate a memory block + if MemStructPtr.MemArrayPtr(BlockAddr) = NULL then + MemStructPtr.MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; + MemStructPtr.MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ; + end if ; + end procedure MemWrite ; + begin + MemInit(AddrWidth => 20, DataWidth => 16); + + MemWrite(x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/tb4.vhdl b/testsuite/gna/issue2166/tb4.vhdl new file mode 100644 index 000000000..aefaac9e2 --- /dev/null +++ b/testsuite/gna/issue2166/tb4.vhdl @@ -0,0 +1,314 @@ +library OSVVM ; + +use OSVVM.MemorySupportPkg.all ; + +use std.textio.all ; +library IEEE ; + use IEEE.std_logic_1164.all ; + use IEEE.numeric_std.all ; + use IEEE.numeric_std_unsigned.all ; + +package MemoryGenericPkg is + generic ( +-- type integer_vector ; + function SizeMemoryBaseType(Size : integer) return integer ; -- is <> ; + function ToMemoryBaseType (A : std_logic_vector) return integer_vector ; -- is <> ; + function FromMemoryBaseType(A : integer_vector ; Size : integer) return std_logic_vector ; -- is <> ; + function InitMemoryBaseType(Size : integer) return integer_vector -- is <> + ) ; + + type MemoryPType is protected + + ------------------------------------------------------------ + impure function NewID ( + Name : String ; + AddrWidth : integer ; + DataWidth : integer + ) return integer ; + + ------------------------------------------------------------ + procedure MemWrite ( + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) ; + procedure MemRead ( + ID : in integer ; + Addr : in std_logic_vector ; + Data : out std_logic_vector + ) ; + end protected MemoryPType ; + +end MemoryGenericPkg ; + +package body MemoryGenericPkg is + constant BLOCK_WIDTH : integer := 10 ; + + type MemoryPType is protected body + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type MemArrayPtrType is access MemArrayType ; + + type MemStructType is record + MemArrayPtr : MemArrayPtrType ; + AddrWidth : integer ; + DataWidth : natural ; + BlockWidth : natural ; + MemoryBaseTypeWidth : natural ; + end record MemStructType ; + + -- New Structure + type ItemArrayType is array (integer range <>) of MemStructType ; + type ItemArrayPtrType is access ItemArrayType ; + + variable Template : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ; -- Work around for QS 2020.04 and 2021.02 + constant MEM_STRUCT_PTR_LEFT : integer := Template'left ; + variable MemStructPtr : ItemArrayPtrType := new ItemArrayType'(Template) ; + variable NumItems : integer := 0 ; +-- constant MIN_NUM_ITEMS : integer := 4 ; -- Temporarily small for testing + constant MIN_NUM_ITEMS : integer := 32 ; -- Min amount to resize array + + ------------------------------------------------------------ + -- Package Local + function NormalizeArraySize( NewNumItems, MinNumItems : integer ) return integer is + ------------------------------------------------------------ + variable NormNumItems : integer := NewNumItems ; + variable ModNumItems : integer := 0; + begin + ModNumItems := NewNumItems mod MinNumItems ; + if ModNumItems > 0 then + NormNumItems := NormNumItems + (MinNumItems - ModNumItems) ; + end if ; + return NormNumItems ; + end function NormalizeArraySize ; + + ------------------------------------------------------------ + -- Package Local + procedure GrowNumberItems ( + ------------------------------------------------------------ + variable ItemArrayPtr : InOut ItemArrayPtrType ; + variable NumItems : InOut integer ; + constant GrowAmount : in integer ; +-- constant NewNumItems : in integer ; +-- constant CurNumItems : in integer ; + constant MinNumItems : in integer + ) is + variable oldItemArrayPtr : ItemArrayPtrType ; + variable NewNumItems : integer ; + begin + NewNumItems := NumItems + GrowAmount ; + -- Array Allocated in declaration to have a single item, but no items (historical mode) + -- if ItemArrayPtr = NULL then + -- ItemArrayPtr := new ItemArrayType(1 to NormalizeArraySize(NewNumItems, MinNumItems)) ; + -- elsif NewNumItems > ItemArrayPtr'length then + if NewNumItems > ItemArrayPtr'length then + oldItemArrayPtr := ItemArrayPtr ; + ItemArrayPtr := new ItemArrayType(1 to NormalizeArraySize(NewNumItems, MinNumItems)) ; + ItemArrayPtr.all(1 to NumItems) := oldItemArrayPtr.all(1 to NumItems) ; + deallocate(oldItemArrayPtr) ; + end if ; + NumItems := NewNumItems ; + end procedure GrowNumberItems ; + + ------------------------------------------------------------ + -- PT Local + procedure MemInit (ID : integer ; AddrWidth, DataWidth : integer ) is + ------------------------------------------------------------ + constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ; + begin + if AddrWidth <= 0 then + return ; + end if ; +-- if DataWidth <= 0 or DataWidth > 31 then +-- Alert(MemStructPtr(ID).AlertLogID, "MemoryPkg.MemInit/NewID. DataWidth = " & to_string(DataWidth) & " must be > 0 and <= 31.", FAILURE) ; + if DataWidth <= 0 then + return ; + end if ; + + MemStructPtr(ID).AddrWidth := AddrWidth ; + MemStructPtr(ID).DataWidth := DataWidth ; + MemStructPtr(ID).MemoryBaseTypeWidth := SizeMemoryBaseType(DataWidth) ; + MemStructPtr(ID).BlockWidth := ADJ_BLOCK_WIDTH ; + MemStructPtr(ID).MemArrayPtr := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ; + end procedure MemInit ; + + ------------------------------------------------------------ + impure function NewID ( + ------------------------------------------------------------ + Name : String ; + AddrWidth : integer ; + DataWidth : integer + ) return integer is + variable NameID : integer ; + begin + -- Add New Memory to Structure + GrowNumberItems(MemStructPtr, NumItems, GrowAmount => 1, MinNumItems => MIN_NUM_ITEMS) ; + -- Construct Memory, Reports agains AlertLogID + MemInit(NumItems, AddrWidth, DataWidth) ; + -- Check NameStore Index vs MemoryIndex + return NumItems ; + end function NewID ; + + ------------------------------------------------------------ + -- PT Local + impure function IdOutOfRange( + ------------------------------------------------------------ + constant ID : in integer ; + constant Name : in string + ) return boolean is + begin + return ID < MemStructPtr'Low or ID > MemStructPtr'High; + end function IdOutOfRange ; + + ------------------------------------------------------------ + procedure MemWrite ( + ------------------------------------------------------------ + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) is + variable BlockWidth : integer ; + variable MemoryBaseTypeWidth : integer ; +-- constant BlockWidth : integer := MemStructPtr(ID).BlockWidth; + variable BlockAddr, WordAddr : integer ; + alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ; +-- subtype MemBlockSubType is MemBlockType(0 to 2**BlockWidth-1) ; + begin + if IdOutOfRange(ID, "MemWrite") then + return ; + end if ; + BlockWidth := MemStructPtr(ID).BlockWidth ; + MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ; + + -- Check Bounds of Address and if memory is initialized + if Addr'length /= MemStructPtr(ID).AddrWidth then + return ; + end if ; + + -- Check Bounds on Data + if Data'length /= MemStructPtr(ID).DataWidth then + return ; + end if ; + + if is_X( Addr ) then + return ; + end if ; + + -- Slice out upper address to form block address + if aAddr'high >= BlockWidth then + BlockAddr := to_integer(aAddr(aAddr'high downto BlockWidth)) ; + else + BlockAddr := 0 ; + end if ; + + -- If empty, allocate a memory block + if (MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL) then +-- MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType'(0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ; + MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ; + MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ; +--KO2 MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (others => InitMemoryBaseType(Data'length)) ; + + end if ; + + -- Address of a word within a block + WordAddr := to_integer(aAddr(BlockWidth -1 downto 0)) ; + + -- Write to BlockAddr, WordAddr + MemStructPtr(ID).MemArrayPtr(BlockAddr)(WordAddr) := ToMemoryBaseType(Data) ; + end procedure MemWrite ; + + ------------------------------------------------------------ + procedure MemRead ( + ------------------------------------------------------------ + ID : in integer ; + Addr : in std_logic_vector ; + Data : out std_logic_vector + ) is + variable BlockWidth : integer ; + variable BlockAddr, WordAddr : integer ; + alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ; + begin + if IdOutOfRange(ID, "MemRead") then + return ; + end if ; + BlockWidth := MemStructPtr(ID).BlockWidth ; + + -- Check Bounds of Address and if memory is initialized + if Addr'length /= MemStructPtr(ID).AddrWidth then + Data := (Data'range => 'U') ; + return ; + end if ; + + -- Check Bounds on Data + if Data'length /= MemStructPtr(ID).DataWidth then + Data := (Data'range => 'U') ; + return ; + end if ; + + -- If Addr X, data = X + if is_X( aAddr ) then + Data := (Data'range => 'X') ; + return ; + end if ; + + -- Slice out upper address to form block address + if aAddr'high >= BlockWidth then + BlockAddr := to_integer(aAddr(aAddr'high downto BlockWidth)) ; + else + BlockAddr := 0 ; + end if ; + + -- Empty Block, return all U + if (MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL) then + Data := (Data'range => 'U') ; + return ; + end if ; + + -- Address of a word within a block + WordAddr := to_integer(aAddr(BlockWidth -1 downto 0)) ; + + Data := FromMemoryBaseType(MemStructPtr(ID).MemArrayPtr(BlockAddr)(WordAddr), Data'length) ; + + end procedure MemRead ; + end protected body MemoryPType ; +end MemoryGenericPkg ; + +library OSVVM ; + +use OSVVM.MemorySupportPkg.all ; + +package MemoryPkg is new work.MemoryGenericPkg + generic map ( +-- MemoryBaseType => MemoryBaseType_X, + SizeMemoryBaseType => SizeMemoryBaseType_X, + ToMemoryBaseType => ToMemoryBaseType_X, + FromMemoryBaseType => FromMemoryBaseType_X, + InitMemoryBaseType => InitMemoryBaseType_X + ) ; + +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +use work.MemoryPkg.all; + +entity tb3 is +end; + +architecture behav of tb3 is + shared variable MemoryStore : MemoryPType ; +begin + process + variable MemoryID : integer; + begin + MemoryID := MemoryStore.NewID( + Name => "my_sram", + AddrWidth => 20, + DataWidth => 16); + + MemoryStore.MemWrite(MemoryId, x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/tb5.vhdl b/testsuite/gna/issue2166/tb5.vhdl new file mode 100644 index 000000000..38bb5920d --- /dev/null +++ b/testsuite/gna/issue2166/tb5.vhdl @@ -0,0 +1,114 @@ +use std.textio.all ; +library IEEE ; + use IEEE.std_logic_1164.all ; + use IEEE.numeric_std.all ; + use IEEE.numeric_std_unsigned.all ; + +package MemoryPkg is + type MemoryPType is protected + procedure MemInit (ID : integer ; AddrWidth, DataWidth : integer); + + procedure MemWrite ( + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) ; + end protected MemoryPType ; +end; + +package body MemoryPkg is + constant BLOCK_WIDTH : integer := 10 ; + + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return (Size / 32 downto 1 => 0); + end; + + type MemoryPType is protected body + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type MemArrayPtrType is access MemArrayType ; + + type MemStructType is record + MemArrayPtr : MemArrayPtrType ; + AddrWidth : integer ; + DataWidth : natural ; + BlockWidth : natural ; + MemoryBaseTypeWidth : natural ; + end record MemStructType ; + + -- New Structure + type ItemArrayType is array (integer range <>) of MemStructType ; + type ItemArrayPtrType is access ItemArrayType ; + + variable Template : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ; -- Work around for QS 2020.04 and 2021.02 + variable MemStructPtr : ItemArrayPtrType := new ItemArrayType'(Template) ; + variable NumItems : integer := 0 ; + constant MIN_NUM_ITEMS : integer := 32 ; -- Min amount to resize array + + ------------------------------------------------------------ + -- PT Local + procedure MemInit (ID : integer ; AddrWidth, DataWidth : integer ) is + ------------------------------------------------------------ + constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ; + begin + if AddrWidth <= 0 then + return ; + end if ; + if DataWidth <= 0 then + return ; + end if ; + + MemStructPtr(ID).AddrWidth := AddrWidth ; + MemStructPtr(ID).DataWidth := DataWidth ; + MemStructPtr(ID).MemoryBaseTypeWidth := (DataWidth + 31) / 32; + MemStructPtr(ID).BlockWidth := ADJ_BLOCK_WIDTH ; + MemStructPtr(ID).MemArrayPtr := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ; + end procedure MemInit ; + + ------------------------------------------------------------ + procedure MemWrite ( + ------------------------------------------------------------ + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) is + variable BlockWidth : integer ; + variable MemoryBaseTypeWidth : integer ; + variable BlockAddr, WordAddr : integer ; + begin + BlockWidth := MemStructPtr(ID).BlockWidth ; + MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ; + BlockAddr := 0 ; + + -- If empty, allocate a memory block + if MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL then + MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ; + MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ; + end if ; + end procedure MemWrite ; + end protected body MemoryPType ; +end; + +library ieee ; +use ieee.std_logic_1164.all ; +use ieee.numeric_std.all ; +use work.MemoryPkg.all; + +entity tb3 is +end; + +architecture behav of tb3 is + shared variable MemoryStore : MemoryPType ; +begin + process + begin + MemoryStore.MemInit(1, AddrWidth => 20, DataWidth => 16); + + MemoryStore.MemWrite(1, x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/tb6.vhdl b/testsuite/gna/issue2166/tb6.vhdl new file mode 100644 index 000000000..3526a4ac5 --- /dev/null +++ b/testsuite/gna/issue2166/tb6.vhdl @@ -0,0 +1,90 @@ +library ieee ; +use ieee.std_logic_1164.all ; + +entity tb3 is +end; + +architecture behav of tb3 is +begin + process + procedure MemInit (ID : integer ; AddrWidth, DataWidth : integer); + + procedure MemWrite ( + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) ; + + constant BLOCK_WIDTH : integer := 10 ; + + function InitMemoryBaseType(Size : integer) return integer_vector is + begin + return (Size / 32 downto 1 => 0); + end; + + subtype MemoryBaseType is integer_vector ; + type MemBlockType is array (integer range <>) of MemoryBaseType ; + type MemBlockPtrType is access MemBlockType ; + type MemArrayType is array (integer range <>) of MemBlockPtrType ; + type MemArrayPtrType is access MemArrayType ; + + type MemStructType is record + MemArrayPtr : MemArrayPtrType ; + AddrWidth : integer ; + DataWidth : natural ; + BlockWidth : natural ; + MemoryBaseTypeWidth : natural ; + end record MemStructType ; + + -- New Structure + type ItemArrayType is array (integer range <>) of MemStructType ; + type ItemArrayPtrType is access ItemArrayType ; + + variable Template : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ; -- Work around for QS 2020.04 and 2021.02 + variable MemStructPtr : ItemArrayPtrType := new ItemArrayType'(Template) ; + + procedure MemInit (ID : integer ; AddrWidth, DataWidth : integer ) is + constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ; + begin + if AddrWidth <= 0 then + return ; + end if ; + if DataWidth <= 0 then + return ; + end if ; + + MemStructPtr(ID).AddrWidth := AddrWidth ; + MemStructPtr(ID).DataWidth := DataWidth ; + MemStructPtr(ID).MemoryBaseTypeWidth := (DataWidth + 31) / 32; + MemStructPtr(ID).BlockWidth := ADJ_BLOCK_WIDTH ; + MemStructPtr(ID).MemArrayPtr := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ; + end procedure MemInit ; + + ------------------------------------------------------------ + procedure MemWrite ( + ------------------------------------------------------------ + ID : integer ; + Addr : std_logic_vector ; + Data : std_logic_vector + ) is + variable BlockWidth : integer ; + variable MemoryBaseTypeWidth : integer ; + variable BlockAddr, WordAddr : integer ; + begin + BlockWidth := MemStructPtr(ID).BlockWidth ; + MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ; + BlockAddr := 0 ; + + -- If empty, allocate a memory block + if MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL then + MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ; + MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ; + end if ; + end procedure MemWrite ; + begin + MemInit(1, AddrWidth => 20, DataWidth => 16); + + MemWrite(1, x"00000", x"0000"); + wait; + end process; +end ; diff --git a/testsuite/gna/issue2166/testsuite.sh b/testsuite/gna/issue2166/testsuite.sh new file mode 100755 index 000000000..8828745e3 --- /dev/null +++ b/testsuite/gna/issue2166/testsuite.sh @@ -0,0 +1,60 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS="--std=08 -frelaxed" + +analyze repro1.vhdl +elab_simulate repro1 + +analyze repro3.vhdl +elab_simulate repro3 + +analyze repro2.vhdl +elab_simulate repro2 + +analyze tb3.vhdl +elab_simulate tb3 + +if false; then + export GHDL_STD_FLAGS="--std=08 -frelaxed --work=osvvm -Wno-hide" + + analyze OsvvmLibraries/osvvm/TextUtilPkg.vhd + analyze OsvvmLibraries/osvvm/ResolutionPkg.vhd + analyze OsvvmLibraries/osvvm/NamePkg.vhd + analyze OsvvmLibraries/osvvm/OsvvmGlobalPkg.vhd + analyze OsvvmLibraries/osvvm/VendorCovApiPkg.vhd + analyze OsvvmLibraries/osvvm/TranscriptPkg.vhd + analyze OsvvmLibraries/osvvm/AlertLogPkg.vhd + analyze OsvvmLibraries/osvvm/NameStorePkg.vhd + #analyze OsvvmLibraries/osvvm/MessageListPkg.vhd + #analyze OsvvmLibraries/osvvm/SortListPkg_int.vhd + #analyze OsvvmLibraries/osvvm/RandomBasePkg.vhd + #analyze OsvvmLibraries/osvvm/RandomPkg.vhd + #analyze OsvvmLibraries/osvvm/RandomProcedurePkg.vhd + #analyze OsvvmLibraries/osvvm/CoveragePkg.vhd + #analyze OsvvmLibraries/osvvm/ScoreboardGenericPkg.vhd + #analyze OsvvmLibraries/osvvm/ScoreboardPkg_slv.vhd + #analyze OsvvmLibraries/osvvm/ScoreboardPkg_int.vhd + #analyze OsvvmLibraries/osvvm/ResizePkg.vhd + analyze OsvvmLibraries/osvvm/MemorySupportPkg.vhd + analyze OsvvmLibraries/osvvm/MemoryGenericPkg.vhd + analyze OsvvmLibraries/osvvm/MemoryPkg.vhd + #analyze OsvvmLibraries/osvvm/TbUtilPkg.vhd + #analyze OsvvmLibraries/osvvm/ReportPkg.vhd + #analyze OsvvmLibraries/osvvm/OsvvmTypesPkg.vhd + #analyze OsvvmLibraries/osvvm/OsvvmContext.vhd + + + export GHDL_STD_FLAGS="--std=08 -frelaxed" + + analyze tb2.vhdl + elab_simulate tb2 + + analyze tb.vhdl + elab_simulate tb +fi + +clean + +echo "Test successful" |