FIXED_GENERIC_PKG package body

-- -----------------------------------------------------------------
-- 
-- Copyright 2019 IEEE P1076 WG Authors
-- 
-- See the LICENSE file distributed with this work for copyright and
-- licensing information and the AUTHORS file.
-- 
-- This file to you under the Apache License, Version 2.0 (the "License").
-- You may obtain a copy of the License at
-- 
--     http://www.apache.org/licenses/LICENSE-2.0
-- 
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
-- implied.  See the License for the specific language governing
-- permissions and limitations under the License.
--
--   Title     :  Fixed-point package (Generic package body)
--             :
--   Library   :  This package shall be compiled into a library
--             :  symbolically named IEEE.
--             :
--   Developers:  Accellera VHDL-TC and IEEE P1076 Working Group
--             :
--   Purpose   :  This packages defines basic binary fixed point arithmetic
--             :  arithmetic functions
--             :
--   Note      :  This package may be modified to include additional data
--             :  required by tools, but it must in no way change the
--             :  external interfaces or simulation behavior of the
--             :  description. It is permissible to add comments and/or
--             :  attributes to the package declarations, but not to change
--             :  or delete any original lines of the package declaration.
--             :  The package body may be changed only in accordance with
--             :  the terms of Clause 16 of this standard.
--             :
-- --------------------------------------------------------------------
-- $Revision: 1220 $
-- $Date: 2008-04-10 17:16:09 +0930 (Thu, 10 Apr 2008) $
-- --------------------------------------------------------------------

library IEEE;
use IEEE.MATH_REAL.all;

package body fixed_generic_pkg is
  -- Author David Bishop (dbishop@vhdl.org)
  -- Other contributers: Jim Lewis, Yannick Grugni, Ryan W. Hilton
  -- null array constants
  constant NAUF : UNRESOLVED_ufixed (0 downto 1) := (others => '0');
  constant NASF : UNRESOLVED_sfixed (0 downto 1) := (others => '0');
  constant NSLV : STD_ULOGIC_VECTOR (0 downto 1) := (others => '0');

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

  -- Special version of "minimum" to do some boundary checking without errors
  function mins (l, r : INTEGER)
    return INTEGER is
  begin  -- function mins
    if (l = INTEGER'low or r = INTEGER'low) then
      return 0;                         -- error condition, silent
    end if;
    return minimum (l, r);
  end function mins;

  -- Special version of "minimum" to do some boundary checking with errors
  function mine (l, r : INTEGER)
    return INTEGER is
  begin  -- function mine
    if (l = INTEGER'low or r = INTEGER'low) then
      report fixed_generic_pkg'instance_name
        & " Unbounded number passed, was a literal used?"
        severity error;
      return 0;
    end if;
    return minimum (l, r);
  end function mine;

  -- The following functions are used only internally.  Every function
  -- calls "cleanvec" either directly or indirectly.
  -- purpose: Fixes "downto" problem and resolves meta states
  function cleanvec (
    arg : UNRESOLVED_sfixed)            -- input
    return UNRESOLVED_sfixed
  is
  begin  -- function cleanvec
    assert not (arg'ascending and (arg'low /= INTEGER'low))
      report fixed_generic_pkg'instance_name
      & " Vector passed using a ""to"" range, expected is ""downto"""
      severity error;
    return arg;
  end function cleanvec;

  -- purpose: Fixes "downto" problem and resolves meta states
  function cleanvec (
    arg : UNRESOLVED_ufixed)            -- input
    return UNRESOLVED_ufixed
  is
  begin  -- function cleanvec
    assert not (arg'ascending and (arg'low /= INTEGER'low))
      report fixed_generic_pkg'instance_name
      & " Vector passed using a ""to"" range, expected is ""downto"""
      severity error;
    return arg;
  end function cleanvec;

  -- Type convert a "unsigned" into a "ufixed", used internally
  function to_fixed (
    arg                  : UNRESOLVED_UNSIGNED;  -- shifted vector
    constant left_index  : INTEGER;
    constant right_index : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable result : UNRESOLVED_ufixed (left_index downto right_index);
  begin  -- function to_fixed
    result := UNRESOLVED_ufixed(arg);
    return result;
  end function to_fixed;

  -- Type convert a "signed" into an "sfixed", used internally
  function to_fixed (
    arg                  : UNRESOLVED_SIGNED;  -- shifted vector
    constant left_index  : INTEGER;
    constant right_index : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable result : UNRESOLVED_sfixed (left_index downto right_index);
  begin  -- function to_fixed
    result := UNRESOLVED_sfixed(arg);
    return result;
  end function to_fixed;

  -- Type convert a "ufixed" into an "unsigned", used internally
  function to_uns (
    arg : UNRESOLVED_ufixed)            -- fp vector
    return UNRESOLVED_UNSIGNED
  is
    subtype t is UNRESOLVED_UNSIGNED(arg'high - arg'low downto 0);
    variable slv : t;
  begin  -- function to_uns
    slv := t(arg);
    return slv;
  end function to_uns;

  -- Type convert an "sfixed" into a "signed", used internally
  function to_s (
    arg : UNRESOLVED_sfixed)            -- fp vector
    return UNRESOLVED_SIGNED
  is
    subtype t is UNRESOLVED_SIGNED(arg'high - arg'low downto 0);
    variable slv : t;
  begin  -- function to_s
    slv := t(arg);
    return slv;
  end function to_s;

  -- adds 1 to the LSB of the number
  procedure round_up (arg       : in  UNRESOLVED_ufixed;
                      result    : out UNRESOLVED_ufixed;
                      overflowx : out BOOLEAN) is
    variable arguns, resuns : UNRESOLVED_UNSIGNED (arg'high-arg'low+1 downto 0)
      := (others => '0');
  begin  -- round_up
    arguns (arguns'high-1 downto 0) := to_uns (arg);
    resuns                          := arguns + 1;
    result := to_fixed(resuns(arg'high-arg'low
                              downto 0), arg'high, arg'low);
    overflowx := (resuns(resuns'high) = '1');
  end procedure round_up;

  -- adds 1 to the LSB of the number
  procedure round_up (arg       : in  UNRESOLVED_sfixed;
                      result    : out UNRESOLVED_sfixed;
                      overflowx : out BOOLEAN) is
    variable args, ress : UNRESOLVED_SIGNED (arg'high-arg'low+1 downto 0);
  begin  -- round_up
    args (args'high-1 downto 0) := to_s (arg);
    args(args'high)             := arg(arg'high);  -- sign extend
    ress                        := args + 1;
    result := to_fixed(ress (ress'high-1
                             downto 0), arg'high, arg'low);
    overflowx := ((arg(arg'high) /= ress(ress'high-1))
                  and (or (STD_ULOGIC_VECTOR(ress)) /= '0'));
  end procedure round_up;

  -- Rounding - Performs a "round_nearest" (IEEE 754) which rounds up
  -- when the remainder is > 0.5.  If the remainder IS 0.5 then if the
  -- bottom bit is a "1" it is rounded, otherwise it remains the same.
  function round_fixed (arg            : UNRESOLVED_ufixed;
                        remainder      : UNRESOLVED_ufixed;
                        overflow_style : fixed_overflow_style_type := fixed_overflow_style)
    return UNRESOLVED_ufixed
  is
    variable rounds         : BOOLEAN;
    variable round_overflow : BOOLEAN;
    variable result         : UNRESOLVED_ufixed (arg'range);
  begin
    rounds := false;
    if (remainder'length > 1) then
      if (remainder (remainder'high) = '1') then
        rounds := (arg(arg'low) = '1')
                  or (or (to_sulv(remainder(remainder'high-1 downto
                                           remainder'low))) = '1');
      end if;
    else
      rounds := (arg(arg'low) = '1') and (remainder (remainder'high) = '1');
    end if;
    if rounds then
      round_up(arg       => arg,
               result    => result,
               overflowx => round_overflow);
    else
      result := arg;
    end if;
    if (overflow_style = fixed_saturate) and round_overflow then
      result := saturate (result'high, result'low);
    end if;
    return result;
  end function round_fixed;

  -- Rounding case statement
  function round_fixed (arg            : UNRESOLVED_sfixed;
                        remainder      : UNRESOLVED_sfixed;
                        overflow_style : fixed_overflow_style_type := fixed_overflow_style)
    return UNRESOLVED_sfixed
  is
    variable rounds         : BOOLEAN;
    variable round_overflow : BOOLEAN;
    variable result         : UNRESOLVED_sfixed (arg'range);
  begin
    rounds := false;
    if (remainder'length > 1) then
      if (remainder (remainder'high) = '1') then
        rounds := (arg(arg'low) = '1')
                  or (or (to_sulv(remainder(remainder'high-1 downto
                                           remainder'low))) = '1');
      end if;
    else
      rounds := (arg(arg'low) = '1') and (remainder (remainder'high) = '1');
    end if;
    if rounds then
      round_up(arg       => arg,
               result    => result,
               overflowx => round_overflow);
    else
      result := arg;
    end if;
    if round_overflow then
      if (overflow_style = fixed_saturate) then
        if arg(arg'high) = '0' then
          result := saturate (result'high, result'low);
        else
          result := not saturate (result'high, result'low);
        end if;
        -- Sign bit not fixed when wrapping
      end if;
    end if;
    return result;
  end function round_fixed;

  -- converts an sfixed into a ufixed.  The output is the same length as the
  -- input, because abs("1000") = "1000" = 8.
  function to_ufixed (
    arg : UNRESOLVED_sfixed)
    return UNRESOLVED_ufixed
  is
    constant left_index  : INTEGER := arg'high;
    constant right_index : INTEGER := mine(arg'low, arg'low);
    variable xarg        : UNRESOLVED_sfixed(left_index+1 downto right_index);
    variable result      : UNRESOLVED_ufixed(left_index downto right_index);
  begin
    if arg'length < 1 then
      return NAUF;
    end if;
    xarg   := abs(arg);
    result := UNRESOLVED_ufixed (xarg (left_index downto right_index));
    return result;
  end function to_ufixed;

-----------------------------------------------------------------------------
-- Visible functions
-----------------------------------------------------------------------------
  -- Conversion functions.  These are needed for synthesis where typically
  -- the only input and output type is a std_logic_vector.
  function to_sulv (
    arg : UNRESOLVED_ufixed)            -- fixed point vector
    return STD_ULOGIC_VECTOR
  is
    variable intermediate_result : UNRESOLVED_ufixed(arg'length-1 downto 0);
  begin
    if arg'length < 1 then
      return NSLV;
    end if;
    intermediate_result := arg;
    return STD_ULOGIC_VECTOR (intermediate_result);
  end function to_sulv;

  function to_sulv (
    arg : UNRESOLVED_sfixed)            -- fixed point vector
    return STD_ULOGIC_VECTOR
  is
    variable intermediate_result : UNRESOLVED_sfixed(arg'length-1 downto 0);
  begin
    if arg'length < 1 then
      return NSLV;
    end if;
    intermediate_result := arg;
    return STD_ULOGIC_VECTOR (intermediate_result);
  end function to_sulv;

  function to_slv (
    arg : UNRESOLVED_ufixed)            -- fixed point vector
    return STD_LOGIC_VECTOR is
  begin
    return to_sulv(arg);
  end function to_slv;

  function to_slv (
    arg : UNRESOLVED_sfixed)            -- fixed point vector
    return STD_LOGIC_VECTOR is
  begin
    return to_sulv(arg);
  end function to_slv;

  function to_ufixed (
    arg                  : STD_ULOGIC_VECTOR;  -- shifted vector
    constant left_index  : INTEGER;
    constant right_index : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable result : UNRESOLVED_ufixed (left_index downto right_index);
  begin
    if (arg'length < 1 or right_index > left_index) then
      return NAUF;
    end if;
    if (arg'length /= result'length) then
      report fixed_generic_pkg'instance_name & "TO_UFIXED(SLV) "
        & "Vector lengths do not match.  Input length is "
        & INTEGER'image(arg'length) & " and output will be "
        & INTEGER'image(result'length) & " wide."
        severity error;
      return NAUF;
    else
      result := to_fixed (arg         => UNRESOLVED_UNSIGNED(arg),
                          left_index  => left_index,
                          right_index => right_index);
      return result;
    end if;
  end function to_ufixed;

  function to_sfixed (
    arg                  : STD_ULOGIC_VECTOR;  -- shifted vector
    constant left_index  : INTEGER;
    constant right_index : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable result : UNRESOLVED_sfixed (left_index downto right_index);
  begin
    if (arg'length < 1 or right_index > left_index) then
      return NASF;
    end if;
    if (arg'length /= result'length) then
      report fixed_generic_pkg'instance_name & "TO_SFIXED(SLV) "
        & "Vector lengths do not match.  Input length is "
        & INTEGER'image(arg'length) & " and output will be "
        & INTEGER'image(result'length) & " wide."
        severity error;
      return NASF;
    else
      result := to_fixed (arg         => UNRESOLVED_SIGNED(arg),
                          left_index  => left_index,
                          right_index => right_index);
      return result;
    end if;
  end function to_sfixed;

  -- Two's complement number, Grows the vector by 1 bit.
  -- because "abs (1000.000) = 01000.000" or abs(-16) = 16.
  function "abs" (
    arg : UNRESOLVED_sfixed)            -- fixed point input
    return UNRESOLVED_sfixed
  is
    constant left_index  : INTEGER := arg'high;
    constant right_index : INTEGER := mine(arg'low, arg'low);
    variable ressns      : UNRESOLVED_SIGNED (arg'length downto 0);
    variable result      : UNRESOLVED_sfixed (left_index+1 downto right_index);
  begin
    if (arg'length < 1 or result'length < 1) then
      return NASF;
    end if;
    ressns (arg'length-1 downto 0) := to_s (cleanvec (arg));
    ressns (arg'length)            := ressns (arg'length-1);  -- expand sign bit
    result                         := to_fixed (abs(ressns), left_index+1, right_index);
    return result;
  end function "abs";

  -- also grows the vector by 1 bit.
  function "-" (
    arg : UNRESOLVED_sfixed)            -- fixed point input
    return UNRESOLVED_sfixed
  is
    constant left_index  : INTEGER := arg'high+1;
    constant right_index : INTEGER := mine(arg'low, arg'low);
    variable ressns      : UNRESOLVED_SIGNED (arg'length downto 0);
    variable result      : UNRESOLVED_sfixed (left_index downto right_index);
  begin
    if (arg'length < 1 or result'length < 1) then
      return NASF;
    end if;
    ressns (arg'length-1 downto 0) := to_s (cleanvec(arg));
    ressns (arg'length)            := ressns (arg'length-1);  -- expand sign bit
    result                         := to_fixed (-ressns, left_index, right_index);
    return result;
  end function "-";

  -- Addition
  function "+" (
    l, r : UNRESOLVED_ufixed)    -- ufixed(a downto b) + ufixed(c downto d) =
    return UNRESOLVED_ufixed     -- ufixed(max(a,c)+1 downto min(b,d))
  is
    constant left_index       : INTEGER := maximum(l'high, r'high)+1;
    constant right_index      : INTEGER := mine(l'low, r'low);
    variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index);
    variable result           : UNRESOLVED_ufixed (left_index downto right_index);
    variable lslv, rslv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
  begin
    if (l'length < 1 or r'length < 1 or result'length < 1) then
      return NAUF;
    end if;
    lresize    := resize (l, left_index, right_index);
    rresize    := resize (r, left_index, right_index);
    lslv       := to_uns (lresize);
    rslv       := to_uns (rresize);
    result_slv := lslv + rslv;
    result     := to_fixed(result_slv, left_index, right_index);
    return result;
  end function "+";

  function "+" (
    l, r : UNRESOLVED_sfixed)    -- sfixed(a downto b) + sfixed(c downto d) =
    return UNRESOLVED_sfixed     -- sfixed(max(a,c)+1 downto min(b,d))
  is
    constant left_index       : INTEGER := maximum(l'high, r'high)+1;
    constant right_index      : INTEGER := mine(l'low, r'low);
    variable lresize, rresize : UNRESOLVED_sfixed (left_index downto right_index);
    variable result           : UNRESOLVED_sfixed (left_index downto right_index);
    variable lslv, rslv       : UNRESOLVED_SIGNED (left_index-right_index downto 0);
    variable result_slv       : UNRESOLVED_SIGNED (left_index-right_index downto 0);
  begin
    if (l'length < 1 or r'length < 1 or result'length < 1) then
      return NASF;
    end if;
    lresize    := resize (l, left_index, right_index);
    rresize    := resize (r, left_index, right_index);
    lslv       := to_s (lresize);
    rslv       := to_s (rresize);
    result_slv := lslv + rslv;
    result     := to_fixed(result_slv, left_index, right_index);
    return result;
  end function "+";

  -- Subtraction
  function "-" (
    l, r : UNRESOLVED_ufixed)    -- ufixed(a downto b) - ufixed(c downto d) =
    return UNRESOLVED_ufixed     -- ufixed(max(a,c)+1 downto min(b,d))
  is
    constant left_index       : INTEGER := maximum(l'high, r'high)+1;
    constant right_index      : INTEGER := mine(l'low, r'low);
    variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index);
    variable result           : UNRESOLVED_ufixed (left_index downto right_index);
    variable lslv, rslv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
  begin
    if (l'length < 1 or r'length < 1 or result'length < 1) then
      return NAUF;
    end if;
    lresize    := resize (l, left_index, right_index);
    rresize    := resize (r, left_index, right_index);
    lslv       := to_uns (lresize);
    rslv       := to_uns (rresize);
    result_slv := lslv - rslv;
    result     := to_fixed(result_slv, left_index, right_index);
    return result;
  end function "-";

  function "-" (
    l, r : UNRESOLVED_sfixed)    -- sfixed(a downto b) - sfixed(c downto d) =
    return UNRESOLVED_sfixed     -- sfixed(max(a,c)+1 downto min(b,d))
  is
    constant left_index       : INTEGER := maximum(l'high, r'high)+1;
    constant right_index      : INTEGER := mine(l'low, r'low);
    variable lresize, rresize : UNRESOLVED_sfixed (left_index downto right_index);
    variable result           : UNRESOLVED_sfixed (left_index downto right_index);
    variable lslv, rslv       : UNRESOLVED_SIGNED (left_index-right_index downto 0);
    variable result_slv       : UNRESOLVED_SIGNED (left_index-right_index downto 0);
  begin
    if (l'length < 1 or r'length < 1 or result'length < 1) then
      return NASF;
    end if;
    lresize    := resize (l, left_index, right_index);
    rresize    := resize (r, left_index, right_index);
    lslv       := to_s (lresize);
    rslv       := to_s (rresize);
    result_slv := lslv - rslv;
    result     := to_fixed(result_slv, left_index, right_index);
    return result;
  end function "-";

  function "*" (
    l, r : UNRESOLVED_ufixed)    -- ufixed(a downto b) * ufixed(c downto d) =
    return UNRESOLVED_ufixed     -- ufixed(a+c+1 downto b+d)
  is
    variable lslv       : UNRESOLVED_UNSIGNED (l'length-1 downto 0);
    variable rslv       : UNRESOLVED_UNSIGNED (r'length-1 downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (r'length+l'length-1 downto 0);
    variable result     : UNRESOLVED_ufixed (l'high + r'high+1 downto
                                             mine(l'low, l'low) + mine(r'low, r'low));
  begin
    if (l'length < 1 or r'length < 1 or
        result'length /= result_slv'length) then
      return NAUF;
    end if;
    lslv       := to_uns (cleanvec(l));
    rslv       := to_uns (cleanvec(r));
    result_slv := lslv * rslv;
    result     := to_fixed (result_slv, result'high, result'low);
    return result;
  end function "*";

  function "*" (
    l, r : UNRESOLVED_sfixed)    -- sfixed(a downto b) * sfixed(c downto d) =
    return UNRESOLVED_sfixed     -- sfixed(a+c+1 downto b+d)
  is
    variable lslv       : UNRESOLVED_SIGNED (l'length-1 downto 0);
    variable rslv       : UNRESOLVED_SIGNED (r'length-1 downto 0);
    variable result_slv : UNRESOLVED_SIGNED (r'length+l'length-1 downto 0);
    variable result     : UNRESOLVED_sfixed (l'high + r'high+1 downto
                                             mine(l'low, l'low) + mine(r'low, r'low));
  begin
    if (l'length < 1 or r'length < 1 or
        result'length /= result_slv'length) then
      return NASF;
    end if;
    lslv       := to_s (cleanvec(l));
    rslv       := to_s (cleanvec(r));
    result_slv := lslv * rslv;
    result     := to_fixed (result_slv, result'high, result'low);
    return result;
  end function "*";

  function "/" (
    l, r : UNRESOLVED_ufixed)    -- ufixed(a downto b) / ufixed(c downto d) =
    return UNRESOLVED_ufixed is         --  ufixed(a-d downto b-c-1)
  begin
    return divide (l, r);
  end function "/";

  function "/" (
    l, r : UNRESOLVED_sfixed)    -- sfixed(a downto b) / sfixed(c downto d) =
    return UNRESOLVED_sfixed is         -- sfixed(a-d+1 downto b-c)
  begin
    return divide (l, r);
  end function "/";

  -- This version of divide gives the user more control
  -- ufixed(a downto b) / ufixed(c downto d) = ufixed(a-d downto b-c-1)
  function divide (
    l, r                 : UNRESOLVED_ufixed;
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_ufixed
  is
    variable result     : UNRESOLVED_ufixed (l'high - mine(r'low, r'low) downto
                                         mine (l'low, l'low) - r'high -1);
    variable dresult    : UNRESOLVED_ufixed (result'high downto result'low -guard_bits);
    variable lresize    : UNRESOLVED_ufixed (l'high downto l'high - dresult'length+1);
    variable lslv       : UNRESOLVED_UNSIGNED (lresize'length-1 downto 0);
    variable rslv       : UNRESOLVED_UNSIGNED (r'length-1 downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (lresize'length-1 downto 0);
  begin
    if (l'length < 1 or r'length < 1 or
        mins(r'low, r'low) /= r'low or mins(l'low, l'low) /= l'low) then
      return NAUF;
    end if;
    lresize := resize (arg            => l,
                       left_index     => lresize'high,
                       right_index    => lresize'low,
                       overflow_style => fixed_wrap,   -- vector only grows
                       round_style    => fixed_truncate);
    lslv := to_uns (cleanvec (lresize));
    rslv := to_uns (cleanvec (r));
    if (rslv = 0) then
      report fixed_generic_pkg'instance_name
        & "DIVIDE(ufixed) Division by zero" severity error;
      result := saturate (result'high, result'low);    -- saturate
    else
      result_slv := lslv / rslv;
      dresult    := to_fixed (result_slv, dresult'high, dresult'low);
      result := resize (arg            => dresult,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => fixed_wrap,  -- overflow impossible
                        round_style    => round_style);
    end if;
    return result;
  end function divide;

  -- sfixed(a downto b) / sfixed(c downto d) = sfixed(a-d+1 downto b-c)
  function divide (
    l, r                 : UNRESOLVED_sfixed;
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_sfixed
  is
    variable result     : UNRESOLVED_sfixed (l'high - mine(r'low, r'low) + 1 downto
                                             mine (l'low, l'low) - r'high);
    variable dresult    : UNRESOLVED_sfixed (result'high downto result'low-guard_bits);
    variable lresize    : UNRESOLVED_sfixed (l'high+1 downto l'high+1 -dresult'length+1);
    variable lslv       : UNRESOLVED_SIGNED (lresize'length-1 downto 0);
    variable rslv       : UNRESOLVED_SIGNED (r'length-1 downto 0);
    variable result_slv : UNRESOLVED_SIGNED (lresize'length-1 downto 0);
  begin
    if (l'length < 1 or r'length < 1 or
        mins(r'low, r'low) /= r'low or mins(l'low, l'low) /= l'low) then
      return NASF;
    end if;
    lresize := resize (arg            => l,
                       left_index     => lresize'high,
                       right_index    => lresize'low,
                       overflow_style => fixed_wrap,   -- vector only grows
                       round_style    => fixed_truncate);
    lslv := to_s (cleanvec (lresize));
    rslv := to_s (cleanvec (r));
    if (rslv = 0) then
      report fixed_generic_pkg'instance_name
        & "DIVIDE(sfixed) Division by zero" severity error;
      result := saturate (result'high, result'low);
    else
      result_slv := lslv / rslv;
      dresult    := to_fixed (result_slv, dresult'high, dresult'low);
      result := resize (arg            => dresult,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => fixed_wrap,  -- overflow impossible
                        round_style    => round_style);
    end if;
    return result;
  end function divide;

  -- 1 / ufixed(a downto b) = ufixed(-b downto -a-1)
  function reciprocal (
    arg                  : UNRESOLVED_ufixed;  -- fixed point input
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_ufixed
  is
    constant one : UNRESOLVED_ufixed (0 downto 0) := "1";
  begin
    return divide (l           => one,
                   r           => arg,
                   round_style => round_style,
                   guard_bits  => guard_bits);
  end function reciprocal;

  -- 1 / sfixed(a downto b) = sfixed(-b+1 downto -a)
  function reciprocal (
    arg                  : UNRESOLVED_sfixed;              -- fixed point input
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_sfixed
  is
    constant one     : UNRESOLVED_sfixed (1 downto 0) := "01";  -- extra bit.
    variable resultx : UNRESOLVED_sfixed (-mine(arg'low, arg'low)+2 downto -arg'high);
  begin
    if (arg'length < 1 or resultx'length < 1) then
      return NASF;
    else
      resultx := divide (l           => one,
                         r           => arg,
                         round_style => round_style,
                         guard_bits  => guard_bits);
      return resultx (resultx'high-1 downto resultx'low);  -- remove extra bit
    end if;
  end function reciprocal;

  -- ufixed (a downto b) rem ufixed (c downto d)
  --        = ufixed (min(a,c) downto min(b,d))
  function "rem" (
    l, r : UNRESOLVED_ufixed)           -- fixed point input
    return UNRESOLVED_ufixed is
  begin
    return remainder (l, r);
  end function "rem";

  -- remainder
  -- sfixed (a downto b) rem sfixed (c downto d)
  --        = sfixed (min(a,c) downto min(b,d))
  function "rem" (
    l, r : UNRESOLVED_sfixed)           -- fixed point input
    return UNRESOLVED_sfixed is
  begin
    return remainder (l, r);
  end function "rem";

  -- ufixed (a downto b) rem ufixed (c downto d)
  --        = ufixed (min(a,c) downto min(b,d))
  function remainder (
    l, r                 : UNRESOLVED_ufixed;            -- fixed point input
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_ufixed
  is
    variable result     : UNRESOLVED_ufixed (minimum(l'high, r'high) downto
                                             mine(l'low, r'low));
    variable lresize    : UNRESOLVED_ufixed (maximum(l'high, r'low) downto
                                             mins(r'low, r'low)-guard_bits);
    variable rresize    : UNRESOLVED_ufixed (r'high downto r'low-guard_bits);
    variable dresult    : UNRESOLVED_ufixed (rresize'range);
    variable lslv       : UNRESOLVED_UNSIGNED (lresize'length-1 downto 0);
    variable rslv       : UNRESOLVED_UNSIGNED (rresize'length-1 downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (rslv'range);
  begin
    if (l'length < 1 or r'length < 1 or
        mins(r'low, r'low) /= r'low or mins(l'low, l'low) /= l'low) then
      return NAUF;
    end if;
    lresize := resize (arg            => l,
                       left_index     => lresize'high,
                       right_index    => lresize'low,
                       overflow_style => fixed_wrap,     -- vector only grows
                       round_style    => fixed_truncate);
    lslv := to_uns (lresize);
    rresize := resize (arg            => r,
                       left_index     => rresize'high,
                       right_index    => rresize'low,
                       overflow_style => fixed_wrap,     -- vector only grows
                       round_style    => fixed_truncate);
    rslv := to_uns (rresize);
    if (rslv = 0) then
      report fixed_generic_pkg'instance_name
        & "remainder(ufixed) Division by zero" severity error;
      result := saturate (result'high, result'low);      -- saturate
    else
      if (r'low <= l'high) then
        result_slv := lslv rem rslv;
        dresult    := to_fixed (result_slv, dresult'high, dresult'low);
        result := resize (arg            => dresult,
                          left_index     => result'high,
                          right_index    => result'low,
                          overflow_style => fixed_wrap,  -- can't overflow
                          round_style    => round_style);
      end if;
      if l'low < r'low then
        result(mins(r'low-1, l'high) downto l'low) :=
          cleanvec(l(mins(r'low-1, l'high) downto l'low));
      end if;
    end if;
    return result;
  end function remainder;

  -- remainder
  -- sfixed (a downto b) rem sfixed (c downto d)
  --        = sfixed (min(a,c) downto min(b,d))
  function remainder (
    l, r                 : UNRESOLVED_sfixed;  -- fixed point input
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_sfixed
  is
    variable l_abs      : UNRESOLVED_ufixed (l'range);
    variable r_abs      : UNRESOLVED_ufixed (r'range);
    variable result     : UNRESOLVED_sfixed (minimum(r'high, l'high) downto
                                             mine(r'low, l'low));
    variable neg_result : UNRESOLVED_sfixed (minimum(r'high, l'high)+1 downto
                                             mins(r'low, l'low));
  begin
    if (l'length < 1 or r'length < 1 or
        mins(r'low, r'low) /= r'low or mins(l'low, l'low) /= l'low) then
      return NASF;
    end if;
    l_abs := to_ufixed (l);
    r_abs := to_ufixed (r);
    result := UNRESOLVED_sfixed (remainder (
      l           => l_abs,
      r           => r_abs,
      round_style => round_style));
    neg_result := -result;
    if l(l'high) = '1' then
      result := neg_result(result'range);
    end if;
    return result;
  end function remainder;

  -- modulo
  -- ufixed (a downto b) mod ufixed (c downto d)
  --        = ufixed (min(a,c) downto min(b, d))
  function "mod" (
    l, r : UNRESOLVED_ufixed)           -- fixed point input
    return UNRESOLVED_ufixed is
  begin
    return modulo (l, r);
  end function "mod";

  -- sfixed (a downto b) mod sfixed (c downto d)
  --        = sfixed (c downto min(b, d))
  function "mod" (
    l, r : UNRESOLVED_sfixed)           -- fixed point input
    return UNRESOLVED_sfixed is
  begin
    return modulo(l, r);
  end function "mod";

  -- modulo
  -- ufixed (a downto b) mod ufixed (c downto d)
  --        = ufixed (min(a,c) downto min(b, d))
  function modulo (
    l, r                 : UNRESOLVED_ufixed;  -- fixed point input
    constant round_style : fixed_round_style_type := fixed_round_style;
    constant guard_bits  : NATURAL                := fixed_guard_bits)
    return UNRESOLVED_ufixed is
  begin
    return remainder(l           => l,
                     r           => r,
                     round_style => round_style,
                     guard_bits  => guard_bits);
  end function modulo;

  -- sfixed (a downto b) mod sfixed (c downto d)
  --        = sfixed (c downto min(b, d))
  function modulo (
    l, r                    : UNRESOLVED_sfixed;  -- fixed point input
    constant overflow_style : fixed_overflow_style_type := fixed_overflow_style;
    constant round_style    : fixed_round_style_type    := fixed_round_style;
    constant guard_bits     : NATURAL                   := fixed_guard_bits)
    return UNRESOLVED_sfixed
  is
    variable l_abs : UNRESOLVED_ufixed (l'range);
    variable r_abs : UNRESOLVED_ufixed (r'range);
    variable result : UNRESOLVED_sfixed (r'high downto
                                         mine(r'low, l'low));
    variable dresult : UNRESOLVED_sfixed (minimum(r'high, l'high)+1 downto
                                          mins(r'low, l'low));
    variable dresult_not_zero : BOOLEAN;
  begin
    if (l'length < 1 or r'length < 1 or
        mins(r'low, r'low) /= r'low or mins(l'low, l'low) /= l'low) then
      return NASF;
    end if;
    l_abs := to_ufixed (l);
    r_abs := to_ufixed (r);
    dresult := "0" & UNRESOLVED_sfixed(remainder (l           => l_abs,
                                                  r           => r_abs,
                                                  round_style => round_style));
    if (to_s(dresult) = 0) then
      dresult_not_zero := false;
    else
      dresult_not_zero := true;
    end if;
    if to_x01(l(l'high)) = '1' and to_x01(r(r'high)) = '0'
      and dresult_not_zero then
      result := resize (arg            => r - dresult,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => overflow_style,
                        round_style    => round_style);
    elsif to_x01(l(l'high)) = '1' and to_x01(r(r'high)) = '1' then
      result := resize (arg            => -dresult,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => overflow_style,
                        round_style    => round_style);
    elsif to_x01(l(l'high)) = '0' and to_x01(r(r'high)) = '1'
      and dresult_not_zero then
      result := resize (arg            => dresult + r,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => overflow_style,
                        round_style    => round_style);
    else
      result := resize (arg            => dresult,
                        left_index     => result'high,
                        right_index    => result'low,
                        overflow_style => overflow_style,
                        round_style    => round_style);
    end if;
    return result;
  end function modulo;

  -- Procedure for those who need an "accumulator" function
  procedure add_carry (
    L, R   : in  UNRESOLVED_ufixed;
    c_in   : in  STD_ULOGIC;
    result : out UNRESOLVED_ufixed;
    c_out  : out STD_ULOGIC) is
    constant left_index       : INTEGER := maximum(L'high, R'high)+1;
    constant right_index      : INTEGER := mins(L'low, R'low);
    variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index);
    variable lslv, rslv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
    variable result_slv : UNRESOLVED_UNSIGNED (left_index-right_index
                                               downto 0);
    variable cx : UNRESOLVED_UNSIGNED (0 downto 0);  -- Carry in
  begin
    if (L'length < 1 or R'length < 1) then
      result := NAUF;
      c_out  := '0';
    else
      cx (0)     := c_in;
      lresize    := resize (L, left_index, right_index);
      rresize    := resize (R, left_index, right_index);
      lslv       := to_uns (lresize);
      rslv       := to_uns (rresize);
      result_slv := lslv + rslv + cx;
      c_out      := result_slv(left_index-right_index);
      result := to_fixed(result_slv (left_index-right_index-1 downto 0),
                         left_index-1, right_index);
    end if;
  end procedure add_carry;

  procedure add_carry (
    L, R   : in  UNRESOLVED_sfixed;
    c_in   : in  STD_ULOGIC;
    result : out UNRESOLVED_sfixed;
    c_out  : out STD_ULOGIC) is
    constant left_index       : INTEGER := maximum(L'high, R'high)+1;
    constant right_index      : INTEGER := mins(L'low, R'low);
    variable lresize, rresize : UNRESOLVED_sfixed (left_index downto right_index);
    variable lslv, rslv : UNRESOLVED_SIGNED (left_index-right_index
                                             downto 0);
    variable result_slv : UNRESOLVED_SIGNED (left_index-right_index
                                             downto 0);
    variable cx : UNRESOLVED_SIGNED (1 downto 0);  -- Carry in
  begin
    if (L'length < 1 or R'length < 1) then
      result := NASF;
      c_out  := '0';
    else
      cx (1)     := '0';
      cx (0)     := c_in;
      lresize    := resize (L, left_index, right_index);
      rresize    := resize (R, left_index, right_index);
      lslv       := to_s (lresize);
      rslv       := to_s (rresize);
      result_slv := lslv + rslv + cx;
      c_out      := result_slv(left_index-right_index);
      result := to_fixed(result_slv (left_index-right_index-1 downto 0),
                         left_index-1, right_index);
    end if;
  end procedure add_carry;

  -- Scales the result by a power of 2.  Width of input = width of output with
  -- the decimal point moved.
  function scalb (y : UNRESOLVED_ufixed; N : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable result : UNRESOLVED_ufixed (y'high+N downto y'low+N);
  begin
    if y'length < 1 then
      return NAUF;
    else
      result := y;
      return result;
    end if;
  end function scalb;

  function scalb (y : UNRESOLVED_ufixed; N : UNRESOLVED_SIGNED)
    return UNRESOLVED_ufixed is
  begin
    return scalb (y => y,
                  N => to_integer(N));
  end function scalb;

  function scalb (y : UNRESOLVED_sfixed; N : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable result : UNRESOLVED_sfixed (y'high+N downto y'low+N);
  begin
    if y'length < 1 then
      return NASF;
    else
      result := y;
      return result;
    end if;
  end function scalb;

  function scalb (y : UNRESOLVED_sfixed; N : UNRESOLVED_SIGNED)
    return UNRESOLVED_sfixed is
  begin
    return scalb (y => y,
                  N => to_integer(N));
  end function scalb;

  function Is_Negative (arg : UNRESOLVED_sfixed) return BOOLEAN is
  begin
    if to_X01(arg(arg'high)) = '1' then
      return true;
    else
      return false;
    end if;
  end function Is_Negative;

  function find_rightmost (arg : UNRESOLVED_ufixed; y : STD_ULOGIC)
    return INTEGER is
  begin
    for_loop : for i in arg'reverse_range loop
      if arg(i) ?= y then
        return i;
      end if;
    end loop;
    return arg'high+1;                  -- return out of bounds 'high
  end function find_rightmost;

  function find_leftmost (arg : UNRESOLVED_ufixed; y : STD_ULOGIC)
    return INTEGER is
  begin
    for_loop : for i in arg'range loop
      if arg(i) ?= y then
        return i;
      end if;
    end loop;
    return arg'low-1;                   -- return out of bounds 'low
  end function find_leftmost;

  function find_rightmost (arg : UNRESOLVED_sfixed; y : STD_ULOGIC)
    return INTEGER is
  begin
    for_loop : for i in arg'reverse_range loop
      if arg(i) ?= y then
        return i;
      end if;
    end loop;
    return arg'high+1;                  -- return out of bounds 'high
  end function find_rightmost;

  function find_leftmost (arg : UNRESOLVED_sfixed; y : STD_ULOGIC)
    return INTEGER is
  begin
    for_loop : for i in arg'range loop
      if arg(i) ?= y then
        return i;
      end if;
    end loop;
    return arg'low-1;                   -- return out of bounds 'low
  end function find_leftmost;

  function "sll" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    argslv := argslv sll COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sll";

  function "srl" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    argslv := argslv srl COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "srl";

  function "rol" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    argslv := argslv rol COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "rol";

  function "ror" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    argslv := argslv ror COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "ror";

  function "sla" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    -- Arithmetic shift on an unsigned is a logical shift
    argslv := argslv sll COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sla";

  function "sra" (ARG : UNRESOLVED_ufixed; COUNT : INTEGER)
    return UNRESOLVED_ufixed
  is
    variable argslv : UNRESOLVED_UNSIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_ufixed (ARG'range);
  begin
    argslv := to_uns (ARG);
    -- Arithmetic shift on an unsigned is a logical shift
    argslv := argslv srl COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sra";

  function "sll" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    argslv := argslv sll COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sll";

  function "srl" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    argslv := argslv srl COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "srl";

  function "rol" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    argslv := argslv rol COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "rol";

  function "ror" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    argslv := argslv ror COUNT;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "ror";

  function "sla" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    if COUNT > 0 then
      -- Arithmetic shift left on a 2's complement number is a logic shift
      argslv := argslv sll COUNT;
    else
      argslv := argslv sra -COUNT;
    end if;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sla";

  function "sra" (ARG : UNRESOLVED_sfixed; COUNT : INTEGER)
    return UNRESOLVED_sfixed
  is
    variable argslv : UNRESOLVED_SIGNED (ARG'length-1 downto 0);
    variable result : UNRESOLVED_sfixed (ARG'range);
  begin
    argslv := to_s (ARG);
    if COUNT > 0 then
      argslv := argslv sra COUNT;
    else
      -- Arithmetic shift left on a 2's complement number is a logic shift
      argslv := argslv sll -COUNT;
    end if;
    result := to_fixed (argslv, result'high, result'low);
    return result;
  end function "sra";

  -- Because some people want the older functions.
  function SHIFT_LEFT (ARG : UNRESOLVED_ufixed; COUNT : NATURAL)
    return UNRESOLVED_ufixed is
  begin
    if (ARG'length < 1) then
      return NAUF;
    end if;
    return ARG sla COUNT;
  end function SHIFT_LEFT;

  function SHIFT_RIGHT (ARG : UNRESOLVED_ufixed; COUNT : NATURAL)
    return UNRESOLVED_ufixed is
  begin
    if (ARG'length < 1) then
      return NAUF;
    end if;
    return ARG sra COUNT;
  end function SHIFT_RIGHT;

  function SHIFT_LEFT (ARG : UNRESOLVED_sfixed; COUNT : NATURAL)
    return UNRESOLVED_sfixed is
  begin
    if (ARG'length < 1) then
      return NASF;
    end if;
    return ARG sla COUNT;
  end function SHIFT_LEFT;

  function SHIFT_RIGHT (ARG : UNRESOLVED_sfixed; COUNT : NATURAL)
    return UNRESOLVED_sfixed is
  begin
    if (ARG'length < 1) then
      return NASF;
    end if;
    return ARG sra COUNT;
  end function SHIFT_RIGHT;