library IEEE;
use IEEE.STD_LOGIC_1164.ALL;
use ieee.numeric_std.all;
use ieee.math_real.all;
use std.textio.all;

package body fixed_ja is

	-------------------------------------------------------------
	-- Local Procedures
	-------------------------------------------------------------
	-- adds 1 to the LSB of the number
	procedure round_up
	(
		src       : in  ufixed_t;
		result    : out ufixed_t;
		overflowx : out BOOLEAN ) is
		
	variable srcuns, resuns : UNSIGNED (src'high-src'low+1 downto 0) := (others => '0');
	begin  -- round_up
	srcuns (srcuns'high-1 downto 0) := to_unsigned (src);
	resuns                          := srcuns + 1;

	result := to_ufixed(resuns(src'high-src'low downto 0), src);
	overflowx := (resuns(resuns'high) = '1');

	end procedure round_up;

	-------------------------------------------------------------
	-- adds 1 to the LSB of the number
	procedure round_up 
	(
		src       : in  sfixed_t;
		result    : out sfixed_t;
		overflowx : out BOOLEAN ) is
	
	variable srcs, ress : SIGNED (src'high-src'low+1 downto 0);
	begin  -- round_up
	srcs (srcs'high-1 downto 0) := to_signed (src);
	srcs(srcs'high)             := src(src'high);  -- sign extend
	ress                        := srcs + 1;

	result := to_sfixed(ress (ress'high-1 downto 0), src);
	overflowx := ((src(src'high) /= ress(ress'high-1)) and (or_red (sfixed_t(ress)) /= '0'));

	end procedure round_up;
	
	-------------------------------------------------------------
	-- Local functions
	-------------------------------------------------------------
	-- round_fixed()
--	function round_fixed
--	(
--		src : ufixed_t;
--		remainder : ufixed_t;
--		rnd_mode : round_mode_t := default_round_mode
--	) return ufixed_t is
--	variable res : ufixed_t(src'range);
--	begin
--	return res;
--
--	end round_fixed;
		
	-------------------------------------------------------------
--	function round_fixed 
--	(
--		src : sfixed_t;
--		remainder : sfixed_t;
--		rnd_mode : round_mode_t := default_round_mode
--	) return sfixed_t is
--	variable res : to_signed(src'length-1 downto 0);
--	begin
--	return src;
--
--	end round_fixed;

	-------------------------------------------------------------
	function reshape
	(
		src : ufixed_t;
		proto : ufixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is

	variable RemainLow : ufixed_t (proto'low-1 downto src'low) := (others => '0');
	variable RemainHigh : ufixed_t (src'high downto proto'high+1) := (others => '0');
	variable dst, tmp : ufixed_t (proto'high downto proto'low) := (others => '0');
	variable ovf, isTruncLo, isTruncHi : boolean := false;
	begin

	if proto'high < -1 then
		assert false report "U: reshape: Bad dual point (Upper bound < (-1))" severity error;
	end if;	

	-- Check for high and low truncation
	isTruncLo := (src'low < dst'low);
	isTruncHi := (src'high > dst'high);
	
	-- Reshape
	dst := (others => '0');
	dst(min(src'high, dst'high) downto max(src'low, dst'low)) := src(min(src'high, dst'high) downto max(src'low, dst'low));
	tmp := dst;

	-- Get low remainder
	if isTruncLo then
		RemainLow := src(RemainLow'range);
	end if;
	
	-- Get high remainder
	if isTruncHi then
		RemainHigh := src(RemainHigh'range);
	end if;	

	ovf := false;

	-- Rounding
	if isTruncLo then

		case rnd_mode is

		-- Round to positive infinity (round ceiling)
		when round_pos_infinity =>
			if or_red(RemainLow) = '1' then
				round_up(tmp, dst, ovf);
			end if;

		-- Round Half-up
		-- Round nearest
		when round_half_up | round_nearest => 
			if (RemainLow(RemainLow'high) = '1') then
				round_up(tmp, dst, ovf);
			end if;

		-- Round convergent
		when round_convergent =>
			if RemainLow(RemainLow'high) = '1' then
				if or_red(RemainLow(RemainLow'high-1 downto RemainLow'low)) = '1' then
					round_up(tmp, dst, ovf);
				elsif tmp(dst'low) = '1' then
					round_up(tmp, dst, ovf);
				end if;	
			end if;
			
		-- Round to zero
		when round_to_zero | none => null;
		
		when others =>
		assert false report "Reshape(U): Rounding mode (" & round_mode_t'image(rnd_mode) & ") not implemented!" severity error;

		end case;
	end if;	

	-- Saturating
	if sat_mode = saturate then

		-- Check overflow
		if isTruncHi then
			ovf := ovf or or_red(RemainHigh) = '1';
		end if;	

		-- Saturate
		if ovf then
			dst := (others => '1');
		end if;

	end if;
	
	return dst;

	end reshape;

	-------------------------------------------------------------
	function reshape
	(
		src : ufixed_t;
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is
	
	begin
	return reshape(src, uproto(nbits, nbits_int), rnd_mode, sat_mode);
	
	end reshape;

	-------------------------------------------------------------
	function reshape
	(
		src : sfixed_t;
		proto : sfixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is

	variable RemainLow : sfixed_t (proto'low-1 downto src'low) := (others => '0');
	variable RemainHigh : sfixed_t (src'high-1 downto proto'high) := (others => '0');
	variable dst, tmp : sfixed_t (proto'high downto proto'low) := (others => '0');
	variable ovf, isTruncLo, isTruncHi : boolean := false;
	variable sign : std_logic; 
	begin

	if proto'high < 0 then
		assert false report "Reshape(S): Bad dual point (Upper bound < (0))" severity error;
	end if;
	
	-- Check for high and low truncation
	isTruncLo := (src'low < dst'low);
	isTruncHi := (src'high > dst'high);
	
	-- Reshape
	sign := src(src'high);
	dst := (others => '0');
	dst(dst'high downto max(src'low, dst'low)) := (dst'high downto min(src'high, dst'high) => sign) & src(min(src'high, dst'high)-1 downto max(src'low, dst'low));
	tmp := dst;
	
	-- Get low remainder
	if isTruncLo then
		RemainLow := src(RemainLow'range);
	end if;
	
	-- Get high remainder
	if isTruncHi then
		RemainHigh := src(RemainHigh'range);
	end if;	

	ovf := false;

	-- Rounding
	if isTruncLo then

		case rnd_mode is

		-- Round to positive infinity (round ceiling)
		when round_pos_infinity =>
			round_up(tmp, dst, ovf);
			if ovf then
				dst(dst'high) := '0';
			end if;	

		-- Round Half-up
		when round_half_up => 
			if RemainLow(RemainLow'high) = '1' then
				round_up(tmp, dst, ovf);
			end if;	

		-- Round nearest
		when round_nearest =>
			if RemainLow(RemainLow'high) = '1' then
				if RemainLow'length = 1 then
					if sign = '0' then
						round_up(tmp, dst, ovf);
					end if;
				elsif sign = '0' or (sign and or_red(RemainLow(RemainLow'high-1 downto RemainLow'low))) = '1' then
						round_up(tmp, dst, ovf);
				end if;	
			end if;	
		
		-- Round convergent
		when round_convergent =>
			if RemainLow(RemainLow'high) = '1' then
				if or_red(RemainLow(RemainLow'high-1 downto RemainLow'low)) = '1' then
					round_up(tmp, dst, ovf);
				elsif tmp(dst'low) = '1' then
					round_up(tmp, dst, ovf);
				end if;	
			end if;

		-- Round to zero
		when round_to_zero =>
			if (or_red(RemainLow) = '1' and sign = '1') then
				round_up(tmp, dst, ovf);
			end if;

		-- No Round
		when none =>
			-- Same as RoundToZero but overflow detection is omitted
			dst := tmp + (or_red(RemainLow) and sign);

		when others =>
		assert false report "Reshape(S): Rounding mode (" & round_mode_t'image(rnd_mode) & ") not implemented!" severity error;
		
		end case;
		
		-- Check negative zero
		if dst(dst'high) = '1' then
			if or_red(dst(dst'high-1 downto dst'low)) = '0' then
				dst(dst'high) := '0';
			--	assert false report "Reshape(S): -0 detected" severity note;
			end if;	
		end if;	
	end if;	

	-- Saturating
	if sat_mode = saturate then

		-- Check overflow
		if isTruncHi then
			ovf :=	ovf or
					(sign = '1' and src(dst'high) = '0' and or_red(tmp(dst'high-1 downto dst'low)) = '1') or
					(sign = '1' and src(dst'high) = '1' and or_red(tmp(dst'high-1 downto dst'low)) = '0') or
					(sign = '0' and or_red(RemainHigh) = '1');
		end if;
		
		-- Saturate
		if ovf then
			if (sign = '1') then
				dst := '1' & (dst'high-1 downto dst'low+1 => '0') & '1';
			else
				dst := '0' & (dst'high-1 downto dst'low => '1');
			end if;
		end if;
		
	end if;
	
	return dst;

	end reshape;

	-------------------------------------------------------------
	function reshape
	(
		src : sfixed_t;
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is
	
	begin
	return reshape(src, sproto(nbits, nbits_int), rnd_mode, sat_mode);
	
	end reshape;

	-------------------------------------------------------------
	-- Constuctor helpers
	-------------------------------------------------------------
	function uproto (nbits : integer; nbits_int : integer) return ufixed_t is
	constant result : ufixed_t (nbits_int-1 downto nbits_int-nbits) := (others => '0');
	begin 
	return result(nbits_int-1 downto nbits_int-nbits);
	end uproto;

	-------------------------------------------------------------
	function sproto (nbits : integer; nbits_int : integer) return sfixed_t is
	constant result : sfixed_t (nbits_int downto nbits_int-nbits+1) := (others => '0');
	begin 
	return result(nbits_int downto nbits_int-nbits+1);
	end sproto;

	-------------------------------------------------------------
	function uproto (a : ufixed_t; op : character; b : ufixed_t) return ufixed_t is
	constant result : ufixed_t(a'high + b'high + 4 downto a'low + b'low - 4) := (others => '0');
	variable hi, lo : integer := 0;

	begin

	case op is
		when '+' =>
		hi := max(a'high, b'high);
		if a'high = b'high then
			hi := hi + 1;
		end if;	
		lo := min(a'low, b'low);

		when '-' =>  
		hi := max(a'high, b'high);
		lo := min(a'low, b'low);

		when '*' => 
		hi := a'high + b'high + 1;
		if (a'high < 0 or b'high < 0) then
			if (hi > -1) then
				hi := hi-1;
			end if;
		end if;
		lo := hi - a'length - b'length + 1;

		when others => null;

	end case;

	return result(hi downto lo);
	end uproto;

	-------------------------------------------------------------
	function sproto (a : sfixed_t; op : character; b : sfixed_t) return sfixed_t is
	constant result : sfixed_t(a'high + b'high + 4 downto a'low + b'low - 4) := (others => '0');
	variable hi, lo : integer := 0;

	begin

	case op is
		when '+' =>
		hi := max(a'high, b'high);
		if a'high = b'high then
			hi := hi + 1;
		end if;	
		lo := min(a'low, b'low);

		when '-' =>  
		hi := max(a'high, b'high);
		lo := min(a'low, b'low);

		when '*' =>  
		hi := a'high + b'high;
		if (a'high = 0 or b'high = 0) then
			if (hi > 0) then
				hi := hi-1;
			end if;
		end if;
		lo := hi - a'length - b'length + 1;

		when others => null;

	end case;

	return result(hi downto lo);
	end sproto;

	-------------------------------------------------------------
	-- Type conversions
	-------------------------------------------------------------
    -- ufixed <= ufixed
	function to_ufixed(src : ufixed_t) return ufixed_t is
	begin
	return to_ufixed(src, src);

	end to_ufixed;
	
	-------------------------------------------------------------
    -- ufixed <= sfixed
	function to_ufixed(src : sfixed_t) return ufixed_t is
	variable dst : ufixed_t(src'range) := (others => '0');
	begin
	dst := ufixed_t(abs(src));
	return dst(src'high-1 downto src'low);

	end to_ufixed;
	
	-------------------------------------------------------------
    -- sfixed <= sfixed
	function to_sfixed(src : sfixed_t) return sfixed_t is
	begin
	return src;

	end to_sfixed;
	
	-------------------------------------------------------------
    -- sfixed <= ufixed
	function to_sfixed(src : ufixed_t) return sfixed_t is
	variable dst : sfixed_t(src'high+1 downto src'low) := (others => '0');
	begin
	dst(src'range) := sfixed_t(src);
	return dst;

	end to_sfixed;

	-------------------------------------------------------------
    -- ufixed <= ufixed
	function to_ufixed
	(
		src : ufixed_t;
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is
	begin
	return reshape(src, nbits, nbits_int, rnd_mode, sat_mode);
	
	end to_ufixed;
	
	-------------------------------------------------------------
    -- ufixed <= ufixed
	function to_ufixed
	(
		src : ufixed_t; 
		proto : ufixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is
	begin
	return reshape(src, proto, rnd_mode, sat_mode);
	
	end to_ufixed;
	
	-------------------------------------------------------------
    -- sfixed <= sfixed
	function to_sfixed
	(
		src : sfixed_t;
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is
	begin
	return reshape(src, nbits, nbits_int, rnd_mode, sat_mode);
	
	end to_sfixed;
	
	-------------------------------------------------------------
    -- sfixed <= sfixed
	function to_sfixed
	(
		src : sfixed_t; 
		proto : sfixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is
	begin
	return reshape(src, proto, rnd_mode, sat_mode);
	
	end to_sfixed;

	-------------------------------------------------------------
	-- ufixed <= integer
	function to_ufixed (src : integer; nbits : integer; nbits_int : integer) return ufixed_t is
	begin
	return to_ufixed(src, uproto(nbits, nbits_int));
		
	end to_ufixed;

	function to_ufixed (src : integer; proto : ufixed_t) return ufixed_t is
	begin
	return to_ufixed(to_unsigned(src, proto'length), proto);
		
	end to_ufixed;
	
	-------------------------------------------------------------
	-- ufixed <= unsigned
	function to_ufixed (src : unsigned; nbits : integer; nbits_int : integer) return ufixed_t is
	begin
	return to_ufixed(src, uproto(nbits, nbits_int));

	end to_ufixed;
	
	-------------------------------------------------------------
	-- ufixed <= unsigned
	function to_ufixed(src : unsigned; proto : ufixed_t) return ufixed_t is
	variable dst : ufixed_t(proto'high downto proto'low) := (others => '0');
	begin
	
	dst(dst'low + min(dst'length, src'length)-1 downto dst'low) := ufixed_t(src(min(dst'length, src'length)-1 downto 0));	

	return dst;

	end to_ufixed;

	-------------------------------------------------------------
	-- sfixed <= integer
	function to_sfixed (src : integer; nbits : integer; nbits_int : integer) return sfixed_t is
	begin
	return to_sfixed(src, sproto(nbits, nbits_int));
		
	end to_sfixed;

	function to_sfixed (src : integer; proto : sfixed_t) return sfixed_t is
	begin
	
	return to_sfixed(to_signed(src, proto'length), proto);
		
	end to_sfixed;
	
	-------------------------------------------------------------
	-- sfixed <= signed
	function to_sfixed (src : signed; nbits : integer; nbits_int : integer) return sfixed_t is
	begin
	return to_sfixed(src, sproto(nbits, nbits_int));
	
	end to_sfixed;

	-------------------------------------------------------------
	-- sfixed <= signed
	function to_sfixed(src : signed; proto : sfixed_t) return sfixed_t is
	variable dst : sfixed_t(proto'high downto proto'low) := (others => '0');
	begin

	dst(dst'low + min(dst'length, src'length)-2 downto dst'low) := sfixed_t(src(min(dst'length, src'length)-2 downto 0));	
	dst(dst'high) := src(src'high);

	return dst;
	
	end to_sfixed;

	-------------------------------------------------------------
	function to_ufixed (src : STD_LOGIC_VECTOR;	proto : ufixed_t) return ufixed_t is
	variable result : ufixed_t (proto'left downto proto'right);
	begin
	if (result'length < 1) then
		return result;
	else
		result := to_ufixed (unsigned(src), proto);
	return result;
	end if;
	
	end function to_ufixed;

	-------------------------------------------------------------
	function to_ufixed (src : STD_LOGIC_VECTOR;	nbits : integer; nbits_int : integer) return ufixed_t is
	begin
	return to_ufixed(src, uproto(nbits, nbits_int));
	
	end function to_ufixed;

	-------------------------------------------------------------
	function to_sfixed (src : STD_LOGIC_VECTOR;	proto : sfixed_t) return sfixed_t is
	variable result : sfixed_t (proto'left downto proto'right);
	begin
	if (result'length < 1) then
		return result;
	else
		result := to_sfixed (signed(src), proto);
	return result;
	end if;
	
	end function to_sfixed;

	-------------------------------------------------------------
	function to_sfixed (src : STD_LOGIC_VECTOR; nbits : integer; nbits_int : integer) return sfixed_t is
	begin
	return to_sfixed(src, sproto(nbits, nbits_int));
	
	end to_sfixed;
	-------------------------------------------------------------
	
	-- ufixed <= real
	function to_ufixed
	(
		src : real; 
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is

	constant nbits_ext : integer := nbits + 1;
	constant fix_hi : integer := nbits_int - 1;
	constant fix_lo : integer := nbits_int - nbits_ext;
	
	variable dst : ufixed_t (fix_hi downto fix_lo) := (others => '0');
	variable i : integer := 0;
	variable remain : real := 0.0;
	
	begin
	
	if (nbits_int < 0) then
		assert false report "to_ufixed: Bad dual point (N integer bits < 0)" severity error;
	end if;
	
	if ((2.0**nbits_int - 1.0) < ipart(abs(src))) then
--		assert ASSERT_NO_WARN report "to_ufixed: Overflow (" & REAL'image(src) & ") "  severity warning;
--		print_info(dst, "dst: ");
	end if;
	
	remain := abs(src);
    for i in dst'range loop
		if remain >= 2.0**i then
			dst(i) := '1';
			remain := remain - 2.0**i;
		else
			dst(i) := '0';
		end if;
    end loop;
	
	return to_ufixed(dst, nbits, nbits_int, rnd_mode, sat_mode);

	end to_ufixed;

	-------------------------------------------------------------
	-- sfixed <= real
	function to_sfixed
	(
		src : real;
		proto : sfixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is

	variable utmp : ufixed_t(proto'high-1 downto proto'low) := (others => '0');
	variable dst : sfixed_t(proto'high downto proto'low) := (others => '0');
	
	begin
	utmp := to_ufixed(src, utmp, rnd_mode, sat_mode);
	if (src < 0.0) then
		dst := -to_sfixed(utmp);
	else
		dst := to_sfixed(utmp);
	end if;
	
	return dst;
	end to_sfixed;  

	-------------------------------------------------------------
	-- ufixed <= real
	function to_ufixed
	(
		src : real;
		proto : ufixed_t;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return ufixed_t is
	begin
		return to_ufixed(src, proto'length, proto'high+1, rnd_mode, sat_mode);
	end to_ufixed;

	-------------------------------------------------------------
	-- sfixed <= real
	function to_sfixed
	(
		src : real;
		nbits : integer;
		nbits_int : integer;
		rnd_mode : round_mode_t := default_round_mode;
		sat_mode : saturate_mode_t := default_saturate_mode
	) return sfixed_t is
	begin
		return to_sfixed(src, sproto(nbits, nbits_int), rnd_mode, sat_mode);
	end to_sfixed;

	-------------------------------------------------------------------------------
	-- ufixed <= ufixed_array(i)
	function to_ufixed(src : ufixed_array_t; index : integer) return ufixed_t is
	variable dst : ufixed_t(src'range(2));
	begin
		for j in src'range(2) loop
			dst(j) := src(index, j);
		end loop;
		
		return dst;
		
	end to_ufixed;	
	
	-------------------------------------------------------------------------------
	-- sfixed <= sfixed_array(i)
	function to_sfixed(src : sfixed_array_t; index : integer) return sfixed_t is
	variable dst : sfixed_t(src'range(2));
	begin
		for j in src'range(2) loop
			dst(j) := src(index, j);
		end loop;
		
		return dst;
		
	end to_sfixed;	
	
	-------------------------------------------------------------
	-- ufixed <= string
	function to_ufixed (src : string) return ufixed_t is
	
	variable i, j, nbits, nbits_int, nbits_frac : integer := 0;
	variable dst : unsigned(src'length downto 0) := (others => '0');
	variable dp_found : boolean := false;
	begin
	
	for i in src'reverse_range loop
		case src(i) is 
			when '.' =>
			if dp_found then
				assert false report "More than one DP not found." severity error;
			else
				dp_found := true;
				nbits_frac := j;
			end if;  
		
			when '0' => dst(nbits) := '0'; nbits := nbits + 1; j := j + 1;
			when '1' => dst(nbits) := '1'; nbits := nbits + 1; j := j + 1;
			when others => 
			assert false report "Illegal character in binary string." severity error;
			
		end case;
	
	end loop ;
	if not dp_found then
		assert ASSERT_NO_WARN report "DP not found. Using left alignment." severity warning;
	end if;	
	
	nbits_int := nbits - nbits_frac;
	
	return to_ufixed(dst(nbits-1 downto 0), nbits, nbits_int);
	
	end to_ufixed;

	-------------------------------------------------------------
	-- sfixed <= string
	function to_sfixed (src : string) return sfixed_t is
	
	variable i, j, nbits, nbits_int, nbits_frac : integer := 0;
	variable dst : signed(src'length downto 0) := (others => '0');
	variable dp_found : boolean := false;
	variable is_neg : boolean := false;
	begin

	is_neg := src(src'left) = '-';
	
	for i in src'reverse_range loop
		case src(i) is 
			when '-' => null;
			when '+' => null;
	
			when '.' =>
			if dp_found then
				assert false report "More than one DP not found." severity error;
			else
				dp_found := true;
				nbits_frac := j;
			end if;  
	
			when '0' => dst(nbits) := '0'; nbits := nbits + 1; j := j + 1;
			when '1' => dst(nbits) := '1'; nbits := nbits + 1; j := j + 1;
			when others => 
			assert false report "Illegal character in binary string." severity error;
		end case;
	end loop ;
	nbits := nbits + 1;

	if not dp_found then
		assert ASSERT_NO_WARN report "DP not found. Using left alignment." severity warning;
	end if;	
	
	nbits_int := nbits - nbits_frac-1;

	if is_neg then
		dst(nbits-1 downto 0) := -dst(nbits-1 downto 0);
	end if;

	return to_sfixed(dst(nbits-1 downto 0), nbits, nbits_int);

	end to_sfixed;

	-------------------------------------------------------------
	function to_unsigned (src : ufixed_t) return UNSIGNED is
	subtype  t is UNSIGNED(src'high - src'low downto 0);
	variable slv : t;
	begin
	slv := t(src);
	return UNSIGNED(to_X01(std_logic_vector(slv)));

	end function to_unsigned;

	-------------------------------------------------------------
	function to_signed (src : sfixed_t) return SIGNED is
	subtype  t is SIGNED(src'high - src'low downto 0);
	variable slv : t;
	begin
	slv := t(src);
	return SIGNED(to_X01(std_logic_vector(slv)));

	end function to_signed;
	
	-------------------------------------------------------------
	-- integer <= ufixed
	function to_integer (src : ufixed_t) return integer is
	begin
		return to_integer(to_unsigned(src));
	end to_integer;	

	-------------------------------------------------------------
	-- integer <= sfixed
	function to_integer (src : sfixed_t) return integer is
	begin
		return to_integer(to_signed(src));
	end to_integer;	

	-------------------------------------------------------------
	--  to_real
	function to_real(src : ufixed_t) return real is
	variable dst : real := 0.0;
	begin
	for i in src'range loop
		if (src(i) = '1') then
			dst := dst + real(2.0**i);
		end if;	
	end loop;
	return dst;

	end to_real;		

	-------------------------------------------------------------
	function to_real(src : sfixed_t) return real is
	variable dst : real := 0.0;
	begin
	dst := to_real(to_ufixed(src));

	if (src(src'high) = '1') then
		dst := -dst;
	end if;

	return dst;

	end to_real;		

	-------------------------------------------------------------
	--  to_slv
	function to_slv (src : ufixed_t) return STD_LOGIC_VECTOR is
	subtype t is STD_LOGIC_VECTOR (src'high - src'low downto 0);
	variable slv : t;
	begin
	if src'length < 1 then
		return NSLV;
	end if;
	slv := t (src);
	return slv;

	end function to_slv;

	-------------------------------------------------------------
	--  to_slv
	function to_slv (src : sfixed_t) return STD_LOGIC_VECTOR is
	subtype t is STD_LOGIC_VECTOR (src'high - src'low downto 0);
	variable slv : t;
	begin
	if src'length < 1 then
		return NSLV;
	end if;
	slv := t (src);
	return slv;

	end function to_slv;

	-------------------------------------------------------------
	function to_string(src : ufixed_t) return string is
	variable str : string(src'length+1 downto 1) := (others => '0');
	variable i, j : integer := 0;

	begin
	j := src'length+1;
	for i in src'high downto 0 loop
		if (src(i) = '1') then
			str(j) := '1';
		end if;
		j := j - 1;
	end loop;

	str(j) := '.';
	j := j - 1;

	for i in -1 downto src'low loop
		if (src(i) = '1') then
			str(j) := '1';
		end if;
		j := j - 1;
	end loop;

	return str;

	end to_string;

	-------------------------------------------------------------
	function to_string(src : sfixed_t) return string is
	variable str : string(src'length+1 downto 1) := (others => '0');
	variable i, j, start : integer := 0;
	variable strlen : integer := 0;
	variable src_abs : sfixed_t(src'range) := (others => '0');

	begin
	if (src'high < 0) then
		assert false report "Illegal signed fix point number" severity error;
	end if;
	
	start := src'high;
	strlen := src'length;

	j := src'length+1;
	if (src(start) = '1') then
		str(j) := '-';
		j := j - 1;
		start := start - 1;
		strlen := strlen + 1;
	end if;

	src_abs := abs(src);

	for i in start downto 0 loop
		if (src_abs(i) = '1') then
			str(j) := '1';
		end if;
		j := j - 1;
	end loop;

	str(j) := '.';
	j := j - 1;

	for i in -1 downto src'low loop
		if (src_abs(i) = '1') then
			str(j) := '1';
		end if;
		j := j - 1;
	end loop;

	return str(strlen downto 1);

	end to_string;

	-------------------------------------------------------------
	function to_string(src : std_logic_vector) return string is
	variable str : string(src'length downto 1) := (others => '0');
	variable i : integer := 0;

	begin
	for i in src'range loop
		if (src(i) = '1') then
			str(i+1) := '1';
		end if;
	end loop;

	return str;

	end to_string;

	-------------------------------------------------------------
	-- Binary Operators
	-------------------------------------------------------------
	function "sla" (src : ufixed_t; count : integer) return ufixed_t is
	variable result : ufixed_t (src'high downto src'low) := (others => '0');
	
	begin 
	if (count = 0) then
		result := src;
	elsif (count < 0) then
		result := src sra -count;
	elsif (count < src'length) then
		result(src'high downto src'low) := src(src'high-count downto src'low) & (count-1 downto 0 => '0');
	end if;	
	return result;
	
	end "sla";

	-------------------------------------------------------------
	function "sla" (src : sfixed_t; count : integer) return sfixed_t is
	variable result : sfixed_t (src'high downto src'low) := (others => '0');
	variable sign : std_logic := '0';
	
	begin 
	sign := src(src'high);
	if (count = 0) then
		result := src;
	elsif (count < 0) then
		result := src sra -count;
	elsif (count < src'length-1) then
		result(src'high downto src'low) := sign & src(src'high-count-1 downto src'low) & (count-1 downto 0 => '0');
	end if;	
	return result;
	
	end "sla";

	-------------------------------------------------------------
	function "sra" (src : ufixed_t; count : integer) return ufixed_t is
	variable result : ufixed_t (src'high downto src'low) := (others => '0');

	begin 
	if (count = 0) then
		result := src;
	elsif (count < 0) then
		result := src sla -count;
	elsif (count < src'length) then
		result(src'high downto src'low) := (count-1 downto 0 => '0') & src(src'high downto src'low + count);
	end if;	
	return result;

	end "sra";
	
	-------------------------------------------------------------
	function "sra" (src : sfixed_t; count : integer) return sfixed_t is
	variable result : sfixed_t (src'high downto src'low) := (others => '0');
	variable res_slv, src_slv : signed (src'length-1 downto 0) := (others => '0');
	variable sign, do_sub : std_logic := '0';
	
	begin 
	src_slv := to_signed(src);
	sign := src(src'high);
	do_sub := src(src'high) and src(src'low);
	if (count = 0) then
		result := src;
	elsif (count < 0) then
		result := src sla -count;
	elsif (count < src'length-1) then
		res_slv := (count downto 0 => sign) & src_slv(src'length-2 downto count);
		if (do_sub = '1') then
			result(src'high downto src'low) := to_sfixed(res_slv+1, result);
		else
			result(src'high downto src'low) := to_sfixed(res_slv, result);
		end if;	
	end if;	
	return result;

	end "sra";
	
	-------------------------------------------------------------
	function "*" (a : ufixed_t; b : ufixed_t) return ufixed_t is
	variable result : ufixed_t (uproto(a,'*',b)'high downto uproto(a,'*',b)'low);

	begin 
	if (a'high < 0 and b'high >= 0) or (a'high >= 0 and b'high < 0)  then
		result := to_ufixed(to_unsigned(a) * to_unsigned(b), result) sla 1;
	else	
		result := to_ufixed(to_unsigned(a) * to_unsigned(b), result);
	end if;	
	return result;

	end "*";

	-------------------------------------------------------------
	function "*" (a : sfixed_t; b : sfixed_t) return sfixed_t is
	variable result : sfixed_t (sproto(a,'*',b)'high downto sproto(a,'*',b)'low);

	begin 
	if (a'high = 0 and b'high > 0) or (a'high > 0 and b'high = 0)  then
		result := to_sfixed(to_signed(a) * to_signed(b), result) sla 2;
	else
		result := to_sfixed(to_signed(a) * to_signed(b), result) sla 1;
 	end if;
	return result;

	end "*";

	-------------------------------------------------------------
	function "*" (a : ufixed_t; b : sfixed_t) return sfixed_t is

	begin 
	return to_sfixed(a) * b;

	end "*";

	-------------------------------------------------------------
	function "*" (a : sfixed_t; b : ufixed_t) return sfixed_t is

	begin 
	return b * a;

	end "*";

	-------------------------------------------------------------
	function "+" (a : ufixed_t; b : ufixed_t) return ufixed_t is
	variable result : ufixed_t (uproto(a,'+',b)'high downto uproto(a,'+',b)'low);

	begin 
	result := ufixed_t(to_unsigned(reshape(a, result)) + to_unsigned(reshape(b, result)));
	return result;

	end "+";

	-------------------------------------------------------------
	function "+" (a : sfixed_t; b : sfixed_t) return sfixed_t is
	variable result : sfixed_t (sproto(a,'+',b)'high downto sproto(a,'+',b)'low);

	begin 
	result := to_sfixed(to_signed(reshape(a,result)) + to_signed(reshape(b,result)), result);
--	result := to_sfixed(to_signed(a) + to_signed(b), result);
	return result;

	end "+";

	-------------------------------------------------------------
	function "+" (a : ufixed_t; b : sfixed_t) return sfixed_t is

	begin 
	return to_sfixed(a) + b;

	end "+";

	-------------------------------------------------------------
	function "+" (a : sfixed_t; b : ufixed_t) return sfixed_t is

	begin 
	return b + a;

	end "+";

	-------------------------------------------------------------
	function "+" (a : ufixed_t; b : unsigned) return ufixed_t is

	begin 
	
	return ufixed_t(to_unsigned(a) + b);

	end "+";

	-------------------------------------------------------------
	function "+" (a : sfixed_t; b : signed) return sfixed_t is

	begin 

	return sfixed_t(to_signed(a) + b);

	end "+";

	-------------------------------------------------------------
	function "+" (a : ufixed_t; b : integer) return ufixed_t is

	begin 
	
	return ufixed_t(to_unsigned(a) + to_unsigned(b, a'length));

	end "+";

	-------------------------------------------------------------
	function "+" (a : sfixed_t; b : integer) return sfixed_t is

	begin 

	return sfixed_t(to_signed(a) + to_signed(b, a'length));

	end "+";

	-------------------------------------------------------------
	function "+" (a : ufixed_t; b : std_logic) return ufixed_t is
	variable result : ufixed_t (a'high downto a'low);
	variable buns : unsigned(a'length-1 downto 0);

	begin 
	buns := (a'length-1 downto 1 => '0') & b;
	result := ufixed_t(to_unsigned(a) + buns);
	return result;

	end "+";

	-------------------------------------------------------------
	function "+" (a : sfixed_t; b : std_logic) return sfixed_t is
	variable result : sfixed_t (a'high downto a'low);
	variable bs : signed(a'length-1 downto 0);

	begin 
	bs := (a'length-1 downto 1 => '0') & b;
	result := sfixed_t(to_signed(a) + bs);
	return result;

	end "+";

	-------------------------------------------------------------
	function "-" (a : ufixed_t; b : ufixed_t) return ufixed_t is
	variable result : ufixed_t (uproto(a,'-',b)'high downto uproto(a,'-',b)'low);
	begin 
	result := to_ufixed(to_sfixed(a) - to_sfixed(b));
	return result;

	end "-";

	-------------------------------------------------------------
	function "-" (a : sfixed_t; b : sfixed_t) return sfixed_t is
	variable result : sfixed_t (sproto(a,'-',b)'high downto sproto(a,'-',b)'low);

	begin 
	result := to_sfixed(to_signed(reshape(a,result)) - to_signed(reshape(b,result)), result);
	return result;

	end "-";

	-------------------------------------------------------------
	function "-" (a : ufixed_t; b : sfixed_t) return sfixed_t is
	begin 
	return to_sfixed(a) - b;

	end "-";

	-------------------------------------------------------------
	function "-" (a : sfixed_t; b : ufixed_t) return sfixed_t is

	begin 
	return a - to_sfixed(b);

	end "-";

	-------------------------------------------------------------
	function "-" (a : ufixed_t; b : unsigned) return ufixed_t is

	begin 
	return ufixed_t(to_unsigned(a) - b);

	end "-";

	-------------------------------------------------------------
	function "-" (a : sfixed_t; b : signed) return sfixed_t is

	begin 
	return sfixed_t(to_signed(a) - b);

	end "-";

	-------------------------------------------------------------
	function "-" (a : ufixed_t; b : integer) return ufixed_t is

	begin 
	
	return ufixed_t(to_unsigned(a) - to_unsigned(b, a'length));

	end "-";

	-------------------------------------------------------------
	function "-" (a : sfixed_t; b : integer) return sfixed_t is

	begin 

	return sfixed_t(to_signed(a) - to_signed(b, a'length));

	end "-";

	-------------------------------------------------------------
	function "-" (a : ufixed_t; b : std_logic) return ufixed_t is
	variable result : ufixed_t (a'high downto a'low);
	variable buns : unsigned(a'length-1 downto 0);

	begin 
	buns := (a'length-1 downto 1 => '0') & b;
	result := ufixed_t(to_unsigned(a) - buns);
	return result;

	end "-";

	-------------------------------------------------------------
	function "-" (a : sfixed_t; b : std_logic) return sfixed_t is
	variable result : sfixed_t (a'high downto a'low);
	variable bs : signed(a'length-1 downto 0);

	begin 
	bs := (a'length-1 downto 1 => '0') & b;
	result := sfixed_t(to_signed(a) - bs);
	return result;

	end "-";

	-------------------------------------------------------------
	-- Unary Operators
	-------------------------------------------------------------
	function "abs" (src : sfixed_t) return sfixed_t is
	begin
	return to_sfixed(abs(to_signed(src)), src);

	end "abs";

	-------------------------------------------------------------
	function "-" (src : ufixed_t) return sfixed_t is
	begin
	return -to_sfixed(src);

	end "-";

	-------------------------------------------------------------
	function "-" (src : sfixed_t) return sfixed_t is
	begin
	return to_sfixed(-to_signed(src), src);

	end "-";

	-------------------------------------------------------------
	-- Binary Equality
	-------------------------------------------------------------
	function "=" (a : ufixed_t; b : ufixed_t) return boolean is
	variable ta, tb: ufixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_ufixed(a, ta);
	tb := to_ufixed(b, tb);
	return to_unsigned(ta) = to_unsigned(tb);

	end "=";
	
	-------------------------------------------------------------
	function "=" (a : sfixed_t; b : sfixed_t) return boolean is
	variable ta, tb: sfixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_sfixed(a, ta);
	tb := to_sfixed(b, tb);
	return to_signed(ta) = to_signed(tb);

	end "=";
	
	-------------------------------------------------------------
	function "=" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return to_sfixed(a) = b;
	end "=";
	
	-------------------------------------------------------------
	function "=" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return b = a;
	end "=";
	
	-------------------------------------------------------------
	-- Binary Inequality
	-------------------------------------------------------------
	function "/=" (a : ufixed_t; b : ufixed_t) return boolean is
	begin
	return not (a = b);

	end "/=";
	
	-------------------------------------------------------------
	function "/=" (a : sfixed_t; b : sfixed_t) return boolean is
	begin
	return not (a = b);

	end "/=";
	
	-------------------------------------------------------------
	function "/=" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return not (a = b);
	end "/=";
	
	-------------------------------------------------------------
	function "/=" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return not (a = b);
	end "/=";
	
	-------------------------------------------------------------
	-- Binary less than
	-------------------------------------------------------------
	function "<" (a : ufixed_t; b : ufixed_t) return boolean is
	variable ta, tb: ufixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_ufixed(a, ta);
	tb := to_ufixed(b, tb);
	return to_unsigned(ta) < to_unsigned(tb);
	
	end "<";
	
	-------------------------------------------------------------
	function "<" (a : sfixed_t; b : sfixed_t) return boolean is
	variable ta, tb: sfixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_sfixed(a, ta);
	tb := to_sfixed(b, tb);
	return to_signed(ta) < to_signed(tb);
	
	end "<";

	-------------------------------------------------------------
	function "<" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return to_sfixed(a) < b;
	
	end "<";

	-------------------------------------------------------------
	function "<" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return a < to_sfixed(b);
	
	end "<";
	
	-------------------------------------------------------------
	-- Binary greater than
	-------------------------------------------------------------
	function ">" (a : ufixed_t; b : ufixed_t) return boolean is
	variable ta, tb: ufixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_ufixed(a, ta);
	tb := to_ufixed(b, tb);
	return to_unsigned(ta) > to_unsigned(tb);
	
	end ">";

	-------------------------------------------------------------
	function ">" (a : sfixed_t; b : sfixed_t) return boolean is
	variable ta, tb: sfixed_t(max(a'high, b'high) downto min(a'low, b'low));
	begin
	ta := (others => '0');
	tb := (others => '0');
	ta := to_sfixed(a, ta);
	tb := to_sfixed(b, tb);
	return to_signed(ta) > to_signed(tb);
	
	end ">";

	-------------------------------------------------------------
	function ">" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return to_sfixed(a) > b;
	end ">";
	
	-------------------------------------------------------------
	function ">" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return a > to_sfixed(b);
	end ">";
	
	-------------------------------------------------------------
	-- Binary less equal than
	-------------------------------------------------------------
	function "<=" (a : ufixed_t; b : ufixed_t) return boolean is
	begin
	return not (a > b);
	end "<=";
	
	function "<=" (a : sfixed_t; b : sfixed_t) return boolean is
	begin
	return not (a > b);
	end "<=";

	function "<=" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return not (a > b);
	end "<=";

	function "<=" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return not (a > b);
	end "<=";
	
	-------------------------------------------------------------
	-- Binary greater or equal than
	-------------------------------------------------------------
	function ">=" (a : ufixed_t; b : ufixed_t) return boolean is
	begin
	return not (a < b);
	end ">=";

	function ">=" (a : sfixed_t; b : sfixed_t) return boolean is
	begin
	return not (a < b);
	end ">=";

	function ">=" (a : ufixed_t; b : sfixed_t) return boolean is
	begin
	return not (a < b);
	end ">=";

	function ">=" (a : sfixed_t; b : ufixed_t) return boolean is
	begin
	return not (a < b);
	end ">=";

	-------------------------------------------------------------
	-- Misc. Operators
	-------------------------------------------------------------
	function ipart (src : ufixed_t) return ufixed_t is
	begin
		return src(src'high downto 0);
	end ipart;
	
	function fpart (src : ufixed_t) return ufixed_t is
	begin
		return src(-1 downto src'low);
	end fpart;
	
	function ipart (src : sfixed_t) return sfixed_t is
	begin
		return src(src'high-1 downto 0);
	end ipart;
	
	function fpart (src : sfixed_t) return sfixed_t is
	begin
		return src(-1 downto src'low);
	end fpart;

	-------------------------------------------------------------
	-- Print functions
	-------------------------------------------------------------
	procedure print_info(src : in ufixed_t; prefix : in string) is
	variable L : line;

	begin
	write (L, prefix & "'length     = ");write (L, src'length);
	writeline (output, L);

	write (L, prefix & "'high(left) = ");
	write (L, src'high);
	write (L, '(');
	write (L, src'left);
	write (L, ')');
	writeline (output, L);

	write (L, prefix & "'low(right) = ");
	write (L, src'low);
	write (L, '(');
	write (L, src'right);
	write (L, ')');
	writeline (output, L);

	write (L, prefix & "'value      = B");write (L, to_string(src));
	writeline (output, L);

	write (L, prefix & "'value      = ");write (L, to_real(src));
	writeline (output, L);

	--      write (L, prefix & "'cmsb       = ");write (L, cmsb(src));
	--      writeline (output, L);

	--      write (L, prefix & "'clsb       = ");write (L, clsb(src));
	--      writeline (output, L);

	writeline (output, L);

	end print_info;

	-------------------------------------------------------------
	procedure print_info(src : in sfixed_t; prefix : in string) is
	variable L : line;

	begin
	write (L, prefix & "'length     = ");write (L, src'length);
	writeline (output, L);

	write (L, prefix & "'high(left) = ");
	write (L, src'high);
	write (L, '(');
	write (L, src'left);
	write (L, ')');
	writeline (output, L);

	write (L, prefix & "'low(right) = ");
	write (L, src'low);
	write (L, '(');
	write (L, src'right);
	write (L, ')');
	writeline (output, L);

	write (L, prefix & "'value      = B");write (L, to_string(src));
	writeline (output, L);

	write (L, prefix & "'value      = ");write (L, to_real(src));
	writeline (output, L);

	--      write (L, prefix & "'cmsb       = ");write (L, cmsb(src));
	--      writeline (output, L);

	--      write (L, prefix & "'clsb       = ");write (L, clsb(src));
	--      writeline (output, L);

	writeline (output, L);

	end print_info;

	-------------------------------------------------------------
	procedure print_info(src : in string; prefix : in string) is
	variable L : line;

	begin
	write (L, prefix & "'length     = ");write (L, src'length);
	writeline (output, L);

	write (L, prefix & "'high(left) = ");
	write (L, src'high);
	write (L, '(');
	write (L, src'left);
	write (L, ')');
	writeline (output, L);

	write (L, prefix & "'low(right) = ");
	write (L, src'low);
	write (L, '(');
	write (L, src'right);
	write (L, ')');
	writeline (output, L);

	writeline (output, L);

	end print_info;

	-------------------------------------------------------------
	-- Helpers
	-------------------------------------------------------------
	-- Count significant bits for integer part    
	function cmsb(src : ufixed_t) return integer is
	variable j, i : integer := src'high;
	begin
	for i in src'range loop
		if src(i) = '1' then
			exit;
		end if;
		j := j - 1;
	end loop;

	-- LRM nachlesen: hier is i=src'high re-initialisert

	return j;

	end cmsb;

	-------------------------------------------------------------
	-- Count significant bits for fractional part    
	function clsb(src : ufixed_t) return integer is
	variable j, i : integer := src'low;
	begin
	for i in src'reverse_range loop
		if src(i) = '1' then
			exit;
		end if;
		j := j + 1;
	end loop;

	-- LRM nachlesen: hier is i=src'low re-initialisert

	return j;

	end clsb;

	-------------------------------------------------------------
	function MIN (X, Y: INTEGER) return INTEGER is
	variable res : integer := X;
	begin
	if Y < X then
		res := Y;
	end if;

	return res;

	end MIN;

	-------------------------------------------------------------
	function MAX (X, Y: INTEGER) return INTEGER is
	variable res : integer := X;
	begin
	if Y > X then
		res := Y;
	end if;

	return res;
	
	end MAX;

	-------------------------------------------------------------
	function "MOD" (X, Y: in REAL ) return REAL is
	-- Description:
	--        See function declaration in IEEE Std 1076.2-1996
	-- Notes:
	--        a) Returns 0.0 on error

	variable XNEGATIVE : BOOLEAN := X < 0.0;
	variable YNEGATIVE : BOOLEAN := Y < 0.0;
	variable VALUE : REAL;
	begin
	-- Check validity of input arguments
	if (Y = 0.0) then
		 assert FALSE
				report "MOD(X, 0.0) is undefined"
				severity ERROR;
		 return 0.0;
	end if;

	-- Compute value
	if ( XNEGATIVE ) then
			if ( YNEGATIVE ) then
					VALUE := X + (FLOOR(ABS(X)/ABS(Y)))*ABS(Y);
			else
					VALUE := X + (CEIL(ABS(X)/ABS(Y)))*ABS(Y);
			end if;
	else
			if ( YNEGATIVE ) then
					VALUE := X - (CEIL(ABS(X)/ABS(Y)))*ABS(Y);
			else
					VALUE := X - (FLOOR(ABS(X)/ABS(Y)))*ABS(Y);
			end if;
	end if;

	return VALUE;

	end "MOD";

	-------------------------------------------------------------
	-- misc. conversion
	function ipart(src : real) return real is
	begin
	return floor(src);

	end ipart;

	-------------------------------------------------------------
	function fpart(src : real) return real is
	begin
	return src - floor(src);

	end fpart;

	-------------------------------------------------------------
	function or_red (arg : STD_LOGIC_VECTOR)
	return STD_LOGIC is
	variable Upper, Lower : STD_LOGIC;
	variable Half         : INTEGER;
	variable BUS_int      : STD_LOGIC_VECTOR (arg'length - 1 downto 0);
	variable Result       : STD_LOGIC;
	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_red (BUS_int (BUS_int'left downto Half));
			Lower  := or_red (BUS_int (Half - 1 downto BUS_int'right));
			Result := Upper or Lower;
		end if;
	end if;
	return Result;

	end function or_red;

	-------------------------------------------------------------
	function and_red (arg : STD_LOGIC_VECTOR)
	return STD_LOGIC is
	variable Upper, Lower : STD_LOGIC;
	variable Half         : INTEGER;
	variable BUS_int      : STD_LOGIC_VECTOR (arg'length - 1 downto 0);
	variable Result       : STD_LOGIC;
	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_red (BUS_int (BUS_int'left downto Half));
			Lower  := and_red (BUS_int (Half - 1 downto BUS_int'right));
			Result := Upper and Lower;
		end if;
	end if;
	return Result;

	end function and_red;

	-------------------------------------------------------------
	function xor_red (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is
	variable Upper, Lower : STD_ULOGIC;
	variable Half         : INTEGER;
	variable BUS_int      : STD_LOGIC_VECTOR (arg'length - 1 downto 0);
	variable Result       : STD_ULOGIC := '0';  -- In the case of a NULL range
	begin
	if (arg'length >= 1) then
		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) xor BUS_int(BUS_int'left);
		else
			Half   := (BUS_int'length + 1) / 2 + BUS_int'right;
			Upper  := xor_red (BUS_int (BUS_int'left downto Half));
			Lower  := xor_red (BUS_int (Half - 1 downto BUS_int'right));
			Result := Upper xor Lower;
		end if;
	end if;
	return Result;

	end function xor_red;

	-------------------------------------------------------------
	-- Reduction operators, same as numeric_std functions
	function and_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return and_red (to_slv(arg));
	end function and_red;

	function nand_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return not and_red (to_slv(arg));
	end function nand_red;

	function or_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return or_red (to_slv(arg));
	end function or_red;

	function nor_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return not or_red (to_slv(arg));
	end function nor_red;

	function xor_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return xor_red (to_slv(arg));
	end function xor_red;

	function xnor_red(arg : ufixed_t) return STD_ULOGIC is
	begin
		return not xor_red (to_slv(arg));
	end function xnor_red;

	function and_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return and_red (to_slv(arg));
	end function and_red;

	function nand_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return not and_red (to_slv(arg));
	end function nand_red;

	function or_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return or_red (to_slv(arg));
	end function or_red;

	function nor_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return not or_red (to_slv(arg));
	end function nor_red;

	function xor_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return xor_red (to_slv(arg));
	end function xor_red;

	function xnor_red(arg : sfixed_t) return STD_ULOGIC is
	begin
		return not xor_red (to_slv(arg));
	end function xnor_red;

	-------------------------------------------------------------

end; -- package body fixed_ja;