-- Altera Microperipheral Reference Design Version 0802
--------------------------------------------------------------------------------
--  File Name: l_conversions_b.vhd
--------------------------------------------------------------------------------
--  Copyright (C) 1997, 1998 Free Model Foundation
-- 
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License version 2 as
--  published by the Free Software Foundation.
-- 
--  This package was written by SEVA Technologies, Inc. and donated to the FMF.
--  www.seva.com
--
--  MODIFICATION HISTORY:
-- 
--  version: |  author:  | mod date: | changes made:
--    V1.0     R. Steele   97 DEC 05   Added header and formatting to SEVA file
--    V1.1     R. Munden   98 NOV 28   Corrected function b
-- 
--------------------------------------------------------------------------------

PACKAGE BODY conversions IS

    -- private declarations for this package 
    type basetype     is (binary, octal, decimal, hex);

    function max(x,y: integer) return integer is
    begin
      if x > y then return x; else return y; end if;
    end max;

    function min(x,y: integer) return integer is
    begin
      if x < y then return x; else return y; end if;
    end min;

    -- consider function sizeof for string/slv/???, return natural

    --  function size(len: natural) return natural is
    --  begin
    --    if len=0 then
    --      return 31;
    --    else return len;
    --    end if;
    --  end size;

      function nextmultof (x    : positive;
                           size : positive) return positive is
      begin
        case x mod size is
          when 0      => return size * x/size;
          when others => return size * (x/size + 1);
        end case;
      end nextmultof;

      function rtn_base (base : basetype) return character is
      begin
        case base is
          when binary  => return 'b';
          when octal   => return 'o';
          when decimal => return 'd';
          when hex     => return 'h';
        end case;
      end rtn_base;

      function format (r          : string;
                       base       : basetype;
                       rtn_len    : natural     ;
                       justify    : justify_side;
                       basespec   : b_spec) return string is
        variable int_rtn_len : integer; 
      begin
        if basespec=yes then 
          int_rtn_len := rtn_len - 3;
        else 
          int_rtn_len := rtn_len;
        end if;
        if int_rtn_len <= r'length then
          case basespec is
            when no  => return r ;
            when yes => return rtn_base(base) & '"' & r & '"';
          end case;
        else 
          case justify is
            when left  =>
              case basespec is
                when no  => 
                  return r & fill(' ',int_rtn_len - r'length);
                when yes  => 
                  return rtn_base(base) & '"' & r & '"' & 
                         fill(' ',int_rtn_len - r'length);
              end case;
            when right =>
              case basespec is
                when no  => 
                  return fill(' ',int_rtn_len - r'length) & r ;
                when yes  => 
                  return fill(' ',int_rtn_len - r'length) & 
                         rtn_base(base) & '"' & r & '"';
              end case;
          end case;
        end if;
      end format;

      -- convert numeric string of any base to natural
      function cnvt_base (x      : string;
                          inbase : natural range 2 to 16) return natural is
        -- assumes x is an unsigned number string of base 'inbase'
        -- values larger than natural'high are not supported
        variable r,t   : natural  := 0;
        variable place : positive := 1;
      begin
        for i in x'reverse_range loop
          case x(i) is
            when '0'     => t := 0;
            when '1'     => t := 1;
            when '2'     => t := 2;
            when '3'     => t := 3;
            when '4'     => t := 4;
            when '5'     => t := 5;
            when '6'     => t := 6;
            when '7'     => t := 7;
            when '8'     => t := 8;
            when '9'     => t := 9;
            when 'a'|'A' => t := 10;
            when 'b'|'B' => t := 11;
            when 'c'|'C' => t := 12;
            when 'd'|'D' => t := 13;
            when 'e'|'E' => t := 14;
            when 'f'|'F' => t := 15;
            when '_'     => t := 0;    -- ignore these characters
                            place := place / inbase;
            when others  => 
              assert false 
                report lf &
                       "CNVT_BASE found input value larger than base: " & lf &
                       "Input value: " & x(i) &
                         " Base: " & to_int_str(inbase) & lf &
                       "converting input to integer 0"
                severity warning;
              return 0;   
          end case;
          if t / inbase > 1 then       -- invalid value for base
            assert false 
              report lf &
                     "CNVT_BASE found input value larger than base: " & lf &
                     "Input value: " & x(i) &
                       " Base: " & to_int_str(inbase) & lf &
                     "converting input to integer 0"
              severity warning;
            return 0;
          else
            r     := r + (t * place);   
            place := place * inbase;
          end if;
        end loop;
        return r;
      end cnvt_base;

    function extend (x   : std_logic;
                     len : positive) return std_logic_vector is
      variable v : std_logic_vector(1 to len) := (others => x); 
    begin
      return v; 
    end extend;


    -- implementation of public declarations

    function to_bin_str(x          : std_logic_vector;
                        rtn_len    : natural      := 0;
                        justify    : justify_side := right;
                        basespec   : b_spec       := yes) return string is

      variable int : std_logic_vector(1 to x'length):=x;
      variable r   : string(1 to x'length):=(others=>'$');
    begin
      for i in int'range loop
        r(i to i) := to_bin_str(int(i),basespec=>no);
      end loop;
      return format (r,binary,rtn_len,justify,basespec);
    end to_bin_str;

    function to_bin_str(x          : std_logic;
                        rtn_len    : natural      := 0;
                        justify    : justify_side := right;
                        basespec   : b_spec       := yes) return string is
      variable r   : string(1 to 1);
    begin
        case x is
          when '0'    => r(1) := '0';
          when '1'    => r(1) := '1';
          when 'U'    => r(1) := 'U';
          when 'X'    => r(1) := 'X';
          when 'Z'    => r(1) := 'Z';
          when 'W'    => r(1) := 'W';
          when 'H'    => r(1) := 'H';
          when 'L'    => r(1) := 'L';
          when '-'    => r(1) := '-';
        end case;
      return format (r,binary,rtn_len,justify,basespec);
    end to_bin_str;

    function to_bin_str(x          : natural;
                        rtn_len    : natural      := 0;
                        justify    : justify_side := right;
                        basespec   : b_spec       := yes) return string is
      variable int : natural := x;
      variable ptr : positive range 2 to 32 := 32;
      variable r   : string(2 to 32):=(others=>'$');
    begin
      if int = 0 then 
        return format ("0",binary,rtn_len,justify,basespec);
      end if;

      while int > 0 loop
        case int rem 2 is
          when 0 => r(ptr) := '0';
          when 1 => r(ptr) := '1';
          when others =>
            assert false report lf & "TO_BIN_STR, shouldn't happen" 
            severity failure;
            return "$";
           null;
        end case;
        int := int / 2;
        ptr := ptr - 1;
      end loop;
      return format (r(ptr+1 to 32),binary,rtn_len,justify,basespec);
    end to_bin_str;

    function to_hex_str(x          : std_logic_vector;
                        rtn_len    : natural      := 0;
                        justify    : justify_side := right;
                        basespec   : b_spec       := yes) return string is
      -- will return x'length/4
      variable nxt : positive := nextmultof(x'length,4);
      variable int : std_logic_vector(1 to nxt):= (others => '0');
      variable ptr : positive range 1 to (nxt/4)+1 := 1;
      variable r   : string(1 to nxt/4):=(others=>'$');
      subtype slv4 is std_logic_vector(1 to 4);
    begin
      int(nxt-x'length+1 to nxt) := x;
      if nxt-x'length > 0 and x(x'left) /= '1' then 
        int(1 to nxt-x'length) := extend(x(x'left),nxt-x'length);
      end if;
      for i in int'range loop
        next when i rem 4 /= 1;
        case slv4'(int(i to i+3)) is
          when "0000" => r(ptr) := '0';
          when "0001" => r(ptr) := '1';
          when "0010" => r(ptr) := '2';
          when "0011" => r(ptr) := '3';
          when "0100" => r(ptr) := '4';
          when "0101" => r(ptr) := '5';
          when "0110" => r(ptr) := '6';
          when "0111" => r(ptr) := '7';
          when "1000" => r(ptr) := '8';
          when "1001" => r(ptr) := '9';
          when "1010" => r(ptr) := 'A';
          when "1011" => r(ptr) := 'B';
          when "1100" => r(ptr) := 'C';
          when "1101" => r(ptr) := 'D';
          when "1110" => r(ptr) := 'E';
          when "1111" => r(ptr) := 'F';
          when "ZZZZ" => r(ptr) := 'Z';
          when "WWWW" => r(ptr) := 'W';
          when "LLLL" => r(ptr) := 'L';
          when "HHHH" => r(ptr) := 'H';
          when "UUUU" => r(ptr) := 'U';
          when "XXXX" => r(ptr) := 'X';
          when "----" => r(ptr) := '-';
          when others =>
            assert false 
              report lf &
                     "TO_HEX_STR found illegal value: " & 
                       to_bin_str(int(i to i+3)) & lf &
                     "converting input to '-'"
              severity warning;
            r(ptr) := '-';
        end case;
        ptr := ptr + 1;
      end loop;
      return format (r,hex,rtn_len,justify,basespec);
    end to_hex_str;

    function to_hex_str(x          : natural;
                        rtn_len    : natural      := 0;
                        justify    : justify_side := right;
                        basespec   : b_spec       := yes)     return string is
      variable int : natural := x;
      variable ptr : positive range 1 to 20 := 20;
      variable r   : string(1 to 20):=(others=>'$');
    begin
      if x=0 then return format ("0",hex,rtn_len,justify,basespec); end if;
      while int > 0 loop
        case int rem 16 is
          when 0  => r(ptr) := '0';
          when 1  => r(ptr) := '1';
          when 2  => r(ptr) := '2';
          when 3  => r(ptr) := '3';
          when 4  => r(ptr) := '4';
          when 5  => r(ptr) := '5';
          when 6  => r(ptr) := '6';
          when 7  => r(ptr) := '7';
          when 8  => r(ptr) := '8';
          when 9  => r(ptr) := '9';
          when 10 => r(ptr) := 'A';
          when 11 => r(ptr) := 'B';
          when 12 => r(ptr) := 'C';
          when 13 => r(ptr) := 'D';
          when 14 => r(ptr) := 'E';
          when 15 => r(ptr) := 'F';
          when others =>
            assert false report lf & "TO_HEX_STR, shouldn't happen"
            severity failure;
            return "$";
        end case;
        int := int / 16;
        ptr := ptr - 1;
      end loop;
      return format (r(ptr+1 to 20),hex,rtn_len,justify,basespec);
    end to_hex_str;

      function to_oct_str(x          : std_logic_vector;
                          rtn_len    : natural      := 0;
                          justify    : justify_side := right;
                          basespec   : b_spec       := yes) return string is
        -- will return x'length/3
        variable nxt : positive := nextmultof(x'length,3);
        variable int : std_logic_vector(1 to nxt):= (others => '0');
        variable ptr : positive range 1 to (nxt/3)+1 := 1;
        variable r   : string(1 to nxt/3):=(others=>'$');
        subtype slv3 is std_logic_vector(1 to 3);
      begin
        int(nxt-x'length+1 to nxt) := x;
        if nxt-x'length > 0 and x(x'left) /= '1' then 
          int(1 to nxt-x'length) := extend(x(x'left),nxt-x'length);
        end if;
        for i in int'range loop
          next when i rem 3 /= 1;
          case slv3'(int(i to i+2)) is
            when "000" => r(ptr) := '0';
            when "001" => r(ptr) := '1';
            when "010" => r(ptr) := '2';
            when "011" => r(ptr) := '3';
            when "100" => r(ptr) := '4';
            when "101" => r(ptr) := '5';
            when "110" => r(ptr) := '6';
            when "111" => r(ptr) := '7';
            when "ZZZ" => r(ptr) := 'Z';
            when "WWW" => r(ptr) := 'W';
            when "LLL" => r(ptr) := 'L';
            when "HHH" => r(ptr) := 'H';
            when "UUU" => r(ptr) := 'U';
            when "XXX" => r(ptr) := 'X';
            when "---" => r(ptr) := '-';
            when others =>
              assert false 
                report lf &
                       "TO_OCT_STR found illegal value: " & 
                         to_bin_str(int(i to i+2)) & lf &
                       "converting input to '-'"
                severity warning;
              r(ptr) := '-';
          end case;
          ptr := ptr + 1;
        end loop;
        return format (r,octal,rtn_len,justify,basespec);
      end to_oct_str;