From d08386567e47854722e2b3a92720737837ca0bbd Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 18 Jun 2015 22:40:31 +0200 Subject: Add testcase for ticket89. --- .../ticket89/project/src93/string_methods_pkg.vhd | 1073 ++++++++++++++++++++ 1 file changed, 1073 insertions(+) create mode 100644 testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd (limited to 'testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd') 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 000000000..15f8b5844 --- /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 '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 '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 '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; -- cgit v1.2.3