float_pkg_c.vhdl

something i got you may find this useful

  function nanfp (
    size_res : UNRESOLVED_float)        -- variable is only use for sizing
    return UNRESOLVED_float;
  function qnanfp (
    size_res : UNRESOLVED_float)        -- variable is only use for sizing
    return UNRESOLVED_float;
  function pos_inffp (
    size_res : UNRESOLVED_float)        -- variable is only use for sizing
    return UNRESOLVED_float;
  function neg_inffp (
    size_res : UNRESOLVED_float)        -- variable is only use for sizing
    return UNRESOLVED_float;
  function neg_zerofp (
    size_res : UNRESOLVED_float)        -- variable is only use for sizing
    return UNRESOLVED_float;

  --===========================================================================
  -- string and textio Functions
  --===========================================================================
-- rtl_synthesis off
-- pragma synthesis_off
  -- writes S:EEEE:FFFFFFFF
  procedure WRITE (
    L         : inout LINE;              -- access type (pointer)
    VALUE     : in    UNRESOLVED_float;  -- value to write
    JUSTIFIED : in    SIDE  := right;    -- which side to justify text
    FIELD     : in    WIDTH := 0);       -- width of field

  -- Reads SEEEEFFFFFFFF, "." and ":" are ignored
  procedure READ (L    : inout LINE; VALUE : out UNRESOLVED_float);
  procedure READ (L    : inout LINE; VALUE : out UNRESOLVED_float;
                  GOOD : out   BOOLEAN);

  alias BREAD is READ [LINE, UNRESOLVED_float, BOOLEAN];
  alias BREAD is READ [LINE, UNRESOLVED_float];
  alias BWRITE is WRITE [LINE, UNRESOLVED_float, SIDE, WIDTH];
  alias BINARY_READ is READ [LINE, UNRESOLVED_FLOAT, BOOLEAN];
  alias BINARY_READ is READ [LINE, UNRESOLVED_FLOAT];
  alias BINARY_WRITE is WRITE [LINE, UNRESOLVED_float, SIDE, WIDTH];

  procedure OWRITE (
    L         : inout LINE;              -- access type (pointer)
    VALUE     : in    UNRESOLVED_float;  -- value to write
    JUSTIFIED : in    SIDE  := right;    -- which side to justify text
    FIELD     : in    WIDTH := 0);       -- width of field

  -- Octal read with padding, no separators used
  procedure OREAD (L    : inout LINE; VALUE : out UNRESOLVED_float);
  procedure OREAD (L    : inout LINE; VALUE : out UNRESOLVED_float;
                   GOOD : out   BOOLEAN);
  alias OCTAL_READ is OREAD [LINE, UNRESOLVED_FLOAT, BOOLEAN];
  alias OCTAL_READ is OREAD [LINE, UNRESOLVED_FLOAT];
  alias OCTAL_WRITE is OWRITE [LINE, UNRESOLVED_FLOAT, SIDE, WIDTH];

  -- Hex write with padding, no separators
  procedure HWRITE (
    L         : inout LINE;              -- access type (pointer)
    VALUE     : in    UNRESOLVED_float;  -- value to write
    JUSTIFIED : in    SIDE  := right;    -- which side to justify text
    FIELD     : in    WIDTH := 0);       -- width of field

  -- Hex read with padding, no separators used
  procedure HREAD (L : inout LINE; VALUE : out UNRESOLVED_float);
  procedure HREAD (L    : inout LINE; VALUE : out UNRESOLVED_float;
                   GOOD : out   BOOLEAN);
  alias HEX_READ is HREAD [LINE, UNRESOLVED_FLOAT, BOOLEAN];
  alias HEX_READ is HREAD [LINE, UNRESOLVED_FLOAT];
  alias HEX_WRITE is HWRITE [LINE, UNRESOLVED_FLOAT, SIDE, WIDTH];

  -- returns "S:EEEE:FFFFFFFF"
  function to_string (value : UNRESOLVED_float) return STRING;
  alias TO_BSTRING is TO_STRING [UNRESOLVED_FLOAT return STRING];
  alias TO_BINARY_STRING is TO_STRING [UNRESOLVED_FLOAT return STRING];

  -- Returns a HEX string, with padding
  function to_hstring (value : UNRESOLVED_float) return STRING;
  alias TO_HEX_STRING is TO_HSTRING [UNRESOLVED_FLOAT return STRING];

  -- Returns and octal string, with padding
  function to_ostring (value : UNRESOLVED_float) return STRING;
  alias TO_OCTAL_STRING is TO_OSTRING [UNRESOLVED_FLOAT return STRING];

  function from_string (
    bstring                 : STRING;   -- binary string
    constant exponent_width : NATURAL := float_exponent_width;
    constant fraction_width : NATURAL := float_fraction_width)
    return UNRESOLVED_float;
  alias from_bstring is from_string [STRING, NATURAL, NATURAL
                                     return UNRESOLVED_float];
  alias from_binary_string is from_string [STRING, NATURAL, NATURAL
                                           return UNRESOLVED_float];
  function from_ostring (
    ostring                 : STRING;   -- Octal string
    constant exponent_width : NATURAL := float_exponent_width;
    constant fraction_width : NATURAL := float_fraction_width)
    return UNRESOLVED_float;
  alias from_octal_string is from_ostring [STRING, NATURAL, NATURAL
                                           return UNRESOLVED_float];

  function from_hstring (
    hstring                 : STRING;   -- hex string
    constant exponent_width : NATURAL := float_exponent_width;
    constant fraction_width : NATURAL := float_fraction_width)
    return UNRESOLVED_float;
  alias from_hex_string is from_hstring [STRING, NATURAL, NATURAL
                                         return UNRESOLVED_float];

  function from_string (
    bstring  : STRING;                  -- binary string
    size_res : UNRESOLVED_float)        -- used for sizing only 
    return UNRESOLVED_float;
  alias from_bstring is from_string [STRING, UNRESOLVED_float
                                     return UNRESOLVED_float];
  alias from_binary_string is from_string [STRING, UNRESOLVED_float
                                           return UNRESOLVED_float];

  function from_ostring (
    ostring  : STRING;                  -- Octal string
    size_res : UNRESOLVED_float)        -- used for sizing only 
    return UNRESOLVED_float;
  alias from_octal_string is from_ostring [STRING, UNRESOLVED_float
                                           return UNRESOLVED_float];

  function from_hstring (
    hstring  : STRING;                  -- hex string
    size_res : UNRESOLVED_float)        -- used for sizing only 
    return UNRESOLVED_float;
  alias from_hex_string is from_hstring [STRING, UNRESOLVED_float
                                         return UNRESOLVED_float];
-- rtl_synthesis on
-- pragma synthesis_on
  -- IN VHDL-2006 std_logic_vector is a subtype of std_ulogic_vector, so these
  -- extra functions are needed for compatability.
  function to_float (
    arg                     : STD_LOGIC_VECTOR;
    constant exponent_width : NATURAL := float_exponent_width;  -- length of FP output exponent
    constant fraction_width : NATURAL := float_fraction_width)  -- length of FP output fraction
    return UNRESOLVED_float;

  function to_float (
    arg      : STD_LOGIC_VECTOR;
    size_res : UNRESOLVED_float)
    return UNRESOLVED_float;
    
end package float_pkg;
-------------------------------------------------------------------------------
-- Proposed package body for the VHDL-200x-FT float_pkg package
-- This version is optimized for Synthesis, and not for simulation.
-- Note that there are functional differences between the synthesis and
-- simulation packages bodies.  The Synthesis version is preferred.
-- This package body supplies a recommended implementation of these functions
-- Version    : $Revision: 1.7 $
-- Date       : $Date: 2007-02-28 10:25:01-05 $
--
--  Created for VHDL-200X par, David Bishop ([e-mail])
-------------------------------------------------------------------------------

package body float_pkg is

  -- Author David Bishop ([e-mail])
  -----------------------------------------------------------------------------
  -- type declarations
  -----------------------------------------------------------------------------

  -- This deferred constant will tell you if the package body is synthesizable
  -- or implemented as real numbers, set to "true" if synthesizable.
  constant fphdlsynth_or_real : BOOLEAN := true;  -- deferred constant

  -- types of boundary conditions
  type boundary_type is (normal, infinity, zero, denormal);

  -- null range array constant
  constant NAFP : UNRESOLVED_float (0 downto 1)  := (others => '0');
  constant NSLV : STD_ULOGIC_VECTOR (0 downto 1) := (others => '0');

  -- %%% Replicated functions
  -- These funcitons are replicated so that we don't need to reference the new
  -- 2006 package std.standard, std_logic_1164 and numeric_std.
  function maximum (
    l, r : integer)                    -- inputs
    return integer is
  begin  -- function max
    if l > r then return l;
    else return r;
    end if;
  end function maximum;

  function minimum (
    l, r : integer)                    -- inputs
    return integer is
  begin  -- function min
    if l > r then return r;
    else return l;
    end if;
  end function minimum;

  function or_reduce (arg : STD_ULOGIC_VECTOR)
    return STD_LOGIC is
    variable Upper, Lower : STD_ULOGIC;
    variable Half         : INTEGER;
    variable BUS_int      : STD_ULOGIC_VECTOR (arg'length - 1 downto 0);
    variable Result       : STD_ULOGIC;
  begin
    if (arg'length < 1) then            -- In the case of a NULL range
      Result := '0';
    else
      BUS_int := to_ux01 (arg);
      if (BUS_int'length = 1) then
        Result := BUS_int (BUS_int'left);
      elsif (BUS_int'length = 2) then
        Result := BUS_int (BUS_int'right) or BUS_int (BUS_int'left);
      else
        Half   := (BUS_int'length + 1) / 2 + BUS_int'right;
        Upper  := or_reduce (BUS_int (BUS_int'left downto Half));
        Lower  := or_reduce (BUS_int (Half - 1 downto BUS_int'right));
        Result := Upper or Lower;
      end if;
    end if;
    return Result;
  end function or_reduce;

  function or_reduce (arg : UNSIGNED)
    return STD_ULOGIC is
  begin
    return or_reduce (std_ulogic_vector (arg));
  end function or_reduce;

  function or_reduce (arg : SIGNED)
    return STD_ULOGIC is
  begin
    return or_reduce (std_ulogic_vector (arg));
  end function or_reduce;

  function or_reduce (arg : std_logic_vector)
    return STD_ULOGIC is
  begin
    return or_reduce (std_ulogic_vector (arg));
  end function or_reduce;

  -- purpose: AND all of the bits in a vector together
  -- This is a copy of the proposed "and_reduce" from 1076.3
  function and_reduce (arg : STD_ULOGIC_VECTOR)
    return STD_LOGIC is
    variable Upper, Lower : STD_ULOGIC;
    variable Half         : INTEGER;
    variable BUS_int      : STD_ULOGIC_VECTOR (arg'length - 1 downto 0);
    variable Result       : STD_ULOGIC;
  begin
    if (arg'length < 1) then            -- In the case of a NULL range
      Result := '1';
    else
      BUS_int := to_ux01 (arg);
      if (BUS_int'length = 1) then
        Result := BUS_int (BUS_int'left);
      elsif (BUS_int'length = 2) then
        Result := BUS_int (BUS_int'right) and BUS_int (BUS_int'left);
      else
        Half   := (BUS_int'length + 1) / 2 + BUS_int'right;
        Upper  := and_reduce (BUS_int (BUS_int'left downto Half));
        Lower  := and_reduce (BUS_int (Half - 1 downto BUS_int'right));
        Result := Upper and Lower;
      end if;
    end if;
    return Result;
  end function and_reduce;

  function and_reduce (arg : UNSIGNED)
    return STD_ULOGIC is
  begin
    return and_reduce (std_ulogic_vector (arg));
  end function and_reduce;

  function and_reduce (arg : SIGNED)
    return STD_ULOGIC is
  begin
    return and_reduce (std_ulogic_vector (arg));
  end function and_reduce;

  function xor_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is
    variable Upper, Lower : STD_ULOGIC;
    variable Half         : INTEGER;
    variable BUS_int      : STD_ULOGIC_VECTOR (arg'length - 1 downto 0);