diff options
| author | Tristan Gingold | 2015-06-18 22:40:31 +0200 |
|---|---|---|
| committer | Tristan Gingold | 2015-06-18 22:40:31 +0200 |
| commit | d08386567e47854722e2b3a92720737837ca0bbd (patch) | |
| tree | 9195e0e903ca3f2fc5baab03911b5558ffaf6e4e /testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd | |
| parent | 03f2df0a31ac07711863c9580bc3bc48cbab3a3b (diff) | |
| download | ghdl-d08386567e47854722e2b3a92720737837ca0bbd.tar.gz ghdl-d08386567e47854722e2b3a92720737837ca0bbd.tar.bz2 ghdl-d08386567e47854722e2b3a92720737837ca0bbd.zip | |
Add testcase for ticket89.
Diffstat (limited to 'testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd')
| -rw-r--r-- | testsuite/gna/ticket89/project/src93/string_methods_pkg.vhd | 1073 |
1 files changed, 1073 insertions, 0 deletions
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;
|