summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorTristan Gingold2015-06-18 22:40:31 +0200
committerTristan Gingold2015-06-18 22:40:31 +0200
commitd08386567e47854722e2b3a92720737837ca0bbd (patch)
tree9195e0e903ca3f2fc5baab03911b5558ffaf6e4e /testsuite
parent03f2df0a31ac07711863c9580bc3bc48cbab3a3b (diff)
downloadghdl-d08386567e47854722e2b3a92720737837ca0bbd.tar.gz
ghdl-d08386567e47854722e2b3a92720737837ca0bbd.tar.bz2
ghdl-d08386567e47854722e2b3a92720737837ca0bbd.zip
Add testcase for ticket89.
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/gna/ticket89/project/script.bat14
-rw-r--r--testsuite/gna/ticket89/project/src93/adaptations_pkg.vhd173
-rw-r--r--testsuite/gna/ticket89/project/src93/bfm_common_pkg.vhd396
-rw-r--r--testsuite/gna/ticket89/project/src93/license_open_pkg.vhd134
-rw-r--r--testsuite/gna/ticket89/project/src93/methods_pkg.vhd3808
-rw-r--r--testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd1073
-rw-r--r--testsuite/gna/ticket89/project/src93/types_pkg.vhd101
-rw-r--r--testsuite/gna/ticket89/project/src93/vhdl_version_layer_pkg.vhd97
-rw-r--r--testsuite/gna/ticket89/project/tb/partial_test_tb.vhd156
-rw-r--r--testsuite/gna/ticket89/repro.vhdl24
-rwxr-xr-xtestsuite/gna/ticket89/testsuite.sh30
-rw-r--r--testsuite/gna/ticket89/versions.txt5
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/CHANGES.TXT8
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/README.TXT8
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/script/compile_src.do50
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/README173
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/compile_additions24
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/env_c.vhdl48
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/standard_additions_c.vhdl2073
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/standard_textio_additions_c.vhdl480
-rw-r--r--testsuite/gna/ticket89/x_ieee_proposed/src/std_logic_1164_additions.vhdl1680
21 files changed, 10555 insertions, 0 deletions
diff --git a/testsuite/gna/ticket89/project/script.bat b/testsuite/gna/ticket89/project/script.bat
new file mode 100644
index 0000000..6ff2e49
--- /dev/null
+++ b/testsuite/gna/ticket89/project/script.bat
@@ -0,0 +1,14 @@
+ghdl -a -v --work=ieee_proposed ../x_ieee_proposed/src/std_logic_1164_additions.vhdl
+ghdl -a -v --work=ieee_proposed ../x_ieee_proposed/src/standard_additions_c.vhdl
+ghdl -a -v --work=ieee_proposed ../x_ieee_proposed/src/standard_textio_additions_c.vhdl
+ghdl -a -v --work=bitvis_util src93/types_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/adaptations_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/string_methods_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/vhdl_version_layer_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/license_open_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/methods_pkg.vhd
+ghdl -a -v --work=bitvis_util src93/bfm_common_pkg.vhd
+
+ghdl -a --work=bitvis_util tb/partial_test_tb.vhd
+ghdl -e --work=bitvis_util partial_test_tb
+ghdl -r --work=bitvis_util partial_test_tb \ No newline at end of file
diff --git a/testsuite/gna/ticket89/project/src93/adaptations_pkg.vhd b/testsuite/gna/ticket89/project/src93/adaptations_pkg.vhd
new file mode 100644
index 0000000..8c172bb
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/adaptations_pkg.vhd
@@ -0,0 +1,173 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : adaptations_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+use std.textio.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+use work.types_pkg.all;
+
+package adaptations_pkg is
+ constant C_ALERT_FILE_NAME : string := "_Alert.txt";
+ constant C_LOG_FILE_NAME : string := "_Log.txt";
+
+ constant C_SHOW_BITVIS_UTILITY_LIBRARY_INFO : boolean := true; -- Set this to false when you no longer need the initial info
+ constant C_SHOW_BITVIS_UTILITY_LIBRARY_RELEASE_INFO : boolean := true; -- Set this to false when you no longer need the release info
+
+ -------------------------------------------------------------------------------
+ -- Log format
+ -------------------------------------------------------------------------------
+ --Bitvis: [<ID>] <time> <Scope> Msg
+ --PPPPPPPPIIIIII TTTTTTTT SSSSSSSSSSSSSS MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+ constant C_LOG_PREFIX : string := "Bitvis: "; -- Note: ': ' is recommended as final characters
+
+ constant C_LOG_PREFIX_WIDTH : natural := C_LOG_PREFIX'length;
+ constant C_LOG_MSG_ID_WIDTH : natural := 20;
+ constant C_LOG_TIME_WIDTH : natural := 16; -- 3 chars used for unit eg. " ns"
+ constant C_LOG_TIME_BASE : time := ns; -- Unit in which time is shown in log (ns | ps)
+ constant C_LOG_TIME_DECIMALS : natural := 1; -- Decimals to show for given C_LOG_TIME_BASE
+ constant C_LOG_SCOPE_WIDTH : natural := 16;
+ constant C_LOG_LINE_WIDTH : natural := 150;
+ constant C_LOG_INFO_WIDTH : natural := C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH;
+
+ constant C_USE_BACKSLASH_N_AS_LF : boolean := true; -- If true interprets '\n' as Line feed
+
+ constant C_SINGLE_LINE_ALERT : boolean := false; -- If true prints alerts on a single line.
+ constant C_SINGLE_LINE_LOG : boolean := false; -- If true prints log messages on a single line.
+
+ constant C_TB_SCOPE_DEFAULT : string := "TB seq."; -- Default scope in test sequencer
+
+ constant C_LOG_TIME_TRUNC_WARNING : boolean := true; -- Yields a single TB_WARNING if time stamp truncated. Otherwise none
+ signal global_show_log_id : boolean := true;
+ signal global_show_log_scope : boolean := true;
+
+ -- UVVM dedicated. May be moved to separate UVVM adaptation package
+ signal global_show_msg_for_uvvm_cmd : boolean := true;
+ -- End of UVVM dedicated
+
+ -------------------------------------------------------------------------------
+ -- Verbosity control
+ -- NOTE: Do not enter new IDs without proper evaluation:
+ -- 1. Is it - or could it be covered by an existing ID
+ -- 2. Could it be combined with other needs for a more general new ID
+ -- Feel free to suggest new ID for future versions of Bitvis Utility Library (info@bitvis.no)
+ -------------------------------------------------------------------------------
+ type t_msg_id is (
+ -- Bitvis utility methods
+ NO_ID, -- Used as default prior to setting actual ID when transfering ID as a field in a record
+ ID_UTIL_BURIED, -- Used for buried log messages where msg and scope cannot be modified from outside
+ ID_UTIL_SETUP, -- Used for Utility setup
+ ID_LOG_MSG_CTRL, -- Used inside Utility library only - when enabling/disabling msg IDs.
+ ID_ALERT_CTRL, -- Used inside Utility library only - when setting IGNORE or REGARD on various alerts.
+ ID_NEVER, -- Used for avoiding log entry. Cannot be enabled.
+ ID_CLOCK_GEN, -- Used for logging when clock generators are enabled or disabled
+ ID_GEN_PULSE, -- Used for logging when a gen_pulse procedure starts pulsing a signal
+ -- General
+ ID_POS_ACK, -- To write a positive acknowledge on a check
+ -- Directly inside test sequencers
+ ID_LOG_HDR, -- ONLY allowed in test sequencer, Log section headers
+ ID_LOG_HDR_LARGE, -- ONLY allowed in test sequencer, Large log section headers
+ ID_LOG_HDR_XL, -- ONLY allowed in test sequencer, Extra large log section headers
+ ID_SEQUENCER, -- ONLY allowed in test sequencer, Normal log (not log headers)
+ ID_SEQUENCER_SUB, -- ONLY allowed in test sequencer, Subprograms defined in sequencer
+ -- BFMs
+ ID_BFM, -- Used inside a BFM (to log BFM access)
+ ID_BFM_WAIT, -- Used inside a BFM to indicate that it is waiting for something (e.g. for ready)
+ -- Packet related data Ids with three levels of granularity, for differentiating between frames, packets and segments.
+ -- Segment Ids, finest granularity of packet data
+ ID_SEGMENT_INITIATE, -- Notify that a packet is about to be transmitted or received
+ ID_SEGMENT_COMPLETE, -- Notify that a packet has been transmitted or received
+ ID_SEGMENT_HDR, -- AS ID_SEGMENT_COMPLETE, but also writes header info
+ ID_SEGMENT_DATA, -- AS ID_SEGMENT_COMPLETE, but also writes packet data (could be huge)
+ -- Packet Ids, medium granularity of packet data
+ ID_PACKET_INITIATE, -- Notify that a packet is about to be transmitted or received
+ ID_PACKET_COMPLETE, -- Notify that a packet has been transmitted or received
+ ID_PACKET_HDR, -- AS ID_PACKET_COMPLETED, but also writes header info
+ ID_PACKET_DATA, -- AS ID_PACKET_COMPLETED, but also writes packet data (could be huge)
+ -- Frame Ids, roughest granularity of packet data
+ ID_FRAME_INITIATE, -- Notify that a packet is about to be transmitted or received
+ ID_FRAME_COMPLETE, -- Notify that a packet has been transmitted or received
+ ID_FRAME_HDR, -- AS ID_FRAME_COMPLETE, but also writes header info
+ ID_FRAME_DATA, -- AS ID_FRAME_COMPLETE, but also writes packet data (could be huge)
+ -- Distributed command systems
+ ID_UVVM_SEND_CMD,
+ ID_UVVM_CMD_ACK,
+ ID_UVVM_CMD_RESULT,
+ ID_INTERPRETER, -- Message from VVC interpreter about correctly received and queued/issued command
+ ID_INTERPRETER_WAIT, -- Message from VVC interpreter that it is actively waiting for a command
+ ID_IMMEDIATE, -- Message from VVC interpreter that an IMMEDIATE command has been executed
+ ID_IMMEDIATE_WAIT, -- Message from VVC interpreter that an IMMEDIATE command is waiting for command to complete
+ ID_EXECUTOR, -- Message from VVC executor about correctly received command - prior to actual execution
+ ID_EXECUTOR_WAIT, -- Message from VVC executor that it is actively waiting for a command
+ -- VVC system
+ ID_VVC_CONSTRUCTOR, -- Constructor message from VVCs
+ -- Special purpose - Not really IDs
+ ALL_MESSAGES -- Applies to ALL message ID apart from ID_NEVER
+ );
+ type t_msg_id_panel is array (t_msg_id'left to t_msg_id'right) of t_enabled;
+
+ constant C_DEFAULT_MSG_ID_PANEL : t_msg_id_panel := (
+ ID_NEVER => DISABLED,
+ ID_UTIL_BURIED => DISABLED,
+ others => ENABLED
+ );
+
+ type t_msg_id_indent is array (t_msg_id'left to t_msg_id'right) of string(1 to 4);
+ constant C_MSG_ID_INDENT : t_msg_id_indent := (
+ ID_IMMEDIATE_WAIT => " ..",
+ ID_INTERPRETER => " " & NUL & NUL,
+ ID_INTERPRETER_WAIT => " ..",
+ ID_EXECUTOR => " " & NUL & NUL,
+ ID_EXECUTOR_WAIT => " ..",
+ ID_UVVM_SEND_CMD => "->" & NUL & NUL,
+ ID_UVVM_CMD_ACK => " ",
+ others => "" & NUL & NUL & NUL & NUL
+ );
+
+ -------------------------------------------------------------------------
+ -- Alert counters
+ -------------------------------------------------------------------------
+ -- Default values. These can be overwritten in each sequencer by using
+ -- set_alert_attention or set_alert_stop_limit (see quick ref).
+ constant C_DEFAULT_ALERT_ATTENTION : t_alert_attention := (others => REGARD);
+
+ -- 0 = Never stop
+ constant C_DEFAULT_STOP_LIMIT : t_alert_counters := (note to manual_check => 0,
+ others => 1);
+
+ -------------------------------------------------------------------------
+ -- Deprecate
+ -------------------------------------------------------------------------
+ -- These values are used to indicate outdated sub-programs
+ constant C_DEPRECATE_SETTING : t_deprecate_setting := DEPRECATE_ONCE;
+ shared variable deprecated_subprogram_list : t_deprecate_list := (others=>(others => ' '));
+
+end package adaptations_pkg;
+
+package body adaptations_pkg is
+end package body adaptations_pkg;
diff --git a/testsuite/gna/ticket89/project/src93/bfm_common_pkg.vhd b/testsuite/gna/ticket89/project/src93/bfm_common_pkg.vhd
new file mode 100644
index 0000000..8a57804
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/bfm_common_pkg.vhd
@@ -0,0 +1,396 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : bfm_common_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.math_real.all;
+use ieee.numeric_std.all;
+use std.textio.all;
+
+use work.types_pkg.all;
+use work.string_methods_pkg.all;
+use work.methods_pkg.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.std_logic_1164_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+package bfm_common_pkg is
+ -- General declarations related to BFMs
+ type t_normalization_mode is (ALLOW_WIDER, ALLOW_NARROWER, ALLOW_WIDER_NARROWER, ALLOW_EXACT_ONLY);
+
+ -- Functions/procedures
+ impure function normalise(
+ constant value : in std_logic_vector;
+ constant target : in std_logic_vector;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "slv"
+ ) return std_logic_vector;
+
+ impure function normalise(
+ constant value : in unsigned;
+ constant target : in unsigned;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "unsigned"
+ ) return unsigned;
+
+ impure function normalise(
+ constant value : in signed;
+ constant target : in signed;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "signed"
+ ) return signed;
+
+
+ -- Functions/procedures
+ impure function normalize_and_check(
+ constant value : in std_logic_vector;
+ constant target : in std_logic_vector;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "slv"
+ ) return std_logic_vector;
+
+ impure function normalize_and_check(
+ constant value : in unsigned;
+ constant target : in unsigned;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "unsigned"
+ ) return unsigned;
+
+ impure function normalize_and_check(
+ constant value : in signed;
+ constant target : in signed;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "signed"
+ ) return signed;
+
+ procedure wait_until_given_time_after_rising_edge (
+ signal clk : in std_logic;
+ constant wait_time : in time
+ );
+
+end package bfm_common_pkg;
+--=================================================================================================
+
+package body bfm_common_pkg is
+ constant C_SCOPE : string := "bfm_common";
+
+ -- Normalize 'value' to the width given by 'target' and perform sanity check.
+ impure function normalize_and_check(
+ constant value : in std_logic_vector;
+ constant target : in std_logic_vector;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "slv"
+ ) return std_logic_vector is
+ constant name : string := "normalize_and_check(" & val_type & ": " &
+ value_name & "=" & to_string(value, HEX, AS_IS) & ", " &
+ target_name & "=" & to_string(target, HEX, AS_IS) & ")";
+ alias a_value : std_logic_vector(value'length - 1 downto 0) is value;
+ alias a_target : std_logic_vector(target'length - 1 downto 0) is target;
+ variable v_normalized_value : std_logic_vector(target'length - 1 downto 0);
+ begin
+ -- Verify that value and target are not zero-length vectors
+ if value'length = 0 then
+ tb_error(name & " => Value length is zero! " & msg, C_SCOPE);
+ return v_normalized_value;
+ elsif target'length = 0 then
+ tb_error(name & " => Target length is zero! " & msg, C_SCOPE);
+ return v_normalized_value;
+ end if;
+ -- If value'length > target'length, remove leading zeros from value
+ if (a_value'length > a_target'length) then
+ v_normalized_value := a_value(a_target'length - 1 downto 0);
+ -- Sanity checks
+ if not (mode = ALLOW_WIDER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " without using ALLOW_WIDER mode. " & msg, C_SCOPE);
+ end if;
+ if not matching_widths(a_value, a_target) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-zeros in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ -- If value'length = target'length
+ elsif (a_value'length = a_target'length) then
+ v_normalized_value := a_value;
+ -- If value'length < target'length, add padding (leading zeros) to value
+ elsif (a_value'length < a_target'length) then
+ v_normalized_value := (others => '0');
+ v_normalized_value(a_value'length - 1 downto 0) := a_value;
+ -- Sanity check
+ if not (mode = ALLOW_NARROWER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is narrower than " & target_name & " without using ALLOW_NARROWER mode. " & msg, C_SCOPE);
+ end if;
+ end if;
+
+ return v_normalized_value;
+ end;
+
+ impure function normalize_and_check(
+ constant value : in unsigned;
+ constant target : in unsigned;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "unsigned"
+ ) return unsigned is
+ begin
+ return unsigned( normalize_and_check(std_logic_vector(value), std_logic_vector(target), mode, value_name, target_name, msg, val_type) );
+ end;
+
+ impure function normalize_and_check(
+ constant value : in signed;
+ constant target : in signed;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "signed"
+ ) return signed is
+ constant name : string := "normalize_and_check(" & val_type & ": " &
+ value_name & "=" & to_string(std_logic_vector(value)) & ", " &
+ target_name & "=" & to_string(std_logic_vector(target)) & ")";
+ alias a_value : signed(value'length - 1 downto 0) is value;
+ alias a_target : signed(target'length - 1 downto 0) is target;
+ variable v_normalized_value : signed(target'length - 1 downto 0);
+ begin
+ -- Verify that value and target are not zero-length vectors
+ if value'length = 0 then
+ tb_error(name & " => Value length is zero! " & msg, C_SCOPE);
+ return v_normalized_value;
+ elsif target'length = 0 then
+ tb_error(name & " => Target length is zero! " & msg, C_SCOPE);
+ return v_normalized_value;
+ end if;
+ -- If value'length > target'length, remove leading zeros/ones from value
+ if a_value'length > a_target'length then
+ v_normalized_value := a_value(a_target'length - 1 downto 0);
+ -- Sanity checks
+ if not (mode = ALLOW_WIDER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " without using ALLOW_WIDER mode. " & msg, C_SCOPE);
+ end if;
+
+ if a_value(a_value'high) = '0' then -- positive value
+ if not matching_widths(a_value, a_target) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-zeros in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ elsif a_value(a_value'high) = '1' then -- negative value
+ for i in a_value'high downto a_target'length loop
+ if a_value(i) = '0' then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-sign bits in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ end loop;
+ end if;
+ -- If value'length = target'length
+ elsif a_value'length = a_target'length then
+ v_normalized_value := a_value;
+ -- If value'length < target'length, add padding (leading zeros/ones) to value
+ elsif a_value'length < a_target'length then
+ if a_value(a_value'high) = '0' then -- positive value
+ v_normalized_value := (others => '0');
+ elsif a_value(a_value'high) = '1' then -- negative value
+ v_normalized_value := (others => '1');
+ end if;
+ v_normalized_value(a_value'length - 1 downto 0) := a_value;
+ -- Sanity check
+ if not (mode = ALLOW_NARROWER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is narrower than " & target_name & " without using ALLOW_NARROWER mode. " & msg, C_SCOPE);
+ end if;
+ end if;
+
+ return v_normalized_value;
+ end;
+
+
+ -- Normalise 'value' to the width given by 'target'.
+ impure function normalise(
+ constant value : in std_logic_vector;
+ constant target : in std_logic_vector;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "slv"
+ ) return std_logic_vector is
+ constant name : string := "normalise(" & val_type & ": " &
+ value_name & "=" & to_string(value, HEX, AS_IS) & ", " &
+ target_name & "=" & to_string(target, HEX, AS_IS) & ")";
+ alias a_value : std_logic_vector(value'length - 1 downto 0) is value;
+ alias a_target : std_logic_vector(target'length - 1 downto 0) is target;
+ variable v_normalised_value : std_logic_vector(target'length - 1 downto 0);
+ begin
+ deprecate(get_procedure_name_from_instance_name(value'instance_name), "Use normalize_and_check().");
+ -- Verify that value and target are not zero-length vectors
+ if value'length = 0 then
+ tb_error(name & " => Value length is zero! " & msg, C_SCOPE);
+ return v_normalised_value;
+ elsif target'length = 0 then
+ tb_error(name & " => Target length is zero! " & msg, C_SCOPE);
+ return v_normalised_value;
+ end if;
+ -- If value'length > target'length, remove leading zeros from value
+ if (a_value'length > a_target'length) then
+ v_normalised_value := a_value(a_target'length - 1 downto 0);
+ -- Sanity checks
+ if not (mode = ALLOW_WIDER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " without using ALLOW_WIDER mode. " & msg, C_SCOPE);
+ end if;
+ if not matching_widths(a_value, a_target) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-zeros in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ -- If value'length = target'length
+ elsif (a_value'length = a_target'length) then
+ v_normalised_value := a_value;
+ -- If value'length < target'length, add padding (leading zeros) to value
+ elsif (a_value'length < a_target'length) then
+ v_normalised_value := (others => '0');
+ v_normalised_value(a_value'length - 1 downto 0) := a_value;
+ -- Sanity check
+ if not (mode = ALLOW_NARROWER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is narrower than " & target_name & " without using ALLOW_NARROWER mode. " & msg, C_SCOPE);
+ end if;
+ end if;
+
+ return v_normalised_value;
+ end;
+
+ impure function normalise(
+ constant value : in unsigned;
+ constant target : in unsigned;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "unsigned"
+ ) return unsigned is
+ begin
+ return unsigned( normalise(std_logic_vector(value), std_logic_vector(target), mode, value_name, target_name, msg, val_type) );
+ end;
+
+ impure function normalise(
+ constant value : in signed;
+ constant target : in signed;
+ constant mode : in t_normalization_mode;
+ constant value_name : string;
+ constant target_name : string;
+ constant msg : string;
+ constant val_type : string := "signed"
+ ) return signed is
+ constant name : string := "normalise(" & val_type & ": " &
+ value_name & "=" & to_string(std_logic_vector(value)) & ", " &
+ target_name & "=" & to_string(std_logic_vector(target)) & ")";
+ alias a_value : signed(value'length - 1 downto 0) is value;
+ alias a_target : signed(target'length - 1 downto 0) is target;
+ variable v_normalised_value : signed(target'length - 1 downto 0);
+ begin
+ deprecate(get_procedure_name_from_instance_name(value'instance_name), "Use normalize_and_check().");
+ -- Verify that value and target are not zero-length vectors
+ if value'length = 0 then
+ tb_error(name & " => Value length is zero! " & msg, C_SCOPE);
+ return v_normalised_value;
+ elsif target'length = 0 then
+ tb_error(name & " => Target length is zero! " & msg, C_SCOPE);
+ return v_normalised_value;
+ end if;
+ -- If value'length > target'length, remove leading zeros/ones from value
+ if a_value'length > a_target'length then
+ v_normalised_value := a_value(a_target'length - 1 downto 0);
+ -- Sanity checks
+ if not (mode = ALLOW_WIDER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " without using ALLOW_WIDER mode. " & msg, C_SCOPE);
+ end if;
+
+ if a_value(a_value'high) = '0' then -- positive value
+ if not matching_widths(a_value, a_target) then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-zeros in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ elsif a_value(a_value'high) = '1' then -- negative value
+ for i in a_value'high downto a_target'length loop
+ if a_value(i) = '0' then
+ tb_error(name & " => " & value_name & " is wider than " & target_name & " and has non-sign bits in the extended MSB. " & msg, C_SCOPE);
+ end if;
+ end loop;
+ end if;
+ -- If value'length = target'length
+ elsif a_value'length = a_target'length then
+ v_normalised_value := a_value;
+ -- If value'length < target'length, add padding (leading zeros/ones) to value
+ elsif a_value'length < a_target'length then
+ if a_value(a_value'high) = '0' then -- positive value
+ v_normalised_value := (others => '0');
+ elsif a_value(a_value'high) = '1' then -- negative value
+ v_normalised_value := (others => '1');
+ end if;
+ v_normalised_value(a_value'length - 1 downto 0) := a_value;
+ -- Sanity check
+ if not (mode = ALLOW_NARROWER or mode = ALLOW_WIDER_NARROWER) then
+ tb_error(name & " => " & value_name & " is narrower than " & target_name & " without using ALLOW_NARROWER mode. " & msg, C_SCOPE);
+ end if;
+ end if;
+
+ return v_normalised_value;
+ end;
+
+ -- Wait until wait_time after rising_edge(clk)
+ procedure wait_until_given_time_after_rising_edge (
+ signal clk : in std_logic;
+ constant wait_time : in time
+ ) is
+ variable v_remaining_wait_time : time;
+ begin
+ -- If the time since the previous rising_edge is less than wait_time,
+ -- we don't have to wait until the next rising_edge,
+ -- only wait_time minus the time already passed since rising_edge
+ if (clk'last_event <= wait_time and -- less than wait_time has passed since last event
+ clk'last_value = '0' and clk = '1' -- last event was a rising_edge
+ ) then
+ v_remaining_wait_time := wait_time - clk'last_event; -- Wait until wait_time after rising_edge
+ else
+ wait until rising_edge(clk);
+ v_remaining_wait_time := wait_time; -- Wait until wait_time after rising_edge
+ end if;
+ wait for v_remaining_wait_time;
+ end;
+
+end package body bfm_common_pkg;
diff --git a/testsuite/gna/ticket89/project/src93/license_open_pkg.vhd b/testsuite/gna/ticket89/project/src93/license_open_pkg.vhd
new file mode 100644
index 0000000..c6979b4
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/license_open_pkg.vhd
@@ -0,0 +1,134 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : license_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+use std.textio.all;
+
+use work.types_pkg.all;
+use work.string_methods_pkg.all;
+use work.adaptations_pkg.all;
+
+package license_pkg is
+
+ impure function show_license(
+ constant dummy : in t_void
+ ) return boolean;
+
+ impure function show_bitvis_utility_library_info(
+ constant dummy : in t_void
+ ) return boolean;
+
+ impure function show_bitvis_utility_library_release_info(
+ constant dummy : in t_void
+ ) return boolean;
+
+end package license_pkg;
+
+package body license_pkg is
+
+
+
+ impure function show_license(
+ constant dummy : in t_void
+ ) return boolean is
+ constant C_VERSION : string := "v2.5.1"; -- June 2015
+ constant C_SEPARATOR : string :=
+ "=====================================================================================================";
+
+ constant C_LICENSE_STR : string :=
+ LF & LF & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF &
+ " Bitvis Utility Library " & C_VERSION & " is being used by this simulation." & LF &
+ " This is a *** LICENSED PRODUCT *** as given in the copyright notice of the VHDL code." & LF &
+ " The free license granted is subject to the conditions given in the VHDL copyright notice." & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF & LF;
+
+ begin
+ report (C_LICENSE_STR);
+ return true;
+ end;
+
+ impure function show_bitvis_utility_library_info(
+ constant dummy : in t_void
+ ) return boolean is
+ constant C_SEPARATOR : string :=
+ "=====================================================================================================";
+
+ constant C_LICENSE_STR : string :=
+ LF & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF &
+ "This info section may be turned off via C_SHOW_BITVIS_UTILITY_LIBRARY_INFO in adaptations_pkg.vhd" & LF & LF &
+ "Important Simulator setup: " & LF &
+ "- Set simulator to break on severity 'FAILURE' " & LF &
+ "- Set simulator transcript to a monospace font (e.g. Courier new)" & LF & LF &
+ "Bitvis Utility Library setup:" & LF &
+ "- It is recommended to go through the two powerpoint presentations provided with the download" & LF &
+ "- There is a Quick-Reference in the doc-directory" & LF &
+ "- In order to change layout or behaviour - please check the src*/adaptations_pkg.vhd" & LF &
+ " This is intended for personal or company customization" & LF & LF &
+ "License conditions are given in License.txt" & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF & LF;
+
+ begin
+ if C_SHOW_BITVIS_UTILITY_LIBRARY_INFO then
+ report (C_LICENSE_STR);
+ end if;
+ return true;
+ end;
+
+
+ impure function show_bitvis_utility_library_release_info(
+ constant dummy : in t_void
+ ) return boolean is
+ constant C_IMPORTANT_UPDATE_FOR_THIS_VERSION : boolean := true; -- ***** NOTE: Evaluate a change here
+ constant C_SEPARATOR : string :=
+ "=====================================================================================================";
+
+ constant C_LICENSE_STR : string :=
+ LF & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF &
+ "This release info may be turned off via C_SHOW_BITVIS_UTILITY_LIBRARY_RELEASE_INFO in adaptations_pkg.vhd" & LF & LF &
+ "Important Issues for this version update: " & LF &
+ "- Two procedures have changed name (see CHANGES.TXT)" & LF &
+ " The old names will still work for a few more version updates, but a deprecate-message will be displayed" & LF &
+ " (The deprecate-message may be turned off, but we recommend to rather change the actual procedure names)" & LF & LF &
+ C_SEPARATOR & LF &
+ C_SEPARATOR & LF & LF;
+
+ begin
+ if C_SHOW_BITVIS_UTILITY_LIBRARY_RELEASE_INFO and C_IMPORTANT_UPDATE_FOR_THIS_VERSION then
+ report (C_LICENSE_STR);
+ end if;
+ return true;
+ end;
+
+
+end package body license_pkg;
+
diff --git a/testsuite/gna/ticket89/project/src93/methods_pkg.vhd b/testsuite/gna/ticket89/project/src93/methods_pkg.vhd
new file mode 100644
index 0000000..98f7b4a
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/methods_pkg.vhd
@@ -0,0 +1,3808 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : methods_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.math_real.all;
+use ieee.numeric_std.all;
+use std.textio.all;
+
+use work.types_pkg.all;
+use work.string_methods_pkg.all;
+use work.adaptations_pkg.all;
+--use work.protected_types_pkg.all;
+use work.vhdl_version_layer_pkg.all;
+use work.license_pkg.all;
+
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.std_logic_1164_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+package methods_pkg is
+
+
+
+ -- Shared variables
+ shared variable shared_initialised_util : boolean := false;
+ shared variable shared_msg_id_panel : t_msg_id_panel := C_DEFAULT_MSG_ID_PANEL;
+ shared variable shared_log_file_name_is_set : boolean := false;
+ shared variable shared_alert_file_name_is_set : boolean := false;
+ shared variable shared_warned_time_stamp_trunc : boolean := false;
+ shared variable shared_alert_attention : t_alert_attention:= C_DEFAULT_ALERT_ATTENTION;
+ shared variable shared_stop_limit : t_alert_counters := C_DEFAULT_STOP_LIMIT;
+ shared variable shared_log_hdr_for_waveview : string(1 to C_LOG_HDR_FOR_WAVEVIEW_WIDTH);
+ shared variable shared_current_log_hdr : t_current_log_hdr;
+ shared variable shared_seed1 : positive;
+ shared variable shared_seed2 : positive;
+
+
+-- -- ============================================================================
+-- -- Initialisation and license
+-- -- ============================================================================
+-- procedure initialise_util(
+-- constant dummy : in t_void
+-- );
+--
+
+-- ============================================================================
+-- File handling (that needs to use other utility methods)
+-- ============================================================================
+ procedure check_file_open_status(
+ constant status : in file_open_status;
+ constant file_name : in string
+ );
+
+ procedure set_alert_file_name(
+ constant file_name : string := C_ALERT_FILE_NAME;
+ constant msg_id : t_msg_id := ID_UTIL_SETUP
+ );
+
+ procedure set_log_file_name(
+ constant file_name : string := C_LOG_FILE_NAME;
+ constant msg_id : t_msg_id := ID_UTIL_SETUP
+ );
+
+
+-- ============================================================================
+-- Log-related
+-- ============================================================================
+ procedure log(
+ msg_id : t_msg_id;
+ msg : string;
+ scope : string := C_TB_SCOPE_DEFAULT;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure log_text_block(
+ msg_id : t_msg_id;
+ variable text_block : inout line;
+ formatting : t_log_format; -- FORMATTED or UNFORMATTED
+ msg_header : string := "";
+ log_if_block_empty : t_log_if_block_empty := WRITE_HDR_IF_BLOCK_EMPTY;
+ scope : string := C_TB_SCOPE_DEFAULT;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ -- Enable and Disable do not have a Scope parameter as they are only allowed from main test sequencer
+ procedure enable_log_msg(
+ constant msg_id : t_msg_id;
+ variable msg_id_panel : inout t_msg_id_panel;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure enable_log_msg(
+ msg_id : t_msg_id;
+ msg : string := ""
+ ) ;
+ procedure disable_log_msg(
+ constant msg_id : t_msg_id;
+ variable msg_id_panel : inout t_msg_id_panel;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant quietness : t_quietness := NON_QUIET
+ );
+
+ procedure disable_log_msg(
+ msg_id : t_msg_id;
+ msg : string := "";
+ quietness : t_quietness := NON_QUIET
+ );
+
+ impure function is_log_msg_enabled(
+ msg_id : t_msg_id;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) return boolean;
+
+
+-- ============================================================================
+-- Alert-related
+-- ============================================================================
+ procedure alert(
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ -- Dedicated alert-procedures all alert levels (less verbose - as 2 rather than 3 parameters...)
+ procedure note(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure tb_note(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure warning(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure tb_warning(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure manual_check(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure error(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure tb_error(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure failure(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure tb_failure(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure increment_expected_alerts(
+ constant alert_level : t_alert_level;
+ constant number : natural := 1;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure report_alert_counters(
+ constant order : in t_order
+ );
+
+ procedure report_alert_counters(
+ constant dummy : in t_void
+ );
+
+ procedure report_global_ctrl(
+ constant dummy : in t_void
+ );
+
+ procedure report_msg_id_panel(
+ constant dummy : in t_void
+ );
+
+ procedure set_alert_attention(
+ alert_level : t_alert_level;
+ attention : t_attention;
+ msg : string := ""
+ );
+
+ impure function get_alert_attention(
+ alert_level : t_alert_level
+ ) return t_attention;
+
+ procedure set_alert_stop_limit(
+ alert_level : t_alert_level;
+ value : natural
+ );
+
+ impure function get_alert_stop_limit(
+ alert_level : t_alert_level
+ ) return natural;
+
+
+-- ============================================================================
+-- Deprecate message
+-- ============================================================================
+
+ procedure deprecate(
+ caller_name : string;
+ constant msg : string := ""
+ );
+
+
+-- ============================================================================
+-- Non time consuming checks
+-- ============================================================================
+
+ -- Matching if same width or only zeros in "extended width"
+ function matching_widths(
+ value1: std_logic_vector;
+ value2: std_logic_vector
+ ) return boolean;
+
+ function matching_widths(
+ value1: unsigned;
+ value2: unsigned
+ ) return boolean;
+
+ function matching_widths(
+ value1: signed;
+ value2: signed
+ ) return boolean;
+
+ -- function version of check_value (with return value)
+ impure function check_value(
+ constant value : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : boolean;
+ constant exp : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : std_logic;
+ constant exp : std_logic;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "slv"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : unsigned;
+ constant exp : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "unsigned"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : signed;
+ constant exp : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "signed"
+ ) return boolean ;
+
+
+ impure function check_value(
+ constant value : integer;
+ constant exp : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : time;
+ constant exp : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ impure function check_value(
+ constant value : string;
+ constant exp : string;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean ;
+
+ -- procedure version of check_value (no return value)
+ procedure check_value(
+ constant value : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ procedure check_value(
+ constant value : boolean;
+ constant exp : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ procedure check_value(
+ constant value : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "slv"
+ );
+
+ procedure check_value(
+ constant value : unsigned;
+ constant exp : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "unsigned"
+ );
+
+ procedure check_value(
+ constant value : signed;
+ constant exp : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "signed"
+ );
+
+
+ procedure check_value(
+ constant value : std_logic;
+ constant exp : std_logic;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ procedure check_value(
+ constant value : integer;
+ constant exp : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ procedure check_value(
+ constant value : time;
+ constant exp : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ procedure check_value(
+ constant value : string;
+ constant exp : string;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ );
+
+ -- Check_value_in_range
+ impure function check_value_in_range (
+ constant value : integer;
+ constant min_value : integer;
+ constant max_value : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "integer"
+ ) return boolean;
+
+ impure function check_value_in_range (
+ constant value : unsigned;
+ constant min_value : unsigned;
+ constant max_value : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "unsigned"
+ ) return boolean;
+
+ impure function check_value_in_range (
+ constant value : signed;
+ constant min_value : signed;
+ constant max_value : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "signed"
+ ) return boolean;
+
+ impure function check_value_in_range (
+ constant value : time;
+ constant min_value : time;
+ constant max_value : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) return boolean;
+
+ impure function check_value_in_range (
+ constant value : real;
+ constant min_value : real;
+ constant max_value : real;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) return boolean;
+
+ -- Procedure overloads for check_value_in_range
+ procedure check_value_in_range (
+ constant value : integer;
+ constant min_value : integer;
+ constant max_value : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ );
+
+ procedure check_value_in_range (
+ constant value : unsigned;
+ constant min_value : unsigned;
+ constant max_value : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ );
+
+ procedure check_value_in_range (
+ constant value : signed;
+ constant min_value : signed;
+ constant max_value : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ );
+
+ procedure check_value_in_range (
+ constant value : time;
+ constant min_value : time;
+ constant max_value : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ );
+
+ procedure check_value_in_range (
+ constant value : real;
+ constant min_value : real;
+ constant max_value : real;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ );
+
+ -- Check_stable
+ procedure check_stable(
+ signal target : boolean;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "boolean"
+ );
+
+ procedure check_stable(
+ signal target : std_logic_vector;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "slv"
+ );
+
+ procedure check_stable(
+ signal target : unsigned;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "unsigned"
+ );
+
+ procedure check_stable(
+ signal target : signed;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "signed"
+ );
+
+ procedure check_stable(
+ signal target : std_logic;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "std_logic"
+ );
+
+ procedure check_stable(
+ signal target : integer;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "integer"
+ );
+
+ impure function random (
+ constant length : integer
+ ) return std_logic_vector;
+
+ impure function random (
+ constant VOID : t_void
+ ) return std_logic;
+
+ impure function random (
+ constant min_value : integer;
+ constant max_value : integer
+ ) return integer;
+
+ impure function random (
+ constant min_value : real;
+ constant max_value : real
+ ) return real;
+
+ impure function random (
+ constant min_value : time;
+ constant max_value : time
+ ) return time;
+
+ procedure random (
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout std_logic_vector
+ );
+
+ procedure random (
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout std_logic
+ );
+
+ procedure random (
+ constant min_value : integer;
+ constant max_value : integer;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout integer
+ );
+
+ procedure random (
+ constant min_value : real;
+ constant max_value : real;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout real
+ );
+
+ procedure random (
+ constant min_value : time;
+ constant max_value : time;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout time
+ );
+
+ procedure randomize (
+ constant seed1 : positive;
+ constant seed2 : positive;
+ constant msg : string := "randomizing seeds";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+ procedure randomise (
+ constant seed1 : positive;
+ constant seed2 : positive;
+ constant msg : string := "randomising seeds";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ );
+
+-- ============================================================================
+-- Time consuming checks
+-- ============================================================================
+
+ procedure await_change(
+ signal target : boolean;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "boolean"
+ );
+
+ procedure await_change(
+ signal target : std_logic;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "std_logic"
+ );
+
+ procedure await_change(
+ signal target : std_logic_vector;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "slv"
+ );
+
+ procedure await_change(
+ signal target : unsigned;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "unsigned"
+ );
+
+ procedure await_change(
+ signal target : signed;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "signed"
+ );
+
+ procedure await_change(
+ signal target : integer;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "integer"
+ );
+
+ procedure await_value (
+ signal target : boolean;
+ constant exp : boolean;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_value (
+ signal target : std_logic;
+ constant exp : std_logic;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_value (
+ signal target : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_value (
+ signal target : unsigned;
+ constant exp : unsigned;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_value (
+ signal target : signed;
+ constant exp : signed;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_value (
+ signal target : integer;
+ constant exp : integer;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : boolean;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : std_logic;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : std_logic_vector;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : unsigned;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : signed;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure await_stable (
+ signal target : integer;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ constant pulse_duration : time;
+ constant blocking_mode : t_blocking_mode;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ constant pulse_duration : time;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ signal clock_signal : std_logic;
+ constant num_periods : natural;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure gen_pulse(
+ signal target : inout std_logic_vector;
+ constant pulse_value : std_logic_vector;
+ signal clock_signal : std_logic;
+ constant num_periods : natural;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ );
+
+ procedure clock_generator(
+ signal clock_signal : inout std_logic;
+ constant clock_period : in time
+ );
+
+ -- Overloaded version with additional arguments
+ procedure clock_generator(
+ signal clock_signal : inout std_logic;
+ signal clock_ena : in boolean;
+ constant clock_period : in time;
+ constant clock_name : in string
+ );
+
+ procedure deallocate_line_if_exists(
+ variable line_to_be_deallocated : inout line
+ );
+
+end package methods_pkg;
+
+
+--=================================================================================================
+--=================================================================================================
+--=================================================================================================
+
+package body methods_pkg is
+
+ constant C_BURIED_SCOPE : string := "(Util buried)";
+
+ -- The following constants are not used. Report statements in the given functions allow elaboration time messages
+ constant C_BITVIS_LICENSE_INITIALISED : boolean := show_license(VOID);
+ constant C_BITVIS_LIBRARY_INFO_SHOWN : boolean := show_bitvis_utility_library_info(VOID);
+ constant C_BITVIS_LIBRARY_RELEASE_INFO_SHOWN : boolean := show_bitvis_utility_library_release_info(VOID);
+
+
+-- ============================================================================
+-- Initialisation and license
+-- ============================================================================
+
+-- -- Executed a single time ONLY
+-- procedure pot_show_license(
+-- constant dummy : in t_void
+-- ) is
+-- begin
+-- if not shared_license_shown then
+-- show_license(v_trial_license);
+-- shared_license_shown := true;
+-- end if;
+-- end;
+
+-- -- Executed a single time ONLY
+-- procedure initialise_util(
+-- constant dummy : in t_void
+-- ) is
+-- begin
+-- set_log_file_name(C_LOG_FILE_NAME);
+-- set_alert_file_name(C_ALERT_FILE_NAME);
+-- shared_license_shown.set(1);
+-- shared_initialised_util.set(true);
+-- end;
+
+ procedure pot_initialise_util(
+ constant dummy : in t_void
+ ) is
+ begin
+ if not shared_initialised_util then
+ shared_initialised_util := true;
+ if not shared_log_file_name_is_set then
+ set_log_file_name(C_LOG_FILE_NAME, ID_NEVER);
+ end if;
+ if not shared_alert_file_name_is_set then
+ set_alert_file_name(C_ALERT_FILE_NAME, ID_NEVER);
+ end if;
+ --show_license(VOID);
+-- if C_SHOW_BITVIS_UTILITY_LIBRARY_INFO then
+-- show_bitvis_utility_library_info(VOID);
+-- end if;
+-- if C_SHOW_BITVIS_UTILITY_LIBRARY_RELEASE_INFO then
+-- show_bitvis_utility_library_release_info(VOID);
+-- end if;
+ end if;
+ end;
+
+ procedure deallocate_line_if_exists(
+ variable line_to_be_deallocated : inout line
+ ) is
+ begin
+ if line_to_be_deallocated /= NULL then
+ deallocate(line_to_be_deallocated);
+ end if;
+ end procedure deallocate_line_if_exists;
+
+
+
+-- ============================================================================
+-- File handling (that needs to use other utility methods)
+-- ============================================================================
+ procedure check_file_open_status(
+ constant status : in file_open_status;
+ constant file_name : in string
+ ) is
+ begin
+ case status is
+ when open_ok =>
+ null; --**** logmsg (if log is open for write)
+ when status_error =>
+ alert(tb_warning, "File: " & file_name & " is already open", "SCOPE_TBD");
+ when name_error =>
+ alert(tb_error, "Cannot create file: " & file_name, "SCOPE TBD");
+ when mode_error =>
+ alert(tb_error, "File: " & file_name & " exists, but cannot be opened in write mode", "SCOPE TBD");
+ end case;
+ end;
+
+ procedure set_alert_file_name(
+ constant file_name : string := C_ALERT_FILE_NAME;
+ constant msg_id : t_msg_id := ID_UTIL_SETUP
+ ) is
+ variable v_file_open_status: file_open_status;
+ begin
+ if not shared_alert_file_name_is_set then
+ shared_alert_file_name_is_set := true;
+ file_close(ALERT_FILE);
+ file_open(v_file_open_status, ALERT_FILE, file_name, write_mode);
+ check_file_open_status(v_file_open_status, file_name);
+
+ if now > 0 ns then -- Do not show note if set at the very start.
+ -- NOTE: We should usually use log() instead of report. However,
+ -- in this case, there is an issue with log() initialising
+ -- the log file and therefore blocking subsequent set_log_file_name().
+ report "alert file name set: " & file_name;
+ end if;
+ else
+ warning("alert file name already set - or set too late");
+ end if;
+ end;
+
+ procedure set_log_file_name(
+ constant file_name : string := C_LOG_FILE_NAME;
+ constant msg_id : t_msg_id := ID_UTIL_SETUP
+ ) is
+ variable v_file_open_status: file_open_status;
+ begin
+ if not shared_log_file_name_is_set then
+ shared_log_file_name_is_set := true;
+ file_close(LOG_FILE);
+ file_open(v_file_open_status, LOG_FILE, file_name, write_mode);
+ check_file_open_status(v_file_open_status, file_name);
+
+ if now > 0 ns then -- Do not show note if set at the very start.
+ -- NOTE: We should usually use log() instead of report. However,
+ -- in this case, there is an issue with log() initialising
+ -- the alert file and therefore blocking subsequent set_alert_file_name().
+ report "log file name set: " & file_name;
+ end if;
+ else
+ warning("log file name already set - or set too late");
+ end if;
+ end;
+
+
+-- ============================================================================
+-- Log-related
+-- ============================================================================
+ impure function align_log_time(
+ value : time
+ ) return string is
+ variable v_line : line;
+ variable v_value_width : natural;
+ variable v_result : string(1 to 50); -- sufficient for any relevant time value
+ variable v_result_width : natural;
+ variable v_delimeter_pos : natural;
+ variable v_time_number_width : natural;
+ variable v_time_width : natural;
+ variable v_num_initial_blanks : integer;
+ variable v_found_decimal_point : boolean;
+ begin
+ -- 1. Store normal write (to string) and note width
+ write(v_line, value, LEFT, 0, C_LOG_TIME_BASE); -- required as width is unknown
+ v_value_width := v_line'length;
+ v_result(1 to v_value_width) := v_line.all;
+ deallocate(v_line);
+
+ -- 2. Search for decimal point or space between number and unit
+ v_found_decimal_point := true; -- default
+ v_delimeter_pos := pos_of_leftmost('.', v_result(1 to v_value_width), 0);
+ if v_delimeter_pos = 0 then -- No decimal point found
+ v_found_decimal_point := false;
+ v_delimeter_pos := pos_of_leftmost(' ', v_result(1 to v_value_width), 0);
+ end if;
+
+ -- Potentially alert if time stamp is truncated.
+ if C_LOG_TIME_TRUNC_WARNING then
+ if not shared_warned_time_stamp_trunc then
+ if (C_LOG_TIME_DECIMALS < (v_value_width - 3 - v_delimeter_pos)) THEN
+ alert(TB_WARNING, "Time stamp has been truncated to " & to_string(C_LOG_TIME_DECIMALS) &
+ " decimal(s) in the next log message - settable in adaptations_pkg." &
+ " (Actual time stamp has more decimals than displayed) " &
+ "\nThis alert is shown once only.",
+ C_BURIED_SCOPE);
+ shared_warned_time_stamp_trunc := true;
+ end if;
+ end if;
+ end if;
+
+ -- 3. Derive Time number (integer or real)
+ if C_LOG_TIME_DECIMALS = 0 then
+ v_time_number_width := v_delimeter_pos - 1;
+ -- v_result as is
+ else -- i.e. a decimal value is required
+ if v_found_decimal_point then
+ v_result(v_value_width - 2 to v_result'right) := (others => '0'); -- Zero extend
+ else -- Shift right after integer part and add point
+ v_result(v_delimeter_pos + 1 to v_result'right) := v_result(v_delimeter_pos to v_result'right - 1);
+ v_result(v_delimeter_pos) := '.';
+ v_result(v_value_width - 1 to v_result'right) := (others => '0'); -- Zero extend
+ end if;
+ v_time_number_width := v_delimeter_pos + C_LOG_TIME_DECIMALS;
+ end if;
+
+ -- 4. Add time unit for full time specification
+ v_time_width := v_time_number_width + 3;
+ if C_LOG_TIME_BASE = ns then
+ v_result(v_time_number_width + 1 to v_time_width) := " ns";
+ else
+ v_result(v_time_number_width + 1 to v_time_width) := " ps";
+ end if;
+
+ -- 5. Prefix
+ v_num_initial_blanks := maximum(0, (C_LOG_TIME_WIDTH - v_time_width));
+ if v_num_initial_blanks > 0 then
+ v_result(v_num_initial_blanks + 1 to v_result'right) := v_result(1 to v_result'right - v_num_initial_blanks);
+ v_result(1 to v_num_initial_blanks) := fill_string(' ', v_num_initial_blanks);
+ v_result_width := C_LOG_TIME_WIDTH;
+ else
+ -- v_result as is
+ v_result_width := v_time_width;
+ end if;
+ return v_result(1 to v_result_width);
+ end function align_log_time;
+
+ -- Writes Line to a file without modifying the contents of the line
+ -- Not yet available in VHDL
+ procedure tee (
+ file file_handle : text;
+ variable my_line : inout line
+ ) is
+ variable v_line : line;
+ begin
+ write (v_line, my_line.all & lf);
+ writeline(file_handle, v_line);
+ end procedure tee;
+
+
+
+ procedure log(
+ msg_id : t_msg_id;
+ msg : string;
+ scope : string := C_TB_SCOPE_DEFAULT;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel -- compatible with old code
+ ) is
+ variable v_msg : line;
+ variable v_msg_indent : line;
+ variable v_msg_indent_width : natural;
+ variable v_info : line;
+ variable v_info_final : line;
+ variable v_log_msg_id : string(1 to C_LOG_MSG_ID_WIDTH);
+ variable v_log_scope : string(1 to C_LOG_SCOPE_WIDTH);
+ variable v_log_pre_msg_width : natural;
+ begin
+ -- Check if message ID is enabled
+ if (msg_id_panel(msg_id) = ENABLED) then
+ pot_initialise_util(VOID); -- Only executed the first time called
+
+ -- Prepare strings for msg_id and scope
+ v_log_msg_id := to_upper(justify(to_string(msg_id), C_LOG_MSG_ID_WIDTH, LEFT, TRUNCATE));
+ if (scope = "") then
+ v_log_scope := justify("(non scoped)", C_LOG_SCOPE_WIDTH, LEFT, TRUNCATE);
+ else
+ v_log_scope := justify(scope, C_LOG_SCOPE_WIDTH, LEFT, TRUNCATE);
+ end if;
+
+ -- Handle actual log info line
+ -- First write all fields preceeding the actual message - in order to measure their width
+ -- (Prefix is taken care of later)
+ write(v_info,
+ return_string_if_true(v_log_msg_id, global_show_log_id) & -- Optional
+ " " & align_log_time(now) & " " &
+ return_string_if_true(v_log_scope, global_show_log_scope) & " "); -- Optional
+ v_log_pre_msg_width := v_info'length; -- Width of string preceeding the actual message
+ -- Handle \r as potential initial open line
+ if msg'length > 1 then
+ if (msg(1 to 2) = "\r") then
+ write(v_info_final, LF); -- Start transcript with an empty line
+ write(v_msg, remove_initial_chars(msg, 2));
+ else
+ write(v_msg, msg);
+ end if;
+ end if;
+
+ -- Handle dedicated ID indentation.
+ write(v_msg_indent, to_string(C_MSG_ID_INDENT(msg_id)));
+ v_msg_indent_width := v_msg_indent'length;
+ write(v_info, v_msg_indent.all);
+ deallocate_line_if_exists(v_msg_indent);
+
+ -- Then add the message it self (after replacing \n with LF
+ if msg'length > 1 then
+ write(v_info, replace_backslash_n_with_lf(v_msg.all));
+ end if;
+ deallocate_line_if_exists(v_msg);
+
+ if not C_SINGLE_LINE_LOG then
+ -- Modify and align info-string if additional lines are required (after wrapping lines)
+ wrap_lines(v_info, 1, v_log_pre_msg_width + v_msg_indent_width + 1, C_LOG_LINE_WIDTH-C_LOG_PREFIX_WIDTH);
+ else
+ -- Remove line feed character if
+ -- single line log/alert enabled
+ replace(v_info, LF, ' ');
+ end if;
+
+ -- Handle potential log header by including info-lines inside the log header format and update of waveview header.
+ if (msg_id = ID_LOG_HDR) then
+ write(v_info_final, LF & LF);
+ -- also update the Log header string
+ shared_current_log_hdr.normal := justify(msg, C_LOG_HDR_FOR_WAVEVIEW_WIDTH, LEFT, TRUNCATE);
+ shared_log_hdr_for_waveview := justify(msg, C_LOG_HDR_FOR_WAVEVIEW_WIDTH, LEFT, TRUNCATE);
+ elsif (msg_id = ID_LOG_HDR_LARGE) then
+ write(v_info_final, LF & LF);
+ shared_current_log_hdr.large := justify(msg, C_LOG_HDR_FOR_WAVEVIEW_WIDTH, LEFT, TRUNCATE);
+ write(v_info_final, fill_string('=', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)) & LF);
+ elsif (msg_id = ID_LOG_HDR_XL) then
+ write(v_info_final, LF & LF);
+ shared_current_log_hdr.xl := justify(msg, C_LOG_HDR_FOR_WAVEVIEW_WIDTH, LEFT, TRUNCATE);
+ write(v_info_final, LF & fill_string('#', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH))& LF & LF);
+ end if;
+
+ write(v_info_final, v_info.all); -- include actual info
+ deallocate_line_if_exists(v_info);
+ -- Handle rest of potential log header
+ if (msg_id = ID_LOG_HDR) then
+ write(v_info_final, LF & fill_string('-', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)));
+ elsif (msg_id = ID_LOG_HDR_LARGE) then
+ write(v_info_final, LF & fill_string('=', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)));
+ elsif (msg_id = ID_LOG_HDR_XL) then
+ write(v_info_final, LF & LF & fill_string('#', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)) & LF & LF);
+ end if;
+
+ -- Add prefix to all lines
+ prefix_lines(v_info_final);
+
+ -- Write the info string to the target file
+ tee(OUTPUT, v_info_final); -- write to transcript, while keeping the line contents
+ writeline(LOG_FILE, v_info_final);
+ end if;
+ end;
+
+
+ -- Logging for multi line text
+ procedure log_text_block(
+ msg_id : t_msg_id;
+ variable text_block : inout line;
+ formatting : t_log_format; -- FORMATTED or UNFORMATTED
+ msg_header : string := "";
+ log_if_block_empty : t_log_if_block_empty := WRITE_HDR_IF_BLOCK_EMPTY;
+ scope : string := C_TB_SCOPE_DEFAULT;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ variable v_text_block_empty_note : string(1 to 26) := "Note: Text block was empty";
+ variable v_header_line : line;
+ variable v_log_body : line;
+ variable v_text_block_is_empty : boolean;
+ begin
+ -- Check if message ID is enabled
+ if (msg_id_panel(msg_id) = ENABLED) then
+ pot_initialise_util(VOID); -- Only executed the first time called
+
+ v_text_block_is_empty := (text_block = NULL);
+
+ if(formatting = UNFORMATTED) then
+ if(not v_text_block_is_empty) then
+ -- Write the info string to the target file without any header, footer or indentation
+ tee(OUTPUT, text_block); -- write to transcript, while keeping the line contents
+ writeline(LOG_FILE, text_block);
+ end if;
+ elsif not (v_text_block_is_empty and (log_if_block_empty = SKIP_LOG_IF_BLOCK_EMPTY)) then
+
+ -- Add and print header
+ write(v_header_line, LF & LF & fill_string('*', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)));
+ prefix_lines(v_header_line);
+ tee(OUTPUT, v_header_line); -- write to transcript, while keeping the line contents
+ writeline(LOG_FILE, v_header_line);
+
+ -- Print header using log function
+ log(msg_id, msg_header, scope, msg_id_panel);
+
+ -- Print header underline, body and footer
+ write(v_log_body, fill_string('-', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)) & LF);
+ if v_text_block_is_empty then
+ if log_if_block_empty = NOTIFY_IF_BLOCK_EMPTY then
+ write(v_log_body, v_text_block_empty_note); -- Notify that the text block was empty
+ end if;
+ else
+ write(v_log_body, text_block.all); -- include input text
+ end if;
+ write(v_log_body, LF & fill_string('*', (C_LOG_LINE_WIDTH - C_LOG_PREFIX_WIDTH)) & LF);
+ prefix_lines(v_log_body);
+ tee(OUTPUT, v_log_body); -- write to transcript, while keeping the line contents
+ writeline(LOG_FILE, v_log_body);
+ end if;
+ end if;
+ end;
+
+ procedure enable_log_msg(
+ constant msg_id : t_msg_id;
+ variable msg_id_panel : inout t_msg_id_panel;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ case msg_id is
+ when ID_NEVER =>
+ null; -- Shall not be possible to enable
+ log(ID_LOG_MSG_CTRL, "enable_log_msg() ignored for " & to_string(msg_id) & ". (Not allowed)" & msg, scope);
+ when ALL_MESSAGES =>
+ for i in t_msg_id'left to t_msg_id'right loop
+ msg_id_panel(i) := ENABLED;
+ end loop;
+ msg_id_panel(ID_NEVER) := DISABLED;
+ log(ID_LOG_MSG_CTRL, "enable_log_msg(" & to_string(msg_id) & "). " & msg, scope);
+ when others =>
+ msg_id_panel(msg_id) := ENABLED;
+ log(ID_LOG_MSG_CTRL, "enable_log_msg(" & to_string(msg_id) & "). " & msg, scope);
+ end case;
+ end;
+
+ procedure enable_log_msg(
+ msg_id : t_msg_id;
+ msg : string := ""
+ ) is
+ begin
+ enable_log_msg(msg_id, shared_msg_id_panel, msg);
+ end;
+
+ procedure disable_log_msg(
+ constant msg_id : t_msg_id;
+ variable msg_id_panel : inout t_msg_id_panel;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant quietness : t_quietness := NON_QUIET
+ ) is
+ begin
+ case msg_id is
+ when ALL_MESSAGES =>
+ if quietness = NON_QUIET then
+ log(ID_LOG_MSG_CTRL, "disable_log_msg(" & to_string(msg_id) & "). " & msg, scope);
+ end if;
+ for i in t_msg_id'left to t_msg_id'right loop
+ msg_id_panel(i) := DISABLED;
+ end loop;
+ when others =>
+ msg_id_panel(msg_id) := DISABLED;
+ if quietness = NON_QUIET then
+ log(ID_LOG_MSG_CTRL, "disable_log_msg(" & to_string(msg_id) & "). " & msg, scope);
+ end if;
+ end case;
+ end;
+
+ procedure disable_log_msg(
+ msg_id : t_msg_id;
+ msg : string := "";
+ quietness : t_quietness := NON_QUIET
+ ) is
+ begin
+ disable_log_msg(msg_id, shared_msg_id_panel, msg, C_TB_SCOPE_DEFAULT, quietness);
+ end;
+
+ impure function is_log_msg_enabled(
+ msg_id : t_msg_id;
+ msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) return boolean is
+ begin
+ if msg_id_panel(msg_id) = ENABLED then
+ return true;
+ else
+ return false;
+ end if;
+ end;
+
+
+
+
+-- ============================================================================
+-- Alert-related
+-- ============================================================================
+ procedure alert(
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ variable v_msg : line; -- msg after pot. replacement of \n
+ variable v_info : line;
+ begin
+ pot_initialise_util(VOID); -- Only executed the first time called
+
+ write(v_msg, replace_backslash_n_with_lf(msg));
+
+ -- 1. Increase relevant alert counter. Exit if ignore is set for this alert type.
+ if get_alert_attention(alert_level) = IGNORE then
+-- protected_alert_counters.increment(alert_level, IGNORE);
+ increment_alert_counter(alert_level, IGNORE);
+ else
+ --protected_alert_counters.increment(alert_level, REGARD);
+ increment_alert_counter(alert_level, REGARD);
+
+ -- 2. Write first part of alert message
+ -- Serious alerts need more attention - thus more space and lines
+ if (alert_level > MANUAL_CHECK) then
+ write(v_info, LF & fill_string('=', C_LOG_INFO_WIDTH));
+ end if;
+
+ write(v_info, LF & "*** ");
+
+ -- 3. Remove line feed character (LF)
+ -- if single line alert enabled.
+ if not C_SINGLE_LINE_ALERT then
+ write(v_info, to_upper(to_string(alert_level)) & " #" & to_string(get_alert_counter(alert_level)) & " ***" & LF &
+ justify( to_string(now, C_LOG_TIME_BASE), C_LOG_TIME_WIDTH, RIGHT) & " " & scope & LF &
+ wrap_lines(v_msg.all, C_LOG_TIME_WIDTH + 4, C_LOG_TIME_WIDTH + 4, C_LOG_INFO_WIDTH));
+ else
+ replace(v_msg, LF, ' ');
+ write(v_info, to_upper(to_string(alert_level)) & " #" & to_string(get_alert_counter(alert_level)) & " ***" &
+ justify( to_string(now, C_LOG_TIME_BASE), C_LOG_TIME_WIDTH, RIGHT) & " " & scope &
+ " " & v_msg.all);
+ end if;
+ deallocate_line_if_exists(v_msg);
+
+ -- 4. Write stop message if stop-limit is reached for number of this alert
+ if (get_alert_stop_limit(alert_level) /= 0) and
+ (get_alert_counter(alert_level) >= get_alert_stop_limit(alert_level)) then
+ write(v_info, LF & LF & "Simulator has been paused as requested after " &
+ to_string(get_alert_counter(alert_level)) & " " &
+ to_string(alert_level) & LF);
+ if (alert_level = MANUAL_CHECK) then
+ write(v_info, "Carry out above check." & LF &
+ "Then continue simulation from within simulator." & LF);
+ else
+ write(v_info, string'("*** To find the root cause of this alert, " &
+ "step out the HDL calling stack in your simulator. ***" & LF &
+ "*** For example, step out until you reach the call from the test sequencer. ***"));
+ end if;
+ end if;
+
+ -- 5. Write last part of alert message
+ if (alert_level > MANUAL_CHECK) then
+ write(v_info, LF & fill_string('=', C_LOG_INFO_WIDTH) & LF & LF);
+ else
+ write(v_info, LF);
+ end if;
+
+ prefix_lines(v_info);
+ tee(OUTPUT, v_info);
+ tee(ALERT_FILE, v_info);
+ writeline(LOG_FILE, v_info);
+
+ -- 6. Stop simulation if stop-limit is reached for number of this alert
+ if (get_alert_stop_limit(alert_level) /= 0) then
+ if (get_alert_counter(alert_level) >= get_alert_stop_limit(alert_level)) then
+ assert false
+ report "This single Failure line has been provoked to stop the simulation. See alert-message above"
+ severity failure;
+ end if;
+ end if;
+ end if;
+ end;
+
+ -- Dedicated alert-procedures all alert levels (less verbose - as 2 rather than 3 parameters...)
+ procedure note(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(note, msg, scope);
+ end;
+
+ procedure tb_note(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(tb_note, msg, scope);
+ end;
+
+ procedure warning(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(warning, msg, scope);
+ end;
+
+ procedure tb_warning(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(tb_warning, msg, scope);
+ end;
+
+ procedure manual_check(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(manual_check, msg, scope);
+ end;
+
+ procedure error(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(error, msg, scope);
+ end;
+
+ procedure tb_error(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(tb_error, msg, scope);
+ end;
+
+ procedure failure(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(failure, msg, scope);
+ end;
+
+ procedure tb_failure(
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ alert(tb_failure, msg, scope);
+ end;
+
+ procedure increment_expected_alerts(
+ constant alert_level : t_alert_level;
+ constant number : natural := 1;
+ constant msg : string := "";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ increment_alert_counter(alert_level, EXPECT, number);
+ log(ID_UTIL_SETUP, "incremented expected " & to_string(alert_level) & "s by " & to_string(number) & ". " & msg, scope);
+ end;
+
+ -- Arguments:
+ -- - order = FINAL : print out Simulation Success/Fail
+ procedure report_alert_counters(
+ constant order : in t_order
+ ) is
+ begin
+ work.vhdl_version_layer_pkg.report_alert_counters(order);
+ pot_initialise_util(VOID); -- Only executed the first time called
+ end;
+
+ -- This version (with the t_void argument) is kept for backwards compatibility
+ procedure report_alert_counters(
+ constant dummy : in t_void
+ ) is
+ begin
+ work.vhdl_version_layer_pkg.report_alert_counters(FINAL); -- Default when calling this old method is order=FINAL
+ pot_initialise_util(VOID); -- Only executed the first time called
+ end;
+
+ procedure report_global_ctrl(
+ constant dummy : in t_void
+ ) is
+ constant prefix : string := C_LOG_PREFIX & " ";
+ variable v_line : line;
+ begin
+ pot_initialise_util(VOID); -- Only executed the first time called
+ write(v_line,
+ LF &
+ fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ "*** REPORT OF GLOBAL CTRL ***" & LF &
+ fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ " IGNORE STOP_LIMIT " & LF);
+ for i in t_alert_level'left to t_alert_level'right loop
+ write(v_line, " " & to_upper(to_string(i, 13, LEFT)) & ": "); -- Severity
+
+ write(v_line, to_string(get_alert_attention(i), 7, RIGHT) & " "); -- column 1
+ write(v_line, to_string(integer'(get_alert_stop_limit(i)), 6, RIGHT) & " " & LF); -- column 2
+ end loop;
+ write(v_line, fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF);
+
+ wrap_lines(v_line, 1, 1, C_LOG_LINE_WIDTH-prefix'length);
+ prefix_lines(v_line, prefix);
+
+ -- Write the info string to the target file
+ tee(OUTPUT, v_line);
+ writeline(LOG_FILE, v_line);
+
+ end;
+
+ procedure report_msg_id_panel(
+ constant dummy : in t_void
+ ) is
+ constant prefix : string := C_LOG_PREFIX & " ";
+ variable v_line : line;
+ begin
+ write(v_line,
+ LF &
+ fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ "*** REPORT OF MSG ID PANEL ***" & LF &
+ fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ " " & justify("ID", C_LOG_MSG_ID_WIDTH, LEFT) & " Status" & LF &
+ " " & fill_string('-', C_LOG_MSG_ID_WIDTH) & " ------" & LF);
+ for i in t_msg_id'left to t_msg_id'right loop
+ if (i /= ID_NEVER) then -- report all but ID_NEVER
+ write(v_line, " " & to_upper(to_string(i, C_LOG_MSG_ID_WIDTH+5, LEFT)) & ": "); -- MSG_ID
+ write(v_line,to_string(shared_msg_id_panel(i)) & " " & LF); -- Enabled/disabled
+ end if;
+ end loop;
+ write(v_line, fill_string('-', (C_LOG_LINE_WIDTH - prefix'length)) & LF);
+
+ wrap_lines(v_line, 1, 1, C_LOG_LINE_WIDTH-prefix'length);
+ prefix_lines(v_line, prefix);
+
+ -- Write the info string to the target file
+ tee(OUTPUT, v_line);
+ writeline(LOG_FILE, v_line);
+
+ end;
+
+ procedure set_alert_attention(
+ alert_level : t_alert_level;
+ attention : t_attention;
+ msg : string := ""
+ ) is
+ begin
+ check_value(attention = IGNORE or attention = REGARD, TB_WARNING,
+ "set_alert_attention only supported for IGNORE and REGARD", C_BURIED_SCOPE, ID_NEVER);
+ shared_alert_attention(alert_level) := attention;
+ log(ID_ALERT_CTRL, "set_alert_attention(" & to_string(alert_level) & ", " & to_string(attention) & "). " & msg);
+
+ end;
+
+ impure function get_alert_attention(
+ alert_level : t_alert_level
+ ) return t_attention is
+ begin
+ return shared_alert_attention(alert_level);
+ end;
+
+ procedure set_alert_stop_limit(
+ alert_level : t_alert_level;
+ value : natural
+ ) is
+ begin
+ shared_stop_limit(alert_level) := value;
+
+ -- Evaluate new stop limit in case it is less than or equal to the current alert counter for this alert level
+ -- If that is the case, a new alert with the same alert level shall be triggered.
+ if (get_alert_stop_limit(alert_level) /= 0) and
+ (get_alert_counter(alert_level) >= get_alert_stop_limit(alert_level)) then
+ alert(alert_level, "Alert stop limit for " & to_string(alert_level) & " set to " & to_string(value) &
+ ", which is lower than the current " & to_string(alert_level) & " count (" & to_string(get_alert_counter(alert_level)) & ").");
+ end if;
+ end;
+
+ impure function get_alert_stop_limit(
+ alert_level : t_alert_level
+ ) return natural is
+ begin
+ return shared_stop_limit(alert_level);
+ end;
+
+-- ============================================================================
+-- Deprecation message
+-- ============================================================================
+
+ procedure deprecate(
+ caller_name : string;
+ constant msg : string := ""
+ ) is
+ variable v_found : boolean;
+ begin
+ v_found := false;
+ if C_DEPRECATE_SETTING /= NO_DEPRECATE then -- only perform if deprecation enabled
+ l_find_caller_name_in_list:
+ for i in deprecated_subprogram_list'range loop
+ if deprecated_subprogram_list(i) = justify(caller_name, 100) then
+ v_found := true;
+ exit l_find_caller_name_in_list;
+ end if;
+ end loop;
+
+ if v_found then
+ -- Has already been printed.
+ if C_DEPRECATE_SETTING = ALWAYS_DEPRECATE then
+ log(ID_SEQUENCER, "Sub-program " & caller_name & " is outdated and has been replaced by another sub-program." & LF & msg);
+ else -- C_DEPRECATE_SETTING = DEPRECATE_ONCE
+ null;
+ end if;
+ else
+ -- Has not been printed yet.
+ l_insert_caller_name_in_first_available:
+ for i in deprecated_subprogram_list'range loop
+ if deprecated_subprogram_list(i) = justify("", 100) then
+ deprecated_subprogram_list(i) := justify(caller_name, 100);
+ exit l_insert_caller_name_in_first_available;
+ end if;
+ end loop;
+
+ log(ID_SEQUENCER, "Sub-program " & caller_name & " is outdated and has been replaced by another sub-program." & LF & msg);
+ end if;
+ end if;
+ end;
+
+-- ============================================================================
+-- Non time consuming checks
+-- ============================================================================
+
+ -- NOTE: Index in range N downto 0, with -1 meaning not found
+ function idx_leftmost_p1_in_p2(
+ target : std_logic;
+ vector : std_logic_vector
+ ) return integer is
+ alias a_vector : std_logic_vector(vector'length - 1 downto 0) is vector;
+ constant result_if_not_found : integer := -1; -- To indicate not found
+ begin
+ bitvis_assert(vector'length > 0, ERROR, "idx_leftmost_p1_in_p2()", "String input is empty");
+ for i in a_vector'left downto a_vector'right loop
+ if (a_vector(i) = target) then
+ return i;
+ end if;
+ end loop;
+ return result_if_not_found;
+ end;
+
+ -- Matching if same width or only zeros in "extended width"
+ function matching_widths(
+ value1: std_logic_vector;
+ value2: std_logic_vector
+ ) return boolean is
+ -- Normalize vectors to (N downto 0)
+ alias a_value1: std_logic_vector(value1'length - 1 downto 0) is value1;
+ alias a_value2: std_logic_vector(value2'length - 1 downto 0) is value2;
+
+ begin
+ if (a_value1'left >= maximum( idx_leftmost_p1_in_p2('1', a_value2), 0)) and
+ (a_value2'left >= maximum( idx_leftmost_p1_in_p2('1', a_value1), 0)) then
+ return true;
+ else
+ return false;
+ end if;
+ end;
+
+ function matching_widths(
+ value1: unsigned;
+ value2: unsigned
+ ) return boolean is
+ begin
+ return matching_widths(std_logic_vector(value1), std_logic_vector(value2));
+ end;
+
+ function matching_widths(
+ value1: signed;
+ value2: signed
+ ) return boolean is
+ begin
+ return matching_widths(std_logic_vector(value1), std_logic_vector(value2));
+ end;
+
+
+ -- Compare values, but ignore any leading zero's at higher indexes than v_min_length-1.
+ function matching_values(
+ value1: std_logic_vector;
+ value2: std_logic_vector
+ ) return boolean is
+ -- Normalize vectors to (N downto 0)
+ alias a_value1 : std_logic_vector(value1'length - 1 downto 0) is value1;
+ alias a_value2 : std_logic_vector(value2'length - 1 downto 0) is value2;
+ variable v_min_length : natural := minimum(a_value1'length, a_value2'length);
+ variable v_match : boolean := true; -- as default prior to checking
+ begin
+ if matching_widths(a_value1, a_value2) then
+ if not std_match( a_value1(v_min_length-1 downto 0), a_value2(v_min_length-1 downto 0) ) then
+ v_match := false;
+ end if;
+ else
+ v_match := false;
+ end if;
+ return v_match;
+ end;
+
+ function matching_values(
+ value1: unsigned;
+ value2: unsigned
+ ) return boolean is
+ begin
+ return matching_values(std_logic_vector(value1),std_logic_vector(value2));
+ end;
+
+ function matching_values(
+ value1: signed;
+ value2: signed
+ ) return boolean is
+ begin
+ return matching_values(std_logic_vector(value1),std_logic_vector(value2));
+ end;
+
+ -- Function check_value,
+ -- returning 'true' if OK
+ impure function check_value(
+ constant value : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ begin
+ if value then
+ log(msg_id, name & " => OK, for boolean true. " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Boolean was false. " & msg, scope);
+ end if;
+ return value;
+ end;
+
+ impure function check_value(
+ constant value : boolean;
+ constant exp : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ constant v_value_str : string := to_string(value);
+ constant v_exp_str : string := to_string(exp);
+ begin
+ if value = exp then
+ log(msg_id, name & " => OK, for boolean " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. Boolean was " & v_value_str & ". Expected " & v_exp_str & ". " & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value(
+ constant value : std_logic;
+ constant exp : std_logic;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ constant value_type : string := "std_logic";
+ constant v_value_str : string := to_string(value);
+ constant v_exp_str : string := to_string(exp);
+ begin
+ if std_match(value, exp) then
+ if value = exp then
+ log(msg_id, name & " => OK, for " & value_type & " '" & v_value_str & "'. " & msg, scope, msg_id_panel);
+ else
+ log(msg_id, name & " => OK, for " & value_type & " '" & v_value_str & "' (exp: '" & v_exp_str & "'). " & msg, scope, msg_id_panel);
+ end if;
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was '" & v_value_str & "'. Expected '" & v_exp_str & "'" & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value(
+ constant value : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "slv"
+ ) return boolean is
+ -- Normalise vectors to (N downto 0)
+ alias a_value : std_logic_vector(value'length - 1 downto 0) is value;
+ alias a_exp : std_logic_vector(exp'length - 1 downto 0) is exp;
+ constant v_value_str : string := to_string(a_value, radix, format);
+ constant v_exp_str : string := to_string(a_exp, radix, format);
+ variable v_check_ok : boolean := true; -- as default prior to checking
+ begin
+ v_check_ok := matching_values(a_value, a_exp);
+
+ if v_check_ok then
+ if v_value_str = v_exp_str then
+ log(msg_id, name & " => OK, for " & value_type & " x'" & v_value_str & "'. " & msg, scope, msg_id_panel);
+ else
+ -- H,L or - is present in v_exp_str
+ log(msg_id, name & " => OK, for " & value_type & " x'" & v_value_str & "' (exp: x'" & v_exp_str & "'). " & msg,
+ scope, msg_id_panel);
+ end if;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was x'" & v_value_str & "'. Expected x'" & v_exp_str & "'" & LF & msg, scope);
+ end if;
+
+ return v_check_ok;
+ end;
+
+ impure function check_value(
+ constant value : unsigned;
+ constant exp : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "unsigned"
+ ) return boolean is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(std_logic_vector(value), std_logic_vector(exp), alert_level, msg, scope,
+ radix, format, msg_id, msg_id_panel, name, value_type);
+ return v_check_ok;
+ end;
+
+ impure function check_value(
+ constant value : signed;
+ constant exp : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "signed"
+ ) return boolean is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(std_logic_vector(value), std_logic_vector(exp), alert_level, msg, scope,
+ radix, format, msg_id, msg_id_panel, name, value_type);
+ return v_check_ok;
+ end;
+
+ impure function check_value(
+ constant value : integer;
+ constant exp : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ constant value_type : string := "int";
+ constant v_value_str : string := to_string(value);
+ constant v_exp_str : string := to_string(exp);
+ begin
+ if value = exp then
+ log(msg_id, name & " => OK, for " & value_type & " " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was " & v_value_str & ". Expected " & v_exp_str & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value(
+ constant value : time;
+ constant exp : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ constant value_type : string := "time";
+ constant v_value_str : string := to_string(value);
+ constant v_exp_str : string := to_string(exp);
+ begin
+ if value = exp then
+ log(msg_id, name & " => OK, for " & value_type & " " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was " & v_value_str & ". Expected " & v_exp_str & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value(
+ constant value : string;
+ constant exp : string;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) return boolean is
+ constant value_type : string := "string";
+ begin
+ if value = exp then
+ log(msg_id, name & " => OK, for " & value_type & " '" & value & "'. " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was '" & value & "'. Expected '" & exp & "'" & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ ----------------------------------------------------------------------
+ -- Overloads for check_value functions,
+ -- to allow for no return value
+ ----------------------------------------------------------------------
+ procedure check_value(
+ constant value : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value(
+ constant value : boolean;
+ constant exp : boolean;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value(
+ constant value : std_logic;
+ constant exp : std_logic;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value(
+ constant value : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "slv"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, radix, format, msg_id, msg_id_panel, name, value_type);
+ end;
+
+ procedure check_value(
+ constant value : unsigned;
+ constant exp : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "unsigned"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, radix, format, msg_id, msg_id_panel, name, value_type);
+ end;
+
+ procedure check_value(
+ constant value : signed;
+ constant exp : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()";
+ constant value_type : string := "signed"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, radix, format, msg_id, msg_id_panel, name, value_type);
+ end;
+
+ procedure check_value(
+ constant value : integer;
+ constant exp : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value(
+ constant value : time;
+ constant exp : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value(
+ constant value : string;
+ constant exp : string;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value(value, exp, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ ------------------------------------------------------------------------
+ -- check_value_in_range
+ ------------------------------------------------------------------------
+ impure function check_value_in_range (
+ constant value : integer;
+ constant min_value : integer;
+ constant max_value : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "integer"
+ ) return boolean is
+ constant v_value_str : string := to_string(value);
+ constant v_min_value_str : string := to_string(min_value);
+ constant v_max_value_str : string := to_string(max_value);
+ variable v_check_ok : boolean;
+ begin
+ -- Sanity check
+ check_value(max_value >= min_value, TB_ERROR, scope,
+ " => min_value (" & v_min_value_str & ") must be less than max_value("& v_max_value_str & ")" & LF & msg, ID_NEVER, msg_id_panel, name);
+
+ if (value >= min_value and value <= max_value) then
+ log(msg_id, name & " => OK, for " & value_type & " " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was " & v_value_str & ". Expected between " & v_min_value_str & " and " & v_max_value_str & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value_in_range (
+ constant value : unsigned;
+ constant min_value : unsigned;
+ constant max_value : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "unsigned"
+ ) return boolean is
+ begin
+ return check_value_in_range(to_integer(value), to_integer(min_value), to_integer(max_value), alert_level, msg, scope, msg_id, msg_id_panel, name, value_type);
+ end;
+
+ impure function check_value_in_range (
+ constant value : signed;
+ constant min_value : signed;
+ constant max_value : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()";
+ constant value_type : string := "signed"
+ ) return boolean is
+ begin
+ return check_value_in_range(to_integer(value), to_integer(min_value), to_integer(max_value), alert_level, msg, scope, msg_id, msg_id_panel, name, value_type);
+ end;
+
+ impure function check_value_in_range (
+ constant value : time;
+ constant min_value : time;
+ constant max_value : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) return boolean is
+ constant value_type : string := "time";
+ constant v_value_str : string := to_string(value);
+ constant v_min_value_str : string := to_string(min_value);
+ constant v_max_value_str : string := to_string(max_value);
+ variable v_check_ok : boolean;
+ begin
+ -- Sanity check
+ check_value(max_value >= min_value, TB_ERROR, scope,
+ " => min_value (" & v_min_value_str & ") must be less than max_value("& v_max_value_str & ")" & LF & msg, ID_NEVER, msg_id_panel, name);
+
+ if (value >= min_value and value <= max_value) then
+ log(msg_id, name & " => OK, for " & value_type & " " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was " & v_value_str & ". Expected between " & v_min_value_str & " and " & v_max_value_str & LF & msg, scope);
+ return false;
+ end if;
+ end;
+
+ impure function check_value_in_range (
+ constant value : real;
+ constant min_value : real;
+ constant max_value : real;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) return boolean is
+ constant value_type : string := "real";
+ constant v_value_str : string := to_string(value);
+ constant v_min_value_str : string := to_string(min_value);
+ constant v_max_value_str : string := to_string(max_value);
+ variable v_check_ok : boolean;
+ begin
+ -- Sanity check
+ check_value(max_value >= min_value, TB_ERROR,
+ " => min_value (" & v_min_value_str & ") must be less than max_value("& v_max_value_str & ")" & LF & msg, scope,
+ ID_NEVER, msg_id_panel, name);
+
+ if (value >= min_value and value <= max_value) then
+ log(msg_id, name & " => OK, for " & value_type & " " & v_value_str & ". " & msg, scope, msg_id_panel);
+ return true;
+ else
+ alert(alert_level, name & " => Failed. " & value_type & " Was " & v_value_str & ". Expected between " & v_min_value_str & " and " & v_max_value_str & LF & msg, scope);
+ return false;
+ end if;
+ end;
+ --------------------------------------------------------------------------------
+ -- check_value_in_range procedures :
+ -- Call the corresponding function and discard the return value
+ --------------------------------------------------------------------------------
+ procedure check_value_in_range (
+ constant value : integer;
+ constant min_value : integer;
+ constant max_value : integer;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value_in_range(value, min_value, max_value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+ procedure check_value_in_range (
+ constant value : unsigned;
+ constant min_value : unsigned;
+ constant max_value : unsigned;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value_in_range(value, min_value, max_value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+ procedure check_value_in_range (
+ constant value : signed;
+ constant min_value : signed;
+ constant max_value : signed;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value_in_range(value, min_value, max_value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value_in_range (
+ constant value : time;
+ constant min_value : time;
+ constant max_value : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value_in_range(value, min_value, max_value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ procedure check_value_in_range (
+ constant value : real;
+ constant min_value : real;
+ constant max_value : real;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_value_in_range()"
+ ) is
+ variable v_check_ok : boolean;
+ begin
+ v_check_ok := check_value_in_range(value, min_value, max_value, alert_level, msg, scope, msg_id, msg_id_panel, name);
+ end;
+
+ --------------------------------------------------------------------------------
+ -- check_stable
+ --------------------------------------------------------------------------------
+ procedure check_stable(
+ signal target : boolean;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "boolean"
+ ) is
+ constant value_string : string := to_string(target);
+ constant last_value_string : string := to_string(target'last_value);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK. Stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+ procedure check_stable(
+ signal target : std_logic_vector;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "slv"
+ ) is
+ constant value_string : string := 'x' & to_string(target, HEX);
+ constant last_value_string : string := 'x' & to_string(target'last_value, HEX);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK. Stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+ procedure check_stable(
+ signal target : unsigned;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "unsigned"
+ ) is
+ constant value_string : string := 'x' & to_string(target, HEX);
+ constant last_value_string : string := 'x' & to_string(target'last_value, HEX);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK. Stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+ procedure check_stable(
+ signal target : signed;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "signed"
+ ) is
+ constant value_string : string := 'x' & to_string(target, HEX);
+ constant last_value_string : string := 'x' & to_string(target'last_value, HEX);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK. Stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+ procedure check_stable(
+ signal target : std_logic;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "std_logic"
+ ) is
+ constant value_string : string := to_string(target);
+ constant last_value_string : string := to_string(target'last_value);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK. Stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+ procedure check_stable(
+ signal target : integer;
+ constant stable_req : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "check_stable()";
+ constant value_type : string := "integer"
+ ) is
+ constant value_string : string := to_string(target);
+ constant last_value_string : string := to_string(target'last_value);
+ constant last_change : time := target'last_event;
+ constant last_change_string : string := to_string(last_change, ns);
+ begin
+ if (last_change >= stable_req) then
+ log(msg_id, name & " => OK." & value_string & " stable at " & value_string & ". " & msg, scope, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Switched from " & last_value_string & " to " &
+ value_string & " " & last_change_string & " ago. Expected stable for " & to_string(stable_req) & LF & msg, scope);
+ end if;
+ end;
+
+
+ -- check_time_window is used to check if a given condition occurred between
+ -- min_time and max_time
+ -- Usage: wait for requested condition until max_time is reached, then call check_time_window().
+ -- The input 'success' is needed to distinguish between the following cases:
+ -- - the signal reached success condition at max_time,
+ -- - max_time was reached with no success condition
+ procedure check_time_window(
+ constant success : boolean; -- F.ex target'event, or target=exp
+ constant elapsed_time : time;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant name : string;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ begin
+ -- Sanity check
+ check_value(max_time >= min_time, TB_ERROR, name & " => min_time must be less than max_time." & LF & msg, scope, ID_NEVER, msg_id_panel, name);
+
+ if elapsed_time < min_time then
+ alert(alert_level, name & " => Failed. Condition occurred too early, after " &
+ to_string(elapsed_time, C_LOG_TIME_BASE) & ". " & msg, scope);
+ elsif success then
+ log(msg_id, name & " => OK. Condition occurred after " &
+ to_string(elapsed_time, C_LOG_TIME_BASE) & ". " & msg, scope, msg_id_panel);
+ else -- max_time reached with no success
+ alert(alert_level, name & " => Failed. Timed out after " &
+ to_string(max_time, C_LOG_TIME_BASE) & ". " & msg, scope);
+ end if;
+ end;
+
+ ----------------------------------------------------------------------------
+ -- Random functions
+ ----------------------------------------------------------------------------
+ -- Return a random std_logic_vector, using overload for the integer version of random()
+ impure function random (
+ constant length : integer
+ ) return std_logic_vector is
+ variable random_vec : std_logic_vector(length-1 downto 0);
+ begin
+ -- Iterate through each bit and randomly set to 0 or 1
+ for i in 0 to length-1 loop
+ random_vec(i downto i) := std_logic_vector(to_unsigned(random(0,1), 1));
+ end loop;
+ return random_vec;
+ end;
+
+ -- Return a random std_logic, using overload for the SLV version of random()
+ impure function random (
+ constant VOID : t_void
+ ) return std_logic is
+ variable v_random_bit : std_logic_vector(0 downto 0);
+ begin
+ -- randomly set bit to 0 or 1
+ v_random_bit := random(1);
+ return v_random_bit(0);
+ end;
+
+ -- Return a random integer between min_value and max_value
+ -- Use global seeds
+ impure function random (
+ constant min_value : integer;
+ constant max_value : integer
+ ) return integer is
+ variable v_rand_scaled : integer;
+ variable v_seed1 : positive := shared_seed1;
+ variable v_seed2 : positive := shared_seed2;
+ begin
+ random(min_value, max_value, v_seed1, v_seed2, v_rand_scaled);
+ -- Write back seeds
+ shared_seed1 := v_seed1;
+ shared_seed2 := v_seed2;
+ return v_rand_scaled;
+ end;
+
+ -- Return a random real between min_value and max_value
+ -- Use global seeds
+ impure function random (
+ constant min_value : real;
+ constant max_value : real
+ ) return real is
+ variable v_rand_scaled : real;
+ variable v_seed1 : positive := shared_seed1;
+ variable v_seed2 : positive := shared_seed2;
+ begin
+ random(min_value, max_value, v_seed1, v_seed2, v_rand_scaled);
+ -- Write back seeds
+ shared_seed1 := v_seed1;
+ shared_seed2 := v_seed2;
+ return v_rand_scaled;
+ end;
+
+ -- Return a random time between min time and max time, using overload for the integer version of random()
+ impure function random (
+ constant min_value : time;
+ constant max_value : time
+ ) return time is
+ begin
+ return random(min_value/1 ns, max_value/1 ns) * 1 ns;
+ end;
+
+ --
+ -- Procedure versions of random(), where seeds can be specified
+ --
+ -- Set target to a random SLV, using overload for the integer version of random().
+ procedure random (
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout std_logic_vector
+ ) is
+ variable v_length : integer := v_target'length;
+ begin
+ -- Iterate through each bit and randomly set to 0 or 1
+ for i in 0 to v_length-1 loop
+ v_target(i downto i) := std_logic_vector(to_unsigned(random(0,1),1));
+ end loop;
+ end;
+
+ -- Set target to a random SL, using overload for the integer version of random().
+ procedure random (
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout std_logic
+ ) is
+ variable v_random_slv : std_logic_vector(0 downto 0);
+ begin
+ v_random_slv := std_logic_vector(to_unsigned(random(0,1),1));
+ v_target := v_random_slv(0);
+ end;
+
+
+ -- Set target to a random integer between min_value and max_value
+ procedure random (
+ constant min_value : integer;
+ constant max_value : integer;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout integer
+ ) is
+ variable v_rand : real;
+ begin
+ -- Random real-number value in range 0 to 1.0
+ uniform(v_seed1, v_seed2, v_rand);
+ -- Scale to a random integer between min_value and max_value
+ v_target := min_value + integer(trunc(v_rand*real(1+max_value-min_value)));
+ end;
+
+ -- Set target to a random integer between min_value and max_value
+ procedure random (
+ constant min_value : real;
+ constant max_value : real;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout real
+ ) is
+ variable v_rand : real;
+ begin
+ -- Random real-number value in range 0 to 1.0
+ uniform(v_seed1, v_seed2, v_rand);
+
+ -- Scale to a random integer between min_value and max_value
+ v_target := min_value + v_rand*(max_value-min_value);
+ end;
+
+ -- Set target to a random integer between min_value and max_value
+ procedure random (
+ constant min_value : time;
+ constant max_value : time;
+ variable v_seed1 : inout positive;
+ variable v_seed2 : inout positive;
+ variable v_target : inout time
+ ) is
+ variable v_rand : real;
+ variable v_rand_int : integer;
+ begin
+ -- Random real-number value in range 0 to 1.0
+ uniform(v_seed1, v_seed2, v_rand);
+ -- Scale to a random integer between min_value and max_value
+ v_rand_int := min_value/1 ns + integer(trunc(v_rand*real(1 + max_value/1 ns - min_value / 1 ns)));
+ v_target := v_rand_int * 1 ns;
+ end;
+
+ -- Set global seeds
+ procedure randomize (
+ constant seed1 : positive;
+ constant seed2 : positive;
+ constant msg : string := "randomizing seeds";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ log(ID_UTIL_SETUP, "Setting global seeds to " & to_string(seed1) & ", " & to_string(seed2), scope);
+ shared_seed1 := seed1;
+ shared_seed2 := seed2;
+ end;
+
+ -- Set global seeds
+ procedure randomise (
+ constant seed1 : positive;
+ constant seed2 : positive;
+ constant msg : string := "randomising seeds";
+ constant scope : string := C_TB_SCOPE_DEFAULT
+ ) is
+ begin
+ deprecate(get_procedure_name_from_instance_name(seed1'instance_name), "Use randomize().");
+ log(ID_UTIL_SETUP, "Setting global seeds to " & to_string(seed1) & ", " & to_string(seed2), scope);
+ shared_seed1 := seed1;
+ shared_seed2 := seed2;
+ end;
+
+-- ============================================================================
+-- Time consuming checks
+-- ============================================================================
+
+ --------------------------------------------------------------------------------
+ -- await_change
+ -- A signal change is required, but may happen already after 1 delta if min_time = 0 ns
+ --------------------------------------------------------------------------------
+ procedure await_change(
+ signal target : boolean;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "boolean"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " &
+ to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_change(
+ signal target : std_logic;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "std_logic"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " &
+ to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_change(
+ signal target : std_logic_vector;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "slv"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " &
+ to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_change(
+ signal target : unsigned;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "unsigned"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " &
+ to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ -- Note that overloading by casting target to slv without creating a new signal doesn't work
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_change(
+ signal target : signed;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "signed"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " &
+ to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_change(
+ signal target : integer;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel: t_msg_id_panel := shared_msg_id_panel;
+ constant value_type : string := "integer"
+ ) is
+ constant name : string := "await_change(" & value_type & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ constant start_time : time := now;
+ begin
+ wait on target for max_time;
+ check_time_window(target'event, now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ --------------------------------------------------------------------------------
+ -- await_value
+ --------------------------------------------------------------------------------
+ -- Potential improvements
+ -- - Adding an option that the signal must last for more than one delta cycle
+ -- or a specified time
+ -- - Adding an "AS_IS" option that does not allow the signal to change to other values
+ -- before it changes to the expected value
+ --
+ -- The input signal is allowed to change to other values before ending up on the expected value,
+ -- as long as it changes to the expected value within the time window (min_time to max_time).
+
+ -- Wait for target = expected or timeout after max_time.
+ -- Then check if (and when) the value changed to the expected
+ procedure await_value (
+ signal target : boolean;
+ constant exp : boolean;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "boolean";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if (target /= exp) then
+ wait until (target = exp) for max_time;
+ end if;
+ check_time_window((target = exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_value (
+ signal target : std_logic;
+ constant exp : std_logic;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "std_logic";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if (target /= exp) then
+ wait until (target = exp) for max_time;
+ end if;
+ check_time_window((target = exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ procedure await_value (
+ signal target : std_logic_vector;
+ constant exp : std_logic_vector;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "slv";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp, radix, format, INCL_RADIX);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if matching_widths(target, exp) then
+ if not matching_values(target, exp) then
+ wait until matching_values(target, exp) for max_time;
+ end if;
+ check_time_window(matching_values(target, exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Widths did not match. " & msg, scope);
+ end if;
+ end;
+
+ procedure await_value (
+ signal target : unsigned;
+ constant exp : unsigned;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "unsigned";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp, radix, format, INCL_RADIX);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if matching_widths(target, exp) then
+ if not matching_values(target, exp) then
+ wait until matching_values(target, exp) for max_time;
+ end if;
+ check_time_window(matching_values(target, exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Widths did not match. " & msg, scope);
+ end if;
+ end;
+
+ procedure await_value (
+ signal target : signed;
+ constant exp : signed;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant radix : t_radix := HEX_BIN_IF_INVALID;
+ constant format : t_format_zeros := SKIP_LEADING_0;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "signed";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp, radix, format, INCL_RADIX);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if matching_widths(target, exp) then
+ if not matching_values(target, exp) then
+ wait until matching_values(target, exp) for max_time;
+ end if;
+ check_time_window(matching_values(target, exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ else
+ alert(alert_level, name & " => Failed. Widths did not match. " & msg, scope);
+ end if;
+ end;
+
+ procedure await_value (
+ signal target : integer;
+ constant exp : integer;
+ constant min_time : time;
+ constant max_time : time;
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "integer";
+ constant start_time : time := now;
+ constant v_exp_str : string := to_string(exp);
+ constant name : string := "await_value(" & value_type & " " & v_exp_str & ", " &
+ to_string(min_time, ns) & ", " & to_string(max_time, ns) & ")";
+ begin
+ if (target /= exp) then
+ wait until (target = exp) for max_time;
+ end if;
+ check_time_window((target = exp), now-start_time, min_time, max_time, alert_level, name, msg, scope, msg_id, msg_id_panel);
+ end;
+
+ -- Helper procedure:
+ -- Convert time from 'FROM_LAST_EVENT' to 'FROM_NOW'
+ procedure await_stable_calc_time (
+ constant target_last_event : time;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ variable stable_req_from_now : inout time; -- Calculated stable requirement from now
+ variable timeout_from_await_stable_entry : inout time; -- Calculated timeout from procedure entry
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "await_stable_calc_time()";
+ variable stable_req_met : inout boolean -- When true, the stable requirement is satisfied
+ ) is
+ begin
+ stable_req_met := false;
+
+ -- Convert stable_req so that it points to "time_from_now"
+ if stable_req_from = FROM_NOW then
+ stable_req_from_now := stable_req;
+ elsif stable_req_from = FROM_LAST_EVENT then
+ -- Signal has already been stable for target'last_event,
+ -- so we can subtract this in the FROM_NOW version.
+ stable_req_from_now := stable_req - target_last_event;
+ else
+ alert(tb_error, name & " => Unknown stable_req_from." & msg, scope);
+ end if;
+
+ -- Convert timeout so that it points to "time_from_now"
+ if timeout_from = FROM_NOW then
+ timeout_from_await_stable_entry := timeout;
+ elsif timeout_from = FROM_LAST_EVENT then
+ timeout_from_await_stable_entry := timeout - target_last_event;
+ else
+ alert(tb_error, name & " => Unknown timeout_from." & msg, scope);
+ end if;
+
+ -- Check if requirement is already OK
+ if (stable_req_from_now <= 0 ns) then
+ log(msg_id, name & " => OK. Condition occurred immediately." & msg, scope, msg_id_panel);
+ stable_req_met := true;
+ end if;
+
+ -- Check if it is impossible to achieve stable_req before timeout
+ if (stable_req_from_now > timeout_from_await_stable_entry) then
+ alert(alert_level, name & " => Failed immediately: Stable for stable_req = " & to_string(stable_req_from_now, ns) &
+ " is not possible before timeout = " & to_string(timeout_from_await_stable_entry, ns) &
+ ". " & msg, scope);
+ stable_req_met := true;
+ end if;
+
+ end;
+
+ -- Helper procedure:
+ procedure await_stable_checks (
+ constant start_time : time; -- Time at await_stable() procedure entry
+ constant stable_req : time; -- Minimum stable requirement
+ variable stable_req_from_now : inout time; -- Minimum stable requirement from now
+ variable timeout_from_await_stable_entry : inout time; -- Timeout value converted to FROM_NOW
+ constant time_since_last_event : time; -- Time since previous event
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel;
+ constant name : string := "await_stable_checks()";
+ variable stable_req_met : inout boolean -- When true, the stable requirement is satisfied
+ ) is
+ variable v_time_left : time; -- Remaining time until timeout
+ variable v_elapsed_time : time := 0 ns; -- Time since procedure entry
+ begin
+ stable_req_met := false;
+ v_elapsed_time := now - start_time;
+ v_time_left := timeout_from_await_stable_entry - v_elapsed_time;
+
+ -- Check if target has been stable for stable_req
+ if (time_since_last_event >= stable_req_from_now) then
+ log(msg_id, name & " => OK. Condition occurred after " &
+ to_string(v_elapsed_time, C_LOG_TIME_BASE) & ". " & msg, scope, msg_id_panel);
+ stable_req_met := true;
+ end if;
+
+ --
+ -- Prepare for the next iteration in the loop in await_stable() procedure:
+ --
+ if not stable_req_met then
+
+ -- Now that an event has occurred, the stable requirement is stable_req from now (regardless of stable_req_from)
+ stable_req_from_now := stable_req;
+
+ -- Check if it is impossible to achieve stable_req before timeout
+ if (stable_req_from_now > v_time_left) then
+ alert(alert_level, name & " => Failed. After " & to_string(v_elapsed_time, C_LOG_TIME_BASE) &
+ ", stable for stable_req = " & to_string(stable_req_from_now, ns) &
+ " is not possible before timeout = " & to_string(timeout_from_await_stable_entry, ns) &
+ "(time since last event = " & to_string(time_since_last_event, ns) &
+ ". " & msg, scope);
+ stable_req_met := true;
+ end if;
+ end if;
+ end;
+
+
+ -- Wait until the target signal has been stable for at least 'stable_req'
+ -- Report an error if this does not occurr within the time specified by 'timeout'.
+ -- Note : 'Stable' refers to that the signal has not had an event (i.e. not changed value).
+ -- Description of arguments:
+ -- stable_req_from = FROM_NOW : Target must be stable 'stable_req' from now
+ -- stable_req_from = FROM_LAST_EVENT : Target must be stable 'stable_req' from the last event of target.
+ -- timeout_from = FROM_NOW : The timeout argument is given in time from now
+ -- timeout_from = FROM_LAST_EVENT : The timeout argument is given in time the last event of target.
+ procedure await_stable (
+ signal target : boolean;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "boolean";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occurr
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ -- Note that the waiting for target'event can't be called from overloaded procedures where 'target' is a different type.
+ -- Instead, the common code is put in helper procedures
+ procedure await_stable (
+ signal target : std_logic;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "std_logic";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occurr
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ procedure await_stable (
+ signal target : std_logic_vector;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "std_logic_vector";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occurr
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ procedure await_stable (
+ signal target : unsigned;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "unsigned";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occurr
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ procedure await_stable (
+ signal target : signed;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "signed";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occurr
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ procedure await_stable (
+ signal target : integer;
+ constant stable_req : time; -- Minimum stable requirement
+ constant stable_req_from : t_from_point_in_time; -- Which point in time stable_req starts
+ constant timeout : time; -- Timeout if stable_req not achieved
+ constant timeout_from : t_from_point_in_time; -- Which point in time the timeout starts
+ constant alert_level : t_alert_level;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_POS_ACK;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ constant value_type : string := "integer";
+ constant start_time : time := now;
+ constant name : string := "await_stable(" & value_type & ", " & to_string(stable_req, ns) &
+ ", " & to_string(timeout, ns) & ")";
+ variable v_stable_req_from_now : time; -- Stable_req relative to now.
+ variable v_timeout_from_proc_entry : time; -- Timeout relative to time of procedure entry
+ variable v_stable_req_met : boolean := false; -- When true, the procedure is done and has logged a conclusion.
+ begin
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_calc_time(
+ target_last_event => target'last_event,
+ stable_req => stable_req,
+ stable_req_from => stable_req_from,
+ timeout => timeout,
+ timeout_from => timeout_from,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ -- Start waiting for target'event or stable_req time, unless :
+ -- - stable_req already achieved, or
+ -- - it is already too late to be stable for stable_req before timeout will occur
+ while not v_stable_req_met loop
+ wait until target'event for v_stable_req_from_now;
+
+ -- Use a helper procedure to simplify overloading
+ await_stable_checks (
+ start_time => start_time,
+ stable_req => stable_req,
+ stable_req_from_now => v_stable_req_from_now,
+ timeout_from_await_stable_entry => v_timeout_from_proc_entry,
+ time_since_last_event => target'last_event,
+ alert_level => alert_level,
+ msg => msg,
+ scope => scope,
+ msg_id => msg_id,
+ msg_id_panel => msg_id_panel,
+ name => name,
+ stable_req_met => v_stable_req_met);
+
+ end loop;
+ end;
+
+ -----------------------------------------------------------------------------------
+ -- gen_pulse(sl)
+ -- Generate a pulse on a std_logic for a certain amount of time
+ --
+ -- If blocking_mode = BLOCKING : Procedure waits until the pulse is done before returning to the caller.
+ -- If blocking_mode = NON_BLOCKING : Procedure starts the pulse, schedules the end of the pulse, then returns to the caller immediately.
+ --
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ constant pulse_duration : time;
+ constant blocking_mode : t_blocking_mode;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ begin
+ log(msg_id, "Pulse " &
+ " for " & to_string(pulse_duration) & ". " & msg, scope);
+ target <= '1'; -- Start pulse
+
+ if (blocking_mode = BLOCKING) then
+ wait for pulse_duration;
+ target <= '0';
+ else
+ target <= transport '0' after pulse_duration;
+ end if;
+ end;
+
+ -- Overload to allow excluding the blocking_mode argument:
+ -- Make blocking_mode = BLOCKING by default
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ constant pulse_duration : time;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ begin
+ gen_pulse(target, pulse_duration, BLOCKING, msg, scope, msg_id, msg_id_panel); -- Blocking mode by default
+ end;
+
+ -- gen_pulse(sl)
+ -- Generate a pulse on a std_logic for a certain number of clock cycles
+ procedure gen_pulse(
+ signal target : inout std_logic;
+ signal clock_signal : std_logic;
+ constant num_periods : natural;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ begin
+ log(msg_id, "Pulse " &
+ " for " & to_string(num_periods) & " clk cycles. " & msg, scope);
+ if (num_periods > 0) then
+ wait until falling_edge(clock_signal);
+ target <= '1';
+ for i in 1 to num_periods loop
+ wait until falling_edge(clock_signal);
+ end loop;
+ else -- Pulse for one delta cycle only
+ target <= '1';
+ wait for 0 ns;
+ end if;
+ target <= '0';
+ end;
+
+ -- gen_pulse(slv)
+ procedure gen_pulse(
+ signal target : inout std_logic_vector;
+ constant pulse_value : std_logic_vector;
+ signal clock_signal : std_logic;
+ constant num_periods : natural;
+ constant msg : string;
+ constant scope : string := C_TB_SCOPE_DEFAULT;
+ constant msg_id : t_msg_id := ID_GEN_PULSE;
+ constant msg_id_panel : t_msg_id_panel := shared_msg_id_panel
+ ) is
+ begin
+ log(msg_id, "Pulse to " & to_string(pulse_value, HEX, AS_IS, INCL_RADIX) &
+ " for " & to_string(num_periods) & " clk cycles. " & msg, scope);
+
+ if (num_periods > 0) then
+ wait until falling_edge(clock_signal);
+ target <= pulse_value;
+ for i in 1 to num_periods loop
+ wait until falling_edge(clock_signal);
+ end loop;
+ else -- Pulse for one delta cycle only
+ target <= pulse_value;
+ wait for 0 ns;
+ end if;
+ target(target'range) <= (others => '0');
+ end;
+
+ --------------------------------------------
+ -- Clock generators :
+ -- Include this as a concurrent procedure from your test bench.
+ -- ( Including this procedure call as a concurrent statement directly in your architecture
+ -- is in fact identical to a process, where the procedure parameters is the sensitivity list )
+ --------------------------------------------
+ procedure clock_generator(
+ signal clock_signal : inout std_logic;
+ constant clock_period : in time
+ ) is
+ -- Making sure any rounding error after calculating period/2 is not accumulated.
+ variable v_first_half_clk_period : time := clock_period / 2;
+ begin
+ loop
+ clock_signal <= '1';
+ wait for v_first_half_clk_period;
+ clock_signal <= '0';
+ wait for (clock_period - v_first_half_clk_period);
+ end loop;
+ end;
+
+ --------------------------------------------
+ -- Clock generator overload:
+ -- - Enable signal (clock_ena) is added as a parameter
+ -- - The clock goes to '1' immediately when the clock is enabled (clock_ena = true)
+ -- - Log when the clock_ena changes. clock_name is used in the log message.
+ --------------------------------------------
+ procedure clock_generator(
+ signal clock_signal : inout std_logic;
+ signal clock_ena : in boolean;
+ constant clock_period : in time;
+ constant clock_name : in string
+ ) is
+ -- Making sure any rounding error after calculating period/2 is not accumulated.
+ variable v_first_half_clk_period : time := clock_period / 2;
+ begin
+ loop
+ if not clock_ena then
+ log(ID_CLOCK_GEN, "Stopping clock " & clock_name);
+ clock_signal <= '0';
+ wait until clock_ena;
+ log(ID_CLOCK_GEN, "Starting clock " & clock_name);
+ end if;
+ clock_signal <= '1';
+ wait for v_first_half_clk_period;
+ clock_signal <= '0';
+ wait for (clock_period - v_first_half_clk_period);
+ end loop;
+ end;
+
+end package body methods_pkg;
+
diff --git a/testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd b/testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd
new file mode 100644
index 0000000..15f8b58
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd
@@ -0,0 +1,1073 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : string_methods_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use std.textio.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.std_logic_1164_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+
+use work.types_pkg.all;
+use work.adaptations_pkg.all;
+
+package string_methods_pkg is
+
+ -- Need a low level "alert" in the form of a simple assertion (as string handling may also fail)
+ procedure bitvis_assert(
+ val : boolean;
+ severeness : severity_level;
+ msg : string;
+ scope : string
+ );
+
+
+ function justify(
+ val : string;
+ width : natural := 0;
+ justified : side := RIGHT;
+ format: t_format_string := AS_IS -- No defaults on 4 first param - to avoid ambiguity with std.textio
+ ) return string;
+
+
+
+ function pos_of_leftmost(
+ target : character;
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural;
+
+ function pos_of_rightmost(
+ target : character;
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural;
+
+ function pos_of_leftmost_non_zero(
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural;
+
+ function get_string_between_delimeters(
+ val : string;
+ delim_left : character;
+ delim_right: character;
+ start_from : SIDE; -- search from left or right (Only RIGHT implemented so far)
+ occurrence : positive := 1 -- stop on N'th occurrence of delimeter pair. Default first occurrence
+ ) return string;
+
+ function get_procedure_name_from_instance_name(
+ val : string
+ ) return string;
+
+ function get_process_name_from_instance_name(
+ val : string
+ ) return string;
+
+ function get_entity_name_from_instance_name(
+ val : string
+ ) return string;
+
+ function return_string_if_true(
+ val : string;
+ return_val : boolean
+ ) return string;
+
+ function to_upper(
+ val : string
+ ) return string;
+
+ function fill_string(
+ val : character;
+ width : natural
+ ) return string;
+
+ function replace_backslash_n_with_lf(
+ source : string
+ ) return string;
+
+ function remove_initial_chars(
+ source : string;
+ num : natural
+ ) return string;
+
+ function wrap_lines(
+ constant text_string : string;
+ constant alignment_pos1 : natural; -- Line position of first aligned character in line 1
+ constant alignment_pos2 : natural; -- Line position of first aligned character in line 2, etc...
+ constant line_width : natural
+ ) return string;
+
+ procedure wrap_lines(
+ variable text_lines : inout line;
+ constant alignment_pos1 : natural; -- Line position prior to first aligned character (incl. Prefix)
+ constant alignment_pos2 : natural;
+ constant line_width : natural
+ );
+
+ procedure prefix_lines(
+ variable text_lines : inout line;
+ constant prefix : string := C_LOG_PREFIX
+ );
+
+ function replace(
+ val : string;
+ target_char : character;
+ exchange_char : character
+ ) return string;
+
+ procedure replace(
+ variable text_line : inout line;
+ target_char : character;
+ exchange_char : character
+ );
+
+ --========================================================
+ -- Handle missing overloads from 'standard_additions'
+ --========================================================
+ function to_string(
+ val : boolean;
+ width : natural;
+ justified : side := right;
+ format: t_format_string := AS_IS
+ ) return string;
+
+ function to_string(
+ val : integer;
+ width : natural;
+ justified : side := right;
+ format : t_format_string := AS_IS
+ ) return string;
+
+ function to_string(
+ val : std_logic_vector;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string;
+
+ function to_string(
+ val : unsigned;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string;
+
+ function to_string(
+ val : signed;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string;
+
+
+
+ --========================================================
+ -- Handle types defined at lower levels
+ --========================================================
+ function to_string(
+ val : t_alert_level;
+ width : natural := 0;
+ justified : side := right
+ ) return string;
+
+ function to_string(
+ val : t_msg_id;
+ width : natural := 0;
+ justified : side := right
+ ) return string;
+
+ function to_string(
+ val : t_enabled
+ ) return string;
+
+ function to_string(
+ val : t_attention;
+ width : natural := 0;
+ justified : side := right
+ ) return string;
+
+ procedure to_string(
+ val : t_alert_attention_counters;
+ order : t_order := FINAL
+ );
+
+ function ascii_to_char(
+ ascii_pos : integer range 0 to 255;
+ ascii_allow : t_ascii_allow := ALLOW_ALL
+ ) return character;
+
+ function char_to_ascii(
+ char : character
+ ) return integer;
+
+
+ -- return string with only valid ascii characters
+ function to_string(
+ val : string
+ ) return string;
+
+
+end package string_methods_pkg;
+
+
+
+
+package body string_methods_pkg is
+
+ -- Need a low level "alert" in the form of a simple assertion (as string handling may also fail)
+ procedure bitvis_assert(
+ val : boolean;
+ severeness : severity_level;
+ msg : string;
+ scope : string
+ ) is
+ begin
+ assert val
+ report LF & C_LOG_PREFIX & " *** " & to_string(severeness) & "*** caused by Bitvis Util > string handling > "
+ & scope & LF & C_LOG_PREFIX & " " & msg & LF
+ severity severeness;
+ end;
+
+
+
+ function to_upper(
+ val : string
+ ) return string is
+ variable v_result : string (val'range) := val;
+ variable char : character;
+ begin
+ for i in val'range loop
+ -- NOTE: Illegal characters are allowed and will pass through (check Mentor's std_developers_kit)
+ if ( v_result(i) >= 'a' and v_result(i) <= 'z') then
+ v_result(i) := character'val( character'pos(v_result(i)) - character'pos('a') + character'pos('A') );
+ end if;
+ end loop;
+ return v_result;
+ end to_upper;
+
+ function fill_string(
+ val : character;
+ width : natural
+ ) return string is
+ variable v_result : string (1 to maximum(1, width));
+ begin
+ if (width = 0) then
+ return "";
+ else
+ for i in 1 to width loop
+ v_result(i) := val;
+ end loop;
+ end if;
+ return v_result;
+ end fill_string;
+
+ function justify(
+ val : string;
+ width : natural := 0;
+ justified : side := RIGHT;
+ format : t_format_string := AS_IS -- No defaults on 4 first param - to avoid ambiguity with std.textio
+ ) return string is
+ constant val_length : natural := val'length;
+ variable result : string(1 to width) := (others => ' ');
+ begin
+ -- return val if width is too small
+ if val_length >= width then
+ if (format = TRUNCATE) then
+ return val(1 to width);
+ else
+ return val;
+ end if;
+ end if;
+ if justified = left then
+ result(1 to val_length) := val;
+ elsif justified = right then
+ result(width - val_length + 1 to width) := val;
+ end if;
+ return result;
+ end function;
+
+
+
+ function pos_of_leftmost(
+ target : character;
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural is
+ alias a_vector : string(1 to vector'length) is vector;
+ begin
+ bitvis_assert(vector'length > 0, FAILURE, "String input is empty", "pos_of_leftmost()");
+ bitvis_assert(vector'ascending, FAILURE, "Only implemented for string(N to M)", "pos_of_rightmost()");
+ for i in a_vector'left to a_vector'right loop
+ if (a_vector(i) = target) then
+ return i;
+ end if;
+ end loop;
+ return result_if_not_found;
+ end;
+
+ function pos_of_rightmost(
+ target : character;
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural is
+ alias a_vector : string(1 to vector'length) is vector;
+ begin
+ bitvis_assert(vector'length > 0, FAILURE, "String input is empty", "pos_of_rightmost()");
+ bitvis_assert(vector'ascending, FAILURE, "Only implemented for string(N to M)", "pos_of_rightmost()");
+ for i in a_vector'right downto a_vector'left loop
+ if (a_vector(i) = target) then
+ return i;
+ end if;
+ end loop;
+ return result_if_not_found;
+ end;
+
+ function pos_of_leftmost_non_zero(
+ vector : string;
+ result_if_not_found : natural := 1
+ ) return natural is
+ alias a_vector : string(1 to vector'length) is vector;
+ begin
+ bitvis_assert(vector'length > 0, FAILURE, "String input is empty", "pos_of_leftmost()");
+ for i in a_vector'left to a_vector'right loop
+ if (a_vector(i) /= '0' and a_vector(i) /= ' ') then
+ return i;
+ end if;
+ end loop;
+ return result_if_not_found;
+ end;
+
+ function string_contains_char(
+ val : string;
+ char : character
+ ) return boolean is
+ alias a_val : string(1 to val'length) is val;
+ begin
+ if (val'length = 0) then
+ return false;
+ else
+ for i in val'left to val'right loop
+ if (val(i) = char) then
+ return true;
+ end if;
+ end loop;
+ -- falls through only if not found
+ return false;
+ end if;
+ end;
+
+ -- get_*_name
+ -- Note: for sub-programs the following is given: library:package:procedure:object
+ -- Note: for design hierachy the following is given: complete hierarchy from sim-object down to process object
+ -- e.g. 'sbi_tb:i_test_harness:i2_sbi_vvc:p_constructor:v_msg'
+ -- Attribute instance_name also gives [procedure signature] or @entity-name(architecture name)
+ function get_string_between_delimeters(
+ val : string;
+ delim_left : character;
+ delim_right: character;
+ start_from : SIDE; -- search from left or right (Only RIGHT implemented so far)
+ occurrence : positive := 1 -- stop on N'th occurrence of delimeter pair. Default first occurrence
+ ) return string is
+ variable v_left : natural := 0;
+ variable v_right : natural := 0;
+ variable v_start : natural := val'length;
+ variable v_occurrence : natural := 0;
+ alias a_val : string(1 to val'length) is val;
+ begin
+ bitvis_assert(a_val'length > 2, FAILURE, "String input is not wide enough (<3)", "get_string_between_delimeters()");
+ bitvis_assert(start_from = RIGHT, FAILURE, "Only search from RIGHT is implemented so far", "get_string_between_delimeters()");
+ loop
+-- RIGHT
+ v_left := 0; -- default
+ v_right := pos_of_rightmost(delim_right, a_val(1 to v_start), 0);
+ if v_right > 0 then -- i.e. found
+ L1: for i in v_right-1 downto 1 loop -- searching backwards for delimeter
+ if (a_val(i) = delim_left) then
+ v_left := i;
+ v_start := i; -- Previous end delimeter could also be a start delimeter for next section
+ v_occurrence := v_occurrence + 1;
+ exit L1;
+ end if;
+ end loop; -- searching backwards
+ end if;
+ if v_right = 0 or v_left = 0 then
+ return ""; -- No delimeter pair found, and none can be found in the rest (with chars in between)
+ end if;
+ if v_occurrence = occurrence then
+ -- Match
+ if (v_right - v_left) < 2 then
+ return ""; -- no chars in between delimeters
+ else
+ return a_val(v_left+1 to v_right-1);
+ end if;
+ end if;
+ if v_start < 3 then
+ return ""; -- No delimeter pair found, and none can be found in the rest (with chars in between)
+ end if;
+ end loop; -- Will continue until match or not found
+ end;
+
+-- ':sbi_tb(func):i_test_harness@test_harness(struct):i2_sbi_vvc@sbi_vvc(struct):p_constructor:instance'
+-- ':sbi_tb:i_test_harness:i1_sbi_vvc:p_constructor:instance'
+-- - Process name: Search for 2nd last param in path name
+-- - Entity name: Search for 3nd last param in path name
+
+--':bitvis_vip_sbi:sbi_bfm_pkg:sbi_write[unsigned,std_logic_vector,string,std_logic,std_logic,unsigned,
+-- std_logic,std_logic,std_logic,std_logic_vector,time,string,t_msg_id_panel,t_sbi_config]:msg'
+-- - Procedure name: Search for 2nd last param in path name and remove all inside []
+
+ function get_procedure_name_from_instance_name(
+ val : string
+ ) return string is
+ variable v_line : line;
+ variable v_msg_line : line;
+ begin
+ bitvis_assert(val'length > 2, FAILURE, "String input is not wide enough (<3)", "get_procedure_name_from_instance_name()");
+ write(v_line, get_string_between_delimeters(val, ':', '[', RIGHT));
+ if (string_contains_char(val, '@')) then
+ write(v_msg_line, string'("Must be called with <sub-program object>'instance_name"));
+ else
+ write(v_msg_line, string'(" "));
+ end if;
+ bitvis_assert(v_line'length > 0, ERROR, "No procedure name found. " & v_msg_line.all, "get_procedure_name_from_instance_name()");
+ return v_line.all;
+ end;
+
+ function get_process_name_from_instance_name(
+ val : string
+ ) return string is
+ variable v_line : line;
+ variable v_msg_line : line;
+ begin
+ bitvis_assert(val'length > 2, FAILURE, "String input is not wide enough (<3)", "get_process_name_from_instance_name()");
+ write(v_line, get_string_between_delimeters(val, ':', ':', RIGHT));
+ if (string_contains_char(val, '[')) then
+ write(v_msg_line, string'("Must be called with <process-local object>'instance_name"));
+ else
+ write(v_msg_line, string'(" "));
+ end if;
+ bitvis_assert(v_line'length > 0, ERROR, "No process name found", "get_process_name_from_instance_name()");
+ return v_line.all;
+ end;
+
+ function get_entity_name_from_instance_name(
+ val : string
+ ) return string is
+ variable v_line : line;
+ variable v_msg_line : line;
+ begin
+ bitvis_assert(val'length > 2, FAILURE, "String input is not wide enough (<3)", "get_entity_name_from_instance_name()");
+ if string_contains_char(val, '@') then -- for path with instantiations
+ write(v_line, get_string_between_delimeters(val, '@', '(', RIGHT));
+ else -- for path with only a single entity
+ write(v_line, get_string_between_delimeters(val, ':', '(', RIGHT));
+ end if;
+ if (string_contains_char(val, '[')) then
+ write(v_msg_line, string'("Must be called with <Entity/arch-local object>'instance_name"));
+ else
+ write(v_msg_line, string'(" "));
+ end if;
+ bitvis_assert(v_line'length > 0, ERROR, "No entity name found", "get_entity_name_from_instance_name()");
+ return v_line.all;
+ end;
+
+
+
+
+
+
+
+ function adjust_leading_0(
+ val : string;
+ format : t_format_zeros := SKIP_LEADING_0
+ ) return string is
+ alias a_val : string(1 to val'length) is val;
+ constant leftmost_non_zero : natural := pos_of_leftmost_non_zero(a_val, 1);
+ begin
+ if val'length <= 1 then
+ return val;
+ end if;
+ if format = SKIP_LEADING_0 then
+ return a_val(leftmost_non_zero to val'length);
+ else
+ return a_val;
+ end if;
+ end function;
+
+ function return_string_if_true(
+ val : string;
+ return_val : boolean
+ ) return string is
+ begin
+ if return_val then
+ return val;
+ else
+ return "";
+ end if;
+ end function;
+
+ function replace_backslash_n_with_lf(
+ source : string
+ ) return string is
+ variable v_source_idx : natural := 0;
+ variable v_dest_idx : natural := 0;
+ variable v_dest : string(1 to source'length);
+ begin
+ if source'length = 0 then
+ return "";
+ else
+ if C_USE_BACKSLASH_N_AS_LF then
+ loop
+ v_source_idx := v_source_idx + 1;
+ v_dest_idx := v_dest_idx + 1;
+ if (v_source_idx < source'length) then
+ if (source(v_source_idx to v_source_idx +1) /= "\n") then
+ v_dest(v_dest_idx) := source(v_source_idx);
+ else
+ v_dest(v_dest_idx) := LF;
+ v_source_idx := v_source_idx + 1; -- Additional increment as two chars (\n) are consumed
+ if (v_source_idx = source'length) then
+ exit;
+ end if;
+ end if;
+ else
+ -- Final character in string
+ v_dest(v_dest_idx) := source(v_source_idx);
+ exit;
+ end if;
+ end loop;
+ else
+ v_dest := source;
+ v_dest_idx := source'length;
+ end if;
+ return v_dest(1 to v_dest_idx);
+ end if;
+ end;
+
+ function remove_initial_chars(
+ source : string;
+ num : natural
+ ) return string is
+ begin
+ if source'length <= num then
+ return "";
+ else
+ return source(1 + num to source'right);
+ end if;
+ end;
+
+ function wrap_lines(
+ constant text_string : string;
+ constant alignment_pos1 : natural; -- Line position of first aligned character in line 1
+ constant alignment_pos2 : natural; -- Line position of first aligned character in line 2
+ constant line_width : natural
+ ) return string is
+ variable v_text_lines : line;
+ variable v_result : string(1 to 2 * text_string'length + alignment_pos1 + 100); -- Margin for aligns and LF insertions
+ variable v_result_width : natural;
+ begin
+ write(v_text_lines, text_string);
+ wrap_lines(v_text_lines, alignment_pos1, alignment_pos2, line_width);
+ v_result_width := v_text_lines'length;
+ bitvis_assert(v_result_width <= v_result'length, FAILURE,
+ " String is too long after wrapping. Increase v_result string size.", "wrap_lines()");
+ v_result(1 to v_result_width) := v_text_lines.all;
+ deallocate(v_text_lines);
+ return v_result(1 to v_result_width);
+ end;
+
+
+ procedure wrap_lines(
+ variable text_lines : inout line;
+ constant alignment_pos1 : natural; -- Line position of first aligned character in line 1
+ constant alignment_pos2 : natural; -- Line position of first aligned character in line 2
+ constant line_width : natural
+ ) is
+ variable v_string : string(1 to text_lines'length) := text_lines.all;
+ variable v_string_width : natural := text_lines'length;
+ variable v_line_no : natural := 0;
+ variable v_last_string_wrap : natural := 0;
+ variable v_min_string_wrap : natural;
+ variable v_max_string_wrap : natural;
+ begin
+ deallocate(text_lines); -- empty the line prior to filling it up again
+ l_line: loop -- For every tekstline found in text_lines
+ v_line_no := v_line_no + 1;
+ -- Find position to wrap in v_string
+ if (v_line_no = 1) then
+ v_min_string_wrap := 1; -- Minimum 1 character of input line
+ v_max_string_wrap := minimum(line_width - alignment_pos1 + 1, v_string_width);
+ write(text_lines, fill_string(' ', alignment_pos1 - 1));
+ else
+ v_min_string_wrap := v_last_string_wrap + 1; -- Minimum 1 character further into the inpit line
+ v_max_string_wrap := minimum(v_last_string_wrap + (line_width - alignment_pos2 + 1), v_string_width);
+ write(text_lines, fill_string(' ', alignment_pos2 - 1));
+ end if;
+
+ -- 1. First handle any potential explicit line feed in the current maximum text line
+ -- Search forward for potential LF
+ for i in (v_last_string_wrap + 1) to minimum(v_max_string_wrap + 1, v_string_width) loop
+ if (character(v_string(i)) = LF) then
+ write(text_lines, v_string((v_last_string_wrap + 1) to i)); -- LF now terminates this part
+ v_last_string_wrap := i;
+ next l_line; -- next line
+ end if;
+ end loop;
+
+ -- 2. Then check if remaining text fits into a single text line
+ if (v_string_width <= v_max_string_wrap) then
+ -- No (more) wrapping required
+ write(text_lines, v_string((v_last_string_wrap + 1) to v_string_width));
+ exit; -- No more lines
+ end if;
+
+ -- 3. Search for blanks from char after max msg width and downwards (in the left direction)
+ for i in v_max_string_wrap + 1 downto (v_last_string_wrap + 1) loop
+ if (character(v_string(i)) = ' ') then
+ write(text_lines, v_string((v_last_string_wrap + 1) to i-1)); -- Exchange last blank with LF
+ v_last_string_wrap := i;
+ if (i = v_string_width ) then
+ exit l_line;
+ end if;
+ -- Skip any potential extra blanks in the string
+ for j in (i+1) to v_string_width loop
+ if (v_string(j) = ' ') then
+ v_last_string_wrap := j;
+ if (j = v_string_width ) then
+ exit l_line;
+ end if;
+ else
+ write(text_lines, LF); -- Exchange last blanks with LF, provided not at the end of the string
+ exit;
+ end if;
+ end loop;
+ next l_line; -- next line
+ end if;
+ end loop;
+
+ -- 4. At this point no LF or blank is found in the searched section of the string.
+ -- Hence just break the string - and continue.
+ write(text_lines, v_string((v_last_string_wrap + 1) to v_max_string_wrap) & LF); -- Added LF termination
+ v_last_string_wrap := v_max_string_wrap;
+ end loop;
+ end;
+
+ procedure prefix_lines(
+ variable text_lines : inout line;
+ constant prefix : string := C_LOG_PREFIX
+ ) is
+ variable v_string : string(1 to text_lines'length) := text_lines.all;
+ variable v_string_width : natural := text_lines'length;
+ constant prefix_width : natural := prefix'length;
+ variable v_last_string_wrap : natural := 0;
+ variable i : natural := 0; -- for indexing v_string
+ begin
+ deallocate(text_lines); -- empty the line prior to filling it up again
+ l_line : loop
+ -- 1. Write prefix
+ write(text_lines, prefix);
+ -- 2. Write rest of text line (or rest of input line if no LF)
+ l_char: loop
+ i := i + 1;
+ if (i < v_string_width) then
+ if (character(v_string(i)) = LF) then
+ write(text_lines, v_string((v_last_string_wrap + 1) to i));
+ v_last_string_wrap := i;
+ exit l_char;
+ end if;
+ else
+ -- 3. Reached end of string. Hence just write the rest.
+ write(text_lines, v_string((v_last_string_wrap + 1) to v_string_width));
+ -- But ensure new line with prefix if ending with LF
+ if (v_string(i) = LF) then
+ write(text_lines, prefix);
+ end if;
+ exit l_char;
+ end if;
+ end loop;
+ if (i = v_string_width) then
+ exit;
+ end if;
+ end loop;
+ end;
+
+ function replace(
+ val : string;
+ target_char : character;
+ exchange_char : character
+ ) return string is
+ variable result : string(1 to val'length) := val;
+ begin
+ for i in val'range loop
+ if val(i) = target_char then
+ result(i) := exchange_char;
+ end if;
+ end loop;
+ return result;
+ end;
+
+ procedure replace(
+ variable text_line : inout line;
+ target_char : character;
+ exchange_char : character
+ ) is
+ variable v_string : string(1 to text_line'length) := text_line.all;
+ variable v_string_width : natural := text_line'length;
+ variable i : natural := 0; -- for indexing v_string
+ begin
+ if v_string_width > 0 then
+ deallocate(text_line); -- empty the line prior to filling it up again
+ -- 1. Loop through string and replace characters
+ l_char: loop
+ i := i + 1;
+ if (i < v_string_width) then
+ if (character(v_string(i)) = target_char) then
+ v_string(i) := exchange_char;
+ end if;
+ else
+ -- 2. Reached end of string. Hence just write the new string.
+ write(text_line, v_string);
+ exit l_char;
+ end if;
+ end loop;
+ end if;
+ end;
+
+ --========================================================
+ -- Handle missing overloads from 'standard_additions' + advanced overloads
+ --========================================================
+ function to_string(
+ val : boolean;
+ width : natural;
+ justified : side := right;
+ format : t_format_string := AS_IS
+ ) return string is
+ begin
+ return justify(to_string(val), width, justified, format);
+ end;
+
+ function to_string(
+ val : integer;
+ width : natural;
+ justified : side := right;
+ format : t_format_string := AS_IS
+ ) return string is
+ begin
+ return justify(to_string(val), width, justified, format);
+ end;
+
+ function to_string(
+ val : std_logic_vector;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string is
+ variable v_line : line;
+ alias a_val : std_logic_vector(val'length - 1 downto 0) is val;
+ variable v_result : string(1 to 10 + 2 * val'length); --
+ variable v_width : natural;
+ variable v_use_end_char : boolean := false;
+ begin
+ if val'length = 0 then
+ -- Value length is zero,
+ -- return empty string.
+ return "";
+ end if;
+
+ if radix = BIN then
+ if prefix = INCL_RADIX then
+ write(v_line, string'("b"""));
+ v_use_end_char := true;
+ end if;
+ write(v_line, adjust_leading_0(to_string(val), format));
+ elsif radix = HEX then
+ if prefix = INCL_RADIX then
+ write(v_line, string'("x"""));
+ v_use_end_char := true;
+ end if;
+ write(v_line, adjust_leading_0(to_hstring(val), format));
+ elsif radix = DEC then
+ if prefix = INCL_RADIX then
+ write(v_line, string'("d"""));
+ v_use_end_char := true;
+ end if;
+ -- Assuming that val is not signed
+ if (val'length > 31) then
+ write(v_line, to_hstring(val) & " (too wide to be converted to integer)" );
+ else
+ write(v_line, adjust_leading_0(to_string(to_integer(unsigned(val))), format));
+ end if;
+ elsif radix = HEX_BIN_IF_INVALID then
+ if prefix = INCL_RADIX then
+ write(v_line, string'("x"""));
+ end if;
+ if is_x(val) then
+ write(v_line, adjust_leading_0(to_hstring(val), format));
+ if prefix = INCL_RADIX then
+ write(v_line, string'("""")); -- terminate hex value
+ end if;
+ write(v_line, string'(" (b"""));
+ write(v_line, adjust_leading_0(to_string(val), format));
+ write(v_line, string'(""""));
+ write(v_line, string'(")"));
+ else
+ write(v_line, adjust_leading_0(to_hstring(val), format));
+ if prefix = INCL_RADIX then
+ write(v_line, string'(""""));
+ end if;
+ end if;
+ end if;
+ if v_use_end_char then
+ write(v_line, string'(""""));
+ end if;
+
+ v_width := v_line'length;
+ v_result(1 to v_width) := v_line.all;
+ deallocate(v_line);
+ return v_result(1 to v_width);
+ end;
+
+ function to_string(
+ val : unsigned;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string is
+ begin
+ return to_string(std_logic_vector(val), radix, format, prefix);
+ end;
+
+ function to_string(
+ val : signed;
+ radix : t_radix;
+ format : t_format_zeros := AS_IS; -- | SKIP_LEADING_0
+ prefix : t_radix_prefix := EXCL_RADIX -- Insert radix prefix in string?
+ ) return string is
+ variable v_line : line;
+ variable v_result : string(1 to 10 + 2 * val'length); --
+ variable v_width : natural;
+ variable v_use_end_char : boolean := false;
+ begin
+ -- Support negative numbers by _not_ using the slv overload when converting to decimal
+ if radix = DEC then
+ if val'length = 0 then
+ -- Value length is zero,
+ -- return empty string.
+ return "";
+ end if;
+
+ if prefix = INCL_RADIX then
+ write(v_line, string'("d"""));
+ v_use_end_char := true;
+ end if;
+ if (val'length > 32) then
+ write(v_line, to_string(std_logic_vector(val),radix, format, prefix) & " (too wide to be converted to integer)" );
+ else
+ write(v_line, adjust_leading_0(to_string(to_integer(signed(val))), format));
+ end if;
+
+ if v_use_end_char then
+ write(v_line, string'(""""));
+ end if;
+
+ v_width := v_line'length;
+ v_result(1 to v_width) := v_line.all;
+ deallocate(v_line);
+ return v_result(1 to v_width);
+
+ else -- No decimal convertion: May be treated as slv, so use the slv overload
+ return to_string(std_logic_vector(val), radix, format, prefix);
+ end if;
+ end;
+
+ --========================================================
+ -- Handle types defined at lower levels
+ --========================================================
+
+ function to_string(
+ val : t_alert_level;
+ width : natural := 0;
+ justified : side := right
+ ) return string is
+ constant inner_string : string := t_alert_level'image(val);
+ begin
+ return to_upper(justify(inner_string, width, justified));
+ end function;
+
+ function to_string(
+ val : t_msg_id;
+ width : natural := 0;
+ justified : side := right
+ ) return string is
+ constant inner_string : string := t_msg_id'image(val);
+ begin
+ return to_upper(justify(inner_string, width, justified));
+ end function;
+
+ function to_string(
+ val : t_enabled
+ ) return string is
+ begin
+ return to_upper(t_enabled'image(val));
+ end;
+
+ function to_string(
+ val : t_attention;
+ width : natural := 0;
+ justified : side := right
+ ) return string is
+ begin
+ return to_upper(justify(t_attention'image(val), width, justified));
+ end;
+
+
+ procedure to_string(
+ val : t_alert_attention_counters;
+ order : t_order := FINAL
+ ) is
+ variable v_line : line;
+ variable v_line_copy : line;
+ variable v_all_ok : boolean := true;
+ variable v_header : string(1 to 42);
+ constant prefix : string := C_LOG_PREFIX & " ";
+ begin
+ if order = INTERMEDIATE then
+ v_header := "*** INTERMEDIATE SUMMARY OF ALL ALERTS ***";
+ else -- order=FINAL
+ v_header := "*** FINAL SUMMARY OF ALL ALERTS *** ";
+ end if;
+
+ write(v_line,
+ LF &
+ fill_string('=', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ v_header & LF &
+ fill_string('=', (C_LOG_LINE_WIDTH - prefix'length)) & LF &
+ " REGARDED EXPECTED IGNORED Comment?" & LF);
+ for i in t_alert_level'left to t_alert_level'right loop
+ write(v_line, " " & to_upper(to_string(i, 13, LEFT)) & ": "); -- Severity
+ for j in t_attention'left to t_attention'right loop
+ write(v_line, to_string(integer'(val(i)(j)), 6, RIGHT) & " ");
+ end loop;
+ if (val(i)(REGARD) = val(i)(EXPECT)) then
+ write(v_line, " ok " & LF);
+ else
+ write(v_line, " *** " & to_string(i,0) & " *** " & LF);
+ if (i > MANUAL_CHECK) then
+ v_all_ok := false;
+ end if;
+ end if;
+ end loop;
+ write(v_line, fill_string('=', (C_LOG_LINE_WIDTH - prefix'length)) & LF);
+ -- Print a conclusion when called from the FINAL part of the test sequncer
+ -- but not when called from in the middle of the test sequence (order=INTERMEDIATE)
+ if order = FINAL then
+ if v_all_ok then
+ write(v_line, ">> Simulation SUCCESS: No mismatch between counted and expected serious alerts" & LF);
+ else
+ write(v_line, ">> Simulation FAILED, with unexpected serious alert(s)" & LF);
+ end if;
+ write(v_line, fill_string('=', (C_LOG_LINE_WIDTH - prefix'length)) & LF & LF);
+ end if;
+
+ wrap_lines(v_line, 1, 1, C_LOG_LINE_WIDTH-prefix'length);
+ prefix_lines(v_line, prefix);
+
+ -- Write the info string to the target file
+ write (v_line_copy, v_line.all & lf); -- copy line
+ writeline(OUTPUT, v_line);
+ writeline(LOG_FILE, v_line_copy);
+ end;
+
+ -- Convert from ASCII to character
+ -- Inputs:
+ -- ascii_pos (integer) : ASCII number input
+ -- ascii_allow (t_ascii_allow) : Decide what to do with invisible control characters:
+ -- - If ascii_allow = ALLOW_ALL (default) : return the character for any ascii_pos
+ -- - If ascii_allow = ALLOW_PRINTABLE_ONLY : return the character only if it is printable
+ function ascii_to_char(
+ ascii_pos : integer range 0 to 255; -- Supporting Extended ASCII
+ ascii_allow : t_ascii_allow := ALLOW_ALL
+ ) return character is
+ variable v_printable : boolean := true;
+ begin
+
+ if ascii_pos < 32 or -- NUL, SOH, STX etc
+ (ascii_pos >= 128 and ascii_pos < 160) then -- C128 to C159
+ v_printable := false;
+ end if;
+
+ if ascii_allow = ALLOW_ALL or
+ (ascii_allow = ALLOW_PRINTABLE_ONLY and v_printable) then
+ return character'val(ascii_pos);
+ else
+ return ' '; -- Must return something when invisible control signals
+ end if;
+
+ end;
+
+ -- Convert from character to ASCII integer
+ function char_to_ascii(
+ char : character
+ ) return integer is
+ begin
+ return character'pos(char);
+ end;
+
+ -- return string with only valid ascii characters
+ function to_string(
+ val : string
+ ) return string is
+ variable v_new_string : string(1 to val'length);
+ variable v_char_idx : natural := 0;
+ variable v_ascii_pos : natural;
+ begin
+ for i in val'range loop
+ v_ascii_pos := character'pos(val(i));
+ if v_ascii_pos < 32 or -- NUL, SOH, STX etc
+ (v_ascii_pos >= 128 and v_ascii_pos < 160) then -- C128 to C159
+ -- illegal char
+ null;
+ else
+ -- legal char
+ v_char_idx := v_char_idx + 1;
+ v_new_string(v_char_idx) := val(i);
+ end if;
+ end loop;
+ if v_char_idx = 0 then
+ return "";
+ else
+ return v_new_string(1 to v_char_idx);
+ end if;
+ end;
+
+
+end package body string_methods_pkg;
diff --git a/testsuite/gna/ticket89/project/src93/types_pkg.vhd b/testsuite/gna/ticket89/project/src93/types_pkg.vhd
new file mode 100644
index 0000000..2320030
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/types_pkg.vhd
@@ -0,0 +1,101 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : types_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use std.textio.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+package types_pkg is
+ file ALERT_FILE : text;
+ file LOG_FILE : text;
+
+ constant C_LOG_HDR_FOR_WAVEVIEW_WIDTH : natural := 100; -- For string in waveview indicating last log header
+
+ type t_void is (VOID);
+
+ type t_natural_array is array (natural range <>) of natural;
+ type t_integer_array is array (natural range <>) of integer;
+
+
+ -- Note: Most types below have a matching to_string() in 'string_methods_pkg.vhd'
+
+ type t_info_target is (LOG_INFO, ALERT_INFO, USER_INFO);
+ type t_alert_level is (NOTE, TB_NOTE, WARNING, TB_WARNING, MANUAL_CHECK, ERROR, TB_ERROR, FAILURE, TB_FAILURE);
+
+ type t_enabled is (ENABLED, DISABLED);
+ type t_attention is (REGARD, EXPECT, IGNORE);
+ type t_radix is (BIN, HEX, DEC, HEX_BIN_IF_INVALID);
+ type t_radix_prefix is (EXCL_RADIX, INCL_RADIX);
+ type t_order is (INTERMEDIATE, FINAL);
+ type t_ascii_allow is (ALLOW_ALL, ALLOW_PRINTABLE_ONLY);
+ type t_blocking_mode is (BLOCKING, NON_BLOCKING);
+ type t_from_point_in_time is (FROM_NOW, FROM_LAST_EVENT);
+
+ type t_format_zeros is (AS_IS, SKIP_LEADING_0);
+ type t_format_string is (AS_IS, TRUNCATE, SKIP_LEADING_SPACE);
+
+ type t_log_format is (FORMATTED, UNFORMATTED);
+ type t_log_if_block_empty is (WRITE_HDR_IF_BLOCK_EMPTY, SKIP_LOG_IF_BLOCK_EMPTY, NOTIFY_IF_BLOCK_EMPTY);
+
+ type t_alert_counters is array (t_alert_level'left to t_alert_level'right) of natural;
+ type t_alert_attention is array (t_alert_level'left to t_alert_level'right) of t_attention;
+
+ type t_attention_counters is array (t_attention'left to t_attention'right) of natural; -- Only used to build below type
+ type t_alert_attention_counters is array (t_alert_level'left to t_alert_level'right) of t_attention_counters;
+
+ type t_quietness is (NON_QUIET, QUIET);
+
+ type t_deprecate_setting is (NO_DEPRECATE, DEPRECATE_ONCE, ALWAYS_DEPRECATE);
+ type t_deprecate_list is array(0 to 9) of string(1 to 100);
+
+ type t_global_ctrl is record
+ attention : t_alert_attention;
+ stop_limit : t_alert_counters;
+ end record;
+
+ type t_current_log_hdr is record
+ normal : string(1 to C_LOG_HDR_FOR_WAVEVIEW_WIDTH);
+ large : string(1 to C_LOG_HDR_FOR_WAVEVIEW_WIDTH);
+ xl : string(1 to C_LOG_HDR_FOR_WAVEVIEW_WIDTH);
+ end record;
+
+ -------------------------------------
+ -- BFMs and above
+ -------------------------------------
+ type t_transaction_result is (ACK, NAK, ERROR); -- add more when needed
+
+
+
+end package types_pkg;
+
+package body types_pkg is
+end package body types_pkg;
diff --git a/testsuite/gna/ticket89/project/src93/vhdl_version_layer_pkg.vhd b/testsuite/gna/ticket89/project/src93/vhdl_version_layer_pkg.vhd
new file mode 100644
index 0000000..2ad6a80
--- /dev/null
+++ b/testsuite/gna/ticket89/project/src93/vhdl_version_layer_pkg.vhd
@@ -0,0 +1,97 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : vhdl_version_layer_pkg
+--
+-- Description : See library quick reference (under 'doc') and README-file(s)
+------------------------------------------------------------------------------------------
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use std.textio.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+use ieee_proposed.standard_textio_additions.all;
+
+
+use work.types_pkg.all;
+use work.adaptations_pkg.all;
+use work.string_methods_pkg.all;
+
+
+package vhdl_version_layer_pkg is
+
+ impure function get_alert_counter(
+ alert_level: t_alert_level;
+ attention : t_attention := REGARD
+ ) return natural;
+
+ procedure increment_alert_counter(
+ alert_level: t_alert_level;
+ attention : t_attention := REGARD; -- regard, expect, ignore
+ number : natural := 1
+ );
+
+ procedure report_alert_counters(
+ order : t_order
+ );
+
+
+end package vhdl_version_layer_pkg;
+
+--=============================================================================
+--=============================================================================
+
+package body vhdl_version_layer_pkg is
+
+ -- Shared variable for all the alert counters for different attention
+ shared variable shared_alert_attention_counters : t_alert_attention_counters;
+
+ impure function get_alert_counter(
+ alert_level: t_alert_level;
+ attention : t_attention := REGARD
+ ) return natural is
+ begin
+ return shared_alert_attention_counters(alert_level)(attention);
+ end;
+
+ procedure increment_alert_counter(
+ alert_level: t_alert_level;
+ attention : t_attention := REGARD; -- regard, expect, ignore
+ number : natural := 1
+ ) is
+ begin
+ shared_alert_attention_counters(alert_level)(attention) :=
+ shared_alert_attention_counters(alert_level)(attention) + number;
+ end;
+
+ procedure report_alert_counters(
+ order : t_order
+ ) is
+ begin
+ to_string(shared_alert_attention_counters, order);
+ end;
+
+
+end package body vhdl_version_layer_pkg;
diff --git a/testsuite/gna/ticket89/project/tb/partial_test_tb.vhd b/testsuite/gna/ticket89/project/tb/partial_test_tb.vhd
new file mode 100644
index 0000000..2967346
--- /dev/null
+++ b/testsuite/gna/ticket89/project/tb/partial_test_tb.vhd
@@ -0,0 +1,156 @@
+--========================================================================================================================
+-- Copyright (c) 2015 by Bitvis AS. All rights reserved.
+-- A free license is hereby granted, free of charge, to any person obtaining
+-- a copy of this VHDL code and associated documentation files (for 'Bitvis Utility Library'),
+-- to use, copy, modify, merge, publish and/or distribute - subject to the following conditions:
+-- - This copyright notice shall be included as is in all copies or substantial portions of the code and documentation
+-- - The files included in Bitvis Utility Library may only be used as a part of this library as a whole
+-- - The License file may not be modified
+-- - The calls in the code to the license file ('show_license') may not be removed or modified.
+-- - No other conditions whatsoever may be added to those of this License
+
+-- BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+--========================================================================================================================
+
+------------------------------------------------------------------------------------------
+-- VHDL unit : Bitvis Utility Library : partial_test_tb
+--
+-- Description : Parts of the testbench used for testing the Bitvis Utility Library
+------------------------------------------------------------------------------------------
+
+
+library IEEE;
+use IEEE.std_logic_1164.all;
+use IEEE.numeric_std.all;
+
+library STD;
+use std.textio.all;
+
+library work;
+use work.types_pkg.all;
+use work.string_methods_pkg.all;
+use work.adaptations_pkg.all;
+use work.methods_pkg.all;
+use work.bfm_common_pkg.all;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all; -- Used for to_string(real)
+use ieee_proposed.std_logic_1164_additions.all; -- Used for to_string(std_logic)
+
+
+entity partial_test_tb is
+end entity;
+
+
+architecture func of partial_test_tb is
+
+ signal sl : std_logic := '0';
+ signal clk100M : std_logic;
+ signal clk100M_ena : boolean := true;
+
+ signal clk200M : std_logic;
+ signal clk200M_ena : boolean := true;
+
+ signal clk50M : std_logic;
+
+ constant C_CLK100M_PERIOD : time := 10 ns;
+
+begin
+
+ ------------------------------------------------
+ -- Process: clock generator
+ ------------------------------------------------
+ -- Overloaded version with enable signal as argument
+ clock_generator(clk100M, clk100M_ena, C_CLK100M_PERIOD, "Clk100M");
+
+ ------------------------------------------------
+ -- PROCESS: p_main
+ ------------------------------------------------
+ p_main: process
+ constant C_SCOPE : string := "TB seq";
+
+ -- Log overloads for simplification
+ procedure log(
+ msg : string) is
+ begin
+ log(ID_SEQUENCER, msg, C_SCOPE);
+ end;
+
+
+
+ begin
+ set_alert_file_name("alertlog.txt");
+ set_log_file_name("testlog.txt");
+
+
+ set_alert_stop_limit(WARNING, 0);
+ set_alert_stop_limit(ERROR, 0); -- 0 = Never stop
+ wait for 1 ns;
+
+
+
+ -- ####################### BLOCK 1 - Causes "internal error: delayed" ##########################
+
+ -- FROM_NOW, FROM_NOW
+ await_stable(sl, 50 ns, FROM_NOW, 100 ns, FROM_NOW, ERROR, "sl: Stable FROM_NOW, FROM_NOW, OK after 50 ns", C_SCOPE);
+
+ sl <= transport not sl after 30 ns;
+ await_stable(sl, 50 ns, FROM_NOW, 100 ns, FROM_NOW, ERROR, "sl: Stable FROM_NOW, FROM_NOW, OK after 80 ns", C_SCOPE);
+
+ sl <= transport not sl after 30 ns;
+ await_stable(sl, 50 ns, FROM_NOW, 60 ns, FROM_NOW, ERROR, "sl: Not stable FROM_NOW, FROM_NOW, Fail after 30 ns", C_SCOPE);
+ increment_expected_alerts(ERROR, 1);
+
+ await_stable(sl, 50 ns, FROM_NOW, 1 ns, FROM_NOW, ERROR, "sl: Timeout before stable_req, FROM_NOW, FROM_NOW, Fail immediately", C_SCOPE);
+ increment_expected_alerts(ERROR, 1);
+
+ await_stable(sl, 0 ns, FROM_NOW, 0 ns, FROM_NOW, ERROR, "sl: stable for 0 ns, FROM_NOW, FROM_NOW, OK after 0 ns", C_SCOPE);
+
+
+ -- FROM_LAST_EVENT, FROM_NOW
+ sl <= not sl;
+ log("NOTE: ERROR HAPPENS AFTER HERE");
+ wait for 10 ns;
+ log("NOTE: ERROR HAPPENS BEFORE HERE");
+
+ -- ####################### END OF BLOCK 1 ##########################
+
+
+
+
+ -- ####################### BLOCK 2 - Code works if this is removed ##########################
+
+ -- Pulse a certain number of clock periods
+ clk100M_ena <= true; -- Clock must be running
+ sl <= '0';
+ wait for 0 ns; -- Wait for signal to update
+ gen_pulse(sl, clk100M, 10, "Test pulse 10 clk periods");
+ check_value(sl'delayed(0 ns)'last_event, 10*C_CLK100M_PERIOD, ERROR, "Check start of pulse");
+ wait for 0 ns; -- Wait for signal to be updated
+ check_value(sl, '0', ERROR, "pulse for 10 clk periods, pulse done", C_SCOPE);
+ check_value(sl'last_event, 0 ns, ERROR, "pulse for 10 clk periods. Check that it actually pulsed for a delta cycle", C_SCOPE);
+ check_value(sl'last_value, '1', ERROR, "pulse for 10 clk periods, check that it actually pulsed for a delta cycle", C_SCOPE);
+ wait for 100 ns;
+
+ -- ####################### END OF BLOCK 2 ##########################
+
+ --==================================================================================================
+ -- Ending the simulation
+ --------------------------------------------------------------------------------------
+ wait for 1000 ns; -- to allow some time for completion
+ report_alert_counters(INTERMEDIATE);
+ report_alert_counters(FINAL);
+ log(ID_LOG_HDR,"SIMULATION COMPLETED", C_SCOPE);
+ assert false
+ report "End of simulation. (***Ignore this failure. Was provoked to stop the simulation.)"
+ severity failure;
+ wait; -- to stop completely
+
+
+ end process p_main;
+
+end func;
+
diff --git a/testsuite/gna/ticket89/repro.vhdl b/testsuite/gna/ticket89/repro.vhdl
new file mode 100644
index 0000000..8345172
--- /dev/null
+++ b/testsuite/gna/ticket89/repro.vhdl
@@ -0,0 +1,24 @@
+entity repro is
+end repro;
+
+architecture behav of repro is
+ signal s : natural;
+begin -- behav
+ process (s) is
+ variable v : natural;
+ begin
+ v := s'delayed (0 ns);
+ end process;
+
+ process
+ begin
+ s <= 3;
+ wait for 1 ns;
+ s <= 4;
+ wait for 0 ns;
+ s <= 5;
+ wait for 0 ns;
+ s <= 5;
+ wait;
+ end process;
+end behav;
diff --git a/testsuite/gna/ticket89/testsuite.sh b/testsuite/gna/ticket89/testsuite.sh
new file mode 100755
index 0000000..e383bbc
--- /dev/null
+++ b/testsuite/gna/ticket89/testsuite.sh
@@ -0,0 +1,30 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze repro.vhdl
+elab_simulate repro
+clean
+
+GHDL_FLAGS=--work=ieee_proposed
+analyze x_ieee_proposed/src/std_logic_1164_additions.vhdl
+analyze x_ieee_proposed/src/standard_additions_c.vhdl
+analyze x_ieee_proposed/src/standard_textio_additions_c.vhdl
+
+GHDL_FLAGS=--work=bitvis_util
+analyze project/src93/types_pkg.vhd
+analyze project/src93/adaptations_pkg.vhd
+analyze project/src93/string_methods_pkg.vhd
+analyze project/src93/vhdl_version_layer_pkg.vhd
+analyze project/src93/license_open_pkg.vhd
+analyze project/src93/methods_pkg.vhd
+analyze project/src93/bfm_common_pkg.vhd
+
+analyze project/tb/partial_test_tb.vhd
+elab_simulate_failure partial_test_tb
+
+clean
+clean ieee_proposed
+clean bitvis_util
+
+echo "Test successful"
diff --git a/testsuite/gna/ticket89/versions.txt b/testsuite/gna/ticket89/versions.txt
new file mode 100644
index 0000000..5b6343c
--- /dev/null
+++ b/testsuite/gna/ticket89/versions.txt
@@ -0,0 +1,5 @@
+This project uses the following versions:
+ bitvis_util, version v2.5.1
+ bitvis_irqc, version v0.1.5
+ bitvis_vip_sbi, version v0.1.6
+ x_ieee_proposed, version v0.1.4
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/CHANGES.TXT b/testsuite/gna/ticket89/x_ieee_proposed/CHANGES.TXT
new file mode 100644
index 0000000..a4cae08
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/CHANGES.TXT
@@ -0,0 +1,8 @@
+IEEE Proposed - Overview of Versions and Changes
+==============================================================
+
+NOTE: The source for this library originates from IEEE. We do
+ not have an original version number for this code. The
+ version numbers used are Bitvis-specific.
+
+--------------------------------------------------------------
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/README.TXT b/testsuite/gna/ticket89/x_ieee_proposed/README.TXT
new file mode 100644
index 0000000..e7ef7e3
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/README.TXT
@@ -0,0 +1,8 @@
+ -----------------------------------------------------------
+ -- Directory structure --
+ -----------------------------------------------------------
+
+- x_ieee_proposed : The IEEE Proposed library, used by the VHDL2002 and VHDL93 versions of Bitvis Utility Library.
+ This library allows 2008-functionality to be used in simulators not supporting VHDL2008.
+ - script : Compile script
+ - src : Source code
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/script/compile_src.do b/testsuite/gna/ticket89/x_ieee_proposed/script/compile_src.do
new file mode 100644
index 0000000..3343bad
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/script/compile_src.do
@@ -0,0 +1,50 @@
+#========================================================================================================================
+# Copyright (c) 2015 by Bitvis AS. All rights reserved.
+#
+# BITVIS UTILITY LIBRARY AND ANY PART THEREOF ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
+# INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH BITVIS UTILITY LIBRARY.
+#========================================================================================================================
+
+# This file may be called with an argument
+# arg 1: Part directory of this library/module
+
+if {[batch_mode]} {
+ onerror {abort all; exit -f -code 1}
+} else {
+ onerror {abort all}
+}
+
+# Set up part_path and lib_name
+#------------------------------------------------------
+quietly set lib_name "ieee_proposed"
+quietly set part_name "x_ieee_proposed"
+# path from mpf-file in sim
+quietly set part_path "../..//$part_name"
+
+if { [info exists 1] } {
+ # path from this part to target part
+ quietly set part_path "$1/..//$part_name"
+ unset 1
+}
+
+
+
+if {[file exists $part_path/sim/$lib_name]} {
+ file delete -force $part_path/sim/$lib_name
+}
+if {![file exists $part_path/sim]} {
+ file mkdir $part_path/sim
+}
+
+vlib $part_path/sim/$lib_name
+vmap $lib_name $part_path/sim/$lib_name
+
+
+echo "\n\n\n=== Compiling $lib_name source\n"
+vcom -93 -work $lib_name $part_path/src/standard_additions_c.vhdl
+vcom -93 -work $lib_name $part_path/src/standard_textio_additions_c.vhdl
+vcom -93 -work $lib_name $part_path/src/std_logic_1164_additions.vhdl
+vcom -93 -work $lib_name $part_path/src/numeric_std_additions.vhdl
+
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/README b/testsuite/gna/ticket89/x_ieee_proposed/src/README
new file mode 100644
index 0000000..775ff3b
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/README
@@ -0,0 +1,173 @@
+
+ This is the "ieee_proposed" library. This is a compatability library,
+which is designed to provide all of the functionality of the VHDL-200X-FT
+packages in VHDL-93. The "_c" after the package name is used to denote
+that this is a 1993 compliant version of this package. Otherwise, the
+name of the file and the name of the package are the same.
+
+Please compile the following files into a library named "ieee_proposed":
+standard_additions_c.vhdl
+env_c.vhdl
+standard_textio_additions_c.vhdl
+std_logic_1164_additions.vhdl
+numeric_std_additions.vhdl
+numeric_std_unsigned_c.vhdl
+fixed_pkg_c.vhdl
+float_pkg_c.vhdl
+
+
+New/Updated functions
+A) standard_additions -- Additions to the package "std.standard"
+ Use model:
+ use ieee_proposed.standard_additions.all;
+ Dependancies: None.
+ Notes: The functions "rising_edge" and "falling_edge" are defined in
+ this package. If you use "numeric_bit" they are ALSO defined in that
+ package, causing a conflict. The VHDL-2008 version of numeric_bit
+ has these functions commented out, as well as the "sll", "srl", "ror"
+ and "rol" functions which are implicit.
+ New types defined in this package:
+ REAL_VECTOR
+ TIME_VECTOR
+ INTEGER_VECTOR
+ BOOLEAN_VECTOR
+ New constants defined in this package:
+ SIM_RESOLUTION : TIME - returns the simulator's resolution (1 ns default)
+ 1) "maximum" and "minimum" are defined for all default datatypes
+ 2) _reduce functions (and_reduce, nand_reduce, or_reduce ...) are defined
+ These functions reduce a bit_vector to a single bit. Example:
+ or_reduce ("0101") = '1'. In VHDL-2008 syntax these will be "or".
+ 3) "vector" and "bit" operations are defined. These will perform a
+ boolean operation of a vector. Example:
+ "1" xor "1010" = "0101";
+ 5) /??/ function is defined for "bit" ("??" operator is release)
+ if (/??/('1')) then -- will return a "true".
+ 6) rising_edge and falling_edge functions are defined (see Notes).
+ 7) to_string function - Converts any of the base types into a string.
+ Example:
+ assert (bv = "101") report "result was " & to_string(bv) severity note;
+ 8) to_hstring and to_ostring function (bit_vector to hex or octal string)
+B) standard_textio_additions - Additions to the package "std.textio"
+ Use model:
+ use ieee_proposed.standard_textio_additions.all;
+ Dependencies: std.textio, ieee_proposed.standard_additions
+ 1) tee - Echos the string to BOTH the file and the screen
+ 2) SREAD and SWRITE - String read and write routines (so you no longer
+ need to do write (L, string'("ABCEDFG"));
+ 3) HREAD and HWRITE (Hex read and write) for bit_vector
+ 4) OREAD and OWRITE (octal read and write) for bit_vector
+ 5) BREAD and BWRITE (binary read and write, same as "READ" and "WRITE" for
+ bit_vector
+ 6) justify - Justify a string left or right with a width. Example:
+ justify ("ABCD", left, 6); will result in "ABCD "
+C) std_logic_1164_additions - Additions to the package "ieee.std_logic_1164"
+ Usage model:
+ use ieee.std_logic_1164.all;
+ -- use ieee.std_logic_textio.all; -- Comment out, included in "_additions".
+ use ieee_proposed.std_logic_1164_additions.all;
+ Dependencies: ieee.std_logic_1164
+ Note: The contents of the "std_logic_textio" package have now been
+ included in the "std_logic_1164" package, and an EMPTY "std_logic_textio"
+ package is provided in the new release.
+ 1) Short had aliases:
+ a) to_bv - calls "to_BitVector"
+ b) to_slv - calls "to_StdLogicVector"
+ c) to_sulv - calls "to_stdULogicVector"
+ 2) Long hand aliases:
+ a) to_bit_vector - calls "to_BitVector"
+ b) to_std_logic_vector - calls "to_StdLogicVector"
+ c) to_std_ulogic_vector - calls "to_StdULogicVector"
+ 3) _reduce functions (and_reduce, nand_reduce, or_reduce ...) are defined
+ These functions reduce a std_logic_vector (or ulogic) to a single bit.
+ In vhdl-2006 these will be unary "or", example "or "11011" = '1'"
+ 4) "vector" and "std_ulogic" operations are defined. These will perform a
+ boolean operation of a vector. Example:
+ "1" xor "1010" = "0101";
+ 5) "std_ulogic" and "boolean" operations are defined. Thus:
+ if '1' and true then -- returns a "true".
+ 6) "\??\" function is defined for "std_ulogic" ("??" operator is release)
+ if (bool('1')) then -- will return a "true".
+ 7) READ and WRITE procedures for "std_logic_vector", "std_ulogic_vector"
+ and "std_ulogic" are defined.
+ 8) HREAD and HWRITE (Hex read and write) for std_logic_vector
+ and std_ulogic_vector. These are more "forgiving" than the ones
+ originally from "std_logic_textio"
+ 9) OREAD and OWRITE (octal read and write) for std_logic_vector
+ and std_ulogic_vector. These are more "forgiving" than the ones
+ originally from "std_logic_textio"
+ 10) BREAD and BWRITE (binary read and write, same as "READ" and "WRITE" for
+ std_logic_vector and std_ulogic_vector.
+ 11) to_string function - Converts a "std_ulogic", "std_logic_vector" or
+ "std_ulogic_vector" types into a string.
+ Example:
+ assert (slv = "101") report "result was " & to_string(slv) severity note;
+ 12) to_hstring and to_ostring function (std_(u)logic_vector to hex or octal
+ string)
+D) numeric_std_additions - additions the the package "ieee.numeric_std"
+ Usage Model:
+ use ieee.std_logic_1164.all;
+ use ieee.numeric_std.all;
+ use ieee_proposed.numeric_std_additions.all;
+ Dependencies: ieee.std_logic_1164, ieee.numeric_std
+ 1) SIGNED or UNSIGNED + std_ulogic operators
+ 2) SIGNED or UNSIGNED - std_ulogic operators
+ 3) type UNRESOLVED_UNSIGNED (aliased to U_UNSIGNED) is an unresolved
+ verion of UNSIGNED. It is aliased to "UNSIGNED" for compatability.
+ 4) type UNRESOLVED_SIGNED (aliased to U_SIGNED) is an unresolved
+ verion of SIGNED. It is aliased to "SIGNED" for compatability.
+ 5) \?=\, \?/=\ - similar to "std_match", but return std_ulogic values.
+ \?<\, \?<=\, \?>\, \?>=\ - compare functions which retrun std_ulogic.
+ (these will be "?="... operators in the release)
+ 7) To_X01, To_X01Z, To_U01X, Is_X - same as std_logic_1164 functions,
+ but overloaded for SIGNED and UNSIGNED.
+ 8) "sla" and "sra" - Mathmetically correct versions of these functions.
+ 9) minimum and maximum - smaller or larger of two SIGNED or UNSIGNED values.
+ 10) find_rightmost and find_leftmost - finds the first bit in a string.
+ Example:
+ find_leftmost (c12, '1'); -- returns the Log2 of "c12".
+ returns -1 if not found.
+ 11) _reduce functions (and_reduce, nand_reduce, or_reduce ...) are defined
+ These functions reduce a SIGNED or an UNSIGNED to a single bit.
+ (will overload the "or" and "and", ... operators in the release)
+ 12) SIGNED or UNSIGNED and "std_ulogic" operations are defined.
+ These will perform a boolean operation of a vector. Example:
+ "1" xor "1010" = "0101";
+ 13) READ and WRITE procedures for "SIGNED", and "UNSIGNED" are defined.
+ 14) HREAD and HWRITE (Hex read and write) for SIGNED and UNSIGNED.
+ These are more "forgiving" than the ones
+ originally from "std_logic_textio"
+ 15) OREAD and OWRITE (octal read and write) for "SIGNED" and "UNSIGNED.
+ These are more "forgiving" than the ones
+ originally from "std_logic_textio"
+ 16) BREAD and BWRITE (binary read and write, same as "READ" and "WRITE" for
+ SIGNED and UNSIGNED.
+ 17) to_string function - Converts a "SIGNED" or "UNSIGNED" types into a
+ string. Example:
+ assert (UNS = "101") report "result was " & to_string(UNS) severity note;
+ 18) to_hstring and to_ostring function (SIGNED or UNSIGNED to hex or octal
+ string)
+E) numeric_std_unsigned - Simular to the "std_logic_unsigned" packages, but
+ with all of the functionality of the "numeric_std" package.
+ use model:
+ use ieee.std_logic_1164.all;
+ use ieee_proposed.numeric_std_unsigned.all;
+ dependencies: ieee.numeric_std, ieee_proposed.numeric_std_additions
+
+F) For fixed point package:
+use model:
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use ieee_proposed.math_utility_pkg.all;
+use ieee_proposed.fixed_pkg.all;
+See fixed point package documentation
+http://www.vhdl.org/vhdl-200x/vhdl-200x-ft/packages/Fixed_ug.pdf
+
+G) For floating point package:
+use model:
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use ieee_proposed.math_utility_pkg.all;
+use ieee_proposed.fixed_pkg.all;
+use ieee_proposed.float_pkg.all;
+See floating point package documentation
+http://www.vhdl.org/vhdl-200x/vhdl-200x-ft/packages/Float_ug.pdf
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/compile_additions b/testsuite/gna/ticket89/x_ieee_proposed/src/compile_additions
new file mode 100644
index 0000000..d3e9e83
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/compile_additions
@@ -0,0 +1,24 @@
+#! /bin/csh -f
+#
+# Script to compile MTI
+\rm -rf ieee_proposed.lib
+vlib ieee_proposed.lib
+vmap IEEE_PROPOSED ieee_proposed.lib
+if ($MTI_VERSION == "mti5.7") then
+ set VERSION = "-93"
+else
+ set VERSION = "-2002"
+endif
+#set up some compile options
+set OPTIONS = "$VERSION -nologo"
+if ($1 == "quiet") then
+ set OPTIONS = "$OPTIONS -nowarn 3"
+endif
+vcom $OPTIONS -work IEEE_PROPOSED standard_additions_c.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED standard_textio_additions_c.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED std_logic_1164_additions.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED numeric_std_additions.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED numeric_std_unsigned_c.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED fixed_float_types_c.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED fixed_pkg_c.vhdl
+vcom $OPTIONS -work IEEE_PROPOSED float_pkg_c.vhdl
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/env_c.vhdl b/testsuite/gna/ticket89/x_ieee_proposed/src/env_c.vhdl
new file mode 100644
index 0000000..a27d4c0
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/env_c.vhdl
@@ -0,0 +1,48 @@
+package ENV is
+
+ procedure STOP (STATUS : INTEGER);
+ procedure FINISH (STATUS : INTEGER);
+
+ function RESOLUTION_LIMIT return DELAY_LENGTH;
+
+end package ENV;
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+package body ENV is
+
+ procedure STOP (STATUS : INTEGER) is
+ begin
+ report "Procedure STOP called with status: " & INTEGER'image(STATUS)
+ severity failure;
+ end procedure STOP;
+ procedure FINISH (STATUS : INTEGER) is
+ begin
+ report "Procedure FINISH called with status: " & INTEGER'image(STATUS)
+ severity failure;
+ end procedure FINISH;
+
+ constant BASE_TIME_ARRAY : time_vector :=
+ (
+ 1 fs, 10 fs, 100 fs,
+ 1 ps, 10 ps, 100 ps,
+ 1 ns, 10 ns, 100 ns,
+ 1 us, 10 us, 100 us,
+ 1 ms, 10 ms, 100 ms,
+ 1 sec, 10 sec, 100 sec,
+ 1 min, 10 min, 100 min,
+ 1 hr, 10 hr, 100 hr
+ ) ;
+
+ function RESOLUTION_LIMIT return DELAY_LENGTH is
+ begin
+ for i in BASE_TIME_ARRAY'range loop
+ if BASE_TIME_ARRAY(i) > 0 hr then
+ return BASE_TIME_ARRAY(i);
+ end if;
+ end loop;
+ report "STANDATD.RESOLUTION_LIMIT: Simulator resolution not less than 100 hr"
+ severity failure;
+ return 1 ns;
+ end function RESOLUTION_LIMIT;
+
+end package body ENV;
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/standard_additions_c.vhdl b/testsuite/gna/ticket89/x_ieee_proposed/src/standard_additions_c.vhdl
new file mode 100644
index 0000000..83c4881
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/standard_additions_c.vhdl
@@ -0,0 +1,2073 @@
+------------------------------------------------------------------------------
+-- "standard_additions" package contains the additions to the built in
+-- "standard.std" package. In the final version this package will be implicit.
+-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
+------------------------------------------------------------------------------
+package standard_additions is
+
+ function \?=\ (L, R : BOOLEAN) return BOOLEAN;
+ function \?/=\ (L, R : BOOLEAN) return BOOLEAN;
+ function \?<\ (L, R : BOOLEAN) return BOOLEAN;
+ function \?<=\ (L, R : BOOLEAN) return BOOLEAN;
+ function \?>\ (L, R : BOOLEAN) return BOOLEAN;
+ function \?>=\ (L, R : BOOLEAN) return BOOLEAN;
+
+ function MINIMUM (L, R : BOOLEAN) return BOOLEAN;
+ function MAXIMUM (L, R : BOOLEAN) return BOOLEAN;
+
+ function RISING_EDGE (signal S : BOOLEAN) return BOOLEAN;
+ function FALLING_EDGE (signal S : BOOLEAN) return BOOLEAN;
+
+ function \?=\ (L, R : BIT) return BIT;
+ function \?/=\ (L, R : BIT) return BIT;
+ function \?<\ (L, R : BIT) return BIT;
+ function \?<=\ (L, R : BIT) return BIT;
+ function \?>\ (L, R : BIT) return BIT;
+ function \?>=\ (L, R : BIT) return BIT;
+
+ function MINIMUM (L, R : BIT) return BIT;
+ function MAXIMUM (L, R : BIT) return BIT;
+
+ function \??\ (L : BIT) return BOOLEAN;
+
+ function RISING_EDGE (signal S : BIT) return BOOLEAN;
+ function FALLING_EDGE (signal S : BIT) return BOOLEAN;
+
+ function MINIMUM (L, R : CHARACTER) return CHARACTER;
+ function MAXIMUM (L, R : CHARACTER) return CHARACTER;
+
+ function MINIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL;
+ function MAXIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL;
+
+ function MINIMUM (L, R : INTEGER) return INTEGER;
+ function MAXIMUM (L, R : INTEGER) return INTEGER;
+
+ function MINIMUM (L, R : REAL) return REAL;
+ function MAXIMUM (L, R : REAL) return REAL;
+
+ function "mod" (L, R : TIME) return TIME;
+ function "rem" (L, R : TIME) return TIME;
+
+ function MINIMUM (L, R : TIME) return TIME;
+ function MAXIMUM (L, R : TIME) return TIME;
+
+ function MINIMUM (L, R : STRING) return STRING;
+ function MAXIMUM (L, R : STRING) return STRING;
+
+ function MINIMUM (L : STRING) return CHARACTER;
+ function MAXIMUM (L : STRING) return CHARACTER;
+
+ type BOOLEAN_VECTOR is array (NATURAL range <>) of BOOLEAN;
+
+ -- The predefined operations for this type are as follows:
+
+ function "and" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function "or" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function "nand" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function "nor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function "xor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function "xnor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+
+ function "not" (L : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+
+ function "and" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "and" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+ function "or" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "or" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+ function "nand" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "nand" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+ function "nor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "nor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+ function "xor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "xor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+ function "xnor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR;
+ function "xnor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR;
+
+ function and_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function or_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function nand_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function nor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function xor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function xnor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN;
+
+ function "sll" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+ function "srl" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+ function "sla" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+ function "sra" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+ function "rol" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+ function "ror" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR;
+
+-- function "=" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+-- function "/=" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+-- function "<" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+-- function "<=" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+-- function ">" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+-- function ">=" (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+
+ function \?=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+ function \?/=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN;
+
+-- function "&" (L : BOOLEAN_VECTOR; R : BOOLEAN_VECTOR)
+ -- return BOOLEAN_VECTOR;
+-- function "&" (L : BOOLEAN_VECTOR; R : BOOLEAN) -- return BOOLEAN_VECTOR;
+-- function "&" (L : BOOLEAN; R : BOOLEAN_VECTOR) -- return BOOLEAN_VECTOR;
+-- function "&" (L : BOOLEAN; R : BOOLEAN) -- return BOOLEAN_VECTOR;
+
+ function MINIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+ function MAXIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+
+ function MINIMUM (L : BOOLEAN_VECTOR) return BOOLEAN;
+ function MAXIMUM (L : BOOLEAN_VECTOR) return BOOLEAN;
+
+ function "and" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "and" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+ function "or" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "or" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+ function "nand" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "nand" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+ function "nor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "nor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+ function "xor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "xor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+ function "xnor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR;
+ function "xnor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR;
+
+ function and_reduce (L : BIT_VECTOR) return BIT;
+ function or_reduce (L : BIT_VECTOR) return BIT;
+ function nand_reduce (L : BIT_VECTOR) return BIT;
+ function nor_reduce (L : BIT_VECTOR) return BIT;
+ function xor_reduce (L : BIT_VECTOR) return BIT;
+ function xnor_reduce (L : BIT_VECTOR) return BIT;
+
+ function \?=\ (L, R : BIT_VECTOR) return BIT;
+ function \?/=\ (L, R : BIT_VECTOR) return BIT;
+
+ function MINIMUM (L, R : BIT_VECTOR) return BIT_VECTOR;
+ function MAXIMUM (L, R : BIT_VECTOR) return BIT_VECTOR;
+
+ function MINIMUM (L : BIT_VECTOR) return BIT;
+ function MAXIMUM (L : BIT_VECTOR) return BIT;
+
+ function TO_STRING (VALUE : BIT_VECTOR) return STRING;
+
+ alias TO_BSTRING is TO_STRING [BIT_VECTOR return STRING];
+ alias TO_BINARY_STRING is TO_STRING [BIT_VECTOR return STRING];
+ function TO_OSTRING (VALUE : BIT_VECTOR) return STRING;
+ alias TO_OCTAL_STRING is TO_OSTRING [BIT_VECTOR return STRING];
+ function TO_HSTRING (VALUE : BIT_VECTOR) return STRING;
+ alias TO_HEX_STRING is TO_HSTRING [BIT_VECTOR return STRING];
+
+ type INTEGER_VECTOR is array (NATURAL range <>) of INTEGER;
+
+ -- The predefined operations for this type are as follows:
+ function "=" (L, R : INTEGER_VECTOR) return BOOLEAN;
+ function "/=" (L, R : INTEGER_VECTOR) return BOOLEAN;
+ function "<" (L, R : INTEGER_VECTOR) return BOOLEAN;
+ function "<=" (L, R : INTEGER_VECTOR) return BOOLEAN;
+ function ">" (L, R : INTEGER_VECTOR) return BOOLEAN;
+ function ">=" (L, R : INTEGER_VECTOR) return BOOLEAN;
+
+-- function "&" (L : INTEGER_VECTOR; R : INTEGER_VECTOR)
+-- return INTEGER_VECTOR;
+-- function "&" (L : INTEGER_VECTOR; R : INTEGER) return INTEGER_VECTOR;
+-- function "&" (L : INTEGER; R : INTEGER_VECTOR) return INTEGER_VECTOR;
+-- function "&" (L : INTEGER; R : INTEGER) return INTEGER_VECTOR;
+
+ function MINIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR;
+ function MAXIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR;
+
+ function MINIMUM (L : INTEGER_VECTOR) return INTEGER;
+ function MAXIMUM (L : INTEGER_VECTOR) return INTEGER;
+
+ type REAL_VECTOR is array (NATURAL range <>) of REAL;
+
+ -- The predefined operations for this type are as follows:
+ function "=" (L, R : REAL_VECTOR) return BOOLEAN;
+ function "/=" (L, R : REAL_VECTOR) return BOOLEAN;
+ function "<" (L, R : REAL_VECTOR) return BOOLEAN;
+ function "<=" (L, R : REAL_VECTOR) return BOOLEAN;
+ function ">" (L, R : REAL_VECTOR) return BOOLEAN;
+ function ">=" (L, R : REAL_VECTOR) return BOOLEAN;
+
+-- function "&" (L : REAL_VECTOR; R : REAL_VECTOR)
+-- return REAL_VECTOR;
+-- function "&" (L : REAL_VECTOR; R : REAL) return REAL_VECTOR;
+-- function "&" (L : REAL; R : REAL_VECTOR) return REAL_VECTOR;
+-- function "&" (L : REAL; R : REAL) return REAL_VECTOR;
+
+ function MINIMUM (L, R : REAL_VECTOR) return REAL_VECTOR;
+ function MAXIMUM (L, R : REAL_VECTOR) return REAL_VECTOR;
+
+ function MINIMUM (L : REAL_VECTOR) return REAL;
+ function MAXIMUM (L : REAL_VECTOR) return REAL;
+
+ type TIME_VECTOR is array (NATURAL range <>) of TIME;
+
+ -- The predefined operations for this type are as follows:
+ function "=" (L, R : TIME_VECTOR) return BOOLEAN;
+ function "/=" (L, R : TIME_VECTOR) return BOOLEAN;
+ function "<" (L, R : TIME_VECTOR) return BOOLEAN;
+ function "<=" (L, R : TIME_VECTOR) return BOOLEAN;
+ function ">" (L, R : TIME_VECTOR) return BOOLEAN;
+ function ">=" (L, R : TIME_VECTOR) return BOOLEAN;
+
+-- function "&" (L : TIME_VECTOR; R : TIME_VECTOR)
+-- return TIME_VECTOR;
+-- function "&" (L : TIME_VECTOR; R : TIME) return TIME_VECTOR;
+-- function "&" (L : TIME; R : TIME_VECTOR) return TIME_VECTOR;
+-- function "&" (L : TIME; R : TIME) return TIME_VECTOR;
+
+ function MINIMUM (L, R : TIME_VECTOR) return TIME_VECTOR;
+ function MAXIMUM (L, R : TIME_VECTOR) return TIME_VECTOR;
+
+ function MINIMUM (L : TIME_VECTOR) return TIME;
+ function MAXIMUM (L : TIME_VECTOR) return TIME;
+
+ function MINIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND;
+ function MAXIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND;
+
+ function MINIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS;
+ function MAXIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS;
+
+ -- predefined TO_STRING operations on scalar types
+ function TO_STRING (VALUE : BOOLEAN) return STRING;
+ function TO_STRING (VALUE : BIT) return STRING;
+ function TO_STRING (VALUE : CHARACTER) return STRING;
+ function TO_STRING (VALUE : SEVERITY_LEVEL) return STRING;
+ function TO_STRING (VALUE : INTEGER) return STRING;
+ function TO_STRING (VALUE : REAL) return STRING;
+ function TO_STRING (VALUE : TIME) return STRING;
+ function TO_STRING (VALUE : FILE_OPEN_KIND) return STRING;
+ function TO_STRING (VALUE : FILE_OPEN_STATUS) return STRING;
+
+ -- predefined overloaded TO_STRING operations
+ function TO_STRING (VALUE : REAL; DIGITS : NATURAL) return STRING;
+ function TO_STRING (VALUE : REAL; FORMAT : STRING) return STRING;
+ function TO_STRING (VALUE : TIME; UNIT : TIME) return STRING;
+end package standard_additions;
+
+------------------------------------------------------------------------------
+-- "standard_additions" package contains the additions to the built in
+-- "standard.std" package. In the final version this package will be implicit.
+-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
+------------------------------------------------------------------------------
+use std.textio.all;
+package body standard_additions is
+
+ function \?=\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L = R;
+ end function \?=\;
+
+ function \?/=\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L /= R;
+ end function \?/=\;
+
+ function \?<\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L < R;
+ end function \?<\;
+
+ function \?<=\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L <= R;
+ end function \?<=\;
+
+ function \?>\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L > R;
+ end function \?>\;
+
+ function \?>=\ (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ return L >= R;
+ end function \?>=\;
+
+ function MINIMUM (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+ function MAXIMUM (L, R : BOOLEAN) return BOOLEAN is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : BOOLEAN) return STRING is
+ begin
+ return BOOLEAN'image(VALUE);
+ end function TO_STRING;
+
+ function RISING_EDGE (signal S : BOOLEAN) return BOOLEAN is
+ begin
+ return (s'event and (s = true) and (s'last_value = false));
+ end function rising_edge;
+
+ function FALLING_EDGE (signal S : BOOLEAN) return BOOLEAN is
+ begin
+ return (s'event and (s = false) and (s'last_value = true));
+ end function falling_edge;
+
+ function \?=\ (L, R : BIT) return BIT is
+ begin
+ if L = R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?=\;
+
+ function \?/=\ (L, R : BIT) return BIT is
+ begin
+ if L /= R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?/=\;
+
+ function \?<\ (L, R : BIT) return BIT is
+ begin
+ if L < R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?<\;
+
+ function \?<=\ (L, R : BIT) return BIT is
+ begin
+ if L <= R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?<=\;
+
+ function \?>\ (L, R : BIT) return BIT is
+ begin
+ if L > R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?>\;
+
+ function \?>=\ (L, R : BIT) return BIT is
+ begin
+ if L >= R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?>=\;
+
+ function MINIMUM (L, R : BIT) return BIT is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : BIT) return BIT is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : BIT) return STRING is
+ begin
+ if VALUE = '1' then
+ return "1";
+ else
+ return "0";
+ end if;
+ end function TO_STRING;
+
+ function \??\ (L : BIT) return BOOLEAN is
+ begin
+ return L = '1';
+ end function \??\;
+
+ function RISING_EDGE (signal S : BIT) return BOOLEAN is
+ begin
+ return (s'event and (s = '1') and (s'last_value = '0'));
+ end function rising_edge;
+
+ function FALLING_EDGE (signal S : BIT) return BOOLEAN is
+ begin
+ return (s'event and (s = '0') and (s'last_value = '1'));
+ end function falling_edge;
+
+ function MINIMUM (L, R : CHARACTER) return CHARACTER is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : CHARACTER) return CHARACTER is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : CHARACTER) return STRING is
+ variable result : STRING (1 to 1);
+ begin
+ result (1) := VALUE;
+ return result;
+ end function TO_STRING;
+
+ function MINIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : SEVERITY_LEVEL) return STRING is
+ begin
+ return SEVERITY_LEVEL'image(VALUE);
+ end function TO_STRING;
+
+ function MINIMUM (L, R : INTEGER) return INTEGER is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : INTEGER) return INTEGER is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : INTEGER) return STRING is
+ begin
+ return INTEGER'image(VALUE);
+ end function TO_STRING;
+
+ function MINIMUM (L, R : REAL) return REAL is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : REAL) return REAL is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : REAL) return STRING is
+ begin
+ return REAL'image (VALUE);
+ end function TO_STRING;
+
+ function TO_STRING (VALUE : REAL; DIGITS : NATURAL) return STRING is
+ begin
+ return to_string (VALUE, "%1." & INTEGER'image(DIGITS) & "f");
+ end function TO_STRING;
+
+ function "mod" (L, R : TIME) return TIME is
+ variable lint, rint : INTEGER;
+ begin
+ lint := L / 1.0 ns;
+ rint := R / 1.0 ns;
+ return (lint mod rint) * 1.0 ns;
+ end function "mod";
+
+ function "rem" (L, R : TIME) return TIME is
+ variable lint, rint : INTEGER;
+ begin
+ lint := L / 1.0 ns;
+ rint := R / 1.0 ns;
+ return (lint rem rint) * 1.0 ns;
+ end function "rem";
+
+ function MINIMUM (L, R : TIME) return TIME is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : TIME) return TIME is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : TIME) return STRING is
+ begin
+ return TIME'image (VALUE);
+ end function TO_STRING;
+
+ function MINIMUM (L, R : STRING) return STRING is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : STRING) return STRING is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : STRING) return CHARACTER is
+ variable result : CHARACTER := CHARACTER'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : STRING) return CHARACTER is
+ variable result : CHARACTER := CHARACTER'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ -- type BOOLEAN_VECTOR is array (NATURAL range <>) of BOOLEAN;
+ -- The predefined operations for this type are as follows:
+ function "and" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""and"": "
+ & "arguments of overloaded 'and' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) and rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "and";
+
+ function "or" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""or"": "
+ & "arguments of overloaded 'or' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) or rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "or";
+
+ function "nand" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""nand"": "
+ & "arguments of overloaded 'nand' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) nand rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "nand";
+
+ function "nor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""nor"": "
+ & "arguments of overloaded 'nor' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) nor rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "nor";
+
+ function "xor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""xor"": "
+ & "arguments of overloaded 'xor' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) xor rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "xor";
+
+ function "xnor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if (l'length /= r'length) then
+ assert false
+ report "STD.""xnor"": "
+ & "arguments of overloaded 'xnor' operator are not of the same length"
+ severity failure;
+ else
+ for i in result'range loop
+ result(i) := (lv(i) xnor rv(i));
+ end loop;
+ end if;
+ return result;
+ end function "xnor";
+
+ function "not" (L : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := not (lv(i));
+ end loop;
+ return result;
+ end function "not";
+
+ function "and" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) and r;
+ end loop;
+ return result;
+ end function "and";
+
+ function "and" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l and rv(i);
+ end loop;
+ return result;
+ end function "and";
+
+ function "or" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) or r;
+ end loop;
+ return result;
+ end function "or";
+
+ function "or" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l or rv(i);
+ end loop;
+ return result;
+ end function "or";
+
+ function "nand" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) nand r;
+ end loop;
+ return result;
+ end function "nand";
+
+ function "nand" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l nand rv(i);
+ end loop;
+ return result;
+ end function "nand";
+
+ function "nor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) nor r;
+ end loop;
+ return result;
+ end function "nor";
+
+ function "nor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l nor rv(i);
+ end loop;
+ return result;
+ end function "nor";
+
+ function "xor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) xor r;
+ end loop;
+ return result;
+ end function "xor";
+
+ function "xor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l xor rv(i);
+ end loop;
+ return result;
+ end function "xor";
+
+ function "xnor" (L : BOOLEAN_VECTOR; R : BOOLEAN)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) xnor r;
+ end loop;
+ return result;
+ end function "xnor";
+
+ function "xnor" (L : BOOLEAN; R : BOOLEAN_VECTOR)
+ return BOOLEAN_VECTOR is
+ alias rv : BOOLEAN_VECTOR (1 to r'length) is r;
+ variable result : BOOLEAN_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l xnor rv(i);
+ end loop;
+ return result;
+ end function "xnor";
+
+ function and_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := true;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) and result;
+ end loop;
+ return result;
+ end function and_reduce;
+
+ function or_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := false;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) or result;
+ end loop;
+ return result;
+ end function or_reduce;
+
+ function nand_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := true;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) and result;
+ end loop;
+ return not result;
+ end function nand_reduce;
+
+ function nor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := false;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) or result;
+ end loop;
+ return not result;
+ end function nor_reduce;
+
+ function xor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := false;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) xor result;
+ end loop;
+ return result;
+ end function xor_reduce;
+
+ function xnor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := false;
+ begin
+ for i in l'reverse_range loop
+ result := l(i) xor result;
+ end loop;
+ return not result;
+ end function xnor_reduce;
+
+ function "sll" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if r >= 0 then
+ result(1 to l'length - r) := lv(r + 1 to l'length);
+ else
+ result := l srl -r;
+ end if;
+ return result;
+ end function "sll";
+
+ function "srl" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ if r >= 0 then
+ result(r + 1 to l'length) := lv(1 to l'length - r);
+ else
+ result := l sll -r;
+ end if;
+ return result;
+ end function "srl";
+
+ function "sla" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in L'range loop
+ result (i) := L(L'high);
+ end loop;
+ if r >= 0 then
+ result(1 to l'length - r) := lv(r + 1 to l'length);
+ else
+ result := l sra -r;
+ end if;
+ return result;
+ end function "sla";
+
+ function "sra" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ begin
+ for i in L'range loop
+ result (i) := L(L'low);
+ end loop;
+ if r >= 0 then
+ result(1 to l'length - r) := lv(r + 1 to l'length);
+ else
+ result := l sra -r;
+ end if;
+ return result;
+ end function "sra";
+
+ function "rol" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(1 to l'length - rm) := lv(rm + 1 to l'length);
+ result(l'length - rm + 1 to l'length) := lv(1 to rm);
+ else
+ result := l ror -r;
+ end if;
+ return result;
+ end function "rol";
+
+ function "ror" (L : BOOLEAN_VECTOR; R : INTEGER)
+ return BOOLEAN_VECTOR is
+ alias lv : BOOLEAN_VECTOR (1 to l'length) is l;
+ variable result : BOOLEAN_VECTOR (1 to l'length);
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(rm + 1 to l'length) := lv(1 to l'length - rm);
+ result(1 to rm) := lv(l'length - rm + 1 to l'length);
+ else
+ result := l rol -r;
+ end if;
+ return result;
+ end function "ror";
+-- function "=" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+-- function "/=" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+-- function "<" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+-- function "<=" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+-- function ">" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+-- function ">=" (L, R: BOOLEAN_VECTOR) return BOOLEAN;
+
+ function \?=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN is
+ begin
+ return L = R;
+ end function \?=\;
+
+ function \?/=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN is
+ begin
+ return L /= R;
+ end function \?/=\;
+-- function "&" (L: BOOLEAN_VECTOR; R: BOOLEAN_VECTOR)
+-- return BOOLEAN_VECTOR;
+-- function "&" (L: BOOLEAN_VECTOR; R: BOOLEAN) return BOOLEAN_VECTOR;
+-- function "&" (L: BOOLEAN; R: BOOLEAN_VECTOR) return BOOLEAN_VECTOR;
+-- function "&" (L: BOOLEAN; R: BOOLEAN) return BOOLEAN_VECTOR;
+
+ function MINIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := BOOLEAN'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : BOOLEAN_VECTOR) return BOOLEAN is
+ variable result : BOOLEAN := BOOLEAN'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ function "and" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) and r;
+ end loop;
+ return result;
+ end function "and";
+
+ function "and" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l and rv(i);
+ end loop;
+ return result;
+ end function "and";
+
+ function "or" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) or r;
+ end loop;
+ return result;
+ end function "or";
+
+ function "or" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l or rv(i);
+ end loop;
+ return result;
+ end function "or";
+
+ function "nand" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) and r;
+ end loop;
+ return not result;
+ end function "nand";
+
+ function "nand" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l and rv(i);
+ end loop;
+ return not result;
+ end function "nand";
+
+ function "nor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) or r;
+ end loop;
+ return not result;
+ end function "nor";
+
+ function "nor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l or rv(i);
+ end loop;
+ return not result;
+ end function "nor";
+
+ function "xor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) xor r;
+ end loop;
+ return result;
+ end function "xor";
+
+ function "xor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l xor rv(i);
+ end loop;
+ return result;
+ end function "xor";
+
+ function "xnor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is
+ alias lv : BIT_VECTOR (1 to l'length) is l;
+ variable result : BIT_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := lv(i) xor r;
+ end loop;
+ return not result;
+ end function "xnor";
+
+ function "xnor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is
+ alias rv : BIT_VECTOR (1 to r'length) is r;
+ variable result : BIT_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := l xor rv(i);
+ end loop;
+ return not result;
+ end function "xnor";
+
+ function and_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '1';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) and result;
+ end loop;
+ return result;
+ end function and_reduce;
+
+ function or_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '0';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) or result;
+ end loop;
+ return result;
+ end function or_reduce;
+
+ function nand_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '1';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) and result;
+ end loop;
+ return not result;
+ end function nand_reduce;
+
+ function nor_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '0';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) or result;
+ end loop;
+ return not result;
+ end function nor_reduce;
+
+ function xor_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '0';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) xor result;
+ end loop;
+ return result;
+ end function xor_reduce;
+
+ function xnor_reduce (L : BIT_VECTOR) return BIT is
+ variable result : BIT := '0';
+ begin
+ for i in l'reverse_range loop
+ result := l(i) xor result;
+ end loop;
+ return not result;
+ end function xnor_reduce;
+
+ function \?=\ (L, R : BIT_VECTOR) return BIT is
+ begin
+ if L = R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?=\;
+
+ function \?/=\ (L, R : BIT_VECTOR) return BIT is
+ begin
+ if L /= R then
+ return '1';
+ else
+ return '0';
+ end if;
+ end function \?/=\;
+
+ function MINIMUM (L, R : BIT_VECTOR) return BIT_VECTOR is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : BIT_VECTOR) return BIT_VECTOR is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : BIT_VECTOR) return BIT is
+ variable result : BIT := BIT'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : BIT_VECTOR) return BIT is
+ variable result : BIT := BIT'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : BIT_VECTOR) return STRING is
+ alias ivalue : BIT_VECTOR(1 to value'length) is value;
+ variable result : STRING(1 to value'length);
+ begin
+ if value'length < 1 then
+ return "";
+ else
+ for i in ivalue'range loop
+ if iValue(i) = '0' then
+ result(i) := '0';
+ else
+ result(i) := '1';
+ end if;
+ end loop;
+ return result;
+ end if;
+ end function to_string;
+
+-- alias TO_BSTRING is TO_STRING [BIT_VECTOR return STRING];
+-- alias TO_BINARY_STRING is TO_STRING [BIT_VECTOR return STRING];
+
+ function TO_OSTRING (VALUE : BIT_VECTOR) return STRING is
+ constant ne : INTEGER := (value'length+2)/3;
+ constant pad : BIT_VECTOR(0 to (ne*3 - value'length) - 1) := (others => '0');
+ variable ivalue : BIT_VECTOR(0 to ne*3 - 1);
+ variable result : STRING(1 to ne);
+ variable tri : BIT_VECTOR(0 to 2);
+ begin
+ if value'length < 1 then
+ return "";
+ end if;
+ ivalue := pad & value;
+ for i in 0 to ne-1 loop
+ tri := ivalue(3*i to 3*i+2);
+ case tri is
+ when o"0" => result(i+1) := '0';
+ when o"1" => result(i+1) := '1';
+ when o"2" => result(i+1) := '2';
+ when o"3" => result(i+1) := '3';
+ when o"4" => result(i+1) := '4';
+ when o"5" => result(i+1) := '5';
+ when o"6" => result(i+1) := '6';
+ when o"7" => result(i+1) := '7';
+ end case;
+ end loop;
+ return result;
+ end function to_ostring;
+-- alias TO_OCTAL_STRING is TO_OSTRING [BIT_VECTOR return STRING];
+
+ function TO_HSTRING (VALUE : BIT_VECTOR) return STRING is
+ constant ne : INTEGER := (value'length+3)/4;
+ constant pad : BIT_VECTOR(0 to (ne*4 - value'length) - 1) := (others => '0');
+ variable ivalue : BIT_VECTOR(0 to ne*4 - 1);
+ variable result : STRING(1 to ne);
+ variable quad : BIT_VECTOR(0 to 3);
+ begin
+ if value'length < 1 then
+ return "";
+ end if;
+ ivalue := pad & value;
+ for i in 0 to ne-1 loop
+ quad := ivalue(4*i to 4*i+3);
+ case quad is
+ when x"0" => result(i+1) := '0';
+ when x"1" => result(i+1) := '1';
+ when x"2" => result(i+1) := '2';
+ when x"3" => result(i+1) := '3';
+ when x"4" => result(i+1) := '4';
+ when x"5" => result(i+1) := '5';
+ when x"6" => result(i+1) := '6';
+ when x"7" => result(i+1) := '7';
+ when x"8" => result(i+1) := '8';
+ when x"9" => result(i+1) := '9';
+ when x"A" => result(i+1) := 'A';
+ when x"B" => result(i+1) := 'B';
+ when x"C" => result(i+1) := 'C';
+ when x"D" => result(i+1) := 'D';
+ when x"E" => result(i+1) := 'E';
+ when x"F" => result(i+1) := 'F';
+ end case;
+ end loop;
+ return result;
+ end function to_hstring;
+-- alias TO_HEX_STRING is TO_HSTRING [BIT_VECTOR return STRING];
+
+-- type INTEGER_VECTOR is array (NATURAL range <>) of INTEGER;
+ -- The predefined operations for this type are as follows:
+
+ function "=" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length or L'length < 1 or R'length < 1 then
+ return false;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ return false;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "=";
+
+ function "/=" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ return not (L = R);
+ end function "/=";
+
+ function "<" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function "<";
+
+ function "<=" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "<=";
+
+ function ">" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function ">";
+
+ function ">=" (L, R : INTEGER_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function ">=";
+-- function "&" (L: INTEGER_VECTOR; R: INTEGER_VECTOR)
+-- return INTEGER_VECTOR;
+-- function "&" (L: INTEGER_VECTOR; R: INTEGER) return INTEGER_VECTOR;
+-- function "&" (L: INTEGER; R: INTEGER_VECTOR) return INTEGER_VECTOR;
+-- function "&" (L: INTEGER; R: INTEGER) return INTEGER_VECTOR;
+
+ function MINIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : INTEGER_VECTOR) return INTEGER is
+ variable result : INTEGER := INTEGER'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : INTEGER_VECTOR) return INTEGER is
+ variable result : INTEGER := INTEGER'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ -- type REAL_VECTOR is array (NATURAL range <>) of REAL;
+ -- The predefined operations for this type are as follows:
+ function "=" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length or L'length < 1 or R'length < 1 then
+ return false;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ return false;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "=";
+
+ function "/=" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ return not (L = R);
+ end function "/=";
+
+ function "<" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function "<";
+
+ function "<=" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "<=";
+
+ function ">" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function ">";
+
+ function ">=" (L, R : REAL_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function ">=";
+-- function "&" (L: REAL_VECTOR; R: REAL_VECTOR)
+-- return REAL_VECTOR;
+-- function "&" (L: REAL_VECTOR; R: REAL) return REAL_VECTOR;
+-- function "&" (L: REAL; R: REAL_VECTOR) return REAL_VECTOR;
+-- function "&" (L: REAL; R: REAL) return REAL_VECTOR;
+
+ function MINIMUM (L, R : REAL_VECTOR) return REAL_VECTOR is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : REAL_VECTOR) return REAL_VECTOR is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : REAL_VECTOR) return REAL is
+ variable result : REAL := REAL'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : REAL_VECTOR) return REAL is
+ variable result : REAL := REAL'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ -- type TIME_VECTOR is array (NATURAL range <>) of TIME;
+ -- The predefined implicit operations for this type are as follows:
+ function "=" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length or L'length < 1 or R'length < 1 then
+ return false;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ return false;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "=";
+
+ function "/=" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ return not (L = R);
+ end function "/=";
+
+ function "<" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function "<";
+
+ function "<=" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length < R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) < R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function "<=";
+
+ function ">" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return false;
+ end if;
+ end function ">";
+
+ function ">=" (L, R : TIME_VECTOR) return BOOLEAN is
+ begin
+ if L'length /= R'length then
+ return L'length > R'length;
+ else
+ for i in l'range loop
+ if L(i) /= R(i) then
+ if L(i) > R(i) then
+ return true;
+ else
+ return false;
+ end if;
+ end if;
+ end loop;
+ return true;
+ end if;
+ end function ">=";
+-- function "&" (L: TIME_VECTOR; R: TIME_VECTOR)
+-- return TIME_VECTOR;
+-- function "&" (L: TIME_VECTOR; R: TIME) return TIME_VECTOR;
+-- function "&" (L: TIME; R: TIME_VECTOR) return TIME_VECTOR;
+-- function "&" (L: TIME; R: TIME) return TIME_VECTOR;
+
+ function MINIMUM (L, R : TIME_VECTOR) return TIME_VECTOR is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : TIME_VECTOR) return TIME_VECTOR is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function MINIMUM (L : TIME_VECTOR) return TIME is
+ variable result : TIME := TIME'high;
+ begin
+ for i in l'range loop
+ result := minimum (l(i), result);
+ end loop;
+ return result;
+ end function MINIMUM;
+
+ function MAXIMUM (L : TIME_VECTOR) return TIME is
+ variable result : TIME := TIME'low;
+ begin
+ for i in l'range loop
+ result := maximum (l(i), result);
+ end loop;
+ return result;
+ end function MAXIMUM;
+
+ function MINIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : FILE_OPEN_KIND) return STRING is
+ begin
+ return FILE_OPEN_KIND'image(VALUE);
+ end function TO_STRING;
+
+ function MINIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function MINIMUM;
+
+ function MAXIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function MAXIMUM;
+
+ function TO_STRING (VALUE : FILE_OPEN_STATUS) return STRING is
+ begin
+ return FILE_OPEN_STATUS'image(VALUE);
+ end function TO_STRING;
+
+ -- USED INTERNALLY!
+ function justify (
+ value : in STRING;
+ justified : in SIDE := right;
+ field : in width := 0)
+ return STRING is
+ constant VAL_LEN : INTEGER := value'length;
+ variable result : STRING (1 to field) := (others => ' ');
+ begin -- function justify
+ -- return value if field is too small
+ if VAL_LEN >= field then
+ return value;
+ end if;
+ if justified = left then
+ result(1 to VAL_LEN) := value;
+ elsif justified = right then
+ result(field - VAL_LEN + 1 to field) := value;
+ end if;
+ return result;
+ end function justify;
+
+ function TO_STRING (VALUE : TIME; UNIT : TIME) return STRING is
+ variable L : LINE; -- pointer
+ begin
+ deallocate (L);
+ write (L => L,
+ VALUE => VALUE,
+ UNIT => UNIT);
+ return L.all;
+ end function to_string;
+
+ function TO_STRING (VALUE : REAL; FORMAT : STRING) return STRING is
+ constant czero : CHARACTER := '0'; -- zero
+ constant half : REAL := 0.4999999999; -- almost 0.5
+ -- Log10 funciton
+ function log10 (arg : REAL) return INTEGER is
+ variable i : INTEGER := 1;
+ begin
+ if ((arg = 0.0)) then
+ return 0;
+ elsif arg >= 1.0 then
+ while arg >= 10.0**i loop
+ i := i + 1;
+ end loop;
+ return (i-1);
+ else
+ while arg < 10.0**i loop
+ i := i - 1;
+ end loop;
+ return i;
+ end if;
+ end function log10;
+ -- purpose: writes a fractional real number into a line
+ procedure writefrc (
+ variable L : inout LINE; -- LINE
+ variable cdes : in CHARACTER;
+ variable precision : in INTEGER; -- number of decimal places
+ variable value : in REAL) is -- real value
+ variable rvar : REAL; -- temp variable
+ variable xint : INTEGER;
+ variable xreal : REAL;
+ begin
+ xreal := (10.0**(-precision));
+ write (L, '.');
+ rvar := value;
+ for i in 1 to precision loop
+ rvar := rvar * 10.0;
+ xint := INTEGER(rvar-0.49999999999); -- round
+ write (L, xint);
+ rvar := rvar - REAL(xint);
+ xreal := xreal * 10.0;
+ if (cdes = 'g') and (rvar < xreal) then
+ exit;
+ end if;
+ end loop;
+ end procedure writefrc;
+ -- purpose: replace the "." with a "@", and "e" with "j" to get around
+ -- read ("6.") and read ("2e") issues.
+ function subdot (
+ constant format : STRING)
+ return STRING is
+ variable result : STRING (format'range);
+ begin
+ for i in format'range loop
+ if (format(i) = '.') then
+ result(i) := '@'; -- Because the parser reads 6.2 as REAL
+ elsif (format(i) = 'e') then
+ result(i) := 'j'; -- Because the parser read 2e as REAL
+ elsif (format(i) = 'E') then
+ result(i) := 'J'; -- Because the parser reads 2E as REAL
+ else
+ result(i) := format(i);
+ end if;
+ end loop;
+ return result;
+ end function subdot;
+ -- purpose: find a . in a STRING
+ function isdot (
+ constant format : STRING)
+ return BOOLEAN is
+ begin
+ for i in format'range loop
+ if (format(i) = '@') then
+ return true;
+ end if;
+ end loop;
+ return false;
+ end function isdot;
+ variable exp : INTEGER; -- integer version of baseexp
+ variable bvalue : REAL; -- base value
+ variable roundvar, tvar : REAL; -- Rounding values
+ variable frcptr : INTEGER; -- integer version of number
+ variable fwidth, dwidth : INTEGER; -- field width and decimal width
+ variable dash, dot : BOOLEAN := false;
+ variable cdes, ddes : CHARACTER := ' ';
+ variable L : LINE; -- line type
+ begin
+ -- Perform the same function that "printf" does
+ -- examples "%6.2f" "%-7e" "%g"
+ if not (format(format'left) = '%') then
+ report "to_string: Illegal format string """ & format & '"'
+ severity error;
+ return "";
+ end if;
+ L := new STRING'(subdot(format));
+ read (L, ddes); -- toss the '%'
+ case L.all(1) is
+ when '-' => dash := true;
+ when '@' => dash := true; -- in FP, a "-" and a "." are the same
+ when 'f' => cdes := 'f';
+ when 'F' => cdes := 'F';
+ when 'g' => cdes := 'g';
+ when 'G' => cdes := 'G';
+ when 'j' => cdes := 'e'; -- parser reads 5e as real, thus we sub j
+ when 'J' => cdes := 'E';
+ when '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' => null;
+ when others =>
+ report "to_string: Illegal format string """ & format & '"'
+ severity error;
+ return "";
+ end case;
+ if (dash or (cdes /= ' ')) then
+ read (L, ddes); -- toss the next character
+ end if;
+ if (cdes = ' ') then
+ if (isdot(L.all)) then -- if you see a . two numbers
+ read (L, fwidth); -- read field width
+ read (L, ddes); -- toss the next character .
+ read (L, dwidth); -- read decimal width
+ else
+ read (L, fwidth); -- read field width
+ dwidth := 6; -- the default decimal width is 6
+ end if;
+ read (L, cdes);
+ if (cdes = 'j') then
+ cdes := 'e'; -- because 2e reads as "REAL".
+ elsif (cdes = 'J') then
+ cdes := 'E';
+ end if;
+ else
+ if (cdes = 'E' or cdes = 'e') then
+ fwidth := 10; -- default for e and E is %10.6e
+ else
+ fwidth := 0; -- default for f and g is %0.6f
+ end if;
+ dwidth := 6;
+ end if;
+ deallocate (L); -- reclame the pointer L.
+-- assert (not debug) report "Format: " & format & " "
+-- & INTEGER'image(fwidth) & "." & INTEGER'image(dwidth) & cdes
+-- severity note;
+ if (not (cdes = 'f' or cdes = 'F' or cdes = 'g' or cdes = 'G'
+ or cdes = 'e' or cdes = 'E')) then
+ report "to_string: Illegal format """ & format & '"' severity error;
+ return "";
+ end if;
+ if (VALUE < 0.0) then
+ bvalue := -value;
+ write (L, '-');
+ else
+ bvalue := value;
+ end if;
+ case cdes is
+ when 'e' | 'E' => -- 7.000E+01
+ exp := log10(bvalue);
+ roundvar := half*(10.0**(exp-dwidth));
+ bvalue := bvalue + roundvar; -- round
+ exp := log10(bvalue); -- because we CAN overflow
+ bvalue := bvalue * (10.0**(-exp)); -- result is D.XXXXXX
+ frcptr := INTEGER(bvalue-half); -- Write a single digit.
+ write (L, frcptr);
+ bvalue := bvalue - REAL(frcptr);
+ writefrc (-- Write out the fraction
+ L => L,
+ cdes => cdes,
+ precision => dwidth,
+ value => bvalue);
+ write (L, cdes); -- e or E
+ if (exp < 0) then
+ write (L, '-');
+ else
+ write (L, '+');
+ end if;
+ exp := abs(exp);
+ if (exp < 10) then -- we need another "0".
+ write (L, czero);
+ end if;
+ write (L, exp);
+ when 'f' | 'F' => -- 70.0
+ exp := log10(bvalue);
+ roundvar := half*(10.0**(-dwidth));
+ bvalue := bvalue + roundvar; -- round
+ exp := log10(bvalue); -- because we CAN overflow
+ if (exp < 0) then -- 0.X case
+ write (L, czero);
+ else -- loop because real'high > integer'high
+ while (exp >= 0) loop
+ frcptr := INTEGER(bvalue * (10.0**(-exp)) - half);
+ write (L, frcptr);
+ bvalue := bvalue - (REAL(frcptr) * (10.0**exp));
+ exp := exp-1;
+ end loop;
+ end if;
+ writefrc (
+ L => L,
+ cdes => cdes,
+ precision => dwidth,
+ value => bvalue);
+ when 'g' | 'G' => -- 70
+ exp := log10(bvalue);
+ roundvar := half*(10.0**(exp-dwidth)); -- small number
+ bvalue := bvalue + roundvar; -- round
+ exp := log10(bvalue); -- because we CAN overflow
+ frcptr := INTEGER(bvalue-half);
+ tvar := bvalue-roundvar - REAL(frcptr); -- even smaller number
+ if (exp < dwidth)
+ and (tvar < roundvar and tvar > -roundvar) then
+-- and ((bvalue-roundvar) = real(frcptr)) then
+ write (L, frcptr); -- Just a short integer, write it.
+ elsif (exp >= dwidth) or (exp < -4) then
+ -- in "e" format (modified)
+ bvalue := bvalue * (10.0**(-exp)); -- result is D.XXXXXX
+ frcptr := INTEGER(bvalue-half);
+ write (L, frcptr);
+ bvalue := bvalue - REAL(frcptr);
+ if (bvalue > (10.0**(1-dwidth))) then
+ dwidth := dwidth - 1;
+ writefrc (
+ L => L,
+ cdes => cdes,
+ precision => dwidth,
+ value => bvalue);
+ end if;
+ if (cdes = 'G') then
+ write (L, 'E');
+ else
+ write (L, 'e');
+ end if;
+ if (exp < 0) then
+ write (L, '-');
+ else
+ write (L, '+');
+ end if;
+ exp := abs(exp);
+ if (exp < 10) then
+ write (L, czero);
+ end if;
+ write (L, exp);
+ else
+ -- in "f" format (modified)
+ if (exp < 0) then
+ write (L, czero);
+ dwidth := maximum (dwidth, 4); -- if exp < -4 or > precision.
+ bvalue := bvalue - roundvar; -- recalculate rounding
+ roundvar := half*(10.0**(-dwidth));
+ bvalue := bvalue + roundvar;
+ else
+ write (L, frcptr); -- integer part (always small)
+ bvalue := bvalue - (REAL(frcptr));
+ dwidth := dwidth - exp - 1;
+ end if;
+ if (bvalue > roundvar) then
+ writefrc (
+ L => L,
+ cdes => cdes,
+ precision => dwidth,
+ value => bvalue);
+ end if;
+ end if;
+ when others => return "";
+ end case;
+ -- You don't truncate real numbers.
+-- if (dot) then -- truncate
+-- if (L.all'length > fwidth) then
+-- return justify (value => L.all (1 to fwidth),
+-- justified => RIGHT,
+-- field => fwidth);
+-- else
+-- return justify (value => L.all,
+-- justified => RIGHT,
+-- field => fwidth);
+-- end if;
+ if (dash) then -- fill to fwidth
+ return justify (value => L.all,
+ justified => left,
+ field => fwidth);
+ else
+ return justify (value => L.all,
+ justified => right,
+ field => fwidth);
+ end if;
+ end function to_string;
+
+end package body standard_additions;
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/standard_textio_additions_c.vhdl b/testsuite/gna/ticket89/x_ieee_proposed/src/standard_textio_additions_c.vhdl
new file mode 100644
index 0000000..aad96f5
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/standard_textio_additions_c.vhdl
@@ -0,0 +1,480 @@
+------------------------------------------------------------------------------
+-- "standard_textio_additions" package contains the additions to the built in
+-- "standard.textio" package.
+-- This package should be compiled into "ieee_proposed" and used as follows:
+-- use ieee_proposed.standard_textio_additions.all;
+-- Last Modified: $Date: 2007/03/13 18:25:58 $
+-- RCS ID: $Id: standard_textio_additions_c.vhdl,v 1.5 2007/03/13 18:25:58 l435385 Exp $
+--
+-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
+------------------------------------------------------------------------------
+use std.textio.all;
+package standard_textio_additions is
+
+-- procedure DEALLOCATE (P : inout LINE);
+
+-- procedure FLUSH (file F : TEXT);
+--
+-- function MINIMUM (L, R : SIDE) return SIDE;
+-- function MAXIMUM (L, R : SIDE) return SIDE;
+--
+-- function TO_STRING (VALUE : SIDE) return STRING;
+--
+-- function JUSTIFY (VALUE : STRING; JUSTIFIED : SIDE := right; FIELD : WIDTH := 0) return STRING;
+--
+-- procedure SREAD (L : inout LINE; VALUE : out STRING; STRLEN : out NATURAL);
+-- alias STRING_READ is SREAD [LINE, STRING, NATURAL];
+-- alias BREAD is READ [LINE, BIT_VECTOR, BOOLEAN];
+-- alias BREAD is READ [LINE, BIT_VECTOR];
+-- alias BINARY_READ is READ [LINE, BIT_VECTOR, BOOLEAN];
+-- alias BINARY_READ is READ [LINE, BIT_VECTOR];
+-- procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
+-- procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR);
+-- alias OCTAL_READ is OREAD [LINE, BIT_VECTOR, BOOLEAN];
+-- alias OCTAL_READ is OREAD [LINE, BIT_VECTOR];
+-- procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
+-- procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR);
+-- alias HEX_READ is HREAD [LINE, BIT_VECTOR, BOOLEAN];
+-- alias HEX_READ is HREAD [LINE, BIT_VECTOR];
+-- procedure TEE (file F : TEXT; L : inout LINE);
+-- procedure WRITE (L : inout LINE; VALUE : in REAL;
+-- FORMAT : in STRING);
+ alias SWRITE is WRITE [LINE, STRING, SIDE, WIDTH];
+ alias STRING_WRITE is WRITE [LINE, STRING, SIDE, WIDTH];
+ alias BWRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
+ alias BINARY_WRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
+ procedure OWRITE (L : inout LINE; VALUE : in BIT_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias OCTAL_WRITE is OWRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
+ procedure HWRITE (L : inout LINE; VALUE : in BIT_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias HEX_WRITE is HWRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
+
+end package standard_textio_additions;
+
+library ieee_proposed;
+use ieee_proposed.standard_additions.all;
+
+package body standard_textio_additions is
+ --pragma synthesis_off
+ constant NUS : STRING(2 to 1) := (others => ' '); -- NULL array
+ constant NBSP : CHARACTER := CHARACTER'val(160); -- space character
+
+ -- Writes L to a file without modifying the contents of the line
+ procedure TEE (file F : TEXT; L : inout LINE) is
+ begin
+ write (OUTPUT, L.all & LF);
+ writeline(F, L);
+ end procedure TEE;
+
+ procedure FLUSH (file F: TEXT) is -- Implicit
+ begin
+ file_close (F);
+ end procedure FLUSH;
+
+ -- Read and Write procedure for strings
+ procedure SREAD (L : inout LINE;
+ VALUE : out STRING;
+ STRLEN : out natural) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ -- Result is padded with space characters
+ variable result : STRING (1 to VALUE'length) := (others => ' ');
+ begin
+ VALUE := result;
+ loop -- skip white space
+ read(L, c, ok);
+ exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
+ end loop;
+ -- Bail out if there was a bad read
+ if not ok then
+ STRLEN := 0;
+ return;
+ end if;
+ result (1) := c;
+ STRLEN := 1;
+ for i in 2 to VALUE'length loop
+ read(L, c, ok);
+ if (ok = false) or ((c = ' ') or (c = NBSP) or (c = HT)) then
+ exit;
+ else
+ result (i) := c;
+ end if;
+ STRLEN := i;
+ end loop;
+ VALUE := result;
+ end procedure SREAD;
+
+ -- Hex Read and Write procedures for bit_vector.
+ -- Procedure only visible internally.
+ procedure Char2QuadBits (C : CHARACTER;
+ RESULT : out BIT_VECTOR(3 downto 0);
+ GOOD : out BOOLEAN;
+ ISSUE_ERROR : in BOOLEAN) is
+ begin
+ case c is
+ when '0' => result := x"0"; good := true;
+ when '1' => result := x"1"; good := true;
+ when '2' => result := x"2"; good := true;
+ when '3' => result := x"3"; good := true;
+ when '4' => result := x"4"; good := true;
+ when '5' => result := x"5"; good := true;
+ when '6' => result := x"6"; good := true;
+ when '7' => result := x"7"; good := true;
+ when '8' => result := x"8"; good := true;
+ when '9' => result := x"9"; good := true;
+ when 'A' | 'a' => result := x"A"; good := true;
+ when 'B' | 'b' => result := x"B"; good := true;
+ when 'C' | 'c' => result := x"C"; good := true;
+ when 'D' | 'd' => result := x"D"; good := true;
+ when 'E' | 'e' => result := x"E"; good := true;
+ when 'F' | 'f' => result := x"F"; good := true;
+ when others =>
+ assert not ISSUE_ERROR report
+ "TEXTIO.HREAD Error: Read a '" & c &
+ "', expected a Hex character (0-F)." severity error;
+ GOOD := false;
+ end case;
+ end procedure Char2QuadBits;
+
+ procedure HREAD (L : inout LINE;
+ VALUE : out BIT_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+3)/4;
+ constant pad : INTEGER := ne*4 - VALUE'length;
+ variable sv : BIT_VECTOR (0 to ne*4 - 1) := (others => '0');
+ variable s : STRING(1 to ne-1);
+ begin
+ VALUE := (VALUE'range => '0');
+ loop -- skip white space
+ read(l, c, ok);
+ exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
+ end loop;
+ -- Bail out if there was a bad read
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ Char2QuadBits(c, sv(0 to 3), ok, false);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ read(L, s, ok);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ for i in 1 to ne-1 loop
+ Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then
+ GOOD := false; -- vector was truncated.
+ else
+ GOOD := true;
+ VALUE := sv (pad to sv'high);
+ end if;
+ end procedure HREAD;
+
+ procedure HREAD (L : inout LINE;
+ VALUE : out BIT_VECTOR) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+3)/4;
+ constant pad : INTEGER := ne*4 - VALUE'length;
+ variable sv : BIT_VECTOR(0 to ne*4 - 1) := (others => '0');
+ variable s : STRING(1 to ne-1);
+ begin
+ VALUE := (VALUE'range => '0');
+ loop -- skip white space
+ read(l, c, ok);
+ exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
+ end loop;
+ -- Bail out if there was a bad read
+ if not ok then
+ report "TEXTIO.HREAD Error: Failed skipping white space"
+ severity error;
+ return;
+ end if;
+ Char2QuadBits(c, sv(0 to 3), ok, true);
+ if not ok then
+ return;
+ end if;
+ read(L, s, ok);
+ if not ok then
+ report "TEXTIO.HREAD Error: Failed to read the STRING"
+ severity error;
+ return;
+ end if;
+ for i in 1 to ne-1 loop
+ Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true);
+ if not ok then
+ return;
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then
+ report "TEXTIO.HREAD Error: Vector truncated"
+ severity error;
+ else
+ VALUE := sv (pad to sv'high);
+ end if;
+ end procedure HREAD;
+
+ procedure HWRITE (L : inout LINE;
+ VALUE : in BIT_VECTOR;
+ JUSTIFIED : in SIDE := right;
+ FIELD : in WIDTH := 0) is
+ begin
+ write (L => L,
+ VALUE => to_hstring(VALUE),
+ JUSTIFIED => JUSTIFIED,
+ FIELD => FIELD);
+ end procedure HWRITE;
+
+ -- Procedure only visible internally.
+ procedure Char2TriBits (C : CHARACTER;
+ RESULT : out BIT_VECTOR(2 downto 0);
+ GOOD : out BOOLEAN;
+ ISSUE_ERROR : in BOOLEAN) is
+ begin
+ case c is
+ when '0' => result := o"0"; good := true;
+ when '1' => result := o"1"; good := true;
+ when '2' => result := o"2"; good := true;
+ when '3' => result := o"3"; good := true;
+ when '4' => result := o"4"; good := true;
+ when '5' => result := o"5"; good := true;
+ when '6' => result := o"6"; good := true;
+ when '7' => result := o"7"; good := true;
+ when others =>
+ assert not ISSUE_ERROR
+ report
+ "TEXTIO.OREAD Error: Read a '" & c &
+ "', expected an Octal character (0-7)."
+ severity error;
+ GOOD := false;
+ end case;
+ end procedure Char2TriBits;
+
+ -- Read and Write procedures for Octal values
+ procedure OREAD (L : inout LINE;
+ VALUE : out BIT_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+2)/3;
+ constant pad : INTEGER := ne*3 - VALUE'length;
+ variable sv : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
+ variable s : STRING(1 to ne-1);
+ begin
+ VALUE := (VALUE'range => '0');
+ loop -- skip white space
+ read(l, c, ok);
+ exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
+ end loop;
+ -- Bail out if there was a bad read
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ Char2TriBits(c, sv(0 to 2), ok, false);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ read(L, s, ok);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ for i in 1 to ne-1 loop
+ Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false);
+ if not ok then
+ GOOD := false;
+ return;
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then
+ GOOD := false; -- vector was truncated.
+ else
+ GOOD := true;
+ VALUE := sv (pad to sv'high);
+ end if;
+ end procedure OREAD;
+
+ procedure OREAD (L : inout LINE;
+ VALUE : out BIT_VECTOR) is
+ variable c : CHARACTER;
+ variable ok : BOOLEAN;
+ constant ne : INTEGER := (VALUE'length+2)/3;
+ constant pad : INTEGER := ne*3 - VALUE'length;
+ variable sv : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
+ variable s : STRING(1 to ne-1);
+ begin
+ VALUE := (VALUE'range => '0');
+ loop -- skip white space
+ read(l, c, ok);
+ exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
+ end loop;
+ -- Bail out if there was a bad read
+ if not ok then
+ report "TEXTIO.OREAD Error: Failed skipping white space"
+ severity error;
+ return;
+ end if;
+ Char2TriBits(c, sv(0 to 2), ok, true);
+ if not ok then
+ return;
+ end if;
+ read(L, s, ok);
+ if not ok then
+ report "TEXTIO.OREAD Error: Failed to read the STRING"
+ severity error;
+ return;
+ end if;
+ for i in 1 to ne-1 loop
+ Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true);
+ if not ok then
+ return;
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then
+ report "TEXTIO.OREAD Error: Vector truncated"
+ severity error;
+ else
+ VALUE := sv (pad to sv'high);
+ end if;
+ end procedure OREAD;
+
+ procedure OWRITE (L : inout LINE;
+ VALUE : in BIT_VECTOR;
+ JUSTIFIED : in SIDE := right;
+ FIELD : in WIDTH := 0) is
+ begin
+ write (L => L,
+ VALUE => to_ostring(VALUE),
+ JUSTIFIED => JUSTIFIED,
+ FIELD => FIELD);
+ end procedure OWRITE;
+
+ -- read and write for vector versions
+ -- These versions produce "value1, value2, value3 ...."
+ procedure read (L : inout LINE;
+ VALUE : out boolean_vector;
+ GOOD : out BOOLEAN) is
+ variable dummy : CHARACTER;
+ variable igood : BOOLEAN := true;
+ begin
+ for i in VALUE'range loop
+ read (L => L,
+ VALUE => VALUE(i),
+ GOOD => igood);
+ if (igood) and (i /= value'right) then
+ read (L => L,
+ VALUE => dummy, -- Toss the comma or seperator
+ good => igood);
+ end if;
+ if (not igood) then
+ good := false;
+ return;
+ end if;
+ end loop;
+ good := true;
+ end procedure read;
+
+ procedure read (L : inout LINE;
+ VALUE : out boolean_vector) is
+ variable dummy : CHARACTER;
+ variable igood : BOOLEAN;
+ begin
+ for i in VALUE'range loop
+ read (L => L,
+ VALUE => VALUE(i),
+ good => igood);
+ if (igood) and (i /= value'right) then
+ read (L => L,
+ VALUE => dummy, -- Toss the comma or seperator
+ good => igood);
+ end if;
+ if (not igood) then
+ report "STANDARD.STD_TEXTIO(BOOLEAN_VECTOR) "
+ & "Read error ecounted during vector read" severity error;
+ return;
+ end if;
+ end loop;
+ end procedure read;
+
+ procedure write (L : inout LINE;
+ VALUE : in boolean_vector;
+ JUSTIFIED : in SIDE := right;
+ FIELD : in WIDTH := 0) is
+ begin
+ for i in VALUE'range loop
+ write (L => L,
+ VALUE => VALUE(i),
+ JUSTIFIED => JUSTIFIED,
+ FIELD => FIELD);
+ if (i /= value'right) then
+ swrite (L, ", ");
+ end if;
+ end loop;
+ end procedure write;
+
+ procedure WRITE (L: inout LINE; VALUE: in REAL;
+ FORMAT: in STRING) is
+ begin
+--ET: Below modification is required to avoid the following error in iSim
+-- "FATAL_ERROR:Simulator:CompilerAssert.h:40:1.67 - Internal Compiler Error in file ../src/VhdlExpr.cpp at line 7524 Process will terminate. For technical support on this issue, please open a WebCase with this project attached at http://www.xilinx.com/support."
+-- swrite ( L => L, VALUE => to_string (VALUE, FORMAT));
+ swrite ( L, to_string (VALUE, FORMAT));
+ end procedure WRITE;
+
+ function justify (
+ value : STRING;
+ justified : SIDE := right;
+ field : width := 0)
+ return STRING is
+ constant VAL_LEN : INTEGER := value'length;
+ variable result : STRING (1 to field) := (others => ' ');
+ begin -- function justify
+ -- return value if field is too small
+ if VAL_LEN >= field then
+ return value;
+ end if;
+ if justified = left then
+ result(1 to VAL_LEN) := value;
+ elsif justified = right then
+ result(field - VAL_LEN + 1 to field) := value;
+ end if;
+ return result;
+ end function justify;
+
+ function to_string (
+ VALUE : SIDE) return STRING is
+ begin
+ return SIDE'image(VALUE);
+ end function to_string;
+
+ -- pragma synthesis_on
+ -- Will be implicit
+ function minimum (L, R : SIDE) return SIDE is
+ begin
+ if L > R then return R;
+ else return L;
+ end if;
+ end function minimum;
+
+ function maximum (L, R : SIDE) return SIDE is
+ begin
+ if L > R then return L;
+ else return R;
+ end if;
+ end function maximum;
+
+end package body standard_textio_additions;
diff --git a/testsuite/gna/ticket89/x_ieee_proposed/src/std_logic_1164_additions.vhdl b/testsuite/gna/ticket89/x_ieee_proposed/src/std_logic_1164_additions.vhdl
new file mode 100644
index 0000000..3e42ef2
--- /dev/null
+++ b/testsuite/gna/ticket89/x_ieee_proposed/src/std_logic_1164_additions.vhdl
@@ -0,0 +1,1680 @@
+------------------------------------------------------------------------------
+-- "std_logic_1164_additions" package contains the additions to the standard
+-- "std_logic_1164" package proposed by the VHDL-200X-ft working group.
+-- This package should be compiled into "ieee_proposed" and used as follows:
+-- use ieee.std_logic_1164.all;
+-- use ieee_proposed.std_logic_1164_additions.all;
+-- Last Modified: $Date: 2010/09/22 18:32:33 $
+-- RCS ID: $Id: std_logic_1164_additions.vhdl,v 1.13 2010/09/22 18:32:33 l435385 Exp $
+--
+-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
+------------------------------------------------------------------------------
+library ieee;
+use ieee.std_logic_1164.all;
+use std.textio.all;
+package std_logic_1164_additions is
+
+ -- NOTE that in the new std_logic_1164, STD_LOGIC_VECTOR is a resolved
+ -- subtype of STD_ULOGIC_VECTOR. Thus there is no need for funcitons which
+ -- take inputs in STD_LOGIC_VECTOR.
+ -- For compatability with VHDL-2002, I have replicated all of these funcitons
+ -- here for STD_LOGIC_VECTOR.
+ -- new aliases
+ alias to_bv is ieee.std_logic_1164.To_bitvector [STD_LOGIC_VECTOR, BIT return BIT_VECTOR];
+ alias to_bv is ieee.std_logic_1164.To_bitvector [STD_ULOGIC_VECTOR, BIT return BIT_VECTOR];
+ alias to_bit_vector is ieee.std_logic_1164.To_bitvector [STD_LOGIC_VECTOR, BIT return BIT_VECTOR];
+ alias to_bit_vector is ieee.std_logic_1164.To_bitvector [STD_ULOGIC_VECTOR, BIT return BIT_VECTOR];
+ alias to_slv is ieee.std_logic_1164.To_StdLogicVector [BIT_VECTOR return STD_LOGIC_VECTOR];
+ alias to_slv is ieee.std_logic_1164.To_StdLogicVector [STD_ULOGIC_VECTOR return STD_LOGIC_VECTOR];
+ alias to_std_logic_vector is ieee.std_logic_1164.To_StdLogicVector [BIT_VECTOR return STD_LOGIC_VECTOR];
+ alias to_std_logic_vector is ieee.std_logic_1164.To_StdLogicVector [STD_ULOGIC_VECTOR return STD_LOGIC_VECTOR];
+ alias to_sulv is ieee.std_logic_1164.To_StdULogicVector [BIT_VECTOR return STD_ULOGIC_VECTOR];
+ alias to_sulv is ieee.std_logic_1164.To_StdULogicVector [STD_LOGIC_VECTOR return STD_ULOGIC_VECTOR];
+ alias to_std_ulogic_vector is ieee.std_logic_1164.To_StdULogicVector [BIT_VECTOR return STD_ULOGIC_VECTOR];
+ alias to_std_ulogic_vector is ieee.std_logic_1164.To_StdULogicVector [STD_LOGIC_VECTOR return STD_ULOGIC_VECTOR];
+
+ function TO_01 (s : STD_ULOGIC_VECTOR; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC_VECTOR;
+ function TO_01 (s : STD_ULOGIC; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC;
+ function TO_01 (s : BIT_VECTOR; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC_VECTOR;
+ function TO_01 (s : BIT; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC;
+
+ -------------------------------------------------------------------
+ -- overloaded shift operators
+ -------------------------------------------------------------------
+
+ function "sll" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR;
+ function "sll" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR;
+
+ function "srl" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR;
+ function "srl" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR;
+
+ function "rol" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR;
+ function "rol" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR;
+
+ function "ror" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR;
+ function "ror" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR;
+ -------------------------------------------------------------------
+ -- vector/scalar overloaded logical operators
+ -------------------------------------------------------------------
+ function "and" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "and" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "and" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "and" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function "nand" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "nand" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "nand" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "nand" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function "or" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "or" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "or" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "or" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function "nor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "nor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "nor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "nor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function "xor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "xor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "xor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "xor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function "xnor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR;
+ function "xnor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR;
+ function "xnor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function "xnor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+
+ -------------------------------------------------------------------
+ -- vector-reduction functions.
+ -- "and" functions default to "1", or defaults to "0"
+ -------------------------------------------------------------------
+ -----------------------------------------------------------------------------
+ -- %%% Replace the "_reduce" functions with the ones commented out below.
+ -----------------------------------------------------------------------------
+ -- function "and" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "and" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ -- function "nand" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "nand" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ -- function "or" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "or" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ -- function "nor" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "nor" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ -- function "xor" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "xor" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ -- function "xnor" ( l : std_logic_vector ) RETURN std_ulogic;
+ -- function "xnor" ( l : std_ulogic_vector ) RETURN std_ulogic;
+ function and_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function and_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function nand_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function nand_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function or_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function or_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function nor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function nor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function xor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function xor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function xnor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function xnor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ -------------------------------------------------------------------
+ -- ?= operators, same functionality as 1076.3 1994 std_match
+ -------------------------------------------------------------------
+-- FUNCTION "?=" ( l, r : std_ulogic ) RETURN std_ulogic;
+-- FUNCTION "?=" ( l, r : std_logic_vector ) RETURN std_ulogic;
+-- FUNCTION "?=" ( l, r : std_ulogic_vector ) RETURN std_ulogic;
+-- FUNCTION "?/=" ( l, r : std_ulogic ) RETURN std_ulogic;
+-- FUNCTION "?/=" ( l, r : std_logic_vector ) RETURN std_ulogic;
+-- FUNCTION "?/=" ( l, r : std_ulogic_vector ) RETURN std_ulogic;
+-- FUNCTION "?>" ( l, r : std_ulogic ) RETURN std_ulogic;
+-- FUNCTION "?>=" ( l, r : std_ulogic ) RETURN std_ulogic;
+-- FUNCTION "?<" ( l, r : std_ulogic ) RETURN std_ulogic;
+-- FUNCTION "?<=" ( l, r : std_ulogic ) RETURN std_ulogic;
+
+ function \?=\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function \?=\ (l, r : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function \?=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function \?/=\ (l, r : STD_LOGIC_VECTOR) return STD_ULOGIC;
+ function \?/=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC;
+ function \?>\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function \?>=\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function \?<\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function \?<=\ (l, r : STD_ULOGIC) return STD_ULOGIC;
+
+
+ -- "??" operator, converts a std_ulogic to a boolean.
+ --%%% Uncomment the following operators
+ -- FUNCTION "??" (S : STD_ULOGIC) RETURN BOOLEAN;
+ --%%% REMOVE the following funciton (for testing only)
+ function \??\ (S : STD_ULOGIC) return BOOLEAN;
+
+ -- rtl_synthesis off
+-- pragma synthesis_off
+ function to_string (value : STD_ULOGIC) return STRING;
+ function to_string (value : STD_ULOGIC_VECTOR) return STRING;
+ function to_string (value : STD_LOGIC_VECTOR) return STRING;
+
+ -- explicitly defined operations
+
+ alias TO_BSTRING is TO_STRING [STD_ULOGIC_VECTOR return STRING];
+ alias TO_BINARY_STRING is TO_STRING [STD_ULOGIC_VECTOR return STRING];
+ function TO_OSTRING (VALUE : STD_ULOGIC_VECTOR) return STRING;
+ alias TO_OCTAL_STRING is TO_OSTRING [STD_ULOGIC_VECTOR return STRING];
+ function TO_HSTRING (VALUE : STD_ULOGIC_VECTOR) return STRING;
+ alias TO_HEX_STRING is TO_HSTRING [STD_ULOGIC_VECTOR return STRING];
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC; GOOD : out BOOLEAN);
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC);
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR);
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_ULOGIC;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+
+ alias BREAD is READ [LINE, STD_ULOGIC_VECTOR, BOOLEAN];
+ alias BREAD is READ [LINE, STD_ULOGIC_VECTOR];
+ alias BINARY_READ is READ [LINE, STD_ULOGIC_VECTOR, BOOLEAN];
+ alias BINARY_READ is READ [LINE, STD_ULOGIC_VECTOR];
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR);
+ alias OCTAL_READ is OREAD [LINE, STD_ULOGIC_VECTOR, BOOLEAN];
+ alias OCTAL_READ is OREAD [LINE, STD_ULOGIC_VECTOR];
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR);
+ alias HEX_READ is HREAD [LINE, STD_ULOGIC_VECTOR, BOOLEAN];
+ alias HEX_READ is HREAD [LINE, STD_ULOGIC_VECTOR];
+
+ alias BWRITE is WRITE [LINE, STD_ULOGIC_VECTOR, SIDE, WIDTH];
+ alias BINARY_WRITE is WRITE [LINE, STD_ULOGIC_VECTOR, SIDE, WIDTH];
+
+ procedure OWRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias OCTAL_WRITE is OWRITE [LINE, STD_ULOGIC_VECTOR, SIDE, WIDTH];
+
+ procedure HWRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias HEX_WRITE is HWRITE [LINE, STD_ULOGIC_VECTOR, SIDE, WIDTH];
+
+ alias TO_BSTRING is TO_STRING [STD_LOGIC_VECTOR return STRING];
+ alias TO_BINARY_STRING is TO_STRING [STD_LOGIC_VECTOR return STRING];
+ function TO_OSTRING (VALUE : STD_LOGIC_VECTOR) return STRING;
+ alias TO_OCTAL_STRING is TO_OSTRING [STD_LOGIC_VECTOR return STRING];
+ function TO_HSTRING (VALUE : STD_LOGIC_VECTOR) return STRING;
+ alias TO_HEX_STRING is TO_HSTRING [STD_LOGIC_VECTOR return STRING];
+
+ procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR);
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+
+ alias BREAD is READ [LINE, STD_LOGIC_VECTOR, BOOLEAN];
+ alias BREAD is READ [LINE, STD_LOGIC_VECTOR];
+ alias BINARY_READ is READ [LINE, STD_LOGIC_VECTOR, BOOLEAN];
+ alias BINARY_READ is READ [LINE, STD_LOGIC_VECTOR];
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR);
+ alias OCTAL_READ is OREAD [LINE, STD_LOGIC_VECTOR, BOOLEAN];
+ alias OCTAL_READ is OREAD [LINE, STD_LOGIC_VECTOR];
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN);
+ procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR);
+ alias HEX_READ is HREAD [LINE, STD_LOGIC_VECTOR, BOOLEAN];
+ alias HEX_READ is HREAD [LINE, STD_LOGIC_VECTOR];
+
+ alias BWRITE is WRITE [LINE, STD_LOGIC_VECTOR, SIDE, WIDTH];
+ alias BINARY_WRITE is WRITE [LINE, STD_LOGIC_VECTOR, SIDE, WIDTH];
+
+ procedure OWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias OCTAL_WRITE is OWRITE [LINE, STD_LOGIC_VECTOR, SIDE, WIDTH];
+
+ procedure HWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
+ alias HEX_WRITE is HWRITE [LINE, STD_LOGIC_VECTOR, SIDE, WIDTH];
+ -- rtl_synthesis on
+-- pragma synthesis_on
+ function maximum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function maximum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function maximum (l, r : STD_ULOGIC) return STD_ULOGIC;
+ function minimum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR;
+ function minimum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR;
+ function minimum (l, r : STD_ULOGIC) return STD_ULOGIC;
+end package std_logic_1164_additions;
+
+package body std_logic_1164_additions is
+ type stdlogic_table is array(STD_ULOGIC, STD_ULOGIC) of STD_ULOGIC;
+ -----------------------------------------------------------------------------
+ -- New/updated funcitons for VHDL-200X fast track
+ -----------------------------------------------------------------------------
+ -- to_01
+ -------------------------------------------------------------------
+ function TO_01 (s : STD_ULOGIC_VECTOR; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC_VECTOR is
+ variable RESULT : STD_ULOGIC_VECTOR(s'length-1 downto 0);
+ variable BAD_ELEMENT : BOOLEAN := false;
+ alias XS : STD_ULOGIC_VECTOR(s'length-1 downto 0) is s;
+ begin
+ for I in RESULT'range loop
+ case XS(I) is
+ when '0' | 'L' => RESULT(I) := '0';
+ when '1' | 'H' => RESULT(I) := '1';
+ when others => BAD_ELEMENT := true;
+ end case;
+ end loop;
+ if BAD_ELEMENT then
+ for I in RESULT'range loop
+ RESULT(I) := XMAP; -- standard fixup
+ end loop;
+ end if;
+ return RESULT;
+ end function TO_01;
+ -------------------------------------------------------------------
+ function TO_01 (s : STD_ULOGIC; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC is
+ begin
+ case s is
+ when '0' | 'L' => RETURN '0';
+ when '1' | 'H' => RETURN '1';
+ when others => return xmap;
+ end case;
+ end function TO_01;
+ -------------------------------------------------------------------
+ function TO_01 (s : BIT_VECTOR; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC_VECTOR is
+ variable RESULT : STD_ULOGIC_VECTOR(s'length-1 downto 0);
+ alias XS : BIT_VECTOR(s'length-1 downto 0) is s;
+ begin
+ for I in RESULT'range loop
+ case XS(I) is
+ when '0' => RESULT(I) := '0';
+ when '1' => RESULT(I) := '1';
+ end case;
+ end loop;
+ return RESULT;
+ end function TO_01;
+ -------------------------------------------------------------------
+ function TO_01 (s : BIT; xmap : STD_ULOGIC := '0')
+ return STD_ULOGIC is
+ begin
+ case s is
+ when '0' => RETURN '0';
+ when '1' => RETURN '1';
+ end case;
+ end function TO_01;
+-- end Bugzilla issue #148
+ -------------------------------------------------------------------
+
+ -------------------------------------------------------------------
+ -- overloaded shift operators
+ -------------------------------------------------------------------
+
+ -------------------------------------------------------------------
+ -- sll
+ -------------------------------------------------------------------
+ function "sll" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length) := (others => '0');
+ begin
+ if r >= 0 then
+ result(1 to l'length - r) := lv(r + 1 to l'length);
+ else
+ result := l srl -r;
+ end if;
+ return result;
+ end function "sll";
+ -------------------------------------------------------------------
+ function "sll" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
+ begin
+ if r >= 0 then
+ result(1 to l'length - r) := lv(r + 1 to l'length);
+ else
+ result := l srl -r;
+ end if;
+ return result;
+ end function "sll";
+
+ -------------------------------------------------------------------
+ -- srl
+ -------------------------------------------------------------------
+ function "srl" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length) := (others => '0');
+ begin
+ if r >= 0 then
+ result(r + 1 to l'length) := lv(1 to l'length - r);
+ else
+ result := l sll -r;
+ end if;
+ return result;
+ end function "srl";
+ -------------------------------------------------------------------
+ function "srl" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
+ begin
+ if r >= 0 then
+ result(r + 1 to l'length) := lv(1 to l'length - r);
+ else
+ result := l sll -r;
+ end if;
+ return result;
+ end function "srl";
+
+ -------------------------------------------------------------------
+ -- rol
+ -------------------------------------------------------------------
+ function "rol" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(1 to l'length - rm) := lv(rm + 1 to l'length);
+ result(l'length - rm + 1 to l'length) := lv(1 to rm);
+ else
+ result := l ror -r;
+ end if;
+ return result;
+ end function "rol";
+ -------------------------------------------------------------------
+ function "rol" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(1 to l'length - rm) := lv(rm + 1 to l'length);
+ result(l'length - rm + 1 to l'length) := lv(1 to rm);
+ else
+ result := l ror -r;
+ end if;
+ return result;
+ end function "rol";
+
+ -------------------------------------------------------------------
+ -- ror
+ -------------------------------------------------------------------
+ function "ror" (l : STD_LOGIC_VECTOR; r : INTEGER) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length) := (others => '0');
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(rm + 1 to l'length) := lv(1 to l'length - rm);
+ result(1 to rm) := lv(l'length - rm + 1 to l'length);
+ else
+ result := l rol -r;
+ end if;
+ return result;
+ end function "ror";
+ -------------------------------------------------------------------
+ function "ror" (l : STD_ULOGIC_VECTOR; r : INTEGER) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
+ constant rm : INTEGER := r mod l'length;
+ begin
+ if r >= 0 then
+ result(rm + 1 to l'length) := lv(1 to l'length - rm);
+ result(1 to rm) := lv(l'length - rm + 1 to l'length);
+ else
+ result := l rol -r;
+ end if;
+ return result;
+ end function "ror";
+ -------------------------------------------------------------------
+ -- vector/scalar overloaded logical operators
+ -------------------------------------------------------------------
+
+ -------------------------------------------------------------------
+ -- and
+ -------------------------------------------------------------------
+ function "and" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "and" (lv(i), r);
+ end loop;
+ return result;
+ end function "and";
+ -------------------------------------------------------------------
+ function "and" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "and" (lv(i), r);
+ end loop;
+ return result;
+ end function "and";
+ -------------------------------------------------------------------
+ function "and" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "and" (l, rv(i));
+ end loop;
+ return result;
+ end function "and";
+ -------------------------------------------------------------------
+ function "and" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "and" (l, rv(i));
+ end loop;
+ return result;
+ end function "and";
+
+ -------------------------------------------------------------------
+ -- nand
+ -------------------------------------------------------------------
+ function "nand" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("and" (lv(i), r));
+ end loop;
+ return result;
+ end function "nand";
+ -------------------------------------------------------------------
+ function "nand" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("and" (lv(i), r));
+ end loop;
+ return result;
+ end function "nand";
+ -------------------------------------------------------------------
+ function "nand" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("and" (l, rv(i)));
+ end loop;
+ return result;
+ end function "nand";
+ -------------------------------------------------------------------
+ function "nand" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("and" (l, rv(i)));
+ end loop;
+ return result;
+ end function "nand";
+
+ -------------------------------------------------------------------
+ -- or
+ -------------------------------------------------------------------
+ function "or" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "or" (lv(i), r);
+ end loop;
+ return result;
+ end function "or";
+ -------------------------------------------------------------------
+ function "or" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "or" (lv(i), r);
+ end loop;
+ return result;
+ end function "or";
+ -------------------------------------------------------------------
+ function "or" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "or" (l, rv(i));
+ end loop;
+ return result;
+ end function "or";
+ -------------------------------------------------------------------
+ function "or" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "or" (l, rv(i));
+ end loop;
+ return result;
+ end function "or";
+
+ -------------------------------------------------------------------
+ -- nor
+ -------------------------------------------------------------------
+ function "nor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("or" (lv(i), r));
+ end loop;
+ return result;
+ end function "nor";
+ -------------------------------------------------------------------
+ function "nor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("or" (lv(i), r));
+ end loop;
+ return result;
+ end function "nor";
+ -------------------------------------------------------------------
+ function "nor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("or" (l, rv(i)));
+ end loop;
+ return result;
+ end function "nor";
+ -------------------------------------------------------------------
+ function "nor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("or" (l, rv(i)));
+ end loop;
+ return result;
+ end function "nor";
+
+ -------------------------------------------------------------------
+ -- xor
+ -------------------------------------------------------------------
+ function "xor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "xor" (lv(i), r);
+ end loop;
+ return result;
+ end function "xor";
+ -------------------------------------------------------------------
+ function "xor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "xor" (lv(i), r);
+ end loop;
+ return result;
+ end function "xor";
+ -------------------------------------------------------------------
+ function "xor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "xor" (l, rv(i));
+ end loop;
+ return result;
+ end function "xor";
+ -------------------------------------------------------------------
+ function "xor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "xor" (l, rv(i));
+ end loop;
+ return result;
+ end function "xor";
+
+ -------------------------------------------------------------------
+ -- xnor
+ -------------------------------------------------------------------
+ function "xnor" (l : STD_LOGIC_VECTOR; r : STD_ULOGIC) return STD_LOGIC_VECTOR is
+ alias lv : STD_LOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_LOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("xor" (lv(i), r));
+ end loop;
+ return result;
+ end function "xnor";
+ -------------------------------------------------------------------
+ function "xnor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC) return STD_ULOGIC_VECTOR is
+ alias lv : STD_ULOGIC_VECTOR (1 to l'length) is l;
+ variable result : STD_ULOGIC_VECTOR (1 to l'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("xor" (lv(i), r));
+ end loop;
+ return result;
+ end function "xnor";
+ -------------------------------------------------------------------
+ function "xnor" (l : STD_ULOGIC; r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ alias rv : STD_LOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_LOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("xor" (l, rv(i)));
+ end loop;
+ return result;
+ end function "xnor";
+ -------------------------------------------------------------------
+ function "xnor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ alias rv : STD_ULOGIC_VECTOR (1 to r'length) is r;
+ variable result : STD_ULOGIC_VECTOR (1 to r'length);
+ begin
+ for i in result'range loop
+ result(i) := "not"("xor" (l, rv(i)));
+ end loop;
+ return result;
+ end function "xnor";
+
+ -------------------------------------------------------------------
+ -- vector-reduction functions
+ -------------------------------------------------------------------
+
+ -------------------------------------------------------------------
+ -- and
+ -------------------------------------------------------------------
+ function and_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return and_reduce (to_StdULogicVector (l));
+ end function and_reduce;
+ -------------------------------------------------------------------
+ function and_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ variable result : STD_ULOGIC := '1';
+ begin
+ for i in l'reverse_range loop
+ result := (l(i) and result);
+ end loop;
+ return result;
+ end function and_reduce;
+
+ -------------------------------------------------------------------
+ -- nand
+ -------------------------------------------------------------------
+ function nand_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return not (and_reduce(to_StdULogicVector(l)));
+ end function nand_reduce;
+ -------------------------------------------------------------------
+ function nand_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return not (and_reduce(l));
+ end function nand_reduce;
+
+ -------------------------------------------------------------------
+ -- or
+ -------------------------------------------------------------------
+ function or_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return or_reduce (to_StdULogicVector (l));
+ end function or_reduce;
+ -------------------------------------------------------------------
+ function or_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ variable result : STD_ULOGIC := '0';
+ begin
+ for i in l'reverse_range loop
+ result := (l(i) or result);
+ end loop;
+ return result;
+ end function or_reduce;
+
+ -------------------------------------------------------------------
+ -- nor
+ -------------------------------------------------------------------
+ function nor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return "not"(or_reduce(To_StdULogicVector(l)));
+ end function nor_reduce;
+ -------------------------------------------------------------------
+ function nor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return "not"(or_reduce(l));
+ end function nor_reduce;
+
+ -------------------------------------------------------------------
+ -- xor
+ -------------------------------------------------------------------
+ function xor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return xor_reduce (to_StdULogicVector (l));
+ end function xor_reduce;
+ -------------------------------------------------------------------
+ function xor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ variable result : STD_ULOGIC := '0';
+ begin
+ for i in l'reverse_range loop
+ result := (l(i) xor result);
+ end loop;
+ return result;
+ end function xor_reduce;
+
+ -------------------------------------------------------------------
+ -- xnor
+ -------------------------------------------------------------------
+ function xnor_reduce (l : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return "not"(xor_reduce(To_StdULogicVector(l)));
+ end function xnor_reduce;
+ -------------------------------------------------------------------
+ function xnor_reduce (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return "not"(xor_reduce(l));
+ end function xnor_reduce;
+ -- %%% End "remove the following functions"
+
+ constant match_logic_table : stdlogic_table := (
+ -----------------------------------------------------
+ -- U X 0 1 Z W L H - | |
+ -----------------------------------------------------
+ ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '1'), -- | U |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '1'), -- | X |
+ ('U', 'X', '1', '0', 'X', 'X', '1', '0', '1'), -- | 0 |
+ ('U', 'X', '0', '1', 'X', 'X', '0', '1', '1'), -- | 1 |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '1'), -- | Z |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '1'), -- | W |
+ ('U', 'X', '1', '0', 'X', 'X', '1', '0', '1'), -- | L |
+ ('U', 'X', '0', '1', 'X', 'X', '0', '1', '1'), -- | H |
+ ('1', '1', '1', '1', '1', '1', '1', '1', '1') -- | - |
+ );
+
+ -------------------------------------------------------------------
+ -- ?= functions, Similar to "std_match", but returns "std_ulogic".
+ -------------------------------------------------------------------
+ -- %%% FUNCTION "?=" ( l, r : std_ulogic ) RETURN std_ulogic IS
+ function \?=\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return match_logic_table (l, r);
+ end function \?=\;
+ -- %%% END FUNCTION "?=";
+ -------------------------------------------------------------------
+ -- %%% FUNCTION "?=" ( l, r : std_logic_vector ) RETURN std_ulogic IS
+ function \?=\ (l, r : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ alias lv : STD_LOGIC_VECTOR(1 to l'length) is l;
+ alias rv : STD_LOGIC_VECTOR(1 to r'length) is r;
+ variable result, result1 : STD_ULOGIC; -- result
+ begin
+ -- Logically identical to an "=" operator.
+ if ((l'length < 1) and (r'length < 1)) then
+ -- VHDL-2008 LRM 9.2.3 Two NULL arrays of the same type are equal
+ return '1';
+ elsif lv'length /= rv'length then
+ -- Two arrays of different lengths are false
+ return '0';
+ else
+ result := '1';
+ for i in lv'low to lv'high loop
+ result1 := match_logic_table(lv(i), rv(i));
+ result := result and result1;
+ end loop;
+ return result;
+ end if;
+ end function \?=\;
+ -- %%% END FUNCTION "?=";
+ -------------------------------------------------------------------
+ -- %%% FUNCTION "?=" ( l, r : std_ulogic_vector ) RETURN std_ulogic IS
+ function \?=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ alias lv : STD_ULOGIC_VECTOR(1 to l'length) is l;
+ alias rv : STD_ULOGIC_VECTOR(1 to r'length) is r;
+ variable result, result1 : STD_ULOGIC;
+ begin
+ -- Logically identical to an "=" operator.
+ if ((l'length < 1) and (r'length < 1)) then
+ -- VHDL-2008 LRM 9.2.3 Two NULL arrays of the same type are equal
+ return '1';
+ elsif lv'length /= rv'length then
+ -- Two arrays of different lengths are false
+ return '0';
+ else
+ result := '1';
+ for i in lv'low to lv'high loop
+ result1 := match_logic_table(lv(i), rv(i));
+ result := result and result1;
+ end loop;
+ return result;
+ end if;
+ end function \?=\;
+ -- %%% END FUNCTION "?=";
+ -- %%% FUNCTION "?/=" ( l, r : std_ulogic ) RETURN std_ulogic is
+ function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return not \?=\ (l, r);
+ end function \?/=\;
+ -- %%% END FUNCTION "?/=";
+ -- %%% FUNCTION "?/=" ( l, r : std_logic_vector ) RETURN std_ulogic is
+ function \?/=\ (l, r : STD_LOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return not \?=\ (l, r);
+ end function \?/=\;
+ -- %%% END FUNCTION "?/=";
+ -- %%% FUNCTION "?/=" ( l, r : std_ulogic_vector ) RETURN std_ulogic is
+ function \?/=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC is
+ begin
+ return not \?=\ (l, r);
+ end function \?/=\;
+ -- %%% END FUNCTION "?/=";
+
+ -- Table for the ?< function (Section 9.2.3)
+ constant qlt : stdlogic_table := (
+ -----------------------------------------------------
+ -- U X 0 1 Z W L H - | |
+ -----------------------------------------------------
+ ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'X'), -- | U |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | X |
+ ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'), -- | 0 |
+ ('U', 'X', '0', '0', 'X', 'X', '0', '0', 'X'), -- | 1 |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | Z |
+ ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | W |
+ ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'), -- | L |
+ ('U', 'X', '0', '0', 'X', 'X', '0', '0', 'X'), -- | H |
+ ('X', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X') -- | - |
+ );
+
+ -- %%% FUNCTION "?>" ( l, r : std_ulogic ) RETURN std_ulogic is
+ function \?>\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return not (qlt (l, r) or match_logic_table (l,r));
+ end function \?>\;
+ -- %%% END FUNCTION "?>";
+
+ -- %%% FUNCTION "?>=" ( l, r : std_ulogic ) RETURN std_ulogic is
+ function \?>=\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return not qlt (l, r);
+ end function \?>=\;
+ -- %%% END FUNCTION "?>=";
+
+ -- %%% FUNCTION "?<" ( l, r : std_ulogic ) RETURN std_ulogic is
+ function \?<\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return qlt (l, r);
+ end function \?<\;
+ -- %%% END FUNCTION "?<";
+
+ -- %%% FUNCTION "?<=" ( l, r : std_ulogic ) RETURN std_ulogic is
+ function \?<=\ (l, r : STD_ULOGIC) return STD_ULOGIC is
+ begin
+ return qlt (l, r) or match_logic_table (l,r);
+ end function \?<=\;
+ -- %%% END FUNCTION "?<=";
+
+ -- "??" operator, converts a std_ulogic to a boolean.
+-- %%% FUNCTION "??"
+ function \??\ (S : STD_ULOGIC) return BOOLEAN is
+ begin
+ return S = '1' or S = 'H';
+ end function \??\;
+-- %%% END FUNCTION "??";
+
+ -- rtl_synthesis off
+-- pragma synthesis_off
+ -----------------------------------------------------------------------------
+ -- This section copied from "std_logic_textio"
+ -----------------------------------------------------------------------------
+ -- Type and constant definitions used to map STD_ULOGIC values
+ -- into/from character values.
+ type MVL9plus is ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-', error);
+ type char_indexed_by_MVL9 is array (STD_ULOGIC) of CHARACTER;
+ type MVL9_indexed_by_char is array (CHARACTER) of STD_ULOGIC;
+ type MVL9plus_indexed_by_char is array (CHARACTER) of MVL9plus;
+ constant MVL9_to_char : char_indexed_by_MVL9 := "UX01ZWLH-";
+ constant char_to_MVL9 : MVL9_indexed_by_char :=
+ ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
+ 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => 'U');
+ constant char_to_MVL9plus : MVL9plus_indexed_by_char :=
+ ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
+ 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => error);
+
+ constant NBSP : CHARACTER := CHARACTER'val(160); -- space character
+ constant NUS : STRING(2 to 1) := (others => ' '); -- null STRING
+
+ -- purpose: Skips white space
+ procedure skip_whitespace (
+ L : inout LINE) is
+ variable readOk : BOOLEAN;
+ variable c : CHARACTER;
+ begin
+ while L /= null and L.all'length /= 0 loop
+ if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then
+ read (l, c, readOk);
+ else
+ exit;
+ end if;
+ end loop;
+ end procedure skip_whitespace;
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC;
+ GOOD : out BOOLEAN) is
+ variable c : CHARACTER;
+ variable readOk : BOOLEAN;
+ begin
+ VALUE := 'U'; -- initialize to a "U"
+ Skip_whitespace (L);
+ read (l, c, readOk);
+ if not readOk then
+ good := false;
+ else
+ if char_to_MVL9plus(c) = error then
+ good := false;
+ else
+ VALUE := char_to_MVL9(c);
+ good := true;
+ end if;
+ end if;
+ end procedure READ;
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable m : STD_ULOGIC;
+ variable c : CHARACTER;
+ variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1);
+ variable readOk : BOOLEAN;
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then
+ read (l, c, readOk);
+ i := 0;
+ good := false;
+ while i < VALUE'length loop
+ if not readOk then -- Bail out if there was a bad read
+ return;
+ elsif c = '_' then
+ if i = 0 then -- Begins with an "_"
+ return;
+ elsif lastu then -- "__" detected
+ return;
+ else
+ lastu := true;
+ end if;
+ elsif (char_to_MVL9plus(c) = error) then -- Illegal character
+ return;
+ else
+ mv(i) := char_to_MVL9(c);
+ i := i + 1;
+ if i > mv'high then -- reading done
+ good := true;
+ VALUE := mv;
+ return;
+ end if;
+ lastu := false;
+ end if;
+ read(L, c, readOk);
+ end loop;
+ else
+ good := true; -- read into a null array
+ end if;
+ end procedure READ;
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC) is
+ variable c : CHARACTER;
+ variable readOk : BOOLEAN;
+ begin
+ VALUE := 'U'; -- initialize to a "U"
+ Skip_whitespace (L);
+ read (l, c, readOk);
+ if not readOk then
+ report "STD_LOGIC_1164.READ(STD_ULOGIC) "
+ & "End of string encountered"
+ severity error;
+ return;
+ elsif char_to_MVL9plus(c) = error then
+ report
+ "STD_LOGIC_1164.READ(STD_ULOGIC) Error: Character '" &
+ c & "' read, expected STD_ULOGIC literal."
+ severity error;
+ else
+ VALUE := char_to_MVL9(c);
+ end if;
+ end procedure READ;
+
+ procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
+ variable m : STD_ULOGIC;
+ variable c : CHARACTER;
+ variable readOk : BOOLEAN;
+ variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1);
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then -- non Null input string
+ read (l, c, readOk);
+ i := 0;
+ while i < VALUE'length loop
+ if readOk = false then -- Bail out if there was a bad read
+ report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
+ & "End of string encountered"
+ severity error;
+ return;
+ elsif c = '_' then
+ if i = 0 then
+ report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
+ & "String begins with an ""_""" severity error;
+ return;
+ elsif lastu then
+ report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
+ & "Two underscores detected in input string ""__"""
+ severity error;
+ return;
+ else
+ lastu := true;
+ end if;
+ elsif c = ' ' or c = NBSP or c = HT then -- reading done.
+ report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
+ & "Short read, Space encounted in input string"
+ severity error;
+ return;
+ elsif char_to_MVL9plus(c) = error then
+ report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
+ & "Error: Character '" &
+ c & "' read, expected STD_ULOGIC literal."
+ severity error;
+ return;
+ else
+ mv(i) := char_to_MVL9(c);
+ i := i + 1;
+ if i > mv'high then
+ VALUE := mv;
+ return;
+ end if;
+ lastu := false;
+ end if;
+ read(L, c, readOk);
+ end loop;
+ end if;
+ end procedure READ;
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_ULOGIC;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ begin
+ write(l, MVL9_to_char(VALUE), justified, field);
+ end procedure WRITE;
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ variable s : STRING(1 to VALUE'length);
+ variable m : STD_ULOGIC_VECTOR(1 to VALUE'length) := VALUE;
+ begin
+ for i in 1 to VALUE'length loop
+ s(i) := MVL9_to_char(m(i));
+ end loop;
+ write(l, s, justified, field);
+ end procedure WRITE;
+
+ -- Read and Write procedures for STD_LOGIC_VECTOR
+
+ procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ READ (L => L, VALUE => ivalue, GOOD => GOOD);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure READ;
+
+ procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ READ (L => L, VALUE => ivalue);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure READ;
+
+ procedure WRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ variable s : STRING(1 to VALUE'length);
+ variable m : STD_LOGIC_VECTOR(1 to VALUE'length) := VALUE;
+ begin
+ for i in 1 to VALUE'length loop
+ s(i) := MVL9_to_char(m(i));
+ end loop;
+ write(L, s, justified, field);
+ end procedure WRITE;
+
+ -----------------------------------------------------------------------
+ -- Alias for bread and bwrite are provided with call out the read and
+ -- write functions.
+ -----------------------------------------------------------------------
+
+ -- Hex Read and Write procedures for STD_ULOGIC_VECTOR.
+ -- Modified from the original to be more forgiving.
+
+ procedure Char2QuadBits (C : CHARACTER;
+ RESULT : out STD_ULOGIC_VECTOR(3 downto 0);
+ GOOD : out BOOLEAN;
+ ISSUE_ERROR : in BOOLEAN) is
+ begin
+ case c is
+ when '0' => result := x"0"; good := true;
+ when '1' => result := x"1"; good := true;
+ when '2' => result := x"2"; good := true;
+ when '3' => result := x"3"; good := true;
+ when '4' => result := x"4"; good := true;
+ when '5' => result := x"5"; good := true;
+ when '6' => result := x"6"; good := true;
+ when '7' => result := x"7"; good := true;
+ when '8' => result := x"8"; good := true;
+ when '9' => result := x"9"; good := true;
+ when 'A' | 'a' => result := x"A"; good := true;
+ when 'B' | 'b' => result := x"B"; good := true;
+ when 'C' | 'c' => result := x"C"; good := true;
+ when 'D' | 'd' => result := x"D"; good := true;
+ when 'E' | 'e' => result := x"E"; good := true;
+ when 'F' | 'f' => result := x"F"; good := true;
+ when 'Z' => result := "ZZZZ"; good := true;
+ when 'X' => result := "XXXX"; good := true;
+ when others =>
+ assert not ISSUE_ERROR
+ report
+ "STD_LOGIC_1164.HREAD Read a '" & c &
+ "', expected a Hex character (0-F)."
+ severity error;
+ good := false;
+ end case;
+ end procedure Char2QuadBits;
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+3)/4;
+ constant pad : INTEGER := ne*4 - VALUE'length;
+ variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1);
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then
+ read (l, c, ok);
+ i := 0;
+ while i < ne loop
+ -- Bail out if there was a bad read
+ if not ok then
+ good := false;
+ return;
+ elsif c = '_' then
+ if i = 0 then
+ good := false; -- Begins with an "_"
+ return;
+ elsif lastu then
+ good := false; -- "__" detected
+ return;
+ else
+ lastu := true;
+ end if;
+ else
+ Char2QuadBits(c, sv(4*i to 4*i+3), ok, false);
+ if not ok then
+ good := false;
+ return;
+ end if;
+ i := i + 1;
+ lastu := false;
+ end if;
+ if i < ne then
+ read(L, c, ok);
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or"
+ good := false; -- vector was truncated.
+ else
+ good := true;
+ VALUE := sv (pad to sv'high);
+ end if;
+ else
+ good := true; -- Null input string, skips whitespace
+ end if;
+ end procedure HREAD;
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+3)/4;
+ constant pad : INTEGER := ne*4 - VALUE'length;
+ variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1);
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then -- non Null input string
+ read (l, c, ok);
+ i := 0;
+ while i < ne loop
+ -- Bail out if there was a bad read
+ if not ok then
+ report "STD_LOGIC_1164.HREAD "
+ & "End of string encountered"
+ severity error;
+ return;
+ end if;
+ if c = '_' then
+ if i = 0 then
+ report "STD_LOGIC_1164.HREAD "
+ & "String begins with an ""_""" severity error;
+ return;
+ elsif lastu then
+ report "STD_LOGIC_1164.HREAD "
+ & "Two underscores detected in input string ""__"""
+ severity error;
+ return;
+ else
+ lastu := true;
+ end if;
+ else
+ Char2QuadBits(c, sv(4*i to 4*i+3), ok, true);
+ if not ok then
+ return;
+ end if;
+ i := i + 1;
+ lastu := false;
+ end if;
+ if i < ne then
+ read(L, c, ok);
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or"
+ report "STD_LOGIC_1164.HREAD Vector truncated"
+ severity error;
+ else
+ VALUE := sv (pad to sv'high);
+ end if;
+ end if;
+ end procedure HREAD;
+
+ procedure HWRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ begin
+ write (L, to_hstring (VALUE), JUSTIFIED, FIELD);
+ end procedure HWRITE;
+
+
+ -- Octal Read and Write procedures for STD_ULOGIC_VECTOR.
+ -- Modified from the original to be more forgiving.
+
+ procedure Char2TriBits (C : CHARACTER;
+ RESULT : out STD_ULOGIC_VECTOR(2 downto 0);
+ GOOD : out BOOLEAN;
+ ISSUE_ERROR : in BOOLEAN) is
+ begin
+ case c is
+ when '0' => result := o"0"; good := true;
+ when '1' => result := o"1"; good := true;
+ when '2' => result := o"2"; good := true;
+ when '3' => result := o"3"; good := true;
+ when '4' => result := o"4"; good := true;
+ when '5' => result := o"5"; good := true;
+ when '6' => result := o"6"; good := true;
+ when '7' => result := o"7"; good := true;
+ when 'Z' => result := "ZZZ"; good := true;
+ when 'X' => result := "XXX"; good := true;
+ when others =>
+ assert not ISSUE_ERROR
+ report
+ "STD_LOGIC_1164.OREAD Error: Read a '" & c &
+ "', expected an Octal character (0-7)."
+ severity error;
+ good := false;
+ end case;
+ end procedure Char2TriBits;
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ok : BOOLEAN;
+ variable c : CHARACTER;
+ constant ne : INTEGER := (VALUE'length+2)/3;
+ constant pad : INTEGER := ne*3 - VALUE'length;
+ variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1);
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then
+ read (l, c, ok);
+ i := 0;
+ while i < ne loop
+ -- Bail out if there was a bad read
+ if not ok then
+ good := false;
+ return;
+ elsif c = '_' then
+ if i = 0 then
+ good := false; -- Begins with an "_"
+ return;
+ elsif lastu then
+ good := false; -- "__" detected
+ return;
+ else
+ lastu := true;
+ end if;
+ else
+ Char2TriBits(c, sv(3*i to 3*i+2), ok, false);
+ if not ok then
+ good := false;
+ return;
+ end if;
+ i := i + 1;
+ lastu := false;
+ end if;
+ if i < ne then
+ read(L, c, ok);
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or"
+ good := false; -- vector was truncated.
+ else
+ good := true;
+ VALUE := sv (pad to sv'high);
+ end if;
+ else
+ good := true; -- read into a null array
+ end if;
+ end procedure OREAD;
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
+ variable c : CHARACTER;
+ variable ok : BOOLEAN;
+ constant ne : INTEGER := (VALUE'length+2)/3;
+ constant pad : INTEGER := ne*3 - VALUE'length;
+ variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1);
+ variable i : INTEGER;
+ variable lastu : BOOLEAN := false; -- last character was an "_"
+ begin
+ VALUE := (VALUE'range => 'U'); -- initialize to a "U"
+ Skip_whitespace (L);
+ if VALUE'length > 0 then
+ read (l, c, ok);
+ i := 0;
+ while i < ne loop
+ -- Bail out if there was a bad read
+ if not ok then
+ report "STD_LOGIC_1164.OREAD "
+ & "End of string encountered"
+ severity error;
+ return;
+ elsif c = '_' then
+ if i = 0 then
+ report "STD_LOGIC_1164.OREAD "
+ & "String begins with an ""_""" severity error;
+ return;
+ elsif lastu then
+ report "STD_LOGIC_1164.OREAD "
+ & "Two underscores detected in input string ""__"""
+ severity error;
+ return;
+ else
+ lastu := true;
+ end if;
+ else
+ Char2TriBits(c, sv(3*i to 3*i+2), ok, true);
+ if not ok then
+ return;
+ end if;
+ i := i + 1;
+ lastu := false;
+ end if;
+ if i < ne then
+ read(L, c, ok);
+ end if;
+ end loop;
+ if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or"
+ report "STD_LOGIC_1164.OREAD Vector truncated"
+ severity error;
+ else
+ VALUE := sv (pad to sv'high);
+ end if;
+ end if;
+ end procedure OREAD;
+
+ procedure OWRITE (L : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ begin
+ write (L, to_ostring(VALUE), JUSTIFIED, FIELD);
+ end procedure OWRITE;
+
+ -- Hex Read and Write procedures for STD_LOGIC_VECTOR
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ HREAD (L => L, VALUE => ivalue, GOOD => GOOD);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure HREAD;
+
+ procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ HREAD (L => L, VALUE => ivalue);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure HREAD;
+
+ procedure HWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ begin
+ write (L, to_hstring(VALUE), JUSTIFIED, FIELD);
+ end procedure HWRITE;
+
+ -- Octal Read and Write procedures for STD_LOGIC_VECTOR
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR;
+ GOOD : out BOOLEAN) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ OREAD (L => L, VALUE => ivalue, GOOD => GOOD);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure OREAD;
+
+ procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is
+ variable ivalue : STD_ULOGIC_VECTOR (VALUE'range);
+ begin
+ OREAD (L => L, VALUE => ivalue);
+ VALUE := to_stdlogicvector (ivalue);
+ end procedure OREAD;
+
+ procedure OWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR;
+ JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is
+ begin
+ write (L, to_ostring(VALUE), JUSTIFIED, FIELD);
+ end procedure OWRITE;
+
+ -----------------------------------------------------------------------------
+ -- New string functions for vhdl-200x fast track
+ -----------------------------------------------------------------------------
+ function to_string (value : STD_ULOGIC) return STRING is
+ variable result : STRING (1 to 1);
+ begin
+ result (1) := MVL9_to_char (value);
+ return result;
+ end function to_string;
+ -------------------------------------------------------------------
+ -- TO_STRING (an alias called "to_bstring" is provide)
+ -------------------------------------------------------------------
+ function to_string (value : STD_ULOGIC_VECTOR) return STRING is
+ alias ivalue : STD_ULOGIC_VECTOR(1 to value'length) is value;
+ variable result : STRING(1 to value'length);
+ begin
+ if value'length < 1 then
+ return NUS;
+ else
+ for i in ivalue'range loop
+ result(i) := MVL9_to_char(iValue(i));
+ end loop;
+ return result;
+ end if;
+ end function to_string;
+
+ -------------------------------------------------------------------
+ -- TO_HSTRING
+ -------------------------------------------------------------------
+ function to_hstring (value : STD_ULOGIC_VECTOR) return STRING is
+ constant ne : INTEGER := (value'length+3)/4;
+ variable pad : STD_ULOGIC_VECTOR(0 to (ne*4 - value'length) - 1);
+ variable ivalue : STD_ULOGIC_VECTOR(0 to ne*4 - 1);
+ variable result : STRING(1 to ne);
+ variable quad : STD_ULOGIC_VECTOR(0 to 3);
+ begin
+ if value'length < 1 then
+ return NUS;
+ else
+ if value (value'left) = 'Z' then
+ pad := (others => 'Z');
+ else
+ pad := (others => '0');
+ end if;
+ ivalue := pad & value;
+ for i in 0 to ne-1 loop
+ quad := To_X01Z(ivalue(4*i to 4*i+3));
+ case quad is
+ when x"0" => result(i+1) := '0';
+ when x"1" => result(i+1) := '1';
+ when x"2" => result(i+1) := '2';
+ when x"3" => result(i+1) := '3';
+ when x"4" => result(i+1) := '4';
+ when x"5" => result(i+1) := '5';
+ when x"6" => result(i+1) := '6';
+ when x"7" => result(i+1) := '7';
+ when x"8" => result(i+1) := '8';
+ when x"9" => result(i+1) := '9';
+ when x"A" => result(i+1) := 'A';
+ when x"B" => result(i+1) := 'B';
+ when x"C" => result(i+1) := 'C';
+ when x"D" => result(i+1) := 'D';
+ when x"E" => result(i+1) := 'E';
+ when x"F" => result(i+1) := 'F';
+ when "ZZZZ" => result(i+1) := 'Z';
+ when others => result(i+1) := 'X';
+ end case;
+ end loop;
+ return result;
+ end if;
+ end function to_hstring;
+
+ -------------------------------------------------------------------
+ -- TO_OSTRING
+ -------------------------------------------------------------------
+ function to_ostring (value : STD_ULOGIC_VECTOR) return STRING is
+ constant ne : INTEGER := (value'length+2)/3;
+ variable pad : STD_ULOGIC_VECTOR(0 to (ne*3 - value'length) - 1);
+ variable ivalue : STD_ULOGIC_VECTOR(0 to ne*3 - 1);
+ variable result : STRING(1 to ne);
+ variable tri : STD_ULOGIC_VECTOR(0 to 2);
+ begin
+ if value'length < 1 then
+ return NUS;
+ else
+ if value (value'left) = 'Z' then
+ pad := (others => 'Z');
+ else
+ pad := (others => '0');
+ end if;
+ ivalue := pad & value;
+ for i in 0 to ne-1 loop
+ tri := To_X01Z(ivalue(3*i to 3*i+2));
+ case tri is
+ when o"0" => result(i+1) := '0';
+ when o"1" => result(i+1) := '1';
+ when o"2" => result(i+1) := '2';
+ when o"3" => result(i+1) := '3';
+ when o"4" => result(i+1) := '4';
+ when o"5" => result(i+1) := '5';
+ when o"6" => result(i+1) := '6';
+ when o"7" => result(i+1) := '7';
+ when "ZZZ" => result(i+1) := 'Z';
+ when others => result(i+1) := 'X';
+ end case;
+ end loop;
+ return result;
+ end if;
+ end function to_ostring;
+
+ function to_string (value : STD_LOGIC_VECTOR) return STRING is
+ begin
+ return to_string (to_stdulogicvector (value));
+ end function to_string;
+
+ function to_hstring (value : STD_LOGIC_VECTOR) return STRING is
+ begin
+ return to_hstring (to_stdulogicvector (value));
+ end function to_hstring;
+
+ function to_ostring (value : STD_LOGIC_VECTOR) return STRING is
+ begin
+ return to_ostring (to_stdulogicvector (value));
+ end function to_ostring;
+
+ -- rtl_synthesis on
+-- pragma synthesis_on
+ function maximum (L, R : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ begin -- function maximum
+ if L > R then return L;
+ else return R;
+ end if;
+ end function maximum;
+
+ -- std_logic_vector output
+ function minimum (L, R : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
+ begin -- function minimum
+ if L > R then return R;
+ else return L;
+ end if;
+ end function minimum;
+
+ function maximum (L, R : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ begin -- function maximum
+ if L > R then return L;
+ else return R;
+ end if;
+ end function maximum;
+
+ -- std_logic_vector output
+ function minimum (L, R : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is
+ begin -- function minimum
+ if L > R then return R;
+ else return L;
+ end if;
+ end function minimum;
+
+ function maximum (L, R : STD_ULOGIC) return STD_ULOGIC is
+ begin -- function maximum
+ if L > R then return L;
+ else return R;
+ end if;
+ end function maximum;
+
+ -- std_logic_vector output
+ function minimum (L, R : STD_ULOGIC) return STD_ULOGIC is
+ begin -- function minimum
+ if L > R then return R;
+ else return L;
+ end if;
+ end function minimum;
+end package body std_logic_1164_additions;