-- ------------------------------------------------------------------------
-- ON Semiconductor Proprietary and Confidential Information.
-- ------------------------------------------------------------------------

-- ------------------------------------------------------------------------
-- Company           : ON Semiconductor
-- ------------------------------------------------------------------------
-- File              : $RCSfile: messages_pkg.vhd,v $
-- ------------------------------------------------------------------------
-- Last Modified     : $Date: 2015/06/19 12:17:04 $
-- Last Modified By  : $Author: ffwxby $
-- Revision          : $Revision: 1.1 $
-- ------------------------------------------------------------------------
-- Description       : TBENCH Messages package, used for unification of
--                     transcript reports from various simulation test-
--                     cases and BFM models.
-- ------------------------------------------------------------------------
-- Revision history  :
--
--   $Log: messages_pkg.vhd,v $
--   Revision 1.1  2015/06/19 12:17:04  ffwxby
--   - initial revision
--
--
-- ------------------------------------------------------------------------

library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;

library std;
use std.textio.all;

package messages_pkg is

    function format_time (
      t  : in    time
    ) return string;

    procedure msg(
      s_id  : in    string;
      s_msg : in    string
    );

    procedure err(
      s_id  : in     string;
      s_msg : in     string
    );

    procedure warning(
      s_id  : in     string;
      s_msg : in     string
    );

    type t_SLV_RADIX is (sr_HEX, sr_DEC, sr_OCT, sr_BIN);

    function slv2str (
      slv     : in     UNSIGNED;
      fmt     : in     t_SLV_RADIX
    ) return string;

    function int2str (
      int     : in integer;
      base    : in integer
    ) return string;

    function int2char (
      int     : in integer
    ) return character;

    -- base 2 logarithm function
    -- ------------------------------------------------------------------------
    function log2 (x : positive) return natural;

    -- base 2 logarithm function + ceiling to higher integer
    -- -------------------------------------------------------------------------
    function log2_ceil (N: natural) return positive;

    type t_SL2CHAR is array (std_logic) of character;
    constant SL2CHAR  : t_SL2CHAR := "UX01ZWLH-";

    type t_SL_VAL is array (std_Logic) of integer;
    constant SL_VAL : t_SL_VAL := (-1, -1, 0, 1, -1, -1, 0, 1, -1);

    type t_HEX_DIGIT is array (-1 to 15) of character;
    constant HEX_DIGIT : t_HEX_DIGIT := "?0123456789ABCDEF";

    -- *************************************************************
    --
    -- new conversion functions compatible with vhdl-200x definition
    --
    -- *************************************************************

    -- pointer on string : type definition
    type str_ptr is access integer;

    -- to_string conversion functions
    function to_string (value : in std_ulogic) return string;
    function to_string (value : in std_ulogic_vector) return string;
    function to_string (value : in integer) return string;
    function to_string (value : in integer;
                        base  : in t_SLV_RADIX) return string;
    function to_string (value : in unsigned) return string;
    function to_string (value : in unsigned;
                        base  : in t_SLV_RADIX) return string;
    function to_string (value : in signed) return string;
    function to_string (value : in signed;
                        base  : in t_SLV_RADIX) return string;
    -- to_string (hex,decimal,octal,binary)
    -- std_ulogic
    function to_ostring (value : in std_ulogic_vector) return string;
    function to_hstring (value : in std_ulogic_vector) return string;
    function to_hstring (value : in natural) return string;
    -- std_logic
    alias to_bstring       is to_string  [std_ulogic_vector return string];
    alias to_binary_string is to_string  [std_ulogic_vector return string];
    alias to_octal_string  is to_ostring [std_ulogic_vector return string];
    alias to_hex_string    is to_hstring [std_ulogic_vector return string];

    -- decode string to verilog format
    function to_verilog_string (value : in std_ulogic_vector) return string;
    function to_verilog_string (value : in unsigned) return string;
    function to_verilog_string (value : in signed) return string;

    -- conversion to uppercase
    function to_upper(c: character) return character;
    function to_upper(s: string) return string;

end messages_pkg;

package body messages_pkg is

    function format_time (
      t  : in    time
    ) return string is
      variable l : line;
      variable e, i, w, g : integer;
      variable s : string (1 to 30) := (others => ' ');
    begin
      -- convert time to 'ps' string, simulator resolution must be in 'ps'!
      write(l, t, left, 1, ps);

      e := l'length;                    -- find last digit
      while ( (e > 1) and  not( l(e) >= '0' and l(e) <= '9' ) ) loop
        e := e - 1;
      end loop;

      e := e - 3;                       -- trunc 'ps'
      if (e < 1) then
        return("0");
      end if;

      w := s'length;
      g := 0;
      while (e > 0) loop                -- copy and separate digit groups
        if ( ((g mod 3) = 0) and (g /= 0) ) then
          g := 0;
          s(w) := ',';
          w := w - 1;
        end if;
        s(w) := l(e);
        w := w - 1;
        e := e - 1;
        g := g + 1;
      end loop;

      deallocate(l);

      return(s(w + 1 to s'length));
    end format_time;

    procedure msg(
      s_id  : in    string;
      s_msg : in    string
    ) is
      constant n_MAX_ID_LEN : natural := 20;

      variable l : line;
    begin
      -- print message ID
      if (s_id'length > n_MAX_ID_LEN) then
        write(l, string'(s_id(1 to n_MAX_ID_LEN)));
      else
        write(l, string'(s_id), LEFT, n_MAX_ID_LEN);
      end if;
      -- print separator
      write(l, ' ');
      -- print message time
      write(l, string'(format_time(now)), RIGHT, 11);
      -- print separator
      write(l, string'("n "));
      -- print message text
      write(l, string'(s_msg), LEFT, 1);
      writeline(output, l);
    end msg;

    procedure err(
      s_id  : in     string;
      s_msg : in     string
    ) is
    begin
      msg(s_id, "ERROR: " & s_msg);
    end err;

    procedure warning(
      s_id  : in     string;
      s_msg : in     string
    ) is
    begin
      msg(s_id, "WARNING: " & s_msg);
    end warning;

    function slv2str (
      slv     : in     UNSIGNED;
      fmt     : in     t_SLV_RADIX
    ) return string is

      variable s    : string (1 to slv'length) := (others => ' ');
      variable i, j : integer;
      variable step : integer;
      variable acc  : integer := 0;
      variable g    : integer := 0;

    begin
      case (fmt) is
        when sr_BIN =>
          if (slv'left > slv'right) then
            step := -1;
          else
            step := 1;
          end if;
          i := slv'left;
          j := 1;
          while (i /= (slv'right + step)) loop
            s(j) := SL2CHAR(slv(i));
            i := i + step;
            j := j + 1;
          end loop;
          return(s);

        when sr_DEC =>
          for i in slv'high downto slv'low loop
            case (slv(i)) is
              when '1' | 'H' =>
                acc := 2 * acc + 1;
              when '0' | 'L' =>
                acc := 2 * acc;
              when others =>
                return ("?");
            end case;
          end loop;
          return(integer'image(acc));

        when sr_HEX =>
          -- !!! wrong result for slv'length < 4 !!!
          for i in slv'low to slv'high loop
            if (acc /= -1) then
              if (SL_VAL(slv(i)) = -1) then
                acc := -1;
              else
                acc := acc + (2 ** g) * SL_VAL(slv(i));
              end if;
            end if;
            g := g + 1;
            if (g = 4) then
              s(j) := HEX_DIGIT(acc);
              acc  := 0;
              j    := j - 1;
              g    := 0;
            end if;
          end loop;
          if (acc /= 0) then
            s(j) := HEX_DIGIT(acc);
          else
            j := j + 1;
          end if;
          return(s(j to s'length));
        when others =>
          return ("");
      end case;

    end slv2str;

    function int2char (
      int     : in integer
    ) return character is
      variable c: character;
    begin
      case int is
        when  0 => c := '0';
        when  1 => c := '1';
        when  2 => c := '2';
        when  3 => c := '3';
        when  4 => c := '4';
        when  5 => c := '5';
        when  6 => c := '6';
        when  7 => c := '7';
        when  8 => c := '8';
        when  9 => c := '9';
        when 10 => c := 'A';
        when 11 => c := 'B';
        when 12 => c := 'C';
        when 13 => c := 'D';
        when 14 => c := 'E';
        when 15 => c := 'F';
        when 16 => c := 'G';
        when 17 => c := 'H';
        when 18 => c := 'I';
        when 19 => c := 'J';
        when 20 => c := 'K';
        when 21 => c := 'L';
        when 22 => c := 'M';
        when 23 => c := 'N';
        when 24 => c := 'O';
        when 25 => c := 'P';
        when 26 => c := 'Q';
        when 27 => c := 'R';
        when 28 => c := 'S';
        when 29 => c := 'T';
        when 30 => c := 'U';
        when 31 => c := 'V';
        when 32 => c := 'W';
        when 33 => c := 'X';
        when 34 => c := 'Y';
        when 35 => c := 'Z';
        when others => c := '?';
      end case;
      return c;
    end int2char;

    function int2str (
      int     : in integer;
      base    : in integer
    ) return string is
      variable temp:      string(1 to 10);
      variable abs_int:   integer;
      variable len:       integer := 1;
      variable power:     integer := 1;
    begin

    abs_int := abs(int);

    while abs_int >= base loop                     -- Determine how many
      len := len + 1;                              -- characters required
      abs_int := abs_int / base;                   -- to represent the
    end loop ;                                     -- number.

    for i in len downto 1 loop                     -- Convert the number to
      temp(i) := int2char(abs_int/power mod base); -- a string starting
      power := power * base;                       -- with the right hand
    end loop ;                                     -- side.

    -- return result and add sign if required
    if int < 0 then
       return '-'& temp(1 to len);
     else
       return temp(1 to len);
    end if;
   end int2str;

  -- *****************************************************************
  --
  -- New string functions for vhdl-200x fast track
  --
  -- *****************************************************************

  -----------------------------------------------------------------------------
  -- 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(1 to 2) := (others => ' ');     -- null string

  -------------------------------------------------------------------
  -- to_string (an alias called "to_bstring" is provide)
  -------------------------------------------------------------------

  -- std_ulogic
  function to_string (value     : in std_ulogic) return string is
    variable result : string (1 to 1);
  begin
    result (1) := mvl9_to_char (value);
    return result;
  end function to_string;

  -- std_ulogic_vector
  function to_string (value     : in std_ulogic_vector) return string is
    variable ivalue : std_ulogic_vector(value'length downto 1);
    variable result : string(1 to value'length);
    variable index1 : integer := 0;
  begin
    -- correct direction
    ivalue := value;
    if (value'left > value'right) then
       for index in value'right to value'left loop
           ivalue(index-value'right+1) := value(value'left-index1);
           index1 := index1 + 1;
       end loop;
    end if;
    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;

  -- integer
  function to_string (value     : in integer) return string is
  begin
    return integer'image(value);
  end function to_string;
  -- integer - (hex,dec,oct,bin)
  function to_string (value : in integer;
                      base  : in t_SLV_RADIX) return string is
    -- internal temporary variable
    variable temp   : integer;
  begin

    if (value < 0 ) then         -- negative number
       temp       := (-1)*value; -- make it positive
    else
       temp       := value;      -- positive value
    end if;

    -- select correct "base" (hex,decimal,octal,binary)
    case base is

      -- hex
      when sr_HEX =>
         -- integer - 4-byte representation in VHDL ~> max. 32-bits
         if (value < 0) then
             -- negative
             return "-" & to_hstring(std_ulogic_vector(to_unsigned(temp,32)));
         else
             -- positive
             return to_hstring(std_ulogic_vector(to_unsigned(temp,32)));
         end if;

      -- DEC
      when sr_DEC =>
           return to_string(value);

      -- OCTAL
      when sr_OCT =>
         -- integer - 4-byte representation in VHDL ~> max. 32-bits
         if (value < 0) then
             -- negative
             return "-" & to_ostring(std_ulogic_vector(to_unsigned(temp,32)));
         else
             -- positive
             return to_ostring(std_ulogic_vector(to_unsigned(temp,32)));
         end if;

      -- BINARY
      when sr_BIN =>
         -- integer - 4-byte representation in VHDL ~> max. 32-bits
         if (value < 0) then
             -- negative
             return "-" & to_bstring(std_ulogic_vector(to_unsigned(temp,32)));
         else
             -- positive
             return to_bstring(std_ulogic_vector(to_unsigned(temp,32)));
         end if;

      when others =>
         -- defence programming
         return "??";
    end case;

  end function to_string;

  -- unsigned
  function to_string (value     : in unsigned) return string is
   variable temp   : std_ulogic_vector(value'length-1 downto 0);
  begin
    if (value'left > value'right) then
       temp := std_ulogic_vector(value);
    else
       for index in value'left to value'right loop
           temp(index-value'left) := value(index);
       end loop;
    end if;
    return to_string(temp);
  end function to_string;
  -- unsigned - (hex,dec,oct,bin)
  function to_string (value : in unsigned;
                      base  : in t_SLV_RADIX) return string is
    -- internal temporary variable
    variable temp   : std_ulogic_vector(value'length-1 downto 0);
  begin

    if (value'left > value'right) then
       temp := std_ulogic_vector(value);
    else
       for index in value'left to value'right loop
           temp(index-value'left) := value(index);
       end loop;
    end if;

    -- select correct "base" (hex,decimal,octal,binary)
    case base is

      -- hex
      when sr_HEX =>
           return to_hstring(temp);

      -- DEC
      when sr_DEC =>
           return to_string(temp);

      -- OCTAL
      when sr_OCT =>
           return to_ostring(temp);

      -- BINARY
      when sr_BIN =>
           return to_string(value);

      when others =>
         -- defence programming
         return "??";
    end case;

  end function to_string;

  -- signed
  function to_string (value     : in signed) return string is
    -- internal temporary variable
    variable temp   : std_ulogic_vector(value'length-2 downto 0);
    variable sign   : string(1 to 1) := " "; -- default positive
  begin

    -- correct direction of vector
    if (value'left > value'right) then
       temp := std_ulogic_vector(value(value'left-1 downto value'right));
       if (value(value'left)='1') then -- negative number;
          sign := "-";
       end if;
    else
       for index in value'left to value'right-1 loop
           temp(index-value'left) := value(index);
       end loop;
       if (value(value'right)='1') then -- negative number;
          sign := "-";
       end if;
    end if;
    return sign & to_string(temp);
  end function to_string;
  -- signed - (hex,dec,oct,bin)
  function to_string (value : in signed;
                      base  : in t_SLV_RADIX) return string is
    -- internal temporary variable
    variable temp   : std_ulogic_vector(value'length-2 downto 0);
    variable sign   : string(1 to 1) := " "; -- default positive
  begin

    -- correct direction of vector
    if (value'left > value'right) then
       temp := std_ulogic_vector(value(value'left-1 downto value'right));
       if (value(value'left)='1') then -- negative number;
          sign := "-";
       end if;
    else
       for index in value'left to value'right-1 loop
           temp(index-value'left) := value(index);
       end loop;
       if (value(value'right)='1') then -- negative number;
          sign := "-";
       end if;
    end if;

    -- select correct "base" (hex,decimal,octal,binary)
    case base is

      -- hex
      when sr_HEX =>
           return sign & to_hstring(temp);

      -- DEC
      when sr_DEC =>
           return sign & to_string(temp);

      -- OCTAL
      when sr_OCT =>
           return sign & to_ostring(temp);

      -- BINARY
      when sr_BIN =>
           return sign & to_string(value);

      when others =>
         -- defence programming
         return "??";
    end case;

  end function to_string;

  -------------------------------------------------------------------
  -- TO_HSTRING
  -------------------------------------------------------------------

  function to_hstring (value     : in 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);
    variable temp   : std_ulogic_vector(value'length-1 downto 0);
  begin

    if value'length < 1 then
      return nus;
    else
      if value (value'left) = 'Z' then
        pad := (others => 'Z');
      else
        pad := (others => '0');
      end if;
      if (value'left > value'right) then
         ivalue := pad & value;
      else
       for index in value'left to value'right loop
           temp(index-value'left) := value(index);
       end loop;
       ivalue := pad & temp;
      end if;
      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_HSTRING
  -------------------------------------------------------------------
  function to_hstring (value : in natural) return string is
  begin
    if (value = 0) then
      return "0";
    else
      return to_hstring(std_ulogic_vector(to_unsigned(value,log2_ceil(value))));
    end if;
  end function to_hstring;

  -------------------------------------------------------------------
  -- TO_OSTRING
  -------------------------------------------------------------------

  function to_ostring (value     : in 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);
    variable temp   : std_ulogic_vector(value'length-1 downto 0);
  begin

    if value'length < 1 then
      return nus;
    else
      if value (value'left) = 'Z' then
        pad := (others => 'Z');
      else
        pad := (others => '0');
      end if;
      if (value'left > value'right) then
         ivalue := pad & value;
      else
       for index in value'left to value'right loop
           temp(index-value'left) := value(index);
       end loop;
       ivalue := pad & temp;
      end if;
      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;

  -------------------------------------------------------------------
  -- TO_VERILOG_STRING
  -------------------------------------------------------------------

  function to_verilog_string (value   : in std_ulogic_vector) return string is
  begin
    return to_string(value'length) & "'b" & to_string(value);
  end function;

  function to_verilog_string (value   : in unsigned) return string is
  begin
    return to_string(value'length) & "'b" & to_string(value);
  end function;

  function to_verilog_string (value   : in signed) return string is
  begin
    return to_string(value'length) & "'b" & to_string(value);
  end function;

  -------------------------------------------------------------------
  -- TO UPPERCASE conversion
  -------------------------------------------------------------------

  function to_upper(c: character) return character is
    variable temp: character;
  begin
    case c is
      when 'a' => temp := 'A';
      when 'b' => temp := 'B';
      when 'c' => temp := 'C';
      when 'd' => temp := 'D';
      when 'e' => temp := 'E';
      when 'f' => temp := 'F';
      when 'g' => temp := 'G';
      when 'h' => temp := 'H';
      when 'i' => temp := 'I';
      when 'j' => temp := 'J';
      when 'k' => temp := 'K';
      when 'l' => temp := 'L';
      when 'm' => temp := 'M';
      when 'n' => temp := 'N';
      when 'o' => temp := 'O';
      when 'p' => temp := 'P';
      when 'q' => temp := 'Q';
      when 'r' => temp := 'R';
      when 's' => temp := 'S';
      when 't' => temp := 'T';
      when 'u' => temp := 'U';
      when 'v' => temp := 'V';
      when 'w' => temp := 'W';
      when 'x' => temp := 'X';
      when 'y' => temp := 'Y';
      when 'z' => temp := 'Z';
      when others => temp := c;
    end case;
    return temp;
  end function;

  function to_upper(s: string) return string is
    variable temp: string (s'range);
  begin
    for i in s'range loop
      temp(i) := to_upper(s(i));
    end loop;
    return temp;
  end function;

  -- -------------------------------------------------------------------------
  -- functions
  -- -------------------------------------------------------------------------

  -- base 2 logarithm function
  -- -------------------------------------------------------------------------
  function log2 (x : positive) return natural is
  begin
    if x <= 1 then
      return 0;
    else
      return (log2 (x / 2)) + 1;
    end if;
  end function log2;

  -- base 2 logarithm function + ceiling to higher integer
  -- -------------------------------------------------------------------------
  function log2_ceil (N: natural) return positive is
  begin
    if N < 2 then
      return 1;
    else
      return 1 + log2_ceil(N/2);
    end if;
  end function log2_ceil;

end messages_pkg;
