diff --git a/Common/sim/compile_fixed.do b/Common/sim/compile_fixed.do deleted file mode 100644 index 0c17180..0000000 --- a/Common/sim/compile_fixed.do +++ /dev/null @@ -1,13 +0,0 @@ -# -# Compile script for Modeltech -# -vlib ieee_proposed -vmap ieee_proposedx ieee_proposed -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/standard_additions_c.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/env_c.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/standard_textio_additions_c.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/std_logic_1164_additions.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/numeric_std_additions.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/numeric_std_unsigned_c.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/math_utility_pkg_c.vhdl" -vcom -work ieee_proposed -93 "../../lib/fixed/modelsim/fixed_pkg_c.vhdl" diff --git a/Common/sim/compile_ieee_proposed.do b/Common/sim/compile_ieee_proposed.do index ad6a440..a45fca1 100644 --- a/Common/sim/compile_ieee_proposed.do +++ b/Common/sim/compile_ieee_proposed.do @@ -17,6 +17,6 @@ vcom -work ieee_proposed ../../ieee_proposed/modelsim/env_c.vhdl vcom -work ieee_proposed ../../ieee_proposed/modelsim/std_logic_1164_additions.vhdl vcom -work ieee_proposed ../../ieee_proposed/modelsim/numeric_std_additions.vhdl vcom -work ieee_proposed ../../ieee_proposed/modelsim/numeric_std_unsigned_c.vhdl -vcom -work ieee_proposed ../../ieee_proposed/modelsim/math_utility_pkg_c.vhdl +vcom -work ieee_proposed ../../ieee_proposed/modelsim/fixed_float_types_c.vhdl vcom -work ieee_proposed ../../ieee_proposed/modelsim/fixed_pkg_c.vhdl vcom -work ieee_proposed ../../ieee_proposed/modelsim/float_pkg_c.vhdl diff --git a/Common/sim/ieee_proposed/modelsim/README b/Common/sim/ieee_proposed/modelsim/README index dca4f6b..27a4080 100644 --- a/Common/sim/ieee_proposed/modelsim/README +++ b/Common/sim/ieee_proposed/modelsim/README @@ -72,7 +72,7 @@ C) std_logic_1164_additions - Additions to the package "ieee.std_logic_1164" 1) Short had aliases: a) to_bv - calls "to_BitVector" b) to_slv - calls "to_StdLogicVector" - c) to_suv - calls "to_stdULogicVector" + c) to_sulv - calls "to_stdULogicVector" 2) Long hand aliases: a) to_bit_vector - calls "to_BitVector" b) to_std_logic_vector - calls "to_StdLogicVector" @@ -157,7 +157,7 @@ F) For fixed point package: use model: use ieee.std_logic_1164.all; use ieee.numeric_std.all; -use ieee_proposed.math_utility_pkg.all; +use ieee_proposed.fixed_float_types.all; use ieee_proposed.fixed_pkg.all; See fixed point package documentation http://www.vhdl.org/vhdl-200x/vhdl-200x-ft/packages/Fixed_ug.pdf @@ -166,7 +166,7 @@ G) For floating point package: use model: use ieee.std_logic_1164.all; use ieee.numeric_std.all; -use ieee_proposed.math_utility_pkg.all; +use ieee_proposed.fixed_float_types.all; use ieee_proposed.fixed_pkg.all; use ieee_proposed.float_pkg.all; See floating point package documentation diff --git a/Common/sim/ieee_proposed/modelsim/compile.mti b/Common/sim/ieee_proposed/modelsim/compile.mti index f54b417..f5aa772 100644 --- a/Common/sim/ieee_proposed/modelsim/compile.mti +++ b/Common/sim/ieee_proposed/modelsim/compile.mti @@ -2,13 +2,13 @@ # Compile script for Modeltech # vlib ieee_proposed.lib -vmap ieee_proposedx ieee_proposed.lib +vmap ieee_proposed ieee_proposed.lib vcom -work ieee_proposed standard_additions_c.vhdl vcom -work ieee_proposed standard_textio_additions_c.vhdl vcom -work ieee_proposed env_c.vhdl vcom -work ieee_proposed std_logic_1164_additions.vhdl vcom -work ieee_proposed numeric_std_additions.vhdl vcom -work ieee_proposed numeric_std_unsigned_c.vhdl -vcom -work ieee_proposed math_utility_pkg_c.vhdl +vcom -work ieee_proposed fixed_float_types_c.vhdl vcom -work ieee_proposed fixed_pkg_c.vhdl vcom -work ieee_proposed float_pkg_c.vhdl diff --git a/Common/sim/ieee_proposed/modelsim/fixed_pkg_c.vhdl b/Common/sim/ieee_proposed/modelsim/fixed_pkg_c.vhdl index f349ca1..f9ca7a2 100644 --- a/Common/sim/ieee_proposed/modelsim/fixed_pkg_c.vhdl +++ b/Common/sim/ieee_proposed/modelsim/fixed_pkg_c.vhdl @@ -4,15 +4,15 @@ -- This package should be compiled into "ieee_proposed" and used as follows: -- use ieee.std_logic_1164.all; -- use ieee.numeric_std.all; --- use ieee_proposed.math_utility_pkg.all; +-- use ieee_proposed.fixed_float_types.all; -- use ieee_proposed.fixed_pkg.all; -- -- This verison is designed to work with the VHDL-93 compilers -- synthesis tools. Please note the "%%%" comments. These are where we -- diverge from the VHDL-200X LRM. -- -------------------------------------------------------------------- --- Version : $Revision: 1.15 $ --- Date : $Date: 2007-04-04 13:59:52-04 $ +-- Version : $Revision: 1.22 $ +-- Date : $Date: 2010/09/22 18:34:14 $ -- -------------------------------------------------------------------- use STD.TEXTIO.all; @@ -20,19 +20,19 @@ library IEEE; use IEEE.STD_LOGIC_1164.all; use IEEE.NUMERIC_STD.all; library IEEE_PROPOSED; -use IEEE_PROPOSED.math_utility_pkg.all; +use IEEE_PROPOSED.fixed_float_types.all; package fixed_pkg is -- generic ( - -- Rounding routine to use in fixed point, fixed_round or fixed_truncate - constant fixed_round_style : fixed_round_style_type := fixed_truncate; - -- Overflow routine to use in fixed point, fixed_saturate or fixed_wrap - constant fixed_overflow_style : fixed_overflow_style_type := fixed_wrap; - -- Extra bits used in divide routines - constant fixed_guard_bits : NATURAL := 3; - -- If TRUE, then turn off warnings on "X" propagation - constant no_warning : BOOLEAN := (false - ); + -- Rounding routine to use in fixed point, fixed_round or fixed_truncate + constant fixed_round_style : fixed_round_style_type := fixed_round; + -- Overflow routine to use in fixed point, fixed_saturate or fixed_wrap + constant fixed_overflow_style : fixed_overflow_style_type := fixed_saturate; + -- Extra bits used in divide routines + constant fixed_guard_bits : NATURAL := 3; + -- If TRUE, then turn off warnings on "X" propagation + constant no_warning : BOOLEAN := (false + ); -- Author David Bishop (dbishop@vhdl.org) @@ -705,7 +705,7 @@ package fixed_pkg is constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_ufixed; - -- "size_res" functions create the size of the output from the length + -- "size_res" functions create the size of the output from the indices -- of the "size_res" input. The actual value of "size_res" is not used. function resize ( arg : UNRESOLVED_ufixed; -- input @@ -740,8 +740,8 @@ package fixed_pkg is -- ufixed (7 downto -3) <= to_ufixed (int, 7, -3); function to_ufixed ( arg : NATURAL; -- integer - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_ufixed; @@ -756,8 +756,8 @@ package fixed_pkg is -- real to unsigned fixed point function to_ufixed ( arg : REAL; -- real - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER; -- right index 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) @@ -774,8 +774,8 @@ package fixed_pkg is -- unsigned to unsigned fixed point function to_ufixed ( arg : UNSIGNED; -- unsigned - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_ufixed; @@ -792,11 +792,6 @@ package fixed_pkg is arg : UNSIGNED) -- unsigned return UNRESOLVED_ufixed; - -- Conversion from sfixed to ufixed (performs an "abs" function) - function to_ufixed ( - arg : UNRESOLVED_sfixed) - return UNRESOLVED_ufixed; - -- unsigned fixed point to unsigned function to_unsigned ( arg : UNRESOLVED_ufixed; -- fixed point input @@ -828,8 +823,8 @@ package fixed_pkg is -- Integer to UNRESOLVED_sfixed function to_sfixed ( arg : INTEGER; -- integer - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_sfixed; @@ -844,8 +839,8 @@ package fixed_pkg is -- Real to sfixed function to_sfixed ( arg : REAL; -- real - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER; -- right index 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) @@ -862,8 +857,8 @@ package fixed_pkg is -- signed to sfixed function to_sfixed ( arg : SIGNED; -- signed - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_sfixed; @@ -1034,20 +1029,20 @@ package fixed_pkg is alias to_Std_Logic_Vector is to_slv [UNRESOLVED_sfixed return STD_LOGIC_VECTOR]; - function to_suv ( + function to_sulv ( arg : UNRESOLVED_ufixed) -- fixed point vector return STD_ULOGIC_VECTOR; - alias to_StdULogicVector is to_suv [UNRESOLVED_ufixed + alias to_StdULogicVector is to_sulv [UNRESOLVED_ufixed return STD_ULOGIC_VECTOR]; - alias to_Std_ULogic_Vector is to_suv [UNRESOLVED_ufixed + alias to_Std_ULogic_Vector is to_sulv [UNRESOLVED_ufixed return STD_ULOGIC_VECTOR]; - function to_suv ( + function to_sulv ( arg : UNRESOLVED_sfixed) -- fixed point vector return STD_ULOGIC_VECTOR; - alias to_StdULogicVector is to_suv [UNRESOLVED_sfixed + alias to_StdULogicVector is to_sulv [UNRESOLVED_sfixed return STD_ULOGIC_VECTOR]; - alias to_Std_ULogic_Vector is to_suv [UNRESOLVED_sfixed + alias to_Std_ULogic_Vector is to_sulv [UNRESOLVED_sfixed return STD_ULOGIC_VECTOR]; function to_ufixed ( @@ -1460,8 +1455,8 @@ end package fixed_pkg; -- Proposed package body for the VHDL-200x-FT fixed_pkg package -- (Fixed point math package) -- This package body supplies a recommended implementation of these functions --- Version : $Revision: 1.15 $ --- Date : $Date: 2007-04-04 13:59:52-04 $ +-- Version : $Revision: 1.22 $ +-- Date : $Date: 2010/09/22 18:34:14 $ -- -- Created for VHDL-200X-ft, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------- @@ -1595,7 +1590,7 @@ package body fixed_pkg is begin return not xor_reduce (arg); end function xnor_reduce; - -- Match table, copied form new std_logic_1164 + -- Match table, copied form new std_logic_1164 type stdlogic_table is array(STD_ULOGIC, STD_ULOGIC) of STD_ULOGIC; constant match_logic_table : stdlogic_table := ( ----------------------------------------------------- @@ -1611,21 +1606,6 @@ package body fixed_pkg is ('U', 'X', '0', '1', 'X', 'X', '0', '1', '1'), -- | H | ('1', '1', '1', '1', '1', '1', '1', '1', '1') -- | - | ); - - constant no_match_logic_table : stdlogic_table := ( - ----------------------------------------------------- - -- U X 0 1 Z W L H - | | - ----------------------------------------------------- - ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '0'), -- | U | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | X | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | 0 | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | 1 | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | Z | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | W | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | L | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | H | - ('0', '0', '0', '0', '0', '0', '0', '0', '0') -- | - | - ); ------------------------------------------------------------------- -- ?= functions, Similar to "std_match", but returns "std_ulogic". @@ -1636,7 +1616,7 @@ package body fixed_pkg is end function \?=\; function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC is begin - return no_match_logic_table (l, r); + return not match_logic_table (l, r); end function \?/=\; -- "?=" operator is similar to "std_match", but returns a std_ulogic.. -- Id: M.2B @@ -1730,7 +1710,7 @@ package body fixed_pkg is for i in LX'low to LX'high loop result1 := \?/=\ (LX(i), RX(i)); if result1 = 'U' then - return 'U'; + result := 'U'; elsif result1 = 'X' or result = 'X' then result := 'X'; else @@ -2185,8 +2165,8 @@ package body fixed_pkg is if (remainder'length > 1) then if (remainder (remainder'high) = '1') then rounds := (arg(arg'low) = '1') - or (or_reduce (to_suv(remainder(remainder'high-1 downto - remainder'low))) = '1'); + or (or_reduce (to_sulv(remainder(remainder'high-1 downto + remainder'low))) = '1'); end if; else rounds := (arg(arg'low) = '1') and (remainder (remainder'high) = '1'); @@ -2217,8 +2197,8 @@ package body fixed_pkg is if (remainder'length > 1) then if (remainder (remainder'high) = '1') then rounds := (arg(arg'low) = '1') - or (or_reduce (to_suv(remainder(remainder'high-1 downto - remainder'low))) = '1'); + or (or_reduce (to_sulv(remainder(remainder'high-1 downto + remainder'low))) = '1'); end if; else rounds := (arg(arg'low) = '1') and (remainder (remainder'high) = '1'); @@ -2243,13 +2223,32 @@ package body fixed_pkg is 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_suv ( + function to_sulv ( arg : UNRESOLVED_ufixed) -- fixed point vector return STD_ULOGIC_VECTOR is variable result : STD_ULOGIC_VECTOR (arg'length-1 downto 0); @@ -2259,9 +2258,9 @@ package body fixed_pkg is end if; result := STD_ULOGIC_VECTOR (arg); return result; - end function to_suv; + end function to_sulv; - function to_suv ( + function to_sulv ( arg : UNRESOLVED_sfixed) -- fixed point vector return STD_ULOGIC_VECTOR is variable result : STD_ULOGIC_VECTOR (arg'length-1 downto 0); @@ -2271,20 +2270,20 @@ package body fixed_pkg is end if; result := STD_ULOGIC_VECTOR (arg); return result; - end function to_suv; + end function to_sulv; function to_slv ( arg : UNRESOLVED_ufixed) -- fixed point vector return STD_LOGIC_VECTOR is begin - return to_stdlogicvector(to_suv(arg)); + return to_stdlogicvector(to_sulv(arg)); end function to_slv; function to_slv ( arg : UNRESOLVED_sfixed) -- fixed point vector return STD_LOGIC_VECTOR is begin - return to_stdlogicvector(to_suv(arg)); + return to_stdlogicvector(to_sulv(arg)); end function to_slv; function to_ufixed ( @@ -2383,9 +2382,9 @@ package body fixed_pkg is variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index); variable result : UNRESOLVED_ufixed (left_index downto right_index); variable lslv, rslv : UNSIGNED (left_index-right_index - downto 0); + downto 0); variable result_slv : UNSIGNED (left_index-right_index - downto 0); + downto 0); begin if (l'length < 1 or r'length < 1 or result'length < 1) then return NAUF; @@ -2430,9 +2429,9 @@ package body fixed_pkg is variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index); variable result : UNRESOLVED_ufixed (left_index downto right_index); variable lslv, rslv : UNSIGNED (left_index-right_index - downto 0); + downto 0); variable result_slv : UNSIGNED (left_index-right_index - downto 0); + downto 0); begin if (l'length < 1 or r'length < 1 or result'length < 1) then return NAUF; @@ -2849,9 +2848,9 @@ package body fixed_pkg is constant right_index : INTEGER := mins(l'low, r'low); variable lresize, rresize : UNRESOLVED_ufixed (left_index downto right_index); variable lslv, rslv : UNSIGNED (left_index-right_index - downto 0); + downto 0); variable result_slv : UNSIGNED (left_index-right_index - downto 0); + downto 0); variable cx : UNSIGNED (0 downto 0); -- Carry in begin if (l'length < 1 or r'length < 1) then @@ -2879,9 +2878,9 @@ package body fixed_pkg is constant right_index : INTEGER := mins(l'low, r'low); variable lresize, rresize : UNRESOLVED_sfixed (left_index downto right_index); variable lslv, rslv : SIGNED (left_index-right_index - downto 0); + downto 0); variable result_slv : SIGNED (left_index-right_index - downto 0); + downto 0); variable cx : SIGNED (1 downto 0); -- Carry in begin if (l'length < 1 or r'length < 1) then @@ -3181,7 +3180,7 @@ package body fixed_pkg is function "not" (L : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin - RESULT := not to_suv(L); + RESULT := not to_sulv(L); return to_ufixed(RESULT, L'high, L'low); end function "not"; @@ -3189,7 +3188,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) and to_suv(R); + RESULT := to_sulv(L) and to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3204,7 +3203,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) or to_suv(R); + RESULT := to_sulv(L) or to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3219,7 +3218,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) nand to_suv(R); + RESULT := to_sulv(L) nand to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3234,7 +3233,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) nor to_suv(R); + RESULT := to_sulv(L) nor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3249,7 +3248,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) xor to_suv(R); + RESULT := to_sulv(L) xor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3264,7 +3263,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) xnor to_suv(R); + RESULT := to_sulv(L) xnor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3278,7 +3277,7 @@ package body fixed_pkg is function "not" (L : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin - RESULT := not to_suv(L); + RESULT := not to_sulv(L); return to_sfixed(RESULT, L'high, L'low); end function "not"; @@ -3286,7 +3285,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) and to_suv(R); + RESULT := to_sulv(L) and to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3301,7 +3300,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) or to_suv(R); + RESULT := to_sulv(L) or to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3316,7 +3315,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) nand to_suv(R); + RESULT := to_sulv(L) nand to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3331,7 +3330,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) nor to_suv(R); + RESULT := to_sulv(L) nor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3346,7 +3345,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) xor to_suv(R); + RESULT := to_sulv(L) xor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3361,7 +3360,7 @@ package body fixed_pkg is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin if (L'high = R'high and L'low = R'low) then - RESULT := to_suv(L) xnor to_suv(R); + RESULT := to_sulv(L) xnor to_sulv(R); else assert NO_WARNING report fixed_pkg'instance_name @@ -3616,62 +3615,62 @@ package body fixed_pkg is -- Reduction operator_reduces function and_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return and_reduce (to_suv(l)); + return and_reduce (to_sulv(l)); end function and_reduce; function nand_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return nand_reduce (to_suv(l)); + return nand_reduce (to_sulv(l)); end function nand_reduce; function or_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return or_reduce (to_suv(l)); + return or_reduce (to_sulv(l)); end function or_reduce; function nor_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return nor_reduce (to_suv(l)); + return nor_reduce (to_sulv(l)); end function nor_reduce; function xor_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return xor_reduce (to_suv(l)); + return xor_reduce (to_sulv(l)); end function xor_reduce; function xnor_reduce (l : UNRESOLVED_ufixed) return STD_ULOGIC is begin - return xnor_reduce (to_suv(l)); + return xnor_reduce (to_sulv(l)); end function xnor_reduce; function and_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return and_reduce (to_suv(l)); + return and_reduce (to_sulv(l)); end function and_reduce; function nand_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return nand_reduce (to_suv(l)); + return nand_reduce (to_sulv(l)); end function nand_reduce; function or_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return or_reduce (to_suv(l)); + return or_reduce (to_sulv(l)); end function or_reduce; function nor_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return nor_reduce (to_suv(l)); + return nor_reduce (to_sulv(l)); end function nor_reduce; function xor_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return xor_reduce (to_suv(l)); + return xor_reduce (to_sulv(l)); end function xor_reduce; function xnor_reduce (l : UNRESOLVED_sfixed) return STD_ULOGIC is begin - return xnor_reduce (to_suv(l)); + return xnor_reduce (to_sulv(l)); end function xnor_reduce; -- End reduction operator_reduces @@ -3931,7 +3930,7 @@ package body fixed_pkg is function std_match (L, R : UNRESOLVED_ufixed) return BOOLEAN is begin if (L'high = R'high and L'low = R'low) then - return std_match(to_suv(L), to_suv(R)); + return std_match(to_sulv(L), to_sulv(R)); else assert NO_WARNING report fixed_pkg'instance_name @@ -3944,7 +3943,7 @@ package body fixed_pkg is function std_match (L, R : UNRESOLVED_sfixed) return BOOLEAN is begin if (L'high = R'high and L'low = R'low) then - return std_match(to_suv(L), to_suv(R)); + return std_match(to_sulv(L), to_sulv(R)); else assert NO_WARNING report fixed_pkg'instance_name @@ -4354,8 +4353,8 @@ package body fixed_pkg is function to_ufixed ( arg : NATURAL; -- integer - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_ufixed is @@ -4400,8 +4399,8 @@ package body fixed_pkg is function to_sfixed ( arg : INTEGER; -- integer - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_sfixed is @@ -4458,8 +4457,8 @@ package body fixed_pkg is function to_ufixed ( arg : REAL; -- real - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER; -- right index 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) -- # of guard bits @@ -4516,8 +4515,8 @@ package body fixed_pkg is function to_sfixed ( arg : REAL; -- real - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER; -- right index 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) -- # of guard bits @@ -4574,8 +4573,8 @@ package body fixed_pkg is function to_ufixed ( arg : UNSIGNED; -- unsigned - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_ufixed is @@ -4607,28 +4606,10 @@ package body fixed_pkg is return UNRESOLVED_ufixed(xarg); end function to_ufixed; - -- 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; - function to_sfixed ( arg : SIGNED; -- signed - constant left_index : INTEGER; -- size of integer portion - constant right_index : INTEGER := 0; -- size of fraction + constant left_index : INTEGER; -- left index (high index) + constant right_index : INTEGER := 0; -- right index constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; constant round_style : fixed_round_style_type := fixed_round_style) return UNRESOLVED_sfixed is @@ -5156,7 +5137,7 @@ package body fixed_pkg is return BOOLEAN is variable argslv : STD_ULOGIC_VECTOR (arg'length-1 downto 0); -- slv begin - argslv := to_suv(arg); + argslv := to_sulv(arg); return Is_X (argslv); end function Is_X; @@ -5165,7 +5146,7 @@ package body fixed_pkg is return BOOLEAN is variable argslv : STD_ULOGIC_VECTOR (arg'length-1 downto 0); -- slv begin - argslv := to_suv(arg); + argslv := to_sulv(arg); return Is_X (argslv); end function Is_X; @@ -5173,42 +5154,42 @@ package body fixed_pkg is arg : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is begin - return to_ufixed (To_X01(to_suv(arg)), arg'high, arg'low); + return to_ufixed (To_X01(to_sulv(arg)), arg'high, arg'low); end function To_X01; function to_X01 ( arg : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is begin - return to_sfixed (To_X01(to_suv(arg)), arg'high, arg'low); + return to_sfixed (To_X01(to_sulv(arg)), arg'high, arg'low); end function To_X01; function To_X01Z ( arg : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is begin - return to_ufixed (To_X01Z(to_suv(arg)), arg'high, arg'low); + return to_ufixed (To_X01Z(to_sulv(arg)), arg'high, arg'low); end function To_X01Z; function to_X01Z ( arg : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is begin - return to_sfixed (To_X01Z(to_suv(arg)), arg'high, arg'low); + return to_sfixed (To_X01Z(to_sulv(arg)), arg'high, arg'low); end function To_X01Z; function To_UX01 ( arg : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is begin - return to_ufixed (To_UX01(to_suv(arg)), arg'high, arg'low); + return to_ufixed (To_UX01(to_sulv(arg)), arg'high, arg'low); end function To_UX01; function to_UX01 ( arg : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is begin - return to_sfixed (To_UX01(to_suv(arg)), arg'high, arg'low); + return to_sfixed (To_UX01(to_sulv(arg)), arg'high, arg'low); end function To_UX01; function resize ( @@ -5236,13 +5217,13 @@ package body fixed_pkg is (right_index = arghigh+1); elsif (left_index < arglow) then -- return overflow if (overflow_style = fixed_saturate) and - (or_reduce(to_suv(invec)) = '1') then + (or_reduce(to_sulv(invec)) = '1') then result := saturate (result'high, result'low); -- saturate end if; elsif (arghigh > left_index) then -- wrap or saturate? if (overflow_style = fixed_saturate and - or_reduce (to_suv(invec(arghigh downto left_index+1))) = '1') + or_reduce (to_sulv(invec(arghigh downto left_index+1))) = '1') then result := saturate (result'high, result'low); -- saturate else @@ -5304,7 +5285,7 @@ package body fixed_pkg is (right_index = arghigh+1); elsif (left_index < arglow) then -- return overflow if (overflow_style = fixed_saturate) then - reduced := or_reduce (to_suv(invec)); + reduced := or_reduce (to_sulv(invec)); if (reduced = '1') then if (invec(arghigh) = '0') then -- saturate POSITIVE @@ -5319,8 +5300,8 @@ package body fixed_pkg is end if; elsif (arghigh > left_index) then if (invec(arghigh) = '0') then - reduced := or_reduce (to_suv(invec(arghigh-1 downto - left_index))); + reduced := or_reduce (to_sulv(invec(arghigh-1 downto + left_index))); if overflow_style = fixed_saturate and reduced = '1' then -- saturate positive result := saturate (result'high, result'low); @@ -5334,8 +5315,8 @@ package body fixed_pkg is end if; end if; else - reduced := and_reduce (to_suv(invec(arghigh-1 downto - left_index))); + reduced := and_reduce (to_sulv(invec(arghigh-1 downto + left_index))); if overflow_style = fixed_saturate and reduced = '0' then result := not saturate (result'high, result'low); else @@ -6046,7 +6027,7 @@ package body fixed_pkg is function \?<=\ ( l : UNRESOLVED_ufixed; r : NATURAL) -- fixed point input - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (l, to_ufixed (r, l'high, l'low)); end function \?<=\; @@ -6159,7 +6140,7 @@ package body fixed_pkg is function \?<=\ ( l : NATURAL; r : UNRESOLVED_ufixed) -- fixed point input - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (to_ufixed (l, r'high, r'low), r); end function \?<=\; @@ -6272,7 +6253,7 @@ package body fixed_pkg is function \?<=\ ( l : UNRESOLVED_ufixed; r : REAL) - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (l, to_ufixed (r, l'high, l'low)); end function \?<=\; @@ -6385,7 +6366,7 @@ package body fixed_pkg is function \?<=\ ( l : REAL; r : UNRESOLVED_ufixed) -- fixed point input - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (to_ufixed (l, r'high, r'low), r); end function \?<=\; @@ -6498,7 +6479,7 @@ package body fixed_pkg is function \?<=\ ( l : UNRESOLVED_sfixed; r : INTEGER) - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (l, to_sfixed (r, l'high, l'low)); end function \?<=\; @@ -6611,7 +6592,7 @@ package body fixed_pkg is function \?<=\ ( l : INTEGER; r : UNRESOLVED_sfixed) -- fixed point input - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (to_sfixed (l, r'high, r'low), r); end function \?<=\; @@ -6724,7 +6705,7 @@ package body fixed_pkg is function \?<=\ ( l : UNRESOLVED_sfixed; r : REAL) - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (l, to_sfixed (r, l'high, l'low)); end function \?<=\; @@ -6837,7 +6818,7 @@ package body fixed_pkg is function \?<=\ ( l : REAL; r : UNRESOLVED_sfixed) -- fixed point input - return STD_ULOGIC is + return STD_ULOGIC is begin return \?<=\ (to_sfixed (l, r'high, r'low), r); end function \?<=\; @@ -6890,6 +6871,8 @@ package body fixed_pkg is 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => error); constant NBSP : CHARACTER := CHARACTER'val(160); -- space character constant NUS : STRING(2 to 1) := (others => ' '); + + -- %%% Replicated Textio functions procedure Char2TriBits (C : CHARACTER; RESULT : out STD_ULOGIC_VECTOR(2 downto 0); GOOD : out BOOLEAN; @@ -6953,7 +6936,22 @@ package body fixed_pkg is good := false; end case; end procedure Char2QuadBits; - -- %%% Replicated Testio functions + + -- purpose: Skips white space + procedure skip_whitespace ( + L : inout LINE) is + variable readOk : BOOLEAN; + variable c : CHARACTER; + begin + while L /= null and L.all'length /= 0 loop + if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then + read (l, c, readOk); + else + exit; + end if; + end loop; + end procedure skip_whitespace; + function to_ostring (value : STD_ULOGIC_VECTOR) return STRING is constant ne : INTEGER := (value'length+2)/3; variable pad : STD_ULOGIC_VECTOR(0 to (ne*3 - value'length) - 1); @@ -7032,92 +7030,7 @@ package body fixed_pkg is end if; end function to_hstring; - procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; - GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+2)/3; - constant pad : INTEGER := ne*3 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - good := true; - VALUE := sv (pad to sv'high); - end if; - end procedure OREAD; - procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; - GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+3)/4; - constant pad : INTEGER := ne*4 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - VALUE := sv (pad to sv'high); - good := true; - end if; - end procedure HREAD; + -- %%% END replicated textio functions -- purpose: writes fixed point into a line @@ -7167,54 +7080,72 @@ package body fixed_pkg is -- Possible data: 00000.0000000 -- 000000000000 variable c : CHARACTER; - variable s : STRING(1 to value'length-1); variable readOk : BOOLEAN; variable i : INTEGER; -- index variable + variable mv : ufixed (VALUE'range); + variable lastu : BOOLEAN := false; -- last character was an "_" + variable founddot : BOOLEAN := false; -- found a "." begin -- READ VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - i := value'high; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - report fixed_pkg'instance_name - & "READ(ufixed) " - & "Error: end of string encountered" - severity error; - return; - elsif c = ' ' or c = NBSP or c = HT then -- reading done. - if i /= value'low then - assert NO_WARNING - report fixed_pkg'instance_name - & "READ(ufixed) " - & "Warning: Value truncated " severity warning; + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, readOk); + i := value'high; + while i >= VALUE'low loop + if readOk = false then -- Bail out if there was a bad read + report fixed_pkg'instance_name & "READ(ufixed) " + & "End of string encountered" + severity error; return; - end if; - elsif c = '.' then -- separator, ignore - if i /= -1 then -- Seperator in the wrong spot - assert NO_WARNING - report fixed_pkg'instance_name - & "READ(ufixed) " - & "Warning: Decimal point does not match number format " - severity warning; - end if; - elsif (char_to_MVL9plus(c) = error) then - report fixed_pkg'instance_name - & "READ(ufixed) " - & "Error: Character '" & c & "' read, expected STD_ULOGIC literal." - severity error; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then + elsif c = '_' then + if i = value'high then + report fixed_pkg'instance_name & "READ(ufixed) " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report fixed_pkg'instance_name & "READ(ufixed) " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + elsif c = '.' then -- binary point + if founddot then + report fixed_pkg'instance_name & "READ(ufixed) " + & "Two binary points found in input string" severity error; + return; + elsif i /= -1 then -- Seperator in the wrong spot + report fixed_pkg'instance_name & "READ(ufixed) " + & "Decimal point does not match number format " + severity error; + return; + end if; + founddot := true; + lastu := false; + elsif c = ' ' or c = NBSP or c = HT then -- reading done. + report fixed_pkg'instance_name & "READ(ufixed) " + & "Short read, Space encounted in input string" + severity error; return; + elsif char_to_MVL9plus(c) = error then + report fixed_pkg'instance_name & "READ(ufixed) " + & "Character '" & + c & "' read, expected STD_ULOGIC literal." + severity error; + return; + else + mv(i) := char_to_MVL9(c); + i := i - 1; + if i < mv'low then + VALUE := mv; + return; + end if; + lastu := false; end if; - end if; - read(l, c, readOk); - end loop readloop; + read(L, c, readOk); + end loop; + end if; end procedure READ; procedure READ(L : inout LINE; @@ -7223,130 +7154,134 @@ package body fixed_pkg is -- Possible data: 00000.0000000 -- 000000000000 variable c : CHARACTER; - variable i : INTEGER; -- index variable variable readOk : BOOLEAN; + variable mv : ufixed (VALUE'range); + variable i : INTEGER; -- index variable + variable lastu : BOOLEAN := false; -- last character was an "_" + variable founddot : BOOLEAN := false; -- found a "." begin -- READ VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - i := value'high; - good := true; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - good := false; - return; - elsif c = ' ' or c = NBSP or c = HT then -- reading done - good := false; - return; - elsif c = '.' then -- separator, ignore - good := (i = -1); - elsif (char_to_MVL9plus(c) = error) then - good := false; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, readOk); + i := value'high; + GOOD := false; + while i >= VALUE'low loop + if not readOk then -- Bail out if there was a bad read return; + elsif c = '_' then + if i = value'high then -- Begins with an "_" + return; + elsif lastu then -- "__" detected + return; + else + lastu := true; + end if; + elsif c = '.' then -- binary point + if founddot then + return; + elsif i /= -1 then -- Seperator in the wrong spot + return; + end if; + founddot := true; + lastu := false; + elsif (char_to_MVL9plus(c) = error) then -- Illegal character/short read + return; + else + mv(i) := char_to_MVL9(c); + i := i - 1; + if i < mv'low then -- reading done + GOOD := true; + VALUE := mv; + return; + end if; + lastu := false; end if; - end if; - read(l, c, readOk); - end loop readloop; + read(L, c, readOk); + end loop; + else + GOOD := true; -- read into a null array + end if; end procedure READ; procedure READ(L : inout LINE; VALUE : out UNRESOLVED_sfixed) is - -- Possible data: 00000.0000000 - -- 000000000000 variable c : CHARACTER; variable readOk : BOOLEAN; variable i : INTEGER; -- index variable + variable mv : sfixed (VALUE'range); + variable lastu : BOOLEAN := false; -- last character was an "_" + variable founddot : BOOLEAN := false; -- found a "." begin -- READ VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - i := value'high; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - report fixed_pkg'instance_name - & "READ(sfixed) " - & "Error: end of string encountered" - severity error; - return; - elsif c = ' ' or c = NBSP or c = HT then -- reading done. - if i /= value'low then - assert NO_WARNING - report fixed_pkg'instance_name - & "READ(sfixed) " - & "Warning: Value truncated " severity warning; + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, readOk); + i := value'high; + while i >= VALUE'low loop + if readOk = false then -- Bail out if there was a bad read + report fixed_pkg'instance_name & "READ(sfixed) " + & "End of string encountered" + severity error; return; - end if; - elsif c = '.' then -- separator, ignore - if i /= -1 then -- Seperator in the wrong spot - assert NO_WARNING - report fixed_pkg'instance_name - & "READ(sfixed) " - & "Warning: Decimal point does not match number format " - severity warning; - end if; - elsif (char_to_MVL9plus(c) = error) then - report fixed_pkg'instance_name - & "READ(sfixed) " - & "Error: Character '" & c & "' read, expected STD_ULOGIC literal." - severity error; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then + elsif c = '_' then + if i = value'high then + report fixed_pkg'instance_name & "READ(sfixed) " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report fixed_pkg'instance_name & "READ(sfixed) " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + elsif c = '.' then -- binary point + if founddot then + report fixed_pkg'instance_name & "READ(sfixed) " + & "Two binary points found in input string" severity error; + return; + elsif i /= -1 then -- Seperator in the wrong spot + report fixed_pkg'instance_name & "READ(sfixed) " + & "Decimal point does not match number format " + severity error; + return; + end if; + founddot := true; + lastu := false; + elsif c = ' ' or c = NBSP or c = HT then -- reading done. + report fixed_pkg'instance_name & "READ(sfixed) " + & "Short read, Space encounted in input string" + severity error; return; + elsif char_to_MVL9plus(c) = error then + report fixed_pkg'instance_name & "READ(sfixed) " + & "Character '" & + c & "' read, expected STD_ULOGIC literal." + severity error; + return; + else + mv(i) := char_to_MVL9(c); + i := i - 1; + if i < mv'low then + VALUE := mv; + return; + end if; + lastu := false; end if; - end if; - read(l, c, readOk); - end loop readloop; + read(L, c, readOk); + end loop; + end if; end procedure READ; procedure READ(L : inout LINE; VALUE : out UNRESOLVED_sfixed; GOOD : out BOOLEAN) is - -- Possible data: 00000.0000000 - -- 000000000000 - variable c : CHARACTER; - variable i : INTEGER; -- index variable - variable readOk : BOOLEAN; + variable value_ufixed : UNRESOLVED_ufixed (VALUE'range); begin -- READ - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - i := value'high; - good := true; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - good := false; - return; - elsif c = ' ' or c = NBSP or c = HT then -- reading done - good := false; - return; - elsif c = '.' then -- separator, ignore - good := (i = -1); - elsif (char_to_MVL9plus(c) = error) then - good := false; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then - return; - end if; - end if; - read(l, c, readOk); - end loop readloop; + READ (L => L, VALUE => value_ufixed, GOOD => GOOD); + VALUE := UNRESOLVED_sfixed (value_ufixed); end procedure READ; -- octal read and write @@ -7374,229 +7309,235 @@ package body fixed_pkg is FIELD => FIELD); end procedure owrite; + -- purpose: Routines common to the OREAD routines + procedure OREAD_common ( + L : inout LINE; + slv : out STD_ULOGIC_VECTOR; + igood : out BOOLEAN; + idex : out INTEGER; + constant bpoint : in INTEGER; -- binary point + constant message : in BOOLEAN; + constant smath : in BOOLEAN) is + + -- purpose: error message routine + procedure errmes ( + constant mess : in STRING) is -- error message + begin + if message then + if smath then + report fixed_pkg'instance_name + & "OREAD(sfixed) " + & mess + severity error; + else + report fixed_pkg'instance_name + & "OREAD(ufixed) " + & mess + severity error; + end if; + end if; + end procedure errmes; + variable xgood : BOOLEAN; + variable nybble : STD_ULOGIC_VECTOR (2 downto 0); -- 3 bits + variable c : CHARACTER; + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" + variable founddot : BOOLEAN := false; -- found a dot. + begin + Skip_whitespace (L); + if slv'length > 0 then + i := slv'high; + read (l, c, xgood); + while i > 0 loop + if xgood = false then + errmes ("Error: end of string encountered"); + exit; + elsif c = '_' then + if i = slv'length then + errmes ("Error: String begins with an ""_"""); + xgood := false; + exit; + elsif lastu then + errmes ("Error: Two underscores detected in input string ""__"""); + xgood := false; + exit; + else + lastu := true; + end if; + elsif (c = '.') then + if (i + 1 /= bpoint) then + errmes ("encountered ""."" at wrong index"); + xgood := false; + exit; + elsif i = slv'length then + errmes ("encounted a ""."" at the beginning of the line"); + xgood := false; + exit; + elsif founddot then + errmes ("Two ""."" encounted in input string"); + xgood := false; + exit; + end if; + founddot := true; + lastu := false; + else + Char2triBits(c, nybble, xgood, message); + if not xgood then + exit; + end if; + slv (i downto i-2) := nybble; + i := i - 3; + lastu := false; + end if; + if i > 0 then + read (L, c, xgood); + end if; + end loop; + idex := i; + igood := xgood; + else + igood := true; -- read into a null array + idex := -1; + end if; + end procedure OREAD_common; + -- Note that for Octal and Hex read, you can not start with a ".", -- the read is for numbers formatted "A.BC". These routines go to -- the nearest bounds, so "F.E" will fit into an sfixed (2 downto -3). - procedure OREAD(L : inout LINE; - VALUE : out UNRESOLVED_ufixed) is + procedure OREAD (L : inout LINE; + VALUE : out UNRESOLVED_ufixed) is constant hbv : INTEGER := (((maximum(3, (VALUE'high+1))+2)/3)*3)-1; - constant lbv : INTEGER := ((mine(-3, VALUE'low)-2)/3)*3; + constant lbv : INTEGER := ((mine(0, VALUE'low)-2)/3)*3; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_ufixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (2 downto 0); -- 3 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - report fixed_pkg'instance_name - & "OREAD(ufixed): " - & "Error: end of string encountered" - severity error; - return; - else - Char2triBits(c, nybble, igood, true); - i := hbv-lbv - 3; -- Top - 3 - slv (hbv-lbv downto i+1) := nybble; - end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood = false then - report fixed_pkg'instance_name - & "OREAD(ufixed): " - & "Error: end of string encountered" - severity error; - elsif (c = '.') then - if (i + 1 /= -lbv) then - igood := false; - report fixed_pkg'instance_name - & "OREAD(ufixed): " - & "encountered ""."" at wrong index" - severity error; - end if; - else - Char2TriBits(c, nybble, igood, true); - slv (i downto i-2) := nybble; - i := i - 3; - end if; - end loop; + VALUE := (VALUE'range => 'U'); + OREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => true, + smath => false); if igood then -- We did not get another error - assert (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') + if not ((i = -1) and -- We read everything, and high bits 0 + (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0')) then report fixed_pkg'instance_name - & "OREAD(ufixed): Vector truncated." - severity error; - if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then - assert NO_WARNING - report fixed_pkg'instance_name - & "OREAD(ufixed): Vector truncated" - severity warning; + & "OREAD(ufixed): Vector truncated." + severity error; + else + if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then + assert NO_WARNING + report fixed_pkg'instance_name + & "OREAD(ufixed): Vector truncated" + severity warning; + end if; + valuex := to_ufixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); end if; end if; - valuex := to_ufixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure OREAD; procedure OREAD(L : inout LINE; VALUE : out UNRESOLVED_ufixed; GOOD : out BOOLEAN) is constant hbv : INTEGER := (((maximum(3, (VALUE'high+1))+2)/3)*3)-1; - constant lbv : INTEGER := ((mine(-3, VALUE'low)-2)/3)*3; + constant lbv : INTEGER := ((mine(0, VALUE'low)-2)/3)*3; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_ufixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (2 downto 0); -- 3 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - return; + VALUE := (VALUE'range => 'U'); + OREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => false, + smath => false); + if (igood and -- We did not get another error + (i = -1) and -- We read everything, and high bits 0 + (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0')) then + valuex := to_ufixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); + good := true; else - Char2triBits(c, nybble, igood, false); - i := hbv-lbv - 3; -- Top - 3 - slv (hbv-lbv downto i+1) := nybble; + good := false; end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood then - if (c = '.') then - igood := igood and (i + 1 = -lbv); - else - Char2TriBits(c, nybble, igood, false); - slv (i downto i-2) := nybble; - i := i - 3; - end if; - end if; - end loop; - good := igood and -- We did not get another error - (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0'); - valuex := to_ufixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure OREAD; procedure OREAD(L : inout LINE; VALUE : out UNRESOLVED_sfixed) is constant hbv : INTEGER := (((maximum(3, (VALUE'high+1))+2)/3)*3)-1; - constant lbv : INTEGER := ((mine(-3, VALUE'low)-2)/3)*3; + constant lbv : INTEGER := ((mine(0, VALUE'low)-2)/3)*3; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_sfixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (2 downto 0); -- 3 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - report fixed_pkg'instance_name - & "OREAD(sfixed): " - & "Error: end of string encountered" - severity error; - return; - else - Char2triBits(c, nybble, igood, true); - i := hbv-lbv - 3; -- Top - 3 - slv (hbv-lbv downto i+1) := nybble; - end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood = false then - report fixed_pkg'instance_name - & "OREAD(sfixed): " - & "Error: end of string encountered" - severity error; - elsif (c = '.') then - if (i + 1 /= -lbv) then - igood := false; - report fixed_pkg'instance_name - & "OREAD(sfixed): " - & "encountered ""."" at wrong index" - severity error; - end if; - else - Char2TriBits(c, nybble, igood, true); - slv (i downto i-2) := nybble; - i := i - 3; - end if; - end loop; + VALUE := (VALUE'range => 'U'); + OREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => true, + smath => true); if igood then -- We did not get another error - assert (i = -1) and -- We read everything - ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits - or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or - (slv(VALUE'high-lbv) = '1' and - and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1')) + if not ((i = -1) and -- We read everything + ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits + or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or + (slv(VALUE'high-lbv) = '1' and + and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1'))) then report fixed_pkg'instance_name - & "OREAD(sfixed): Vector truncated." - severity error; - if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then - assert NO_WARNING - report fixed_pkg'instance_name - & "OREAD(sfixed): Vector truncated" - severity warning; + & "OREAD(sfixed): Vector truncated." + severity error; + else + if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then + assert NO_WARNING + report fixed_pkg'instance_name + & "OREAD(sfixed): Vector truncated" + severity warning; + end if; + valuex := to_sfixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); end if; end if; - valuex := to_sfixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure OREAD; procedure OREAD(L : inout LINE; VALUE : out UNRESOLVED_sfixed; GOOD : out BOOLEAN) is constant hbv : INTEGER := (((maximum(3, (VALUE'high+1))+2)/3)*3)-1; - constant lbv : INTEGER := ((mine(-3, VALUE'low)-2)/3)*3; + constant lbv : INTEGER := ((mine(0, VALUE'low)-2)/3)*3; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_sfixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (2 downto 0); -- 3 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - return; + VALUE := (VALUE'range => 'U'); + OREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => false, + smath => true); + if (igood -- We did not get another error + and (i = -1) -- We read everything + and ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits + or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or + (slv(VALUE'high-lbv) = '1' and + and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1'))) then + valuex := to_sfixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); + good := true; else - Char2triBits(c, nybble, igood, false); - i := hbv-lbv - 3; -- Top - 3 - slv (hbv-lbv downto i+1) := nybble; + good := false; end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood then - if (c = '.') then - igood := igood and (i + 1 = -lbv); - else - Char2TriBits(c, nybble, igood, false); - slv (i downto i-2) := nybble; - i := i - 3; - end if; - end if; - end loop; - good := igood -- We did not get another error - and (i = -1) -- We read everything - and ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits - or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or - (slv(VALUE'high-lbv) = '1' and - and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1')); - valuex := to_sfixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure OREAD; -- hex read and write @@ -7625,226 +7566,232 @@ package body fixed_pkg is FIELD => FIELD); end procedure hwrite; + -- purpose: Routines common to the OREAD routines + procedure HREAD_common ( + L : inout LINE; + slv : out STD_ULOGIC_VECTOR; + igood : out BOOLEAN; + idex : out INTEGER; + constant bpoint : in INTEGER; -- binary point + constant message : in BOOLEAN; + constant smath : in BOOLEAN) is + + -- purpose: error message routine + procedure errmes ( + constant mess : in STRING) is -- error message + begin + if message then + if smath then + report fixed_pkg'instance_name + & "HREAD(sfixed) " + & mess + severity error; + else + report fixed_pkg'instance_name + & "HREAD(ufixed) " + & mess + severity error; + end if; + end if; + end procedure errmes; + variable xgood : BOOLEAN; + variable nybble : STD_ULOGIC_VECTOR (3 downto 0); -- 4 bits + variable c : CHARACTER; + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" + variable founddot : BOOLEAN := false; -- found a dot. + begin + Skip_whitespace (L); + if slv'length > 0 then + i := slv'high; + read (l, c, xgood); + while i > 0 loop + if xgood = false then + errmes ("Error: end of string encountered"); + exit; + elsif c = '_' then + if i = slv'length then + errmes ("Error: String begins with an ""_"""); + xgood := false; + exit; + elsif lastu then + errmes ("Error: Two underscores detected in input string ""__"""); + xgood := false; + exit; + else + lastu := true; + end if; + elsif (c = '.') then + if (i + 1 /= bpoint) then + errmes ("encountered ""."" at wrong index"); + xgood := false; + exit; + elsif i = slv'length then + errmes ("encounted a ""."" at the beginning of the line"); + xgood := false; + exit; + elsif founddot then + errmes ("Two ""."" encounted in input string"); + xgood := false; + exit; + end if; + founddot := true; + lastu := false; + else + Char2QuadBits(c, nybble, xgood, message); + if not xgood then + exit; + end if; + slv (i downto i-3) := nybble; + i := i - 4; + lastu := false; + end if; + if i > 0 then + read (L, c, xgood); + end if; + end loop; + idex := i; + igood := xgood; + else + idex := -1; + igood := true; -- read null string + end if; + end procedure HREAD_common; + procedure HREAD(L : inout LINE; VALUE : out UNRESOLVED_ufixed) is constant hbv : INTEGER := (((maximum(4, (VALUE'high+1))+3)/4)*4)-1; - constant lbv : INTEGER := ((mine(-4, VALUE'low)-3)/4)*4; + constant lbv : INTEGER := ((mine(0, VALUE'low)-3)/4)*4; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_ufixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (3 downto 0); -- 4 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - report fixed_pkg'instance_name - & "HREAD(ufixed): " - & "Error: end of string encountered" - severity error; - return; - else - Char2QuadBits(c, nybble, igood, true); - i := hbv-lbv - 4; -- Top - 4 - slv (hbv-lbv downto i+1) := nybble; - end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood = false then + VALUE := (VALUE'range => 'U'); + HREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => false, + smath => false); + if igood then + if not ((i = -1) and -- We read everything, and high bits 0 + (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0')) then report fixed_pkg'instance_name - & "HREAD(ufixed): " - & "Error: end of string encountered" + & "HREAD(ufixed): Vector truncated." severity error; - elsif (c = '.') then - if (i + 1 /= -lbv) then - igood := false; - report fixed_pkg'instance_name - & "HREAD(ufixed): " - & "encountered ""."" at wrong index" - severity error; - end if; else - Char2QuadBits(c, nybble, igood, true); - slv (i downto i-3) := nybble; - i := i - 4; - end if; - end loop; - if igood then -- We did not get another error - assert (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') - report fixed_pkg'instance_name - & "HREAD(ufixed): Vector truncated." - severity error; - if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then - assert NO_WARNING - report fixed_pkg'instance_name - & "HREAD(ufixed): Vector truncated" - severity warning; + if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then + assert NO_WARNING + report fixed_pkg'instance_name + & "HREAD(ufixed): Vector truncated" + severity warning; + end if; + valuex := to_ufixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); end if; end if; - valuex := to_ufixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure HREAD; procedure HREAD(L : inout LINE; VALUE : out UNRESOLVED_ufixed; GOOD : out BOOLEAN) is constant hbv : INTEGER := (((maximum(4, (VALUE'high+1))+3)/4)*4)-1; - constant lbv : INTEGER := ((mine(-4, VALUE'low)-3)/4)*4; + constant lbv : INTEGER := ((mine(0, VALUE'low)-3)/4)*4; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_ufixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (3 downto 0); -- 4 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - return; + VALUE := (VALUE'range => 'U'); + HREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => false, + smath => false); + if (igood and -- We did not get another error + (i = -1) and -- We read everything, and high bits 0 + (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0')) then + valuex := to_ufixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); + good := true; else - Char2QuadBits(c, nybble, igood, false); - i := hbv-lbv - 4; -- Top - 4 - slv (hbv-lbv downto i+1) := nybble; + good := false; end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood then - if (c = '.') then - igood := igood and (i + 1 = -lbv); - else - Char2QuadBits(c, nybble, igood, false); - slv (i downto i-3) := nybble; - i := i - 4; - end if; - end if; - end loop; - good := igood and -- We did not get another error - (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0'); - valuex := to_ufixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure HREAD; procedure HREAD(L : inout LINE; VALUE : out UNRESOLVED_sfixed) is constant hbv : INTEGER := (((maximum(4, (VALUE'high+1))+3)/4)*4)-1; - constant lbv : INTEGER := ((mine(-4, VALUE'low)-3)/4)*4; + constant lbv : INTEGER := ((mine(0, VALUE'low)-3)/4)*4; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_sfixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (3 downto 0); -- 4 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - report fixed_pkg'instance_name - & "HREAD(sfixed): " - & "Error: end of string encountered" - severity error; - return; - else - Char2QuadBits(c, nybble, igood, true); - i := hbv-lbv - 4; -- Top - 4 - slv (hbv-lbv downto i+1) := nybble; - end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood = false then - report fixed_pkg'instance_name - & "HREAD(sfixed): " - & "Error: end of string encountered" - severity error; - elsif (c = '.') then - if (i + 1 /= -lbv) then - igood := false; - report fixed_pkg'instance_name - & "HREAD(sfixed): " - & "encountered ""."" at wrong index" - severity error; - end if; - else - Char2QuadBits(c, nybble, igood, true); - slv (i downto i-3) := nybble; - i := i - 4; - end if; - end loop; + VALUE := (VALUE'range => 'U'); + HREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => true, + smath => true); if igood then -- We did not get another error - assert (i = -1) -- We read everything - and ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits - or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or - (slv(VALUE'high-lbv) = '1' and - and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1')) + if not ((i = -1) -- We read everything + and ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits + or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or + (slv(VALUE'high-lbv) = '1' and + and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1'))) then report fixed_pkg'instance_name - & "HREAD(sfixed): Vector truncated." - severity error; - if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then - assert NO_WARNING - report fixed_pkg'instance_name - & "HREAD(sfixed): Vector truncated" - severity warning; + & "HREAD(sfixed): Vector truncated." + severity error; + else + if (or_reduce (slv(VALUE'low-lbv-1 downto 0)) = '1') then + assert NO_WARNING + report fixed_pkg'instance_name + & "HREAD(sfixed): Vector truncated" + severity warning; + end if; + valuex := to_sfixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); end if; end if; - valuex := to_sfixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure HREAD; procedure HREAD(L : inout LINE; VALUE : out UNRESOLVED_sfixed; GOOD : out BOOLEAN) is constant hbv : INTEGER := (((maximum(4, (VALUE'high+1))+3)/4)*4)-1; - constant lbv : INTEGER := ((mine(-4, VALUE'low)-3)/4)*4; + constant lbv : INTEGER := ((mine(0, VALUE'low)-3)/4)*4; variable slv : STD_ULOGIC_VECTOR (hbv-lbv downto 0); -- high bits - variable c : CHARACTER; -- to read the "." variable valuex : UNRESOLVED_sfixed (hbv downto lbv); variable igood : BOOLEAN; - variable nybble : STD_ULOGIC_VECTOR (3 downto 0); -- 4 bits variable i : INTEGER; begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, igood); - exit when (igood = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if igood = false then - return; + VALUE := (VALUE'range => 'U'); + HREAD_common ( L => L, + slv => slv, + igood => igood, + idex => i, + bpoint => -lbv, + message => false, + smath => true); + if (igood and -- We did not get another error + (i = -1) and -- We read everything + ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits + or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or + (slv(VALUE'high-lbv) = '1' and + and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1'))) then + valuex := to_sfixed (slv, hbv, lbv); + VALUE := valuex (VALUE'range); + good := true; else - Char2QuadBits(c, nybble, igood, false); - i := hbv-lbv - 4; -- Top - 4 - slv (hbv-lbv downto i+1) := nybble; + good := false; end if; - while (i /= -1) and igood and L.all'length /= 0 loop - read (L, c, igood); - if igood then - if (c = '.') then - igood := igood and (i + 1 = -lbv); - else - Char2QuadBits(c, nybble, igood, false); - slv (i downto i-3) := nybble; - i := i - 4; - end if; - end if; - end loop; - good := igood and -- We did not get another error - (i = -1) and -- We read everything - ((slv(VALUE'high-lbv) = '0' and -- sign bits = extra bits - or_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '0') or - (slv(VALUE'high-lbv) = '1' and - and_reduce (slv(hbv-lbv downto VALUE'high+1-lbv)) = '1')); - valuex := to_sfixed (slv, hbv, lbv); - VALUE := valuex (VALUE'range); end procedure HREAD; function to_string (value : UNRESOLVED_ufixed) return STRING is @@ -7861,7 +7808,7 @@ package body fixed_pkg is else return to_string (resize (value, 0, value'low)); end if; - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; @@ -7894,7 +7841,7 @@ package body fixed_pkg is else if value'high < 0 then return to_string (resize (value, 0, value'low)); - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; @@ -7932,16 +7879,16 @@ package body fixed_pkg is else return to_ostring (resize (value, 2, value'low)); end if; - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; return to_ostring(subval); else - return to_ostring (resize (value, value'high, -1)); + return to_ostring (resize (value, value'high, -3)); end if; else - slv := to_suv (value); + slv := to_sulv (value); if Is_X (value (value'low)) then lpad := (others => value (value'low)); else @@ -7969,7 +7916,7 @@ package body fixed_pkg is else return to_hstring (resize (value, 3, value'low)); end if; - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; @@ -7978,7 +7925,7 @@ package body fixed_pkg is return to_hstring (resize (value, value'high, -4)); end if; else - slv := to_suv (value); + slv := to_sulv (value); if Is_X (value (value'low)) then lpad := (others => value(value'low)); else @@ -8004,7 +7951,7 @@ package body fixed_pkg is else if value'high < 0 then return to_ostring (resize (value, 2, value'low)); - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; @@ -8014,7 +7961,7 @@ package body fixed_pkg is end if; else pad := (others => value(value'high)); - slv := to_suv (value); + slv := to_sulv (value); if Is_X (value (value'low)) then lpad := (others => value(value'low)); else @@ -8040,7 +7987,7 @@ package body fixed_pkg is else if value'high < 0 then return to_hstring (resize (value, 3, value'low)); - elsif value'low > 0 then + elsif value'low >= 0 then if Is_X (value(value'low)) then subval := (others => value(value'low)); subval (value'range) := value; @@ -8049,7 +7996,7 @@ package body fixed_pkg is return to_hstring (resize (value, value'high, -4)); end if; else - slv := to_suv (value); + slv := to_sulv (value); pad := (others => value(value'high)); if Is_X (value (value'low)) then lpad := (others => value(value'low)); @@ -8070,6 +8017,7 @@ package body fixed_pkg is -- The "." is optional in this syntax, however it exist and is -- in the wrong location an error is produced. Overflow will -- result in saturation. + function from_string ( bstring : STRING; -- binary string constant left_index : INTEGER; @@ -8186,117 +8134,95 @@ package body fixed_pkg is bstring : STRING; -- binary string size_res : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is - variable result : UNRESOLVED_ufixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(bstring); - read (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - return result; + return from_string (bstring, size_res'high, size_res'low); end function from_string; function from_ostring ( ostring : STRING; -- Octal string size_res : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is - variable result : UNRESOLVED_ufixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(ostring); - oread (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - return result; + return from_ostring (ostring, size_res'high, size_res'low); end function from_ostring; function from_hstring ( hstring : STRING; -- hex string size_res : UNRESOLVED_ufixed) return UNRESOLVED_ufixed is - variable result : UNRESOLVED_ufixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(hstring); - hread (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - return result; + return from_hstring(hstring, size_res'high, size_res'low); end function from_hstring; function from_string ( bstring : STRING; -- binary string size_res : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is - variable result : UNRESOLVED_sfixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(bstring); - read (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - return result; + return from_string (bstring, size_res'high, size_res'low); end function from_string; function from_ostring ( ostring : STRING; -- Octal string size_res : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is - variable result : UNRESOLVED_sfixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(ostring); - oread (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - return result; + return from_ostring (ostring, size_res'high, size_res'low); end function from_ostring; function from_hstring ( hstring : STRING; -- hex string size_res : UNRESOLVED_sfixed) return UNRESOLVED_sfixed is - variable result : UNRESOLVED_sfixed (size_res'high downto size_res'low); - variable L : LINE; - variable good : BOOLEAN; begin - L := new STRING'(hstring); - hread (L, result, good); - deallocate (L); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - return result; + return from_hstring (hstring, size_res'high, size_res'low); end function from_hstring; - -- purpose: find a dot in a string, return -1 if no dot (internal function) - function finddot ( - arg : STRING) - return INTEGER is - alias xarg : STRING (arg'length downto 1) is arg; -- make it a downto + -- purpose: Calculate the string boundaries + procedure calculate_string_boundry ( + arg : in STRING; -- input string + left_index : out INTEGER; -- left + right_index : out INTEGER) is -- right + -- examples "10001.111" would return +4, -3 + -- "07X.44" would return +2, -2 (then the octal routine would multiply) + -- "A_B_._C" would return +1, -1 (then the hex routine would multiply) + alias xarg : STRING (arg'length downto 1) is arg; -- make it downto range + variable l, r : INTEGER; -- internal indexes + variable founddot : BOOLEAN := false; begin - for i in xarg'reverse_range loop - if (xarg(i) = '.') then - return i-1; - end if; - end loop; - return -1; - end function finddot; + if arg'length > 0 then + l := xarg'high - 1; + r := 0; + for i in xarg'range loop + if xarg(i) = '_' then + if r = 0 then + l := l - 1; + else + r := r + 1; + end if; + elsif xarg(i) = ' ' or xarg(i) = NBSP or xarg(i) = HT then + report fixed_pkg'instance_name + & "Found a space in the input STRING " & xarg + severity error; + elsif xarg(i) = '.' then + if founddot then + report fixed_pkg'instance_name + & "Found two binary points in input string " & xarg + severity error; + else + l := l - i; + r := -i + 1; + founddot := true; + end if; + end if; + end loop; + left_index := l; + right_index := r; + else + left_index := 0; + right_index := 0; + end if; + end procedure calculate_string_boundry; -- Direct conversion functions. Example: -- signal uf1 : ufixed (3 downto -3); @@ -8306,38 +8232,10 @@ package body fixed_pkg is function from_string ( bstring : STRING) -- binary string return UNRESOLVED_ufixed is - variable result : UNRESOLVED_ufixed (bstring'length-2 downto 0); - variable result_nodot : UNRESOLVED_ufixed (bstring'length-1 downto 0); - variable bstring_nodot : STRING (1 to bstring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(bstring); - if (dot = -1) then - L := new STRING'(bstring); - read (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - deallocate (L); - return result_nodot; - else - j := 1; - for i in 1 to bstring'high loop - if (bstring(i) /= '.') then - bstring_nodot(j) := bstring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(bstring_nodot); - read (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - deallocate (L); - return to_ufixed(to_suv(result), bstring'length-dot-2, -dot); - end if; + calculate_string_boundry (bstring, left_index, right_index); + return from_string (bstring, left_index, right_index); end function from_string; -- Direct octal and hex conversion functions. In this case @@ -8347,186 +8245,46 @@ package body fixed_pkg is function from_ostring ( ostring : STRING) -- Octal string return UNRESOLVED_ufixed is - variable result : STD_ULOGIC_VECTOR((ostring'length-1)*3-1 downto 0); - variable result_nodot : STD_ULOGIC_VECTOR((ostring'length)*3-1 downto 0); - variable ostring_nodot : STRING (1 to ostring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(ostring); - if (dot = -1) then - L := new STRING'(ostring); - oread (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - deallocate (L); - return to_ufixed(UNSIGNED(result_nodot)); - else - j := 1; - for i in 1 to ostring'high loop - if (ostring(i) /= '.') then - ostring_nodot(j) := ostring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(ostring_nodot); - oread (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - deallocate (L); - return to_ufixed(result, (ostring'length-1-dot)*3-1, -dot*3); - end if; + calculate_string_boundry (ostring, left_index, right_index); + return from_ostring (ostring, ((left_index+1)*3)-1, right_index*3); end function from_ostring; function from_hstring ( hstring : STRING) -- hex string return UNRESOLVED_ufixed is - variable result : STD_ULOGIC_VECTOR((hstring'length-1)*4-1 downto 0); - variable result_nodot : STD_ULOGIC_VECTOR((hstring'length)*4-1 downto 0); - variable hstring_nodot : STRING (1 to hstring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(hstring); - if (dot = -1) then - L := new STRING'(hstring); - hread (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - deallocate (L); - return to_ufixed(UNSIGNED(result_nodot)); - else - j := 1; - for i in 1 to hstring'high loop - if (hstring(i) /= '.') then - hstring_nodot(j) := hstring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(hstring_nodot); - hread (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - deallocate (L); - return to_ufixed (result, (hstring'length-1-dot)*4-1, -dot*4); - end if; + calculate_string_boundry (hstring, left_index, right_index); + return from_hstring (hstring, ((left_index+1)*4)-1, right_index*4); end function from_hstring; function from_string ( bstring : STRING) -- binary string return UNRESOLVED_sfixed is - variable result : UNRESOLVED_sfixed (bstring'length-2 downto 0); - variable result_nodot : UNRESOLVED_sfixed (bstring'length-1 downto 0); - variable bstring_nodot : STRING (1 to bstring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(bstring); - if (dot = -1) then - L := new STRING'(bstring); - read (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - deallocate (L); - return result_nodot; - else - j := 1; - for i in 1 to bstring'high loop - if (bstring(i) /= '.') then - bstring_nodot(j) := bstring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(bstring_nodot); - read (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_string: Bad string "& bstring severity error; - deallocate (L); - return to_sfixed(to_suv(result), bstring'length-dot-2, -dot); - end if; + calculate_string_boundry (bstring, left_index, right_index); + return from_string (bstring, left_index, right_index); end function from_string; function from_ostring ( ostring : STRING) -- Octal string return UNRESOLVED_sfixed is - variable result : STD_ULOGIC_VECTOR((ostring'length-1)*3-1 downto 0); - variable result_nodot : STD_ULOGIC_VECTOR((ostring'length)*3-1 downto 0); - variable ostring_nodot : STRING (1 to ostring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(ostring); - if (dot = -1) then - L := new STRING'(ostring); - oread (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - deallocate (L); - return to_sfixed(SIGNED(result_nodot)); - else - j := 1; - for i in 1 to ostring'high loop - if (ostring(i) /= '.') then - ostring_nodot(j) := ostring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(ostring_nodot); - oread (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_ostring: Bad string "& ostring severity error; - deallocate (L); - return to_sfixed(result, (ostring'length-1-dot)*3-1, -dot*3); - end if; + calculate_string_boundry (ostring, left_index, right_index); + return from_ostring (ostring, ((left_index+1)*3)-1, right_index*3); end function from_ostring; function from_hstring ( hstring : STRING) -- hex string return UNRESOLVED_sfixed is - variable result : STD_ULOGIC_VECTOR((hstring'length-1)*4-1 downto 0); - variable result_nodot : STD_ULOGIC_VECTOR((hstring'length)*4-1 downto 0); - variable hstring_nodot : STRING (1 to hstring'length-1); - variable L : LINE; - variable good : BOOLEAN; - variable dot, i, j : INTEGER; + variable left_index, right_index : INTEGER; begin - dot := finddot(hstring); - if (dot = -1) then - L := new STRING'(hstring); - hread (L, result_nodot, good); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - deallocate (L); - return UNRESOLVED_sfixed(SIGNED(result_nodot)); - else - j := 1; - for i in 1 to hstring'high loop - if (hstring(i) /= '.') then - hstring_nodot(j) := hstring(i); -- get rid of the dot. - j := j + 1; - end if; - end loop; - L := new STRING'(hstring_nodot); - hread (L, result, good); - assert (good) - report fixed_pkg'instance_name - & "from_hstring: Bad string "& hstring severity error; - deallocate (L); - return to_sfixed (result, (hstring'length-1-dot)*4-1, -dot*4); - end if; + calculate_string_boundry (hstring, left_index, right_index); + return from_hstring (hstring, ((left_index+1)*4)-1, right_index*4); end function from_hstring; -- pragma synthesis_on -- rtl_synthesis on @@ -8576,7 +8334,7 @@ package body fixed_pkg is size_res => size_res); end function to_sfixed; - -- unsigned fixed point + -- unsigned fixed point function to_UFix ( arg : STD_LOGIC_VECTOR; width : NATURAL; -- width of vector diff --git a/Common/sim/ieee_proposed/modelsim/float_pkg_c.vhdl b/Common/sim/ieee_proposed/modelsim/float_pkg_c.vhdl index a6e8de9..b97d9f9 100644 --- a/Common/sim/ieee_proposed/modelsim/float_pkg_c.vhdl +++ b/Common/sim/ieee_proposed/modelsim/float_pkg_c.vhdl @@ -4,7 +4,7 @@ -- This package should be compiled into "ieee_proposed" and used as follows: -- use ieee.std_logic_1164.all; -- use ieee.numeric_std.all; --- use ieee_proposed.math_utility.all; +-- use ieee_proposed.fixed_float_types.all; -- use ieee_proposed.fixed_pkg.all; -- use ieee_proposed.float_pkg.all; -- @@ -13,8 +13,8 @@ -- VHDL-200X LRM. -- -- -------------------------------------------------------------------- --- Version : $Revision: 1.9 $ --- Date : $Date: 2007-04-04 13:59:52-04 $ +-- Version : $Revision: 2.2 $ +-- Date : $Date: 2010/09/22 18:26:46 $ -- -------------------------------------------------------------------- use STD.TEXTIO.all; @@ -22,29 +22,29 @@ library IEEE; use IEEE.STD_LOGIC_1164.all; use IEEE.NUMERIC_STD.all; library ieee_proposed; -use ieee_proposed.math_utility_pkg.all; +use ieee_proposed.fixed_float_types.all; use ieee_proposed.fixed_pkg.all; package float_pkg is -- generic ( - -- Defaults for sizing routines, when you do a "to_float" this will be - -- the default size. Example float32 would be 8 and 23 (8 downto -23) - constant float_exponent_width : NATURAL := 8; - constant float_fraction_width : NATURAL := 23; - -- Rounding algorithm, "round_nearest" is default, other valid values - -- are "round_zero" (truncation), "round_inf" (round up), and - -- "round_neginf" (round down) - constant float_round_style : round_type := round_nearest; - -- Denormal numbers (very small numbers near zero) true or false - constant float_denormalize : BOOLEAN := true; - -- Turns on NAN processing (invalid numbers and overflow) true of false - constant float_check_error : BOOLEAN := true; - -- Guard bits are added to the bottom of every operation for rounding. - -- any natural number (including 0) are valid. - constant float_guard_bits : NATURAL := 3; - -- If TRUE, then turn off warnings on "X" propagation - constant no_warning : BOOLEAN := (false - ); + -- Defaults for sizing routines, when you do a "to_float" this will be + -- the default size. Example float32 would be 8 and 23 (8 downto -23) + constant float_exponent_width : NATURAL := 8; + constant float_fraction_width : NATURAL := 23; + -- Rounding algorithm, "round_nearest" is default, other valid values + -- are "round_zero" (truncation), "round_inf" (round up), and + -- "round_neginf" (round down) + constant float_round_style : round_type := round_nearest; + -- Denormal numbers (very small numbers near zero) true or false + constant float_denormalize : BOOLEAN := true; + -- Turns on NAN processing (invalid numbers and overflow) true of false + constant float_check_error : BOOLEAN := true; + -- Guard bits are added to the bottom of every operation for rounding. + -- any natural number (including 0) are valid. + constant float_guard_bits : NATURAL := 3; + -- If TRUE, then turn off warnings on "X" propagation + constant no_warning : BOOLEAN := (false + ); -- Author David Bishop (dbishop@vhdl.org) @@ -133,15 +133,15 @@ package float_pkg is -- Arithmetic functions, these operators do not require parameters. function "abs" (arg : UNRESOLVED_float) return UNRESOLVED_float; - function "-" (arg : UNRESOLVED_float) return UNRESOLVED_float; + function "-" (arg : UNRESOLVED_float) return UNRESOLVED_float; -- These allows the base math functions to use the default values -- of their parameters. Thus they do full IEEE floating point. - function "+" (l, r : UNRESOLVED_float) return UNRESOLVED_float; - function "-" (l, r : UNRESOLVED_float) return UNRESOLVED_float; - function "*" (l, r : UNRESOLVED_float) return UNRESOLVED_float; - function "/" (l, r : UNRESOLVED_float) return UNRESOLVED_float; + function "+" (l, r : UNRESOLVED_float) return UNRESOLVED_float; + function "-" (l, r : UNRESOLVED_float) return UNRESOLVED_float; + function "*" (l, r : UNRESOLVED_float) return UNRESOLVED_float; + function "/" (l, r : UNRESOLVED_float) return UNRESOLVED_float; function "rem" (l, r : UNRESOLVED_float) return UNRESOLVED_float; function "mod" (l, r : UNRESOLVED_float) return UNRESOLVED_float; @@ -227,7 +227,7 @@ package float_pkg is -- Square root (all 754 based implementations need this) function sqrt ( - arg : UNRESOLVED_float; -- floating point input + arg : UNRESOLVED_float; -- floating point input constant round_style : round_type := float_round_style; constant guard : NATURAL := float_guard_bits; constant check_error : BOOLEAN := float_check_error; @@ -291,7 +291,7 @@ package float_pkg is function \?<\ (l, r : UNRESOLVED_float) return STD_ULOGIC; function \?<=\ (l, r : UNRESOLVED_float) return STD_ULOGIC; - function std_match (l, r : UNRESOLVED_float) return BOOLEAN; + function std_match (l, r : UNRESOLVED_float) return BOOLEAN; function find_rightmost (arg : UNRESOLVED_float; y : STD_ULOGIC) return INTEGER; function find_leftmost (arg : UNRESOLVED_float; y : STD_ULOGIC) @@ -350,10 +350,10 @@ package float_pkg is alias to_StdLogicVector is to_slv [UNRESOLVED_float return STD_LOGIC_VECTOR]; alias to_Std_Logic_Vector is to_slv [UNRESOLVED_float return STD_LOGIC_VECTOR]; - -- Converts an fp into an SULV - function to_suv (arg : UNRESOLVED_float) return STD_ULOGIC_VECTOR; - alias to_StdULogicVector is to_suv [UNRESOLVED_float return STD_ULOGIC_VECTOR]; - alias to_Std_ULogic_Vector is to_suv [UNRESOLVED_float return STD_ULOGIC_VECTOR]; + -- Converts an fp into an std_ulogic_vector (sulv) + function to_sulv (arg : UNRESOLVED_float) return STD_ULOGIC_VECTOR; + alias to_StdULogicVector is to_sulv [UNRESOLVED_float return STD_ULOGIC_VECTOR]; + alias to_Std_ULogic_Vector is to_sulv [UNRESOLVED_float return STD_ULOGIC_VECTOR]; -- std_ulogic_vector to float function to_float ( @@ -469,16 +469,16 @@ package float_pkg is function to_unsigned ( arg : UNRESOLVED_float; -- floating point input constant size : NATURAL; -- length of output - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return UNSIGNED; -- float to signed function to_signed ( arg : UNRESOLVED_float; -- floating point input constant size : NATURAL; -- length of output - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return SIGNED; -- purpose: Converts a float to unsigned fixed point @@ -486,8 +486,8 @@ package float_pkg is arg : UNRESOLVED_float; -- fp input constant left_index : INTEGER; -- integer part constant right_index : INTEGER; -- fraction part - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_ufixed; @@ -497,8 +497,8 @@ package float_pkg is arg : UNRESOLVED_float; -- fp input constant left_index : INTEGER; -- integer part constant right_index : INTEGER; -- fraction part - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_sfixed; @@ -508,24 +508,24 @@ package float_pkg is function to_unsigned ( arg : UNRESOLVED_float; -- floating point input size_res : UNSIGNED; - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return UNSIGNED; -- float to signed function to_signed ( arg : UNRESOLVED_float; -- floating point input size_res : SIGNED; - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return SIGNED; -- purpose: Converts a float to unsigned fixed point function to_ufixed ( arg : UNRESOLVED_float; -- fp input size_res : UNRESOLVED_ufixed; - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_ufixed; @@ -534,8 +534,8 @@ package float_pkg is function to_sfixed ( arg : UNRESOLVED_float; -- fp input size_res : UNRESOLVED_sfixed; - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_sfixed; @@ -543,7 +543,6 @@ package float_pkg is -- float to real function to_real ( arg : UNRESOLVED_float; -- floating point input - constant round_style : round_type := float_round_style; -- rounding option constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) -- Use IEEE extended FP return REAL; @@ -551,10 +550,14 @@ package float_pkg is -- float to integer function to_integer ( arg : UNRESOLVED_float; -- floating point input - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return INTEGER; + -- For Verilog compatability + function realtobits (arg : REAL) return STD_ULOGIC_VECTOR; + function bitstoreal (arg : STD_ULOGIC_VECTOR) return REAL; + -- Maps metalogical values function to_01 ( arg : UNRESOLVED_float; -- floating point input @@ -592,7 +595,7 @@ package float_pkg is -- Exponent is assumed to be biased by -1 function normalize ( - fract : UNSIGNED; -- fraction, unnormalized + fract : UNSIGNED; -- fraction, unnormalized expon : SIGNED; -- exponent - 1, normalized sign : STD_ULOGIC; -- sign bit sticky : STD_ULOGIC := '0'; -- Sticky bit (rounding) @@ -640,44 +643,44 @@ package float_pkg is return UNRESOLVED_float; -- overloaded versions - function "+" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "+" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "+" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "+" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "+" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "+" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; - function "-" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "-" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "-" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "-" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "-" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "-" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; - function "*" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "*" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "*" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "*" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "*" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "*" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; - function "/" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "/" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "/" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "/" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "/" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "/" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; - function "rem" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "rem" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "rem" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "rem" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "rem" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "rem" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; - function "mod" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function "mod" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function "mod" (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function "mod" (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function "mod" (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function "mod" (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; -- overloaded compare functions - function "=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function "/=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function ">=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function "<=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function ">" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function "<" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; - function "=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; - function "/=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; - function ">=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; - function "<=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; - function ">" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; - function "<" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function "=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function "/=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function ">=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function "<=" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function ">" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function "<" (l : UNRESOLVED_float; r : REAL) return BOOLEAN; + function "=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function "/=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function ">=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function "<=" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function ">" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; + function "<" (l : REAL; r : UNRESOLVED_float) return BOOLEAN; function "=" (l : UNRESOLVED_float; r : INTEGER) return BOOLEAN; function "/=" (l : UNRESOLVED_float; r : INTEGER) return BOOLEAN; function ">=" (l : UNRESOLVED_float; r : INTEGER) return BOOLEAN; @@ -690,18 +693,18 @@ package float_pkg is function "<=" (l : INTEGER; r : UNRESOLVED_float) return BOOLEAN; function ">" (l : INTEGER; r : UNRESOLVED_float) return BOOLEAN; function "<" (l : INTEGER; r : UNRESOLVED_float) return BOOLEAN; - function \?=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?/=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?>\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?>=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?<\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?<=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; - function \?=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; - function \?/=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; - function \?>\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; - function \?>=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; - function \?<\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; - function \?<=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?/=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?>\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?>=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?<\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?<=\ (l : UNRESOLVED_float; r : REAL) return STD_ULOGIC; + function \?=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?/=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?>\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?>=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?<\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; + function \?<=\ (l : REAL; r : UNRESOLVED_float) return STD_ULOGIC; function \?=\ (l : UNRESOLVED_float; r : INTEGER) return STD_ULOGIC; function \?/=\ (l : UNRESOLVED_float; r : INTEGER) return STD_ULOGIC; function \?>\ (l : UNRESOLVED_float; r : INTEGER) return STD_ULOGIC; @@ -715,10 +718,10 @@ package float_pkg is function \?<\ (l : INTEGER; r : UNRESOLVED_float) return STD_ULOGIC; function \?<=\ (l : INTEGER; r : UNRESOLVED_float) return STD_ULOGIC; -- minimum and maximum overloads - function maximum (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function minimum (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; - function maximum (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; - function minimum (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function maximum (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function minimum (l : UNRESOLVED_float; r : REAL) return UNRESOLVED_float; + function maximum (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; + function minimum (l : REAL; r : UNRESOLVED_float) return UNRESOLVED_float; function maximum (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function minimum (l : UNRESOLVED_float; r : INTEGER) return UNRESOLVED_float; function maximum (l : INTEGER; r : UNRESOLVED_float) return UNRESOLVED_float; @@ -760,11 +763,11 @@ package float_pkg is function "xnor" (l : UNRESOLVED_float; r : STD_ULOGIC) return UNRESOLVED_float; -- Reduction operators, same as numeric_std functions - function and_reduce (l : UNRESOLVED_float) return STD_ULOGIC; + function and_reduce (l : UNRESOLVED_float) return STD_ULOGIC; function nand_reduce (l : UNRESOLVED_float) return STD_ULOGIC; - function or_reduce (l : UNRESOLVED_float) return STD_ULOGIC; - function nor_reduce (l : UNRESOLVED_float) return STD_ULOGIC; - function xor_reduce (l : UNRESOLVED_float) return STD_ULOGIC; + function or_reduce (l : UNRESOLVED_float) return STD_ULOGIC; + function nor_reduce (l : UNRESOLVED_float) return STD_ULOGIC; + function xor_reduce (l : UNRESOLVED_float) return STD_ULOGIC; function xnor_reduce (l : UNRESOLVED_float) return STD_ULOGIC; -- Note: "sla", "sra", "sll", "slr", "rol" and "ror" not implemented. @@ -855,9 +858,9 @@ package float_pkg is size_res : UNRESOLVED_float) -- variable is only use for sizing return UNRESOLVED_float; - --=========================================================================== + -- =========================================================================== -- string and textio Functions - --=========================================================================== + -- =========================================================================== -- rtl_synthesis off -- pragma synthesis_off -- writes S:EEEE:FFFFFFFF @@ -868,7 +871,7 @@ package float_pkg is FIELD : in WIDTH := 0); -- width of field -- Reads SEEEEFFFFFFFF, "." and ":" are ignored - procedure READ (L : inout LINE; VALUE : out UNRESOLVED_float); + procedure READ (L : inout LINE; VALUE : out UNRESOLVED_float); procedure READ (L : inout LINE; VALUE : out UNRESOLVED_float; GOOD : out BOOLEAN); @@ -886,7 +889,7 @@ package float_pkg is FIELD : in WIDTH := 0); -- width of field -- Octal read with padding, no separators used - procedure OREAD (L : inout LINE; VALUE : out UNRESOLVED_float); + procedure OREAD (L : inout LINE; VALUE : out UNRESOLVED_float); procedure OREAD (L : inout LINE; VALUE : out UNRESOLVED_float; GOOD : out BOOLEAN); alias OCTAL_READ is OREAD [LINE, UNRESOLVED_FLOAT, BOOLEAN]; @@ -982,7 +985,11 @@ package float_pkg is arg : STD_LOGIC_VECTOR; size_res : UNRESOLVED_float) return UNRESOLVED_float; - + + -- For Verilog compatability + function realtobits (arg : REAL) return STD_LOGIC_VECTOR; + function bitstoreal (arg : STD_LOGIC_VECTOR) return REAL; + end package float_pkg; ------------------------------------------------------------------------------- -- Proposed package body for the VHDL-200x-FT float_pkg package @@ -990,8 +997,8 @@ end package float_pkg; -- Note that there are functional differences between the synthesis and -- simulation packages bodies. The Synthesis version is preferred. -- This package body supplies a recommended implementation of these functions --- Version : $Revision: 1.9 $ --- Date : $Date: 2007-04-04 13:59:52-04 $ +-- Version : $Revision: 2.2 $ +-- Date : $Date: 2010/09/22 18:26:46 $ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------- @@ -1015,11 +1022,11 @@ package body float_pkg is constant NSLV : STD_ULOGIC_VECTOR (0 downto 1) := (others => '0'); -- %%% Replicated functions - -- These funcitons are replicated so that we don't need to reference the new + -- These functions are replicated so that we don't need to reference the new -- 2006 package std.standard, std_logic_1164 and numeric_std. function maximum ( - l, r : integer) -- inputs - return integer is + l, r : INTEGER) -- inputs + return INTEGER is begin -- function max if l > r then return l; else return r; @@ -1027,8 +1034,8 @@ package body float_pkg is end function maximum; function minimum ( - l, r : integer) -- inputs - return integer is + l, r : INTEGER) -- inputs + return INTEGER is begin -- function min if l > r then return r; else return l; @@ -1063,19 +1070,19 @@ package body float_pkg is function or_reduce (arg : UNSIGNED) return STD_ULOGIC is begin - return or_reduce (std_ulogic_vector (arg)); + return or_reduce (STD_ULOGIC_VECTOR (arg)); end function or_reduce; function or_reduce (arg : SIGNED) return STD_ULOGIC is begin - return or_reduce (std_ulogic_vector (arg)); + return or_reduce (STD_ULOGIC_VECTOR (arg)); end function or_reduce; - function or_reduce (arg : std_logic_vector) + function or_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin - return or_reduce (std_ulogic_vector (arg)); + return or_reduce (STD_ULOGIC_VECTOR (arg)); end function or_reduce; -- purpose: AND all of the bits in a vector together @@ -1108,13 +1115,13 @@ package body float_pkg is function and_reduce (arg : UNSIGNED) return STD_ULOGIC is begin - return and_reduce (std_ulogic_vector (arg)); + return and_reduce (STD_ULOGIC_VECTOR (arg)); end function and_reduce; function and_reduce (arg : SIGNED) return STD_ULOGIC is begin - return and_reduce (std_ulogic_vector (arg)); + return and_reduce (STD_ULOGIC_VECTOR (arg)); end function and_reduce; function xor_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is @@ -1139,17 +1146,17 @@ package body float_pkg is return Result; end function xor_reduce; - function nand_reduce(arg : std_ulogic_vector) return STD_ULOGIC is + function nand_reduce(arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not and_reduce (arg); end function nand_reduce; - function nor_reduce(arg : std_ulogic_vector) return STD_ULOGIC is + function nor_reduce(arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not or_reduce (arg); end function nor_reduce; - function xnor_reduce(arg : std_ulogic_vector) return STD_ULOGIC is + function xnor_reduce(arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not xor_reduce (arg); end function xnor_reduce; @@ -1182,20 +1189,6 @@ package body float_pkg is ('1', '1', '1', '1', '1', '1', '1', '1', '1') -- | - | ); - constant no_match_logic_table : stdlogic_table := ( - ----------------------------------------------------- - -- U X 0 1 Z W L H - | | - ----------------------------------------------------- - ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '0'), -- | U | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | X | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | 0 | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | 1 | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | Z | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | W | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | L | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | H | - ('0', '0', '0', '0', '0', '0', '0', '0', '0') -- | - | - ); ------------------------------------------------------------------- -- ?= functions, Similar to "std_match", but returns "std_ulogic". @@ -1210,21 +1203,38 @@ package body float_pkg is -- %%% FUNCTION "?/=" ( l, r : std_ulogic ) RETURN std_ulogic is function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC is begin - return no_match_logic_table (l, r); + return not match_logic_table (l, r); end function \?/=\; -- %%% END FUNCTION "?/="; function \?=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC is + alias lv : STD_ULOGIC_VECTOR(1 to l'length) is l; + alias rv : STD_ULOGIC_VECTOR(1 to r'length) is r; + variable result, result1 : STD_ULOGIC; begin - return \?=\ (ufixed(l), ufixed(r)); + -- Logically identical to an "=" operator. + if ((l'length < 1) and (r'length < 1)) then + -- VHDL-2008 LRM 9.2.3 Two NULL arrays of the same type are equal + return '1'; + elsif lv'length /= rv'length then + -- Two arrays of different lengths are false + return '0'; + else + result := '1'; + for i in lv'low to lv'high loop + result1 := match_logic_table(lv(i), rv(i)); + result := result and result1; + end loop; + return result; + end if; end function \?=\; - function Is_X ( s : UNSIGNED ) return BOOLEAN is + function Is_X (s : UNSIGNED) return BOOLEAN is begin return Is_X (STD_LOGIC_VECTOR (s)); end function Is_X; - - function Is_X ( s : SIGNED ) return BOOLEAN is + + function Is_X (s : SIGNED) return BOOLEAN is begin return Is_X (STD_LOGIC_VECTOR (s)); end function Is_X; @@ -1293,12 +1303,12 @@ package body float_pkg is -- purpose: Test the boundary conditions of a Real number procedure test_boundary ( - arg : in REAL; -- Input, converted to real - constant fraction_width : in NATURAL; -- length of FP output fraction - constant exponent_width : in NATURAL; -- length of FP exponent - constant denormalize : in BOOLEAN := true; -- Use IEEE extended FP - variable btype : out boundary_type; - variable log2i : out INTEGER + arg : in REAL; -- Input, converted to real + constant fraction_width : in NATURAL; -- length of FP output fraction + constant exponent_width : in NATURAL; -- length of FP exponent + constant denormalize : in BOOLEAN := true; -- Use IEEE extended FP + variable btype : out boundary_type; + variable log2i : out INTEGER ) is constant expon_base : SIGNED (exponent_width-1 downto 0) := gen_expon_base(exponent_width); -- exponent offset @@ -1327,7 +1337,7 @@ package body float_pkg is if log2arg < to_integer(exp_min)-1 then btype := zero; else - btype := normal; -- Can still represent this number + btype := normal; -- Can still represent this number end if; end if; elsif exponent_width < 11 then @@ -1365,7 +1375,7 @@ package body float_pkg is if remainder(remainder'high) = '1' then -- round if (remainder'length > 1) then if ((or_reduce (remainder(remainder'high-1 - downto remainder'low)) = '1' + downto remainder'low)) = '1' or sticky = '1') or fract_in = '1') then -- Make the bottom bit zero if possible if we are at 1/2 @@ -1393,12 +1403,12 @@ package body float_pkg is -- purpose: Rounds depending on the state of the "round_style" -- unsigned version procedure fp_round ( - fract_in : in UNSIGNED; -- input fraction - expon_in : in SIGNED; -- input exponent - fract_out : out UNSIGNED; -- output fraction - expon_out : out SIGNED) is -- output exponent + fract_in : in UNSIGNED; -- input fraction + expon_in : in SIGNED; -- input exponent + fract_out : out UNSIGNED; -- output fraction + expon_out : out SIGNED) is -- output exponent begin -- procedure fp_round - if and_reduce (fract_in) = '1' then -- Fraction is all "1" + if and_reduce (fract_in) = '1' then -- Fraction is all "1" expon_out := expon_in + 1; fract_out := to_unsigned(0, fract_out'high+1); else @@ -1538,7 +1548,7 @@ package body float_pkg is -- purpose: converts the negative index to a positive one -- negative indices are illegal in 1164 and 1076.3 - function to_suv ( + function to_sulv ( arg : UNRESOLVED_float) -- fp vector return STD_ULOGIC_VECTOR is variable result : STD_ULOGIC_VECTOR (arg'length-1 downto 0); @@ -1548,19 +1558,19 @@ package body float_pkg is end if; result := STD_ULOGIC_VECTOR (arg); return result; - end function to_suv; + end function to_sulv; - -- Converts an fp into an SULV + -- Converts an fp into an SLV function to_slv (arg : UNRESOLVED_float) return STD_LOGIC_VECTOR is begin - return to_stdlogicvector (to_suv (arg)); + return to_stdlogicvector (to_sulv (arg)); end function to_slv; -- purpose: normalizes a floating point number -- This version assumes an "unsigned" input with function normalize ( - fract : UNSIGNED; -- fraction, unnormalized - expon : SIGNED; -- exponent, normalized by -1 + fract : UNSIGNED; -- fraction, unnormalized + expon : SIGNED; -- exponent, normalized by -1 sign : STD_ULOGIC; -- sign BIT sticky : STD_ULOGIC := '0'; -- Sticky bit (rounding) constant exponent_width : NATURAL := float_exponent_width; -- size of output exponent @@ -1576,61 +1586,51 @@ package body float_pkg is variable rexpon : UNSIGNED (exponent_width-1 downto 0); -- exponent variable result : UNRESOLVED_float (exponent_width downto -fraction_width); -- result variable shiftr : INTEGER; -- shift amount + variable stickyx : STD_ULOGIC; -- version of sticky constant expon_base : SIGNED (exponent_width-1 downto 0) := gen_expon_base(exponent_width); -- exponent offset - variable round : BOOLEAN; + variable round, zerores, infres : BOOLEAN; begin -- function normalize - result (exponent_width) := sign; -- sign bit - round := false; - shiftr := find_leftmost (to_01(fract), '1') -- Find the first "1" - - fraction_width - nguard; -- subtract the length we want + zerores := false; + infres := false; + round := false; + shiftr := find_leftmost (to_01(fract), '1') -- Find the first "1" + - fraction_width - nguard; -- subtract the length we want exp := resize (expon, exp'length) + shiftr; - if (or_reduce (fract) = '0') then -- Zero - result := zerofp (fraction_width => fraction_width, - exponent_width => exponent_width); + if (or_reduce (fract) = '0') then -- Zero + zerores := true; elsif ((exp <= -resize(expon_base, exp'length)-1) and denormalize) or ((exp < -resize(expon_base, exp'length)-1) and not denormalize) then if (exp >= -resize(expon_base, exp'length)-fraction_width-1) and denormalize then - exp := -resize(expon_base, exp'length); - shiftr := to_integer (expon + expon_base); -- new shift - sfract := fract sll shiftr; -- shift - if nguard > 0 then - round := check_round ( - fract_in => sfract (nguard), - sign => sign, - remainder => sfract(nguard-1 downto 0), - round_style => round_style); - end if; - if round then - fp_round(fract_in => sfract (fraction_width-1+nguard downto nguard), - expon_in => exp, - fract_out => rfract, - expon_out => rexp); - else - rfract := sfract (fraction_width-1+nguard downto nguard); - rexp := exp; - end if; - rexpon := UNSIGNED ((rexp(exponent_width-1 downto 0))-1); - rexpon(exponent_width-1) := not rexpon(exponent_width-1); - result (rexpon'range) := UNRESOLVED_float(rexpon); - result (-1 downto -fraction_width) := UNRESOLVED_float(rfract); + exp := -resize(expon_base, exp'length)-1; + shiftr := -to_integer (expon + expon_base); -- new shift else -- return zero - result := zerofp (fraction_width => fraction_width, - exponent_width => exponent_width); + zerores := true; end if; elsif (exp > expon_base-1) then -- infinity + infres := true; + end if; + if zerores then + result := zerofp (fraction_width => fraction_width, + exponent_width => exponent_width); + elsif infres then result := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); - result (exponent_width) := sign; -- redo sign bit for neg inf. - else -- normal number + else sfract := fract srl shiftr; -- shift + if shiftr > 0 then +-- stickyx := sticky or (or_reduce(fract (shiftr-1 downto 0))); + stickyx := sticky or smallfract (fract, shiftr-1); + else + stickyx := sticky; + end if; if nguard > 0 then round := check_round ( fract_in => sfract (nguard), sign => sign, remainder => sfract(nguard-1 downto 0), - sticky => sticky, + sticky => stickyx, round_style => round_style); end if; if round then @@ -1644,18 +1644,19 @@ package body float_pkg is end if; -- result rexpon := UNSIGNED (rexp(exponent_width-1 downto 0)); - rexpon(exponent_width-1) := not rexpon(exponent_width-1); + rexpon (exponent_width-1) := not rexpon(exponent_width-1); result (rexpon'range) := UNRESOLVED_float(rexpon); result (-1 downto -fraction_width) := UNRESOLVED_float(rfract); end if; + result (exponent_width) := sign; -- sign BIT return result; end function normalize; -- purpose: normalizes a floating point number -- This version assumes a "ufixed" input function normalize ( - fract : ufixed; -- unsigned fixed point - expon : SIGNED; -- exponent, normalized by -1 + fract : ufixed; -- unsigned fixed point + expon : SIGNED; -- exponent, normalized by -1 sign : STD_ULOGIC; -- sign bit sticky : STD_ULOGIC := '0'; -- Sticky bit (rounding) constant exponent_width : NATURAL := float_exponent_width; -- size of output exponent @@ -1685,8 +1686,8 @@ package body float_pkg is -- purpose: normalizes a floating point number -- This version assumes a "ufixed" input with a "size_res" input function normalize ( - fract : ufixed; -- unsigned fixed point - expon : SIGNED; -- exponent, normalized by -1 + fract : ufixed; -- unsigned fixed point + expon : SIGNED; -- exponent, normalized by -1 sign : STD_ULOGIC; -- sign bit sticky : STD_ULOGIC := '0'; -- Sticky bit (rounding) size_res : UNRESOLVED_float; -- used for sizing only @@ -1716,8 +1717,8 @@ package body float_pkg is -- Regular "normalize" function with a "size_res" input. function normalize ( - fract : UNSIGNED; -- unsigned - expon : SIGNED; -- exponent - 1, normalized + fract : UNSIGNED; -- unsigned + expon : SIGNED; -- exponent - 1, normalized sign : STD_ULOGIC; -- sign bit sticky : STD_ULOGIC := '0'; -- Sticky bit (rounding) size_res : UNRESOLVED_float; -- used for sizing only @@ -1825,8 +1826,8 @@ package body float_pkg is arg : in UNRESOLVED_float; denormalize : in BOOLEAN := float_denormalize; check_error : in BOOLEAN := float_check_error; - fract : out ufixed; -- 1 downto -fraction_width - expon : out SIGNED; -- exponent_width-1 downto 0 + fract : out ufixed; -- 1 downto -fraction_width + expon : out SIGNED; -- exponent_width-1 downto 0 sign : out STD_ULOGIC) is constant fraction_width : NATURAL := -mine(arg'low, arg'low); -- length of FP output fraction variable fptyp : valid_fpstate; @@ -1920,6 +1921,9 @@ package body float_pkg is elsif (lfptype = neg_inf or rfptype = neg_inf) then -- x - inf = -inf fpresult := neg_inffp (fraction_width => fraction_width, exponent_width => exponent_width); + elsif (lfptype = neg_zero and rfptype = neg_zero) then -- -0 + -0 = -0 + fpresult := neg_zerofp (fraction_width => fraction_width, + exponent_width => exponent_width); else lresize := resize (arg => to_x01(l), exponent_width => exponent_width, @@ -1939,7 +1943,7 @@ package body float_pkg is denormalize => denormalize, fract => ulfract, expon => exponl); - fractl := (others => '0'); + fractl := (others => '0'); fractl (fraction_width+addguard downto addguard) := ulfract; break_number ( arg => rresize, @@ -1947,7 +1951,7 @@ package body float_pkg is denormalize => denormalize, fract => urfract, expon => exponr); - fractr := (others => '0'); + fractr := (others => '0'); fractr (fraction_width+addguard downto addguard) := urfract; shiftx := (exponl(exponent_width-1) & exponl) - exponr; if shiftx < -fractl'high then @@ -2003,7 +2007,10 @@ package body float_pkg is sign := r(r'high); end if; end if; - -- normalize + if or_reduce (ufract) = '0' then + sign := '0'; -- IEEE 854, 6.3, paragraph 2. + end if; + -- normalize fpresult := normalize (fract => ufract, expon => rexpon, sign => sign, @@ -2027,7 +2034,7 @@ package body float_pkg is return UNRESOLVED_float is variable negr : UNRESOLVED_float (r'range); -- negative version of r begin - negr := -r; -- r := -r + negr := -r; return add (l => l, r => negr, round_style => round_style, @@ -2052,8 +2059,9 @@ package body float_pkg is variable fractl, fractr : UNSIGNED (fraction_width downto 0); -- fractions variable rfract : UNSIGNED ((2*(fraction_width))+1 downto 0); -- result fraction variable sfract : UNSIGNED (fraction_width+1+multguard downto 0); -- result fraction + variable shifty : INTEGER; -- denormal shift variable exponl, exponr : SIGNED (exponent_width-1 downto 0); -- exponents - variable rexpon : SIGNED (exponent_width downto 0); -- result exponent + variable rexpon : SIGNED (exponent_width+1 downto 0); -- result exponent variable fp_sign : STD_ULOGIC; -- sign of result variable lresize, rresize : UNRESOLVED_float (exponent_width downto -fraction_width); variable sticky : STD_ULOGIC; -- Holds precision for rounding @@ -2083,7 +2091,8 @@ package body float_pkg is fpresult := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); -- figure out the sign - fpresult (exponent_width) := l(l'high) xor r(r'high); + fp_sign := l(l'high) xor r(r'high); -- figure out the sign + fpresult (exponent_width) := fp_sign; else fp_sign := l(l'high) xor r(r'high); -- figure out the sign lresize := resize (arg => to_x01(l), @@ -2110,14 +2119,24 @@ package body float_pkg is denormalize => denormalize, fract => fractr, expon => exponr); + if (rfptype = pos_denormal or rfptype = neg_denormal) then + shifty := fraction_width - find_leftmost(fractr, '1'); + fractr := shift_left (fractr, shifty); + elsif (lfptype = pos_denormal or lfptype = neg_denormal) then + shifty := fraction_width - find_leftmost(fractl, '1'); + fractl := shift_left (fractl, shifty); + else + shifty := 0; + -- Note that a denormal number * a denormal number is always zero. + end if; -- multiply + -- add the exponents + rexpon := resize (exponl, rexpon'length) + exponr - shifty + 1; rfract := fractl * fractr; -- Multiply the fraction sfract := rfract (rfract'high downto rfract'high - (fraction_width+1+multguard)); sticky := or_reduce (rfract (rfract'high-(fraction_width+1+multguard) - downto 0)); - -- add the exponents - rexpon := (exponl(exponl'high)&exponl) + (exponr(exponr'high)&exponr) +1; + downto 0)); -- normalize fpresult := normalize (fract => sfract, expon => rexpon, @@ -2236,7 +2255,7 @@ package body float_pkg is end if; else fractg (fractg'high downto divguard) := fract; - denorm_offset := 0; + denorm_offset := 0; end if; expon := - expon - 3 + denorm_offset; sfract := onedivy (fractg); @@ -2274,9 +2293,9 @@ package body float_pkg is variable rfract : UNSIGNED (fractl'range); -- result fraction variable sfract : UNSIGNED (fraction_width+1+divguard downto 0); -- result fraction variable exponl, exponr : SIGNED (exponent_width-1 downto 0); -- exponents - variable rexpon : SIGNED (exponent_width downto 0); -- result exponent - variable fp_sign : STD_ULOGIC; -- sign of result - variable shifty : INTEGER; -- denormal number shift + variable rexpon : SIGNED (exponent_width+1 downto 0); -- result exponent + variable fp_sign, sticky : STD_ULOGIC; -- sign of result + variable shifty, shiftx : INTEGER; -- denormal number shift variable lresize, rresize : UNRESOLVED_float (exponent_width downto -fraction_width); begin -- divide if (fraction_width = 0 or l'length < 7 or r'length < 7) then @@ -2301,6 +2320,8 @@ package body float_pkg is else -- x / inf = 0 fpresult := zerofp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (fpresult'high) := fp_sign; -- sign end if; when pos_zero | neg_zero => if lfptype = pos_zero or lfptype = neg_zero -- 0 / 0 @@ -2315,9 +2336,10 @@ package body float_pkg is -- Infinity, define in 754-1985-7.2 fpresult := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (fpresult'high) := fp_sign; -- sign end if; when others => - fp_sign := l(l'high) xor r(r'high); -- sign classcase2 : case lfptype is when isx => fpresult := (others => 'X'); @@ -2328,11 +2350,15 @@ package body float_pkg is when pos_inf | neg_inf => -- inf / x = inf fpresult := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign fpresult(exponent_width) := fp_sign; when pos_zero | neg_zero => -- 0 / X = 0 fpresult := zerofp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult(exponent_width) := fp_sign; when others => + fp_sign := l(l'high) xor r(r'high); -- sign lresize := resize (arg => to_x01(l), exponent_width => exponent_width, fraction_width => fraction_width, @@ -2345,41 +2371,47 @@ package body float_pkg is denormalize_in => denormalize, denormalize => denormalize); rfptype := classfp (rresize, false); -- errors already checked - fractl := (others => '0'); break_number ( arg => lresize, fptyp => lfptype, denormalize => denormalize, fract => ulfract, expon => exponl); - fractl (fractl'high downto fractl'high-fraction_width) := ulfract; -- right side - fractr := (others => '0'); break_number ( arg => rresize, fptyp => rfptype, denormalize => denormalize, fract => urfract, expon => exponr); - fractr (fraction_width+divguard downto divguard) := urfract; - rexpon := (exponl(exponl'high)&exponl) - - (exponr(exponr'high)&exponr) - 2; + -- Compute the exponent + rexpon := resize (exponl, rexpon'length) - exponr - 2; if (rfptype = pos_denormal or rfptype = neg_denormal) then -- Do the shifting here not after. That way we have a smaller -- shifter, and need a smaller divider, because the top -- bit in the divisor will always be a "1". shifty := fraction_width - find_leftmost(urfract, '1'); - fractr := shift_left (fractr, shifty); + urfract := shift_left (urfract, shifty); rexpon := rexpon + shifty; end if; + fractr := (others => '0'); + fractr (fraction_width+divguard downto divguard) := urfract; + if (lfptype = pos_denormal or lfptype = neg_denormal) then + shiftx := fraction_width - find_leftmost(ulfract, '1'); + ulfract := shift_left (ulfract, shiftx); + rexpon := rexpon - shiftx; + end if; + fractl := (others => '0'); + fractl (fractl'high downto fractl'high-fraction_width) := ulfract; -- divide rfract := short_divide (fractl, fractr); -- unsigned divide sfract := rfract (sfract'range); -- lower bits + sticky := '1'; -- normalize fpresult := normalize (fract => sfract, expon => rexpon, sign => fp_sign, - sticky => '1', + sticky => sticky, fraction_width => fraction_width, exponent_width => exponent_width, round_style => round_style, @@ -2429,6 +2461,8 @@ package body float_pkg is else -- x / inf = 0 fpresult := zerofp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (fpresult'high) := fp_sign; -- sign end if; when pos_zero | neg_zero => if lfptype = pos_zero or lfptype = neg_zero then -- 0 / 0 @@ -2442,6 +2476,8 @@ package body float_pkg is -- Infinity, define in 754-1985-7.2 fpresult := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (fpresult'high) := fp_sign; -- sign end if; when others => classcase2 : case lfptype is @@ -2454,11 +2490,15 @@ package body float_pkg is when pos_inf | neg_inf => -- inf / x = inf fpresult := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); - fpresult(exponent_width) := l(exponent_width) xor r(exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (exponent_width) := fp_sign; -- sign when pos_zero | neg_zero => -- 0 / X = 0 fpresult := zerofp (fraction_width => fraction_width, exponent_width => exponent_width); + fp_sign := l(l'high) xor r(r'high); -- sign + fpresult (exponent_width) := fp_sign; -- sign when others => + fp_sign := l(l'high) xor r(r'high); -- sign lresize := resize (arg => to_x01(l), exponent_width => exponent_width, fraction_width => fraction_width, @@ -2471,7 +2511,6 @@ package body float_pkg is denormalize_in => denormalize, denormalize => denormalize); rfptype := classfp (rresize, false); -- errors already checked - fp_sign := l(l'high) xor r(r'high); -- sign break_number ( arg => lresize, fptyp => lfptype, @@ -2527,8 +2566,9 @@ package body float_pkg is variable rfract : UNSIGNED ((2*(fraction_width))+1 downto 0); -- result fraction variable sfract, ufract : UNSIGNED (fraction_width+1+guard downto 0); -- result fraction variable exponl, exponr, exponc : SIGNED (exponent_width-1 downto 0); -- exponents - variable shiftx : SIGNED (exponent_width downto 0); -- shift fractions - variable rexpon, rexpon2 : SIGNED (exponent_width downto 0); -- result exponent + variable rexpon, rexpon2 : SIGNED (exponent_width+1 downto 0); -- result exponent + variable shifty : INTEGER; -- denormal shift + variable shiftx : SIGNED (rexpon'range); -- shift fractions variable fp_sign : STD_ULOGIC; -- sign of result variable lresize, rresize : UNRESOLVED_float (exponent_width downto -fraction_width); variable cresize : UNRESOLVED_float (exponent_width downto -fraction_width - guard); @@ -2602,13 +2642,23 @@ package body float_pkg is denormalize => denormalize, fract => fractx, expon => exponc); + if (rfptype = pos_denormal or rfptype = neg_denormal) then + shifty := fraction_width - find_leftmost(fractr, '1'); + fractr := shift_left (fractr, shifty); + elsif (lfptype = pos_denormal or lfptype = neg_denormal) then + shifty := fraction_width - find_leftmost(fractl, '1'); + fractl := shift_left (fractl, shifty); + else + shifty := 0; + -- Note that a denormal number * a denormal number is always zero. + end if; -- multiply rfract := fractl * fractr; -- Multiply the fraction -- add the exponents - rexpon := (exponl(exponl'high)&exponl) + (exponr(exponr'high)&exponr) +1; + rexpon := resize (exponl, rexpon'length) + exponr - shifty + 1; shiftx := rexpon - exponc; if shiftx < -fractl'high then - rexpon2 := exponc(exponent_width-1) & exponc; + rexpon2 := resize (exponc, rexpon2'length); fractc := "0" & fractx; fracts := (others => '0'); sticky := or_reduce (rfract); @@ -2618,12 +2668,12 @@ package body float_pkg is - fracts'length+1), to_integer(shiftx)); fractc := "0" & fractx; - rexpon2 := exponc(exponent_width-1) & exponc; + rexpon2 := resize (exponc, rexpon2'length); leftright := false; sticky := or_reduce (rfract (to_integer(shiftx)+rfract'high - - fracts'length downto 0)); + - fracts'length downto 0)); elsif shiftx = 0 then - rexpon2 := exponc(exponent_width-1) & exponc; + rexpon2 := resize (exponc, rexpon2'length); sticky := or_reduce (rfract (rfract'high - fractc'length downto 0)); if rfract (rfract'high downto rfract'high - fractc'length+1) > fractx then @@ -2643,14 +2693,14 @@ package body float_pkg is fractc := rfract (rfract'high downto rfract'high - fractc'length+1); leftright := true; sticky := or_reduce (fractx & rfract (rfract'high - fractc'length - downto 0)); + downto 0)); else -- fractx'high > shiftx > 0 rexpon2 := rexpon; fracts := "0" & shift_right (fractx, to_integer (shiftx)); fractc := rfract (rfract'high downto rfract'high - fractc'length+1); leftright := true; sticky := or_reduce (fractx (to_integer (shiftx) downto 0) - & rfract (rfract'high - fractc'length downto 0)); + & rfract (rfract'high - fractc'length downto 0)); end if; fracts (0) := fracts (0) or sticky; -- Or the sticky bit into the LSB if fp_sign = to_X01(c(c'high)) then @@ -2746,7 +2796,7 @@ package body float_pkg is expon => exponl); fractl (fraction_width+divguard downto divguard) := ulfract; -- right side - fractr := (others => '0'); + fractr := (others => '0'); break_number ( arg => rresize, fptyp => rfptype, @@ -2754,8 +2804,8 @@ package body float_pkg is fract => urfract, expon => exponr); fractr (fraction_width+divguard downto divguard) := urfract; - rexpon := (exponr(exponr'high)&exponr); - shifty := to_integer(exponl - rexpon); + rexpon := (exponr(exponr'high)&exponr); + shifty := to_integer(exponl - rexpon); if (shifty > 0) then fractr := shift_right (fractr, shifty); rexpon := rexpon + shifty; @@ -2916,6 +2966,7 @@ package body float_pkg is end function sqrt; function Is_Negative (arg : UNRESOLVED_float) return BOOLEAN is + -- Technically -0 should return "false", but I'm leaving that case out. begin return (to_x01(arg(arg'high)) = '1'); end function Is_Negative; @@ -3180,7 +3231,7 @@ package body float_pkg is fraction_width => fraction_width, denormalize_in => float_denormalize, denormalize => float_denormalize); - is_equal := \?=\ (to_suv(lresize), to_suv(rresize)); + is_equal := \?=\ (to_sulv(lresize), to_sulv(rresize)); end if; if (float_check_error) then if (lfptype = nan or lfptype = quiet_nan or @@ -3222,7 +3273,7 @@ package body float_pkg is fraction_width => fraction_width, denormalize_in => float_denormalize, denormalize => float_denormalize); - is_equal := \?=\ (to_suv(lresize), to_suv(rresize)); + is_equal := \?=\ (to_sulv(lresize), to_sulv(rresize)); end if; if (float_check_error) then if (lfptype = nan or lfptype = quiet_nan or @@ -3368,7 +3419,7 @@ package body float_pkg is function std_match (L, R : UNRESOLVED_float) return BOOLEAN is begin if (L'high = R'high and L'low = R'low) then - return std_match(to_suv(L), to_suv(R)); + return std_match(to_sulv(L), to_sulv(R)); else report float_pkg'instance_name & "STD_MATCH: L'RANGE /= R'RANGE, returning FALSE" @@ -3551,10 +3602,10 @@ package body float_pkg is result (exponent_width-1 downto 0) := (others => '1'); else -- invert top BIT - expon_in(expon_in'high) := not expon_in(expon_in'high); + expon_in(expon_in'high) := not expon_in(expon_in'high); expon_out := resize (expon_in, expon_out'length); -- signed expand -- Flip it back. - expon_out(expon_out'high) := not expon_out(expon_out'high); + expon_out(expon_out'high) := not expon_out(expon_out'high); result (exponent_width-1 downto 0) := UNRESOLVED_float(expon_out); end if; result (exponent_width) := arg (in_exponent_width); -- sign @@ -3695,14 +3746,14 @@ package body float_pkg is expon := (others => '0'); frac := arg_real * (2.0 ** (to_integer(expon_base)-1)); else -- Number less than 1. "normal" number - expon := UNSIGNED (to_signed (exp-1, exponent_width)); + expon := UNSIGNED (to_signed (exp-1, exponent_width)); expon(exponent_width-1) := not expon(exponent_width-1); - frac := (arg_real / 2.0 ** exp) - 1.0; -- Number less than 1. + frac := (arg_real / 2.0 ** exp) - 1.0; -- Number less than 1. end if; for i in 0 to fract'high loop if frac >= 2.0 ** (-1 - i) then fract (fract'high - i) := '1'; - frac := frac - 2.0 ** (-1 - i); + frac := frac - 2.0 ** (-1 - i); else fract (fract'high - i) := '0'; end if; @@ -3725,7 +3776,7 @@ package body float_pkg is null; -- don't round end case; if (round) then - if and_reduce (fract) = '1' then -- fraction is all "1" + if and_reduce (fract) = '1' then -- fraction is all "1" expon := expon + 1; fract := (others => '0'); else @@ -3844,67 +3895,20 @@ package body float_pkg is constant fraction_width : NATURAL := float_fraction_width; -- length of FP output fraction constant round_style : round_type := float_round_style) -- rounding option return UNRESOLVED_float is - variable result : UNRESOLVED_float (exponent_width downto -fraction_width); - constant ARG_LEFT : INTEGER := ARG'length-1; - alias XARG : UNSIGNED(ARG_LEFT downto 0) is ARG; - variable arg_int : UNSIGNED(xarg'range); -- Real version of argument - variable argb2 : UNSIGNED(xarg'high/2 downto 0); -- log2 of input - variable rexp : SIGNED (exponent_width - 1 downto 0); - variable exp : SIGNED (exponent_width - 1 downto 0); - -- signed version of exp. - variable expon : UNSIGNED (exponent_width - 1 downto 0); - -- Unsigned version of exp. - constant expon_base : SIGNED (exponent_width-1 downto 0) := - gen_expon_base(exponent_width); -- exponent offset - variable round : BOOLEAN; - variable fract : UNSIGNED (fraction_width-1 downto 0); - variable rfract : UNSIGNED (fraction_width-1 downto 0); + variable result : UNRESOLVED_float (exponent_width downto -fraction_width); + constant ARG_LEFT : INTEGER := ARG'length-1; + alias XARG : UNSIGNED(ARG_LEFT downto 0) is ARG; + variable sarg : SIGNED (ARG_LEFT+1 downto 0); -- signed version of arg begin - arg_int := UNSIGNED(to_x01(STD_LOGIC_VECTOR (xarg))); - if Is_X (arg_int) then - result := (others => 'X'); - elsif (arg_int = 0) then - result := zerofp (fraction_width => fraction_width, - exponent_width => exponent_width); - else -- Normal number (can't be denormal) - result (exponent_width) := '0'; -- positive sign - -- Compute Exponent - argb2 := to_unsigned(find_leftmost(arg_int, '1'), argb2'length); -- Log2 - if argb2 > UNSIGNED(expon_base) then - result := pos_inffp (fraction_width => fraction_width, - exponent_width => exponent_width); - else - exp := SIGNED(resize(argb2, exp'length)); - arg_int := shift_left (arg_int, arg_int'high-to_integer(exp)); - if (arg_int'high > fraction_width) then - fract := arg_int (arg_int'high-1 downto (arg_int'high-fraction_width)); - round := check_round ( - fract_in => fract (0), - sign => '0', - remainder => arg_int((arg_int'high-fraction_width-1) - downto 0), - round_style => round_style); - if round then - fp_round(fract_in => fract, - expon_in => exp, - fract_out => rfract, - expon_out => rexp); - else - rfract := fract; - rexp := exp; - end if; - else - rexp := exp; - rfract := (others => '0'); - rfract (fraction_width-1 downto fraction_width-1-(arg_int'high-1)) := - arg_int (arg_int'high-1 downto 0); - end if; - expon := UNSIGNED (rexp-1); - expon(exponent_width-1) := not expon(exponent_width-1); - result (exponent_width-1 downto 0) := UNRESOLVED_float(expon); - result (-1 downto -fraction_width) := UNRESOLVED_float(rfract); - end if; + if arg'length < 1 then + return NAFP; end if; + sarg (XARG'range) := SIGNED (XARG); + sarg (sarg'high) := '0'; + result := to_float (arg => sarg, + exponent_width => exponent_width, + fraction_width => fraction_width, + round_style => round_style); return result; end function to_float; @@ -3930,20 +3934,25 @@ package body float_pkg is variable round : BOOLEAN; variable fract : UNSIGNED (fraction_width-1 downto 0); variable rfract : UNSIGNED (fraction_width-1 downto 0); + variable sign : STD_ULOGIC; -- sign bit begin + if arg'length < 1 then + return NAFP; + end if; if Is_X (xarg) then result := (others => 'X'); elsif (xarg = 0) then result := zerofp (fraction_width => fraction_width, exponent_width => exponent_width); else -- Normal number (can't be denormal) - result (exponent_width) := to_X01(xarg (xarg'high)); - arg_int := UNSIGNED(abs (to_01(xarg))); + sign := to_X01(xarg (xarg'high)); + arg_int := UNSIGNED(abs (to_01(xarg))); -- Compute Exponent - argb2 := to_unsigned(find_leftmost(arg_int, '1'), argb2'length); -- Log2 + argb2 := to_unsigned(find_leftmost(arg_int, '1'), argb2'length); -- Log2 if argb2 > UNSIGNED(expon_base) then result := pos_inffp (fraction_width => fraction_width, exponent_width => exponent_width); + result (exponent_width) := sign; else exp := SIGNED(resize(argb2, exp'length)); arg_int := shift_left (arg_int, arg_int'high-to_integer(exp)); @@ -3951,7 +3960,7 @@ package body float_pkg is fract := arg_int (arg_int'high-1 downto (arg_int'high-fraction_width)); round := check_round ( fract_in => fract (0), - sign => result (exponent_width), + sign => sign, remainder => arg_int((arg_int'high-fraction_width-1) downto 0), round_style => round_style); @@ -3970,7 +3979,8 @@ package body float_pkg is rfract (fraction_width-1 downto fraction_width-1-(arg_int'high-1)) := arg_int (arg_int'high-1 downto 0); end if; - expon := UNSIGNED (rexp-1); + result (exponent_width) := sign; + expon := UNSIGNED (rexp-1); expon(exponent_width-1) := not expon(exponent_width-1); result (exponent_width-1 downto 0) := UNRESOLVED_float(expon); result (-1 downto -fraction_width) := UNRESOLVED_float(rfract); @@ -3987,6 +3997,9 @@ package body float_pkg is return UNRESOLVED_float is variable fpvar : UNRESOLVED_float (exponent_width downto -fraction_width); begin + if arg'length < 1 then + return NAFP; + end if; fpvar := UNRESOLVED_float(arg); return fpvar; end function to_float; @@ -3999,90 +4012,19 @@ package body float_pkg is constant round_style : round_type := float_round_style; -- rounding constant denormalize : BOOLEAN := float_denormalize) -- use ieee extensions return UNRESOLVED_float is - constant integer_width : INTEGER := arg'high; - constant in_fraction_width : INTEGER := arg'low; - variable xresult : ufixed (integer_width downto in_fraction_width); + variable sarg : sfixed (arg'high+1 downto arg'low); -- Signed version of arg variable result : UNRESOLVED_float (exponent_width downto -fraction_width); - variable arg_int : UNSIGNED (integer_width - in_fraction_width downto 0); - variable exp, exptmp : SIGNED (exponent_width downto 0); - variable expon : UNSIGNED (exponent_width - 1 downto 0); -- Unsigned version of exp. - constant expon_base : SIGNED (exponent_width-1 downto 0) := - gen_expon_base(exponent_width); -- exponent offset - variable fract, fracttmp : UNSIGNED (fraction_width-1 downto 0) := - (others => '0'); - variable round : BOOLEAN := false; begin -- function to_float - xresult := to_01(arg, 'X'); - arg_int := UNSIGNED(to_slv(xresult)); - if Is_X (arg_int) then - result := (others => 'X'); - elsif (arg_int = 0) then - result := (others => '0'); -- return zero - else - result := (others => '0'); -- positive sign - -- Compute Exponent - exp := to_signed(find_leftmost(arg_int, '1'), exp'length); -- Log2 - if exp + in_fraction_width > expon_base then -- return infinity - result := pos_inffp (fraction_width => fraction_width, - exponent_width => exponent_width); - return result; - elsif (denormalize and - (exp + in_fraction_width <= -resize(expon_base, exp'length))) then - -- denormal number - exp := -resize(expon_base, exp'length); - -- shift by a constant - arg_int := shift_left (arg_int, - (arg_int'high + to_integer(expon_base) - + in_fraction_width - 1)); - if (arg_int'high > fraction_width) then - fract := arg_int (arg_int'high-1 downto (arg_int'high-fraction_width)); - round := check_round ( - fract_in => arg_int(arg_int'high-fraction_width), - sign => '0', - remainder => arg_int((arg_int'high-fraction_width-1) - downto 0), - round_style => round_style); - if (round) then - fp_round (fract_in => arg_int (arg_int'high-1 downto - (arg_int'high-fraction_width)), - expon_in => exp, - fract_out => fract, - expon_out => exptmp); - exp := exptmp; - end if; - else - fract (fraction_width-1 downto fraction_width-1-(arg_int'high-1)) := - arg_int (arg_int'high-1 downto 0); - end if; - else - arg_int := shift_left (arg_int, arg_int'high-to_integer(exp)); - exp := exp + in_fraction_width; - if (arg_int'high > fraction_width) then - fract := arg_int (arg_int'high-1 downto (arg_int'high-fraction_width)); - round := check_round ( - fract_in => fract(0), - sign => '0', - remainder => arg_int((arg_int'high-fraction_width-1) - downto 0), - round_style => round_style); - if (round) then - fp_round (fract_in => fract, - expon_in => exp, - fract_out => fracttmp, - expon_out => exptmp); - fract := fracttmp; - exp := exptmp; - end if; - else - fract (fraction_width-1 downto fraction_width-1-(arg_int'high-1)) := - arg_int (arg_int'high-1 downto 0); - end if; - end if; - expon := UNSIGNED (resize (exp-1, exponent_width)); - expon(exponent_width-1) := not expon(exponent_width-1); - result (exponent_width-1 downto 0) := UNRESOLVED_float(expon); - result (-1 downto -fraction_width) := UNRESOLVED_float(fract); + if (arg'length < 1) then + return NAFP; end if; + sarg (arg'range) := sfixed (arg); + sarg (sarg'high) := '0'; + result := to_float (arg => sarg, + exponent_width => exponent_width, + fraction_width => fraction_width, + round_style => round_style, + denormalize => denormalize); return result; end function to_float; @@ -4095,12 +4037,12 @@ package body float_pkg is return UNRESOLVED_float is constant integer_width : INTEGER := arg'high; constant in_fraction_width : INTEGER := arg'low; - variable xresult : sfixed (integer_width downto in_fraction_width); - variable result : UNRESOLVED_float (exponent_width downto -fraction_width); - variable arg_int : UNSIGNED(integer_width - in_fraction_width - 1 - downto 0); -- signed version of argument + variable xresult : sfixed (integer_width downto in_fraction_width); + variable result : UNRESOLVED_float (exponent_width downto -fraction_width); + variable arg_int : UNSIGNED(integer_width - in_fraction_width + downto 0); -- unsigned version of argument variable argx : SIGNED (integer_width - in_fraction_width downto 0); - variable exp, exptmp : SIGNED (exponent_width downto 0); + variable exp, exptmp : SIGNED (exponent_width + 1 downto 0); variable expon : UNSIGNED (exponent_width - 1 downto 0); -- Unsigned version of exp. constant expon_base : SIGNED (exponent_width-1 downto 0) := @@ -4109,9 +4051,12 @@ package body float_pkg is (others => '0'); variable round : BOOLEAN := false; begin + if (arg'length < 1) then + return NAFP; + end if; xresult := to_01(arg, 'X'); argx := SIGNED(to_slv(xresult)); - if (or_reduce (UNSIGNED(argx)) = 'X') then + if (Is_X (arg)) then result := (others => 'X'); elsif (argx = 0) then result := (others => '0'); @@ -4119,11 +4064,11 @@ package body float_pkg is result := (others => '0'); -- zero out the result if argx(argx'left) = '1' then -- toss the sign bit result (exponent_width) := '1'; -- Negative number - argx := -argx; -- Make it positive. + arg_int := UNSIGNED(to_x01(not STD_LOGIC_VECTOR (argx))) + 1; -- Make it positive with two's complement else result (exponent_width) := '0'; + arg_int := UNSIGNED(to_x01(STD_LOGIC_VECTOR (argx))); -- new line: direct conversion to unsigned end if; - arg_int := UNSIGNED(to_x01(STD_LOGIC_VECTOR (argx(arg_int'range)))); -- Compute Exponent exp := to_signed(find_leftmost(arg_int, '1'), exp'length); -- Log2 if exp + in_fraction_width > expon_base then -- return infinity @@ -4330,8 +4275,8 @@ package body float_pkg is -- to_integer (float) function to_integer ( arg : UNRESOLVED_float; -- floating point input - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return INTEGER is variable validfp : valid_fpstate; -- Valid FP state variable frac : UNSIGNED (-arg'low downto 0); -- Fraction @@ -4404,11 +4349,11 @@ package body float_pkg is function to_unsigned ( arg : UNRESOLVED_float; -- floating point input constant size : NATURAL; -- length of output - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return UNSIGNED is variable validfp : valid_fpstate; -- Valid FP state - variable frac : UNSIGNED (size-1 downto 0); -- Fraction + variable frac : UNSIGNED (size-1 downto 0); -- Fraction variable sign : STD_ULOGIC; -- not used begin validfp := classfp (arg, check_error); @@ -4435,12 +4380,12 @@ package body float_pkg is function to_signed ( arg : UNRESOLVED_float; -- floating point input constant size : NATURAL; -- length of output - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return SIGNED is variable sign : STD_ULOGIC; -- true if negative variable validfp : valid_fpstate; -- Valid FP state - variable frac : UNSIGNED (size-1 downto 0); -- Fraction + variable frac : UNSIGNED (size-1 downto 0); -- Fraction variable result : SIGNED (size-1 downto 0); begin validfp := classfp (arg, check_error); @@ -4489,14 +4434,14 @@ package body float_pkg is arg : UNRESOLVED_float; -- fp input constant left_index : INTEGER; -- integer part constant right_index : INTEGER; -- fraction part - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_ufixed is - constant fraction_width : INTEGER := -mine(arg'low, arg'low); -- length of FP output fraction - constant exponent_width : INTEGER := arg'high; -- length of FP output exponent - constant size : INTEGER := left_index - right_index + 4; -- unsigned size + constant fraction_width : INTEGER := -mine(arg'low, arg'low); -- length of FP output fraction + constant exponent_width : INTEGER := arg'high; -- length of FP output exponent + constant size : INTEGER := left_index - right_index + 4; -- unsigned size variable expon_base : INTEGER; -- exponent offset variable validfp : valid_fpstate; -- Valid FP state variable exp : INTEGER; -- Exponent @@ -4561,14 +4506,14 @@ package body float_pkg is arg : UNRESOLVED_float; -- fp input constant left_index : INTEGER; -- integer part constant right_index : INTEGER; -- fraction part - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_sfixed is - constant fraction_width : INTEGER := -mine(arg'low, arg'low); -- length of FP output fraction - constant exponent_width : INTEGER := arg'high; -- length of FP output exponent - constant size : INTEGER := left_index - right_index + 4; -- unsigned size + constant fraction_width : INTEGER := -mine(arg'low, arg'low); -- length of FP output fraction + constant exponent_width : INTEGER := arg'high; -- length of FP output exponent + constant size : INTEGER := left_index - right_index + 4; -- unsigned size variable expon_base : INTEGER; -- exponent offset variable validfp : valid_fpstate; -- Valid FP state variable exp : INTEGER; -- Exponent @@ -4581,8 +4526,8 @@ package body float_pkg is variable rsigned : SIGNED (size-1 downto 0); -- signed version of result variable result_big : UNRESOLVED_sfixed (left_index downto right_index-3); variable result : UNRESOLVED_sfixed (left_index downto right_index) - := (others => '0'); -- result - begin -- function to_ufixed + := (others => '0'); -- result + begin -- function to_sfixed validfp := classfp (arg, check_error); classcase : case validfp is when isx | nan | quiet_nan => @@ -4650,8 +4595,8 @@ package body float_pkg is function to_unsigned ( arg : UNRESOLVED_float; -- floating point input size_res : UNSIGNED; - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return UNSIGNED is variable result : UNSIGNED (size_res'range); begin @@ -4661,8 +4606,8 @@ package body float_pkg is result := to_unsigned ( arg => arg, size => size_res'length, - check_error => check_error, - round_style => round_style); + round_style => round_style, + check_error => check_error); return result; end if; end function to_unsigned; @@ -4671,8 +4616,8 @@ package body float_pkg is function to_signed ( arg : UNRESOLVED_float; -- floating point input size_res : SIGNED; - constant check_error : BOOLEAN := float_check_error; -- check for errors - constant round_style : round_type := float_round_style) -- rounding option + constant round_style : round_type := float_round_style; -- rounding option + constant check_error : BOOLEAN := float_check_error) -- check for errors return SIGNED is variable result : SIGNED (size_res'range); begin @@ -4682,8 +4627,8 @@ package body float_pkg is result := to_signed ( arg => arg, size => size_res'length, - check_error => check_error, - round_style => round_style); + round_style => round_style, + check_error => check_error); return result; end if; end function to_signed; @@ -4692,8 +4637,8 @@ package body float_pkg is function to_ufixed ( arg : UNRESOLVED_float; -- fp input size_res : UNRESOLVED_ufixed; - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_ufixed is @@ -4706,8 +4651,8 @@ package body float_pkg is arg => arg, left_index => size_res'high, right_index => size_res'low, - round_style => round_style, overflow_style => overflow_style, + round_style => round_style, check_error => check_error, denormalize => denormalize); return result; @@ -4718,8 +4663,8 @@ package body float_pkg is function to_sfixed ( arg : UNRESOLVED_float; -- fp input size_res : UNRESOLVED_sfixed; - constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant overflow_style : fixed_overflow_style_type := fixed_overflow_style; -- saturate + constant round_style : fixed_round_style_type := fixed_round_style; -- rounding constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) return UNRESOLVED_sfixed is @@ -4732,8 +4677,8 @@ package body float_pkg is arg => arg, left_index => size_res'high, right_index => size_res'low, - round_style => round_style, overflow_style => overflow_style, + round_style => round_style, check_error => check_error, denormalize => denormalize); return result; @@ -4744,7 +4689,6 @@ package body float_pkg is -- typically not Synthesizable unless the input is a constant. function to_real ( arg : UNRESOLVED_float; -- floating point input - constant round_style : round_type := float_round_style; -- rounding option constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) -- Use IEEE extended FP return REAL is @@ -4793,6 +4737,25 @@ package body float_pkg is end case classcase; end function to_real; + -- For Verilog compatability + function realtobits (arg : REAL) return STD_ULOGIC_VECTOR is + variable result : float64; -- 64 bit floating point + begin + result := to_float (arg => arg, + exponent_width => float64'high, + fraction_width => -float64'low); + return to_sulv (result); + end function realtobits; + + function bitstoreal (arg : STD_ULOGIC_VECTOR) return REAL is + variable arg64 : float64; -- arg converted to float + begin + arg64 := to_float (arg => arg, + exponent_width => float64'high, + fraction_width => -float64'low); + return to_real (arg64); + end function bitstoreal; + -- purpose: Removes meta-logical values from FP string function to_01 ( arg : UNRESOLVED_float; -- floating point input @@ -5472,67 +5435,101 @@ package body float_pkg is ---------------------------------------------------------------------------- -- logical functions ---------------------------------------------------------------------------- - function "not" (l : UNRESOLVED_float) return UNRESOLVED_float is - variable RESULT : STD_ULOGIC_VECTOR(l'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (l'range); -- back to float + function "not" (L : UNRESOLVED_float) return UNRESOLVED_float is + variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto begin - RESULT := not to_suv(l); - resfp := UNRESOLVED_float (RESULT); - return resfp; + RESULT := not to_sulv(L); + return to_float (RESULT, L'high, -L'low); end function "not"; function "and" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float - begin - RESULT := to_suv(L) and to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + begin + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) and to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """and"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "and"; function "or" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float begin - RESULT := to_suv(L) or to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) or to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """or"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "or"; function "nand" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float begin - RESULT := to_suv(L) nand to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) nand to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """nand"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "nand"; function "nor" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float begin - RESULT := to_suv(L) nor to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) nor to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """nor"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "nor"; function "xor" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float begin - RESULT := to_suv(L) xor to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) xor to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """xor"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "xor"; function "xnor" (L, R : UNRESOLVED_float) return UNRESOLVED_float is variable RESULT : STD_ULOGIC_VECTOR(L'length-1 downto 0); -- force downto - variable resfp : UNRESOLVED_float (L'range); -- back to float begin - RESULT := to_suv(L) xnor to_suv(R); - resfp := UNRESOLVED_float (RESULT); - return resfp; + if (L'high = R'high and L'low = R'low) then + RESULT := to_sulv(L) xnor to_sulv(R); + else + assert NO_WARNING + report float_pkg'instance_name + & """xnor"": Range error L'RANGE /= R'RANGE" + severity warning; + RESULT := (others => 'X'); + end if; + return to_float (RESULT, L'high, -L'low); end function "xnor"; -- Vector and std_ulogic functions, same as functions in numeric_std @@ -5660,32 +5657,32 @@ package body float_pkg is function and_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return and_reduce (to_suv(l)); + return and_reduce (to_sulv(l)); end function and_reduce; function nand_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return nand_reduce (to_suv(l)); + return nand_reduce (to_sulv(l)); end function nand_reduce; function or_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return or_reduce (to_suv(l)); + return or_reduce (to_sulv(l)); end function or_reduce; function nor_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return nor_reduce (to_suv(l)); + return nor_reduce (to_sulv(l)); end function nor_reduce; function xor_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return xor_reduce (to_suv(l)); + return xor_reduce (to_sulv(l)); end function xor_reduce; function xnor_reduce (l : UNRESOLVED_float) return STD_ULOGIC is begin - return xnor_reduce (to_suv(l)); + return xnor_reduce (to_sulv(l)); end function xnor_reduce; ----------------------------------------------------------------------------- @@ -5750,8 +5747,8 @@ package body float_pkg is -- Returns y * 2**n for integral values of N without computing 2**n function Scalb ( - y : UNRESOLVED_float; -- floating point input - N : SIGNED; -- exponent to add + y : UNRESOLVED_float; -- floating point input + N : SIGNED; -- exponent to add constant round_style : round_type := float_round_style; -- rounding option constant check_error : BOOLEAN := float_check_error; -- check for errors constant denormalize : BOOLEAN := float_denormalize) -- Use IEEE extended FP @@ -5877,7 +5874,7 @@ package body float_pkg is fract := (others => '0'); fract(0) := '1'; elsif validfpx = pos_normal then - if and_reduce (fract) = '1' then -- fraction is all "1". + if and_reduce (fract) = '1' then -- fraction is all "1". if and_reduce (expon (exponent_width-1 downto 1)) = '1' and expon (0) = '0' then -- Exponent is one away from infinity. @@ -5895,7 +5892,7 @@ package body float_pkg is fract := fract + 1; end if; elsif validfpx = pos_denormal then - if and_reduce (fract) = '1' then -- fraction is all "1". + if and_reduce (fract) = '1' then -- fraction is all "1". -- return smallest possible normal number expon := (others => '0'); expon(0) := '1'; @@ -5904,7 +5901,7 @@ package body float_pkg is fract := fract + 1; end if; elsif validfpx = neg_normal then - if or_reduce (fract) = '0' then -- fraction is all "0". + if or_reduce (fract) = '0' then -- fraction is all "0". if or_reduce (expon (exponent_width-1 downto 1)) = '0' and expon (0) = '1' then -- Smallest exponent -- return the largest negative denormal number @@ -5941,7 +5938,7 @@ package body float_pkg is fract := (others => '0'); fract(0) := '1'; elsif validfpx = neg_normal then - if and_reduce (fract) = '1' then -- fraction is all "1". + if and_reduce (fract) = '1' then -- fraction is all "1". if and_reduce (expon (exponent_width-1 downto 1)) = '1' and expon (0) = '0' then -- Exponent is one away from infinity. @@ -5959,7 +5956,7 @@ package body float_pkg is fract := fract + 1; end if; elsif validfpx = neg_denormal then - if and_reduce (fract) = '1' then -- fraction is all "1". + if and_reduce (fract) = '1' then -- fraction is all "1". -- return smallest possible normal number expon := (others => '0'); expon(0) := '1'; @@ -5968,7 +5965,7 @@ package body float_pkg is fract := fract + 1; end if; elsif validfpx = pos_normal then - if or_reduce (fract) = '0' then -- fraction is all "0". + if or_reduce (fract) = '0' then -- fraction is all "0". if or_reduce (expon (exponent_width-1 downto 1)) = '0' and expon (0) = '1' then -- Smallest exponent -- return the largest positive denormal number @@ -6061,7 +6058,7 @@ package body float_pkg is begin result (exponent_width-1 downto 0) := (others => '1'); -- Exponent all "1" - result (-1) := '1'; -- MSB of Fraction "1" + result (-1) := '1'; -- MSB of Fraction "1" -- Note: From W. Khan "IEEE Standard 754 for Binary Floating Point" -- The difference between a signaling NAN and a quiet NAN is that -- the MSB of the Fraction is a "1" in a Signaling NAN, and is a @@ -6174,6 +6171,7 @@ package body float_pkg is -- rtl_synthesis off -- pragma synthesis_off + --%%% these functions are copied from std_logic_1164 (VHDL-200X edition) -- Textio functions -- purpose: writes float into a line (NOTE changed basetype) type MVL9plus is ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-', error); @@ -6181,6 +6179,7 @@ package body float_pkg is type MVL9_indexed_by_char is array (CHARACTER) of STD_ULOGIC; type MVL9plus_indexed_by_char is array (CHARACTER) of MVL9plus; + constant NBSP : CHARACTER := CHARACTER'val(160); -- space character constant MVL9_to_char : char_indexed_by_MVL9 := "UX01ZWLH-"; constant char_to_MVL9 : MVL9_indexed_by_char := ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z', @@ -6188,10 +6187,25 @@ package body float_pkg is constant char_to_MVL9plus : MVL9plus_indexed_by_char := ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z', 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => error); - constant NUS : STRING(2 to 1) := (others => ' '); + constant NUS : STRING(2 to 1) := (others => ' '); + + -- purpose: Skips white space + procedure skip_whitespace ( + L : inout LINE) is + variable readOk : BOOLEAN; + variable c : CHARACTER; + begin + while L /= null and L.all'length /= 0 loop + if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then + read (l, c, readOk); + else + exit; + end if; + end loop; + end procedure skip_whitespace; + -- %%% Replicated textio functions - constant NBSP : CHARACTER := CHARACTER'val(160); -- space character - function to_ostring (value : STD_LOGIC_VECTOR) return STRING is + function to_ostring (value : STD_LOGIC_VECTOR) return STRING is constant ne : INTEGER := (value'length+2)/3; variable pad : STD_LOGIC_VECTOR(0 to (ne*3 - value'length) - 1); variable ivalue : STD_LOGIC_VECTOR(0 to ne*3 - 1); @@ -6226,7 +6240,7 @@ package body float_pkg is end if; end function to_ostring; ------------------------------------------------------------------- - function to_hstring (value : STD_LOGIC_VECTOR) return STRING is + function to_hstring (value : STD_LOGIC_VECTOR) return STRING is constant ne : INTEGER := (value'length+3)/4; variable pad : STD_LOGIC_VECTOR(0 to (ne*4 - value'length) - 1); variable ivalue : STD_LOGIC_VECTOR(0 to ne*4 - 1); @@ -6294,6 +6308,61 @@ package body float_pkg is good := false; end case; end procedure Char2TriBits; + + procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; + GOOD : out BOOLEAN) is + variable ok : BOOLEAN; + variable c : CHARACTER; + constant ne : INTEGER := (VALUE'length+2)/3; + constant pad : INTEGER := ne*3 - VALUE'length; + variable sv : STD_LOGIC_VECTOR(0 to ne*3 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" + begin + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + else + Char2TriBits(c, sv(3*i to 3*i+2), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); + end if; + else + good := true; -- read into a null array + end if; + end procedure OREAD; + -- Hex Read and Write procedures for STD_ULOGIC_VECTOR. -- Modified from the original to be more forgiving. @@ -6331,94 +6400,118 @@ package body float_pkg is good := false; end case; end procedure Char2QuadBits; - procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; - GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+2)/3; - constant pad : INTEGER := ne*3 - VALUE'length; - variable sv : STD_LOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - good := true; - VALUE := sv (pad to sv'high); - end if; - end procedure OREAD; + procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+3)/4; - constant pad : INTEGER := ne*4 - VALUE'length; - variable sv : STD_LOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); + variable ok : BOOLEAN; + variable c : CHARACTER; + constant ne : INTEGER := (VALUE'length+3)/4; + constant pad : INTEGER := ne*4 - VALUE'length; + variable sv : STD_LOGIC_VECTOR(0 to ne*4 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false); - if not ok then - good := false; - return; + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + else + Char2QuadBits(c, sv(4*i to 4*i+3), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. else - VALUE := sv (pad to sv'high); - good := true; + good := true; -- Null input string, skips whitespace end if; end procedure HREAD; + -- %%% END replicated textio functions + -- purpose: Checks the punctuation in a line + procedure check_punctuation ( + arg : in STRING; + colon : out BOOLEAN; -- There was a colon in the line + dot : out BOOLEAN; -- There was a dot in the line + good : out BOOLEAN; -- True if enough characters found + chars : in INTEGER) is + -- Examples. Legal inputs are "0000000", "0000.000", "0:000:000" + alias xarg : STRING (1 to arg'length) is arg; -- make it downto range + variable icolon, idot : BOOLEAN; -- internal + variable j : INTEGER := 0; -- charters read + begin + good := false; + icolon := false; + idot := false; + for i in 1 to arg'length loop + if xarg(i) = ' ' or xarg(i) = NBSP or xarg(i) = HT or j = chars then + exit; + elsif xarg(i) = ':' then + icolon := true; + elsif xarg(i) = '.' then + idot := true; + elsif xarg (i) /= '_' then + j := j + 1; + end if; + end loop; + if j = chars then + good := true; -- There are enough charactes to read + end if; + colon := icolon; + if idot and icolon then + dot := false; + else + dot := idot; + end if; + end procedure check_punctuation; + + -- purpose: Searches a line for a ":" and replaces it with a ".". + procedure fix_colon ( + arg : inout STRING; + chars : in integer) is + alias xarg : STRING (1 to arg'length) is arg; -- make it downto range + variable j : INTEGER := 0; -- charters read + begin + for i in 1 to arg'length loop + if xarg(i) = ' ' or xarg(i) = NBSP or xarg(i) = HT or j > chars then + exit; + elsif xarg(i) = ':' then + xarg (i) := '.'; + elsif xarg (i) /= '_' then + j := j + 1; + end if; + end loop; + end procedure fix_colon; + procedure WRITE ( L : inout LINE; -- input line VALUE : in UNRESOLVED_float; -- floating point input @@ -6447,94 +6540,123 @@ package body float_pkg is -- Possible data: 0:0000:0000000 -- 000000000000 variable c : CHARACTER; + variable mv : UNRESOLVED_float (VALUE'range); variable readOk : BOOLEAN; + variable lastu : BOOLEAN := false; -- last character was an "_" variable i : INTEGER; -- index variable begin -- READ - loop -- skip white space - READ (l, c, readOk); - exit when ((readOk = false) or ((c /= ' ') and (c /= CR) and (c /= HT))); - end loop; - for i in value'high downto value'low loop - value(i) := 'X'; - end loop; - i := value'high; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - report float_pkg'instance_name - & "READ(float): " - & "Error end of file encountered." - severity error; - return; - elsif c = ' ' or c = CR or c = HT then -- reading done. - if (i /= value'low) then + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + READ (l, c, readOk); + if VALUE'length > 0 then + i := value'high; + readloop : loop + if readOk = false then -- Bail out if there was a bad read report float_pkg'instance_name & "READ(float): " - & "Warning: Value truncated." - severity warning; + & "Error end of file encountered." + severity error; return; - end if; - elsif c = ':' or c = '.' then -- separator, ignore - if not (i = -1 or i = value'high-1) then + elsif c = ' ' or c = CR or c = HT then -- reading done. + if (i /= value'low) then + report float_pkg'instance_name + & "READ(float): " + & "Warning: Value truncated." + severity warning; + return; + end if; + elsif c = '_' then + if i = value'high then -- Begins with an "_" + report float_pkg'instance_name + & "READ(float): " + & "String begins with an ""_""" severity error; + return; + elsif lastu then -- "__" detected + report float_pkg'instance_name + & "READ(float): " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + elsif c = ':' or c = '.' then -- separator, ignore + if not (i = -1 or i = value'high-1) then + report float_pkg'instance_name + & "READ(float): " + & "Warning: Separator point does not match number format: '" + & c & "' encountered at location " & INTEGER'image(i) & "." + severity warning; + end if; + lastu := false; + elsif (char_to_MVL9plus(c) = error) then report float_pkg'instance_name - & "READ(float): " - & "Warning: Separator point does not match number format: '" - & c & "' encountered at location " & INTEGER'image(i) & "." - severity warning; - end if; - elsif (char_to_MVL9plus(c) = error) then - report float_pkg'instance_name - & "READ(float): " - & "Error: Character '" & c & "' read, expected STD_ULOGIC literal." - severity error; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then + & "READ(float): " + & "Error: Character '" & c & "' read, expected STD_ULOGIC literal." + severity error; return; + else + mv (i) := char_to_MVL9(c); + i := i - 1; + if i < value'low then + VALUE := mv; + return; + end if; + lastu := false; end if; - end if; - READ (l, c, readOk); - end loop readloop; + READ (l, c, readOk); + end loop readloop; + end if; end procedure READ; procedure READ (L : inout LINE; VALUE : out UNRESOLVED_float; GOOD : out BOOLEAN) is -- Possible data: 0:0000:0000000 -- 000000000000 variable c : CHARACTER; + variable mv : UNRESOLVED_float (VALUE'range); + variable lastu : BOOLEAN := false; -- last character was an "_" variable i : INTEGER; -- index variable variable readOk : BOOLEAN; begin -- READ - loop -- skip white space - READ (l, c, readOk); - exit when ((readOk = false) or ((c /= ' ') and (c /= CR) and (c /= HT))); - end loop; - for i in value'high downto value'low loop - value(i) := 'X'; - end loop; - i := value'high; - good := true; - readloop : loop - if readOk = false then -- Bail out if there was a bad read - good := false; - return; - elsif c = ' ' or c = CR or c = HT then -- reading done - good := false; - return; - elsif c = ':' or c = '.' then -- separator, ignore - good := (i = -1 or i = value'high-1); - elsif (char_to_MVL9plus(c) = error) then - good := false; - return; - else - value (i) := char_to_MVL9(c); - i := i - 1; - if i < value'low then + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + READ (l, c, readOk); + if VALUE'length > 0 then + i := value'high; + good := false; + readloop : loop + if readOk = false then -- Bail out if there was a bad read return; + elsif c = ' ' or c = CR or c = HT then -- reading done + return; + elsif c = '_' then + if i = 0 then -- Begins with an "_" + return; + elsif lastu then -- "__" detected + return; + else + lastu := true; + end if; + elsif c = ':' or c = '.' then -- separator, ignore + -- good := (i = -1 or i = value'high-1); + lastu := false; + elsif (char_to_MVL9plus(c) = error) then + return; + else + mv (i) := char_to_MVL9(c); + i := i - 1; + if i < value'low then + good := true; + VALUE := mv; + return; + end if; + lastu := false; end if; - end if; - READ (l, c, readOk); - end loop readloop; + READ (l, c, readOk); + end loop readloop; + else + good := true; -- read into a null array + end if; end procedure READ; procedure OWRITE ( @@ -6550,76 +6672,140 @@ package body float_pkg is end procedure OWRITE; procedure OREAD (L : inout LINE; VALUE : out UNRESOLVED_float) is - constant ne : INTEGER := ((value'length+2)/3) * 3; -- pad - variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv - variable dummy : CHARACTER; -- to read the "." - variable igood : BOOLEAN; - variable nybble : STD_LOGIC_VECTOR (2 downto 0); -- 3 bits - variable i : INTEGER; + constant ne : INTEGER := ((value'length+2)/3) * 3; -- pad + variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv + variable slvu : ufixed (VALUE'range); -- Unsigned fixed point + variable c : CHARACTER; + variable ok : BOOLEAN; + variable nybble : STD_LOGIC_VECTOR (2 downto 0); -- 3 bits + variable colon, dot : BOOLEAN; begin - OREAD (L => L, - VALUE => nybble, - good => igood); - assert (igood) - report float_pkg'instance_name - & "OREAD: Failed to skip white space " & L.all - severity error; - i := ne-1 - 3; -- Top - 3 - slv (ne-1 downto i+1) := nybble; - while (i /= -1) and igood and L.all'length /= 0 loop - if (L.all(1) = '.') or (L.all(1) = ':') then - read (L, dummy); - else - OREAD (L => L, - VALUE => nybble, - good => igood); - assert (igood) - report float_pkg'instance_name - & "OREAD: Failed to read the string " & L.all + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + check_punctuation (arg => L.all, + colon => colon, + dot => dot, + good => ok, + chars => ne/3); + if not ok then + report float_pkg'instance_name & "OREAD: " + & "short string encounted: " & L.all + & " needs to have " & integer'image (ne/3) + & " valid octal characters." severity error; - slv (i downto i-2) := nybble; - i := i - 3; + return; + elsif dot then + OREAD (L, slvu, ok); -- read it like a UFIXED number + if not ok then + report float_pkg'instance_name & "OREAD: " + & "error encounted reading STRING " & L.all + severity error; + return; + else + VALUE := UNRESOLVED_float (slvu); + end if; + elsif colon then + OREAD (L, nybble, ok); -- read the sign bit + if not ok then + report float_pkg'instance_name & "OREAD: " + & "End of string encountered" + severity error; + return; + elsif nybble (2 downto 1) /= "00" then + report float_pkg'instance_name & "OREAD: " + & "Illegal sign bit STRING encounted " + severity error; + return; + end if; + read (l, c, ok); -- read the colon + fix_colon (L.all, ne/3); -- replaces the colon with a ".". + OREAD (L, slvu (slvu'high-1 downto slvu'low), ok); -- read it like a UFIXED number + if not ok then + report float_pkg'instance_name & "OREAD: " + & "error encounted reading STRING " & L.all + severity error; + return; + else + slvu (slvu'high) := nybble (0); + VALUE := UNRESOLVED_float (slvu); + end if; + else + OREAD (L, slv, ok); + if not ok then + report float_pkg'instance_name & "OREAD: " + & "Error encounted during read" + severity error; + return; + end if; + if (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '1') then + report float_pkg'instance_name & "OREAD: " + & "Vector truncated." + severity error; + return; + end if; + VALUE := to_float (slv(VALUE'high-VALUE'low downto 0), + VALUE'high, -VALUE'low); end if; - end loop; - assert igood and -- We did not get another error - (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '0') - report float_pkg'instance_name - & "OREAD: Vector truncated." - severity error; - value := to_float (slv(VALUE'high-VALUE'low downto 0), - value'high, -value'low); + end if; end procedure OREAD; procedure OREAD(L : inout LINE; VALUE : out UNRESOLVED_float; GOOD : out BOOLEAN) is - constant ne : INTEGER := ((value'length+2)/3) * 3; -- pad - variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv - variable dummy : CHARACTER; -- to read the "." - variable igood : BOOLEAN; - variable nybble : STD_LOGIC_VECTOR (2 downto 0); -- 3 bits - variable i : INTEGER; + constant ne : INTEGER := ((value'length+2)/3) * 3; -- pad + variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv + variable slvu : ufixed (VALUE'range); -- Unsigned fixed point + variable c : CHARACTER; + variable ok : BOOLEAN; + variable nybble : STD_LOGIC_VECTOR (2 downto 0); -- 3 bits + variable colon, dot : BOOLEAN; begin - OREAD (L => L, - VALUE => nybble, - good => igood); - i := ne-1 - 3; -- Top - 3 - slv (ne-1 downto i+1) := nybble; - while (i /= -1) and igood and L.all'length /= 0 loop - if (L.all(1) = '.') or (L.all(1) = ':') then - read (L, dummy, igood); + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + GOOD := false; + Skip_whitespace (L); + if VALUE'length > 0 then + check_punctuation (arg => L.all, + colon => colon, + dot => dot, + good => ok, + chars => ne/3); + if not ok then + return; + elsif dot then + OREAD (L, slvu, ok); -- read it like a UFIXED number + if not ok then + return; + else + VALUE := UNRESOLVED_float (slvu); + end if; + elsif colon then + OREAD (L, nybble, ok); -- read the sign bit + if not ok then + return; + elsif nybble (2 downto 1) /= "00" then + return; + end if; + read (l, c, ok); -- read the colon + fix_colon (L.all, ne/3); -- replaces the colon with a ".". + OREAD (L, slvu (slvu'high-1 downto slvu'low), ok); -- read it like a UFIXED number + if not ok then + return; + else + slvu (slvu'high) := nybble (0); + VALUE := UNRESOLVED_float (slvu); + end if; else - OREAD (L => L, - VALUE => nybble, - good => igood); - slv (i downto i-2) := nybble; - i := i - 3; + OREAD (L, slv, ok); + if not ok then + return; + end if; + if (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '1') then + return; + end if; + VALUE := to_float (slv(VALUE'high-VALUE'low downto 0), + VALUE'high, -VALUE'low); end if; - end loop; - good := igood and -- We did not get another error - (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '0'); - value := to_float (slv(VALUE'high-VALUE'low downto 0), - value'high, -value'low); + GOOD := true; + end if; end procedure OREAD; procedure HWRITE ( @@ -6635,76 +6821,140 @@ package body float_pkg is end procedure HWRITE; procedure HREAD (L : inout LINE; VALUE : out UNRESOLVED_float) is - constant ne : INTEGER := ((value'length+3)/4) * 4; -- pad - variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv - variable dummy : CHARACTER; -- to read the "." - variable igood : BOOLEAN; - variable nybble : STD_LOGIC_VECTOR (3 downto 0); -- 4 bits - variable i : INTEGER; + constant ne : INTEGER := ((value'length+3)/4) * 4; -- pad + variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv + variable slvu : ufixed (VALUE'range); -- Unsigned fixed point + variable c : CHARACTER; + variable ok : BOOLEAN; + variable nybble : STD_LOGIC_VECTOR (3 downto 0); -- 4 bits + variable colon, dot : BOOLEAN; begin - HREAD (L => L, - VALUE => nybble, - good => igood); - assert (igood) - report float_pkg'instance_name - & "HREAD: Failed to skip white space " & L.all - severity error; - i := ne - 1 - 4; -- Top - 4 - slv (ne -1 downto i+1) := nybble; - while (i /= -1) and igood and L.all'length /= 0 loop - if (L.all(1) = '.') or (L.all(1) = ':') then - read (L, dummy); - else - HREAD (L => L, - VALUE => nybble, - good => igood); - assert (igood) - report float_pkg'instance_name - & "HREAD: Failed to read the string " & L.all + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + check_punctuation (arg => L.all, + colon => colon, + dot => dot, + good => ok, + chars => ne/4); + if not ok then + report float_pkg'instance_name & "HREAD: " + & "short string encounted: " & L.all + & " needs to have " & integer'image (ne/4) + & " valid hex characters." severity error; - slv (i downto i-3) := nybble; - i := i - 4; + return; + elsif dot then + HREAD (L, slvu, ok); -- read it like a UFIXED number + if not ok then + report float_pkg'instance_name & "HREAD: " + & "error encounted reading STRING " & L.all + severity error; + return; + else + VALUE := UNRESOLVED_float (slvu); + end if; + elsif colon then + HREAD (L, nybble, ok); -- read the sign bit + if not ok then + report float_pkg'instance_name & "HREAD: " + & "End of string encountered" + severity error; + return; + elsif nybble (3 downto 1) /= "000" then + report float_pkg'instance_name & "HREAD: " + & "Illegal sign bit STRING encounted " + severity error; + return; + end if; + read (l, c, ok); -- read the colon + fix_colon (L.all, ne/4); -- replaces the colon with a ".". + HREAD (L, slvu (slvu'high-1 downto slvu'low), ok); -- read it like a UFIXED number + if not ok then + report float_pkg'instance_name & "HREAD: " + & "error encounted reading STRING " & L.all + severity error; + return; + else + slvu (slvu'high) := nybble (0); + VALUE := UNRESOLVED_float (slvu); + end if; + else + HREAD (L, slv, ok); + if not ok then + report float_pkg'instance_name & "HREAD: " + & "Error encounted during read" + severity error; + return; + end if; + if (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '1') then + report float_pkg'instance_name & "HREAD: " + & "Vector truncated." + severity error; + return; + end if; + VALUE := to_float (slv(VALUE'high-VALUE'low downto 0), + VALUE'high, -VALUE'low); end if; - end loop; - assert igood and -- We did not get another error - (i = -1) and -- We read everything - (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '0') - report float_pkg'instance_name - & "HREAD: Vector truncated." - severity error; - value := to_float (slv(VALUE'high-VALUE'low downto 0), - value'high, -value'low); + end if; end procedure HREAD; procedure HREAD (L : inout LINE; VALUE : out UNRESOLVED_float; GOOD : out BOOLEAN) is - constant ne : INTEGER := ((value'length+3)/4) * 4; -- pad - variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv - variable dummy : CHARACTER; -- to read the "." - variable igood : BOOLEAN; - variable nybble : STD_LOGIC_VECTOR (3 downto 0); -- 4 bits - variable i : INTEGER; + constant ne : INTEGER := ((value'length+3)/4) * 4; -- pad + variable slv : STD_LOGIC_VECTOR (ne-1 downto 0); -- slv + variable slvu : ufixed (VALUE'range); -- Unsigned fixed point + variable c : CHARACTER; + variable ok : BOOLEAN; + variable nybble : STD_LOGIC_VECTOR (3 downto 0); -- 4 bits + variable colon, dot : BOOLEAN; begin - HREAD (L => L, - VALUE => nybble, - good => igood); - i := ne - 1 - 4; -- Top - 4 - slv (ne-1 downto i+1) := nybble; - while (i /= -1) and igood and L.all'length /= 0 loop - if (L.all(1) = '.') or (L.all(1) = ':') then - read (L, dummy, igood); + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + GOOD := false; + Skip_whitespace (L); + if VALUE'length > 0 then + check_punctuation (arg => L.all, + colon => colon, + dot => dot, + good => ok, + chars => ne/4); + if not ok then + return; + elsif dot then + HREAD (L, slvu, ok); -- read it like a UFIXED number + if not ok then + return; + else + VALUE := UNRESOLVED_float (slvu); + end if; + elsif colon then + HREAD (L, nybble, ok); -- read the sign bit + if not ok then + return; + elsif nybble (3 downto 1) /= "000" then + return; + end if; + read (l, c, ok); -- read the colon + fix_colon (L.all, ne/4); -- replaces the colon with a ".". + HREAD (L, slvu (slvu'high-1 downto slvu'low), ok); -- read it like a UFIXED number + if not ok then + return; + else + slvu (slvu'high) := nybble (0); + VALUE := UNRESOLVED_float (slvu); + end if; else - HREAD (L => L, - VALUE => nybble, - good => igood); - slv (i downto i-3) := nybble; - i := i - 4; + HREAD (L, slv, ok); + if not ok then + return; + end if; + if (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '1') then + return; + end if; + VALUE := to_float (slv(VALUE'high-VALUE'low downto 0), + VALUE'high, -VALUE'low); end if; - end loop; - good := igood and -- We did not get another error - (i = -1) and -- We read everything, and high bits 0 - (or_reduce (slv(ne-1 downto VALUE'high-VALUE'low+1)) = '0'); - value := to_float (slv(VALUE'high-VALUE'low downto 0), - value'high, -value'low); + GOOD := true; + end if; end procedure HREAD; function to_string (value : UNRESOLVED_float) return STRING is @@ -6840,7 +7090,7 @@ package body float_pkg is return UNRESOLVED_float is begin return to_float ( - arg => to_stdulogicvector (arg), + arg => to_stdulogicvector (arg), exponent_width => exponent_width, fraction_width => fraction_width); end function to_float; @@ -6851,8 +7101,27 @@ package body float_pkg is return UNRESOLVED_float is begin return to_float ( - arg => to_stdulogicvector (arg), + arg => to_stdulogicvector (arg), size_res => size_res); end function to_float; + -- For Verilog compatability + function realtobits (arg : REAL) return STD_LOGIC_VECTOR is + variable result : float64; -- 64 bit floating point + begin + result := to_float (arg => arg, + exponent_width => float64'high, + fraction_width => -float64'low); + return to_slv (result); + end function realtobits; + + function bitstoreal (arg : STD_LOGIC_VECTOR) return REAL is + variable arg64 : float64; -- arg converted to float + begin + arg64 := to_float (arg => arg, + exponent_width => float64'high, + fraction_width => -float64'low); + return to_real (arg64); + end function bitstoreal; + end package body float_pkg; diff --git a/Common/sim/ieee_proposed/modelsim/math_utility_pkg_c.vhdl b/Common/sim/ieee_proposed/modelsim/math_utility_pkg_c.vhdl deleted file mode 100644 index 87390ef..0000000 --- a/Common/sim/ieee_proposed/modelsim/math_utility_pkg_c.vhdl +++ /dev/null @@ -1,38 +0,0 @@ --- -------------------------------------------------------------------- --- "math_utility_pkg" package contains types used by the both the fixed --- and floating point packages. --- This package should be compiled into "ieee_proposed" and used as follows: --- use ieee.std_logic_1164.all; --- use ieee.numeric_std.all; --- use ieee_proposed.math_utility.all; --- use ieee_proposed.fixed_pkg.all; --- use ieee_proposed.float_pkg.all; --- --- This verison is designed to work with the VHDL-93 compilers. Please --- note the "%%%" comments. These are where we diverge from the --- VHDL-200X LRM. --- --- -------------------------------------------------------------------- --- Version : $Revision: 1.1 $ --- Date : $Date: 2007-04-04 14:00:18-04 $ --- -------------------------------------------------------------------- - -package math_utility_pkg is - - -- Types used for generics of fixed_generic_pkg - - type fixed_round_style_type is (fixed_round, fixed_truncate); - - type fixed_overflow_style_type is (fixed_saturate, fixed_wrap); - - -- Type used for generics of float_generic_pkg - - -- These are the same as the C FE_TONEAREST, FE_UPWARD, FE_DOWNWARD, - -- and FE_TOWARDZERO floating point rounding macros. - - type round_type is (round_nearest, -- Default, nearest LSB '0' - round_inf, -- Round toward positive infinity - round_neginf, -- Round toward negative infinity - round_zero); -- Round toward zero (truncate) - -end package math_utility_pkg; diff --git a/Common/sim/ieee_proposed/modelsim/numeric_std_additions.vhdl b/Common/sim/ieee_proposed/modelsim/numeric_std_additions.vhdl index 31cf3ef..0cc8e86 100644 --- a/Common/sim/ieee_proposed/modelsim/numeric_std_additions.vhdl +++ b/Common/sim/ieee_proposed/modelsim/numeric_std_additions.vhdl @@ -6,8 +6,8 @@ -- use ieee.numeric_std.all; -- use ieee_proposed.numeric_std_additions.all; -- (this package is independant of "std_logic_1164_additions") --- Last Modified: $Date: 2007-03-13 14:18:19-04 $ --- RCS ID: $Id: numeric_std_additions.vhdl,v 1.5 2007-03-13 14:18:19-04 l435385 Exp $ +-- Last Modified: $Date: 2010/09/22 18:33:32 $ +-- RCS ID: $Id: numeric_std_additions.vhdl,v 1.10 2010/09/22 18:33:32 l435385 Exp $ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------ @@ -129,6 +129,15 @@ package numeric_std_additions is -- Result: terms compared per STD_LOGIC_1164 intent, -- returns an 'X' if a metavalue is passed + -- size_res versions of these functions (Bugzilla 165) + function TO_UNSIGNED (ARG : NATURAL; SIZE_RES : UNSIGNED) return UNSIGNED; + -- Result subtype: UNRESOLVED_UNSIGNED(SIZE_RES'length-1 downto 0) + function TO_SIGNED (ARG : INTEGER; SIZE_RES : SIGNED) return SIGNED; + -- Result subtype: UNRESOLVED_SIGNED(SIZE_RES'length-1 downto 0) + function RESIZE (ARG, SIZE_RES : UNSIGNED) return UNSIGNED; + -- Result subtype: UNRESOLVED_UNSIGNED (SIZE_RES'length-1 downto 0) + function RESIZE (ARG, SIZE_RES : SIGNED) return SIGNED; + -- Result subtype: UNRESOLVED_SIGNED (SIZE_RES'length-1 downto 0) ----------------------------------------------------------------------------- -- New/updated funcitons for VHDL-200X fast track ----------------------------------------------------------------------------- @@ -376,6 +385,7 @@ package numeric_std_additions is -- function "xnor" ( l : UNSIGNED ) RETURN std_ulogic; -- rtl_synthesis off +-- pragma synthesis_off ------------------------------------------------------------------- -- string functions ------------------------------------------------------------------- @@ -413,11 +423,11 @@ package numeric_std_additions is procedure WRITE (L : inout LINE; VALUE : in SIGNED; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0); --- alias BREAD is READ [LINE, UNRESOLVED_UNSIGNED, BOOLEAN]; --- alias BREAD is READ [LINE, UNRESOLVED_SIGNED, BOOLEAN]; + alias BREAD is READ [LINE, UNSIGNED, BOOLEAN]; + alias BREAD is READ [LINE, SIGNED, BOOLEAN]; --- alias BREAD is READ [LINE, UNRESOLVED_UNSIGNED]; --- alias BREAD is READ [LINE, UNRESOLVED_SIGNED]; + alias BREAD is READ [LINE, UNSIGNED]; + alias BREAD is READ [LINE, SIGNED]; alias BINARY_READ is READ [LINE, UNSIGNED, BOOLEAN]; alias BINARY_READ is READ [LINE, SIGNED, BOOLEAN]; @@ -449,8 +459,8 @@ package numeric_std_additions is alias HEX_READ is HREAD [LINE, UNSIGNED]; alias HEX_READ is HREAD [LINE, SIGNED]; --- alias BWRITE is WRITE [LINE, UNSIGNED, SIDE, WIDTH]; --- alias BWRITE is WRITE [LINE, SIGNED, SIDE, WIDTH]; + alias BWRITE is WRITE [LINE, UNSIGNED, SIDE, WIDTH]; + alias BWRITE is WRITE [LINE, SIGNED, SIDE, WIDTH]; alias BINARY_WRITE is WRITE [LINE, UNSIGNED, SIDE, WIDTH]; alias BINARY_WRITE is WRITE [LINE, SIGNED, SIDE, WIDTH]; @@ -474,6 +484,7 @@ package numeric_std_additions is alias HEX_WRITE is HWRITE [LINE, SIGNED, SIDE, WIDTH]; -- rtl_synthesis on +-- pragma synthesis_on end package numeric_std_additions; package body numeric_std_additions is @@ -566,30 +577,15 @@ package body numeric_std_additions is ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', '1' ), -- | H | ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ) -- | - | ); - constant no_match_logic_table : stdlogic_table := ( - ----------------------------------------------------- - -- U X 0 1 Z W L H - | | - ----------------------------------------------------- - ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '0'), -- | U | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | X | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | 0 | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | 1 | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | Z | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | W | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | L | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | H | - ('0', '0', '0', '0', '0', '0', '0', '0', '0') -- | - | - ); -- %%% FUNCTION "?=" ( l, r : std_ulogic ) RETURN std_ulogic IS function \?=\ ( l, r : STD_ULOGIC ) return STD_ULOGIC is - variable value : STD_ULOGIC; begin return match_logic_table (l, r); end function \?=\; function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC is begin - return no_match_logic_table (l, r); + return not match_logic_table (l, r); end function \?/=\; -- "?=" operator is similar to "std_match", but returns a std_ulogic.. @@ -615,7 +611,7 @@ package body numeric_std_additions is RX := RESIZE(XR, SIZE); result := '1'; for i in LX'low to LX'high loop - result1 := \?=\(LX(i), RX(i)); + result1 := \?=\ (LX(i), RX(i)); if result1 = 'U' then return 'U'; elsif result1 = 'X' or result = 'X' then @@ -693,7 +689,6 @@ package body numeric_std_additions is return \?=\ (L, TO_SIGNED(R, L'length)); end function \?=\; - function \?/=\ (L, R : UNSIGNED) return STD_ULOGIC is constant L_LEFT : INTEGER := L'length-1; constant R_LEFT : INTEGER := R'length-1; @@ -876,8 +871,6 @@ package body numeric_std_additions is begin return \?>\ (L, TO_SIGNED(R, L'length)); end function \?>\; - - function \?>=\ (L, R : UNSIGNED) return STD_ULOGIC is begin @@ -1150,6 +1143,35 @@ package body numeric_std_additions is return \?<=\ (L, TO_SIGNED(R, L'length)); end function \?<=\; + -- size_res versions of these functions (Bugzilla 165) + function TO_UNSIGNED (ARG : NATURAL; SIZE_RES : UNSIGNED) + return UNSIGNED is + begin + return TO_UNSIGNED (ARG => ARG, + SIZE => SIZE_RES'length); + end function TO_UNSIGNED; + + function TO_SIGNED (ARG : INTEGER; SIZE_RES : SIGNED) + return SIGNED is + begin + return TO_SIGNED (ARG => ARG, + SIZE => SIZE_RES'length); + end function TO_SIGNED; + + function RESIZE (ARG, SIZE_RES : SIGNED) + return SIGNED is + begin + return RESIZE (ARG => ARG, + NEW_SIZE => SIZE_RES'length); + end function RESIZE; + + function RESIZE (ARG, SIZE_RES : UNSIGNED) + return UNSIGNED is + begin + return RESIZE (ARG => ARG, + NEW_SIZE => SIZE_RES'length); + end function RESIZE; + -- Id: S.9 function "sll" (ARG : UNSIGNED; COUNT : INTEGER) return UNSIGNED is @@ -2034,6 +2056,7 @@ package body numeric_std_additions is -- end function "xnor"; -- rtl_synthesis off +-- pragma synthesis_off ------------------------------------------------------------------- -- TO_STRING ------------------------------------------------------------------- @@ -2241,263 +2264,131 @@ package body numeric_std_additions is ----------------------------------------------------------------------------- -- Read and Write routines ----------------------------------------------------------------------------- - procedure WRITE ( - L : inout LINE; -- input line - VALUE : in SIGNED; -- fixed point input - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is - variable s : STRING(1 to value'length); - variable m : SIGNED(1 to value'length) := value; - begin - for i in 1 to value'length loop - s(i) := MVL9_to_char(m(i)); - end loop; - write(l, s, justified, field); - end procedure WRITE; - - procedure READ(L : inout LINE; - VALUE : out SIGNED) is - variable m : STD_ULOGIC; - variable c : CHARACTER; - variable readOk : BOOLEAN; - variable s : STRING(1 to value'length-1); - variable mv : STD_LOGIC_VECTOR(0 to value'length-1); - begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when ((readOk = false) or ((c /= ' ') and (c /= CR) and (c /= HT))); - end loop; - if readOk = false then -- Bail out if there was a bad read - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - elsif char_to_MVL9plus(c) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - c & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - read(l, s, readOk); - if readOk then - for i in 1 to value'length-1 loop - if char_to_MVL9plus(s(i)) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - s(i) & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - end loop; - else - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - end if; - mv(0) := char_to_MVL9(c); - for i in 1 to value'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - value := SIGNED(mv); - end procedure READ; - procedure READ(L : inout LINE; - VALUE : out SIGNED; - GOOD : out BOOLEAN) is - variable m : STD_ULOGIC; - variable c : CHARACTER; - variable s : STRING(1 to value'length-1); - variable mv : STD_LOGIC_VECTOR(0 to value'length-1); + -- Routines copied from the "std_logic_1164_additions" package + -- purpose: Skips white space + procedure skip_whitespace ( + L : inout LINE) is variable readOk : BOOLEAN; + variable c : CHARACTER; begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - if char_to_MVL9plus(c) = error then - good := false; - return; - end if; - read(l, s, readOk); - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - for i in 1 to value'length-1 loop - if char_to_MVL9plus(s(i)) = error then - good := false; - return; + while L /= null and L.all'length /= 0 loop + if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then + read (l, c, readOk); + else + exit; end if; end loop; - mv(0) := char_to_MVL9(c); - for i in 1 to value'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - value := SIGNED(mv); - good := true; - end procedure READ; - - procedure WRITE ( - L : inout LINE; -- input line - VALUE : in UNSIGNED; -- fixed point input - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is - variable s : STRING(1 to value'length); - variable m : UNSIGNED(1 to value'length) := value; - begin - for i in 1 to value'length loop - s(i) := MVL9_to_char(m(i)); - end loop; - write(l, s, justified, field); - end procedure WRITE; - - procedure READ(L : inout LINE; - VALUE : out UNSIGNED) is - variable m : STD_LOGIC; - variable c : CHARACTER; + end procedure skip_whitespace; + procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; + GOOD : out BOOLEAN) is + variable m : STD_ULOGIC; + variable c : CHARACTER; + variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1); variable readOk : BOOLEAN; - variable s : STRING(1 to value'length-1); - variable mv : STD_LOGIC_VECTOR(0 to value'length-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when ((readOk = false) or ((c /= ' ') and (c /= CR) and (c /= HT))); - end loop; - if readOk = false then -- Bail out if there was a bad read - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - elsif char_to_MVL9plus(c) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - c & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - read(l, s, readOk); - if readOk then - for i in 1 to value'length-1 loop - if char_to_MVL9plus(s(i)) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - s(i) & "' read, expected STD_ULOGIC literal." - severity error; + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, readOk); + i := 0; + good := true; + while i < VALUE'length loop + if not readOk then -- Bail out if there was a bad read + good := false; return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + elsif (char_to_MVL9plus(c) = error) then + good := false; -- Illegal character + return; + else + mv(i) := char_to_MVL9(c); + i := i + 1; + if i > mv'high then -- reading done + VALUE := mv; + return; + end if; + lastu := false; end if; + read(L, c, readOk); end loop; else - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; + good := true; -- read into a null array end if; - mv(0) := char_to_MVL9(c); - for i in 1 to value'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - value := UNSIGNED(mv); end procedure READ; - procedure READ(L : inout LINE; - VALUE : out UNSIGNED; - GOOD : out BOOLEAN) is - variable m : STD_LOGIC; - variable c : CHARACTER; - variable s : STRING(1 to value'length-1); - variable mv : STD_LOGIC_VECTOR(0 to value'length-1); + procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is + variable m : STD_ULOGIC; + variable c : CHARACTER; variable readOk : BOOLEAN; + variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not readOk then - good := false; - return; + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, readOk); + i := 0; + while i < VALUE'length loop + if readOk = false then -- Bail out if there was a bad read + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "End of string encountered" + severity error; + return; + elsif c = '_' then + if i = 0 then + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + elsif char_to_MVL9plus(c) = error then + report + "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & + c & "' read, expected STD_ULOGIC literal." + severity error; + return; + else + mv(i) := char_to_MVL9(c); + i := i + 1; + if i > mv'high then + VALUE := mv; + return; + end if; + lastu := false; + end if; + read(L, c, readOk); + end loop; end if; - if char_to_MVL9plus(c) = error then - good := false; - return; - end if; - read(l, s, readOk); - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - for i in 1 to value'length-1 loop - if char_to_MVL9plus(s(i)) = error then - good := false; - return; - end if; - end loop; - mv(0) := char_to_MVL9(c); - for i in 1 to value'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - value := UNSIGNED(mv); - good := true; end procedure READ; - procedure BWRITE ( - L : inout LINE; -- input line - VALUE : in SIGNED; -- fixed point input - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is + -- purpose: or reduction + function or_reduce ( + arg : STD_ULOGIC_VECTOR) + return STD_ULOGIC is + variable uarg : UNSIGNED (arg'range); begin - WRITE (L, VALUE, JUSTIFIED, FIELD); - end procedure BWRITE; - - procedure BREAD(L : inout LINE; - VALUE : out SIGNED) is - begin - READ (L, VALUE); - end procedure BREAD; - - procedure BREAD(L : inout LINE; - VALUE : out SIGNED; - GOOD : out BOOLEAN) is - begin - READ (L, VALUE, GOOD); - end procedure BREAD; - - procedure BWRITE ( - L : inout LINE; -- input line - VALUE : in UNSIGNED; -- fixed point input - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is - begin - WRITE (L, VALUE, JUSTIFIED, FIELD); - end procedure BWRITE; - - procedure BREAD(L : inout LINE; - VALUE : out UNSIGNED) is - begin - READ (L, VALUE); - end procedure BREAD; - - procedure BREAD(L : inout LINE; - VALUE : out UNSIGNED; - GOOD : out BOOLEAN) is - begin - READ (L, VALUE, GOOD); - end procedure BREAD; - -- Hex Read and Write procedures for STD_ULOGIC_VECTOR. - -- Modified from the original to be more forgiving. + uarg := unsigned(arg); + return or_reduce (uarg); + end function or_reduce; procedure Char2QuadBits (C : CHARACTER; RESULT : out STD_ULOGIC_VECTOR(3 downto 0); @@ -2523,193 +2414,123 @@ package body numeric_std_additions is when 'F' | 'f' => result := x"F"; good := true; when 'Z' => result := "ZZZZ"; good := true; when 'X' => result := "XXXX"; good := true; - when others => + when others => assert not ISSUE_ERROR report - "STD_LOGIC_1164.OREAD Error: Read a '" & c & - "', expected an Octal character (0-7)." + "STD_LOGIC_1164.HREAD Read a '" & c & + "', expected a Hex character (0-F)." severity error; good := false; end case; end procedure Char2QuadBits; - - procedure HWRITE ( - L : inout LINE; -- input line - VALUE : in SIGNED; - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is + + procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; + GOOD : out BOOLEAN) is + variable ok : BOOLEAN; + variable c : CHARACTER; + constant ne : INTEGER := (VALUE'length+3)/4; + constant pad : INTEGER := ne*4 - VALUE'length; + variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - WRITE ( L => L, - VALUE => to_hstring(VALUE), - JUSTIFIED => JUSTIFIED, - FIELD => FIELD); - end procedure HWRITE; - - procedure HREAD(L : inout LINE; - VALUE : out SIGNED) is - constant ne : INTEGER := (value'length+3)/4; - constant pad : INTEGER := ne*4 - value'length; - variable ivalue : UNSIGNED(0 to ne*4-1); - begin - HREAD ( L => L, - VALUE => ivalue); -- Read padded string - if (pad > 0) then - if (to_X01(ivalue(0)) = '0') then -- positive - if to_X01(ivalue(0)) = or_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; else - assert false - report "NUMERIC_STD.HREAD Error: Signed vector truncated" + Char2QuadBits(c, sv(4*i to 4*i+3), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); + end if; + else + good := true; -- Null input string, skips whitespace + end if; + end procedure HREAD; + + procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is + variable ok : BOOLEAN; + variable c : CHARACTER; + constant ne : INTEGER := (VALUE'length+3)/4; + constant pad : INTEGER := ne*4 - VALUE'length; + variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" + begin + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + report "STD_LOGIC_1164.HREAD " + & "End of string encountered" severity error; + return; end if; - else -- negative - if to_X01(ivalue(0)) = and_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); + if c = '_' then + if i = 0 then + report "STD_LOGIC_1164.HREAD " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.HREAD " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; else - assert false - report "NUMERIC_STD.HREAD Error: Signed vector truncated" - severity error; + Char2QuadBits(c, sv(4*i to 4*i+3), ok, true); + if not ok then + return; + end if; + i := i + 1; + lastu := false; end if; - end if; - else - VALUE := SIGNED (ivalue); - end if; - end procedure HREAD; - - procedure HREAD(L : inout LINE; - VALUE : out SIGNED; - GOOD : out BOOLEAN) is - constant ne : INTEGER := (value'length+3)/4; - constant pad : INTEGER := ne*4 - value'length; - variable ivalue : UNSIGNED(0 to ne*4-1); - variable ok : BOOLEAN; - begin - HREAD ( L => L, - VALUE => ivalue, -- Read padded STRING - good => ok); - if not ok then - good := false; - return; - end if; - if (pad > 0) then - if (to_X01(ivalue(0)) = '0') then -- positive - if to_X01(ivalue(0)) = or_reduce(ivalue(0 to pad)) then - GOOD := true; - VALUE := SIGNED (ivalue (pad to ivalue'high)); - else - GOOD := false; - end if; - else -- negative - if to_X01(ivalue(0)) = and_reduce(ivalue(0 to pad)) then - GOOD := true; - VALUE := SIGNED (ivalue (pad to ivalue'high)); - else - GOOD := false; + if i < ne then + read(L, c, ok); end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + report "STD_LOGIC_1164.HREAD Vector truncated" + severity error; + else + VALUE := sv (pad to sv'high); end if; - else - GOOD := true; - VALUE := SIGNED (ivalue); - end if; - end procedure HREAD; - - procedure HWRITE ( - L : inout LINE; -- input line - VALUE : in UNSIGNED; - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is - begin - WRITE ( L => L, - VALUE => to_hstring(VALUE), - JUSTIFIED => JUSTIFIED, - FIELD => FIELD); - end procedure HWRITE; - - procedure HREAD(L : inout LINE; - VALUE : out UNSIGNED) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (value'length+3)/4; - constant pad : INTEGER := ne*4 - value'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true); - if not ok then - return; - end if; - end loop; - value := UNSIGNED(to_StdLogicVector(sv (pad to sv'high))); - if or_reduce (UNSIGNED(sv (0 to pad-1))) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.HREAD Error: Vector truncated" - severity error; - end if; - end procedure HREAD; - - procedure HREAD(L : inout LINE; - VALUE : out UNSIGNED; - GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (value'length+3)/4; - constant pad : INTEGER := ne*4 - value'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - if or_reduce (UNSIGNED(sv (0 to pad-1))) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - value := UNSIGNED(to_stdlogicvector(sv (pad to sv'high))); - good := true; end if; end procedure HREAD; @@ -2722,16 +2543,16 @@ package body numeric_std_additions is ISSUE_ERROR : in BOOLEAN) is begin case c is - when '0' => result := o"0"; good := true; - when '1' => result := o"1"; good := true; - when '2' => result := o"2"; good := true; - when '3' => result := o"3"; good := true; - when '4' => result := o"4"; good := true; - when '5' => result := o"5"; good := true; - when '6' => result := o"6"; good := true; - when '7' => result := o"7"; good := true; - when 'Z' => result := "ZZZ"; good := true; - when 'X' => result := "XXX"; good := true; + when '0' => result := o"0"; good := true; + when '1' => result := o"1"; good := true; + when '2' => result := o"2"; good := true; + when '3' => result := o"3"; good := true; + when '4' => result := o"4"; good := true; + when '5' => result := o"5"; good := true; + when '6' => result := o"6"; good := true; + when '7' => result := o"7"; good := true; + when 'Z' => result := "ZZZ"; good := true; + when 'X' => result := "XXX"; good := true; when others => assert not ISSUE_ERROR report @@ -2742,184 +2563,309 @@ package body numeric_std_additions is end case; end procedure Char2TriBits; - procedure OWRITE ( - L : inout LINE; -- input line - VALUE : in SIGNED; - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is + procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR; + GOOD : out BOOLEAN) is + variable ok : BOOLEAN; + variable c : CHARACTER; + constant ne : INTEGER := (VALUE'length+2)/3; + constant pad : INTEGER := ne*3 - VALUE'length; + variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - WRITE ( L => L, - VALUE => to_ostring(VALUE), - JUSTIFIED => JUSTIFIED, - FIELD => FIELD); - end procedure OWRITE; - - procedure OREAD(L : inout LINE; - VALUE : out SIGNED) is - constant ne : INTEGER := (value'length+2)/3; - constant pad : INTEGER := ne*3 - value'length; - variable ivalue : UNSIGNED (0 to ne*3-1); + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + else + Char2TriBits(c, sv(3*i to 3*i+2), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); + end if; + else + good := true; -- read into a null array + end if; + end procedure OREAD; + + procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is + variable c : CHARACTER; + variable ok : BOOLEAN; + constant ne : INTEGER := (VALUE'length+2)/3; + constant pad : INTEGER := ne*3 - VALUE'length; + variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin - OREAD ( L => L, + VALUE := (VALUE'range => 'U'); -- initialize to a "U" + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + report "STD_LOGIC_1164.OREAD " + & "End of string encountered" + severity error; + return; + elsif c = '_' then + if i = 0 then + report "STD_LOGIC_1164.OREAD " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.OREAD " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + else + Char2TriBits(c, sv(3*i to 3*i+2), ok, true); + if not ok then + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + report "STD_LOGIC_1164.OREAD Vector truncated" + severity error; + else + VALUE := sv (pad to sv'high); + end if; + end if; + end procedure OREAD; + -- End copied code. + + procedure READ (L : inout LINE; VALUE : out UNSIGNED; + GOOD : out BOOLEAN) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + READ (L => L, + VALUE => ivalue, + GOOD => GOOD); + VALUE := UNSIGNED(ivalue); + end procedure READ; + + procedure READ (L : inout LINE; VALUE : out UNSIGNED) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + READ (L => L, + VALUE => ivalue); + VALUE := UNSIGNED (ivalue); + end procedure READ; + + procedure READ (L : inout LINE; VALUE : out SIGNED; + GOOD : out BOOLEAN) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + READ (L => L, + VALUE => ivalue, + GOOD => GOOD); + VALUE := SIGNED(ivalue); + end procedure READ; + + procedure READ (L : inout LINE; VALUE : out SIGNED) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + READ (L => L, + VALUE => ivalue); + VALUE := SIGNED (ivalue); + end procedure READ; + + procedure WRITE (L : inout LINE; VALUE : in UNSIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is + begin + write (L, to_string(VALUE), JUSTIFIED, FIELD); + end procedure WRITE; + + procedure WRITE (L : inout LINE; VALUE : in SIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is + begin + write (L, to_string(VALUE), JUSTIFIED, FIELD); + end procedure WRITE; + + procedure OREAD (L : inout LINE; VALUE : out UNSIGNED; + GOOD : out BOOLEAN) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + OREAD (L => L, + VALUE => ivalue, + GOOD => GOOD); + VALUE := UNSIGNED(ivalue); + end procedure OREAD; + + procedure OREAD (L : inout LINE; VALUE : out SIGNED; + GOOD : out BOOLEAN) is + constant ne : INTEGER := (value'length+2)/3; + constant pad : INTEGER := ne*3 - value'length; + variable ivalue : STD_ULOGIC_VECTOR(0 to ne*3-1); + variable ok : BOOLEAN; + variable expected_padding : STD_ULOGIC_VECTOR(0 to pad-1); + begin + OREAD (L => L, + VALUE => ivalue, -- Read padded STRING + GOOD => ok); + -- Bail out if there was a bad read + if not ok then + GOOD := false; + return; + end if; + expected_padding := (others => ivalue(pad)); + if ivalue(0 to pad-1) /= expected_padding then + GOOD := false; + else + GOOD := true; + VALUE := UNRESOLVED_SIGNED (ivalue (pad to ivalue'high)); + end if; + end procedure OREAD; + + procedure OREAD (L : inout LINE; VALUE : out UNSIGNED) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); + begin + OREAD (L => L, + VALUE => ivalue); + VALUE := UNSIGNED (ivalue); + end procedure OREAD; + + procedure OREAD (L : inout LINE; VALUE : out SIGNED) is + constant ne : INTEGER := (value'length+2)/3; + constant pad : INTEGER := ne*3 - value'length; + variable ivalue : STD_ULOGIC_VECTOR(0 to ne*3-1); + variable expected_padding : STD_ULOGIC_VECTOR(0 to pad-1); + begin + OREAD (L => L, VALUE => ivalue); -- Read padded string - if (pad > 0) then - if (to_X01(ivalue(0)) = '0') then -- positive - if to_X01(ivalue(0)) = or_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); - else - report "NUMERIC_STD.OREAD Error: Signed vector truncated" - severity error; - end if; - else -- negative - if to_X01(ivalue(0)) = and_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); - else - report "NUMERIC_STD.OREAD Error: Signed vector truncated" - severity error; - end if; - end if; + expected_padding := (others => ivalue(pad)); + if ivalue(0 to pad-1) /= expected_padding then + assert false + report "NUMERIC_STD.OREAD Error: Signed vector truncated" + severity error; else - VALUE := SIGNED (ivalue); + VALUE := UNRESOLVED_SIGNED (ivalue (pad to ivalue'high)); end if; end procedure OREAD; - procedure OREAD(L : inout LINE; - VALUE : out SIGNED; - GOOD : out BOOLEAN) is - constant ne : INTEGER := (value'length+2)/3; - constant pad : INTEGER := ne*3 - value'length; - variable ivalue : UNSIGNED (0 to ne*3-1); - variable ok : BOOLEAN; + procedure HREAD (L : inout LINE; VALUE : out UNSIGNED; + GOOD : out BOOLEAN) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); begin - OREAD ( L => L, - VALUE => ivalue, -- Read padded STRING - good => ok); - -- Bail out if there was a bad read + HREAD (L => L, + VALUE => ivalue, + GOOD => GOOD); + VALUE := UNSIGNED(ivalue); + end procedure HREAD; + + procedure HREAD (L : inout LINE; VALUE : out SIGNED; + GOOD : out BOOLEAN) is + constant ne : INTEGER := (value'length+3)/4; + constant pad : INTEGER := ne*4 - value'length; + variable ivalue : STD_ULOGIC_VECTOR(0 to ne*4-1); + variable ok : BOOLEAN; + variable expected_padding : STD_ULOGIC_VECTOR(0 to pad-1); + begin + HREAD (L => L, + VALUE => ivalue, -- Read padded STRING + GOOD => ok); if not ok then - good := false; + GOOD := false; return; end if; - if (pad > 0) then - if (to_X01(ivalue(0)) = '0') then -- positive - if to_X01(ivalue(0)) = or_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); - good := true; - else - good := false; - end if; - else -- negative - if to_X01(ivalue(0)) = and_reduce(ivalue(0 to pad)) then - VALUE := SIGNED (ivalue (pad to ivalue'high)); - good := true; - else - good := false; - end if; - end if; + expected_padding := (others => ivalue(pad)); + if ivalue(0 to pad-1) /= expected_padding then + GOOD := false; else - good := true; - VALUE := SIGNED (ivalue); + GOOD := true; + VALUE := UNRESOLVED_SIGNED (ivalue (pad to ivalue'high)); end if; - end procedure OREAD; + end procedure HREAD; - procedure OWRITE ( - L : inout LINE; -- input line - VALUE : in UNSIGNED; - JUSTIFIED : in SIDE := right; - FIELD : in WIDTH := 0) is + procedure HREAD (L : inout LINE; VALUE : out UNSIGNED) is + variable ivalue : STD_ULOGIC_VECTOR(value'range); begin - WRITE ( L => L, - VALUE => to_ostring(VALUE), - JUSTIFIED => JUSTIFIED, - FIELD => FIELD); + HREAD (L => L, + VALUE => ivalue); + VALUE := UNSIGNED (ivalue); + end procedure HREAD; + + procedure HREAD (L : inout LINE; VALUE : out SIGNED) is + constant ne : INTEGER := (value'length+3)/4; + constant pad : INTEGER := ne*4 - value'length; + variable ivalue : STD_ULOGIC_VECTOR(0 to ne*4-1); + variable expected_padding : STD_ULOGIC_VECTOR(0 to pad-1); + begin + HREAD (L => L, + VALUE => ivalue); -- Read padded string + expected_padding := (others => ivalue(pad)); + if ivalue(0 to pad-1) /= expected_padding then + assert false + report "NUMERIC_STD.HREAD Error: Signed vector truncated" + severity error; + else + VALUE := UNRESOLVED_SIGNED (ivalue (pad to ivalue'high)); + end if; + end procedure HREAD; + + procedure OWRITE (L : inout LINE; VALUE : in UNSIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is + begin + write (L, to_ostring(VALUE), JUSTIFIED, FIELD); end procedure OWRITE; - - procedure OREAD(L : inout LINE; - VALUE : out UNSIGNED) is - variable c : CHARACTER; - variable ok : BOOLEAN; - constant ne : INTEGER := (value'length+2)/3; - constant pad : INTEGER := ne*3 - value'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); - begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true); - if not ok then - return; - end if; - end loop; - value := UNSIGNED (to_stdlogicvector (sv (pad to sv'high))); - if or_reduce (UNSIGNED(sv (0 to pad-1))) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.OREAD Error: Vector truncated" - severity error; - end if; - end procedure OREAD; - procedure OREAD(L : inout LINE; - VALUE : out UNSIGNED; - GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (value'length+2)/3; - constant pad : INTEGER := ne*3 - value'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); + procedure OWRITE (L : inout LINE; VALUE : in SIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is begin - VALUE := (VALUE'range => 'U'); - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - value := UNSIGNED (to_stdlogicvector (sv (pad to sv'high))); - if or_reduce (UNSIGNED(sv (0 to pad-1))) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - good := true; - end if; - end procedure OREAD; + write (L, to_ostring(VALUE), JUSTIFIED, FIELD); + end procedure OWRITE; + + procedure HWRITE (L : inout LINE; VALUE : in UNSIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is + begin + write (L, to_hstring (VALUE), JUSTIFIED, FIELD); + end procedure HWRITE; + + procedure HWRITE (L : inout LINE; VALUE : in SIGNED; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is + begin + write (L, to_hstring (VALUE), JUSTIFIED, FIELD); + end procedure HWRITE; -- rtl_synthesis on +-- pragma synthesis_on end package body numeric_std_additions; diff --git a/Common/sim/ieee_proposed/modelsim/numeric_std_unsigned_c.vhdl b/Common/sim/ieee_proposed/modelsim/numeric_std_unsigned_c.vhdl index 894e51c..2334fe3 100644 --- a/Common/sim/ieee_proposed/modelsim/numeric_std_unsigned_c.vhdl +++ b/Common/sim/ieee_proposed/modelsim/numeric_std_unsigned_c.vhdl @@ -1,29 +1,3 @@ --- -------------------------------------------------------------------- --- --- --- Copyright©2006 by the Institute of Electrical and Electronics Engineers, Inc. --- Three Park Avenue --- New York, NY 10016-5997, USA --- All rights reserved. --- --- This document is an unapproved draft of a proposed IEEE Standard. As such, --- this document is subject to change. USE AT YOUR OWN RISK! Because this --- is an unapproved draft, this document must not be utilized for any --- conformance/compliance purposes. Permission is hereby granted for IEEE --- Standards Committee participants to reproduce this document for purposes --- of IEEE standardization activities only. Prior to submitting this document --- to another standards development organization for standardization --- activities, permission must first be obtained from the Manager, Standards --- Licensing and Contracts, IEEE Standards Activities Department. Other --- entities seeking permission to reproduce this document, in whole or in --- part, must obtain permission from the Manager, Standards Licensing and --- Contracts, IEEE Standard Activities Department. --- --- IEEE Standards Activities Department --- Standards Licensing and Contracts --- 445 Hoes Lane, P.O. Box 1331 --- Piscataway, NJ 08855-1331, USA - -- -------------------------------------------------------------------- -- Title : Standard VHDL Synthesis Packages (1076.3, NUMERIC_STD_UNSIGNED) -- @@ -40,16 +14,12 @@ -- -- Other changes will be noted here. -- --- Version: $Revision: 1.1 $ --- Date: $Date: 2006-06-13 15:53:20-04 $ --- --- Created for VHDL-200X-ft, David Bishop (dbishop@vhdl.org) --- ----------------------------------------------------------------------------- +-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) +------------------------------------------------------------------------------ + library IEEE; use IEEE.STD_LOGIC_1164.all; package NUMERIC_STD_UNSIGNED is - constant CopyRightNotice : STRING := - "Copyright 2006 IEEE. All rights reserved."; -- begin LCS-2006-141 -- Replace all subsequent occurrences of STD_LOGIC_VECTOR @@ -560,6 +530,9 @@ package NUMERIC_STD_UNSIGNED is -- are filled with '0'. When truncating, the leftmost bits -- are dropped. + -- size_res versions of these functions (Bugzilla 165) + function RESIZE (ARG, SIZE_RES : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; + -- Result subtype: STD_ULOGIC_VECTOR (SIZE_RES'length-1 downto 0) --============================================================================ -- Conversion Functions --============================================================================ @@ -581,19 +554,27 @@ package NUMERIC_STD_UNSIGNED is To_StdLogicVector[NATURAL, NATURAL return STD_LOGIC_VECTOR]; alias To_SLV is To_StdLogicVector[NATURAL, NATURAL return STD_LOGIC_VECTOR]; - + -- size_res versions of these functions (Bugzilla 165) + function To_StdLogicVector (ARG : NATURAL; SIZE_RES : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + -- Result subtype: STD_LOGIC_VECTOR(SIZE_RES'length-1 downto 0) -- end LCS-2006-130 -- Id: D.5 function To_StdULogicVector (ARG, SIZE : NATURAL) return STD_ULOGIC_VECTOR; -- Result subtype: STD_ULOGIC_VECTOR(SIZE-1 downto 0) -- Result: Converts a non-negative INTEGER to an UNSIGNED vector with -- the specified SIZE. - + -- size_res versions of these functions (Bugzilla 165) + function To_StdULogicVector (ARG : NATURAL; SIZE_RES : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; + -- Result subtype: STD_LOGIC_VECTOR(SIZE_RES'length-1 downto 0) -- begin LCS-2006-130 alias To_Std_ULogic_Vector is To_StdULogicVector[NATURAL, NATURAL return STD_ULOGIC_VECTOR]; - alias To_SUV is + alias To_SULV is To_StdULogicVector[NATURAL, NATURAL return STD_ULOGIC_VECTOR]; + alias To_Std_ULogic_Vector is + To_StdULogicVector[NATURAL, STD_ULOGIC_VECTOR return STD_ULOGIC_VECTOR]; + alias To_SULV is + To_StdULogicVector[NATURAL, STD_ULOGIC_VECTOR return STD_ULOGIC_VECTOR]; -- end LCS-2006-130 --============================================================================ @@ -1117,6 +1098,9 @@ package NUMERIC_STD_UNSIGNED is -- are filled with '0'. When truncating, the leftmost bits -- are dropped. + -- size_res versions of these functions (Bugzilla 165) + function RESIZE (ARG, SIZE_RES : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + -- Result subtype: STD_ULOGIC_VECTOR (SIZE_RES'length-1 downto 0) --============================================================================ -- Conversion Functions --============================================================================ @@ -1128,6 +1112,7 @@ package NUMERIC_STD_UNSIGNED is -- Result: Converts the UNSIGNED vector to an INTEGER. -- end LCS-2006-130 + --============================================================================ -- Translation Functions --============================================================================ @@ -1144,8 +1129,8 @@ end package NUMERIC_STD_UNSIGNED; ------------------------------------------------------------------------------- -- Proposed package body for the VHDL-200x-FT NUMERIC_STD_UNSIGNED package -- This package body supplies a recommended implementation of these functions --- Version: $Revision: 1.1 $ --- Date: $Date: 2006-06-13 15:53:20-04 $ +-- Version: $Revision: 1.4 $ +-- Date: $Date: 2009/08/26 19:56:30 $ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------- @@ -1644,6 +1629,13 @@ package body NUMERIC_STD_UNSIGNED is NEW_SIZE => NEW_SIZE)); end function RESIZE; + function RESIZE (ARG, SIZE_RES : STD_ULOGIC_VECTOR) + return STD_ULOGIC_VECTOR is + begin + return STD_ULOGIC_VECTOR ( + RESIZE (ARG => UNSIGNED(ARG), + NEW_SIZE => SIZE_RES'length)); + end function RESIZE; --============================================================================ -- Id: D.1 @@ -1659,6 +1651,11 @@ package body NUMERIC_STD_UNSIGNED is SIZE => SIZE)); end function To_StdLogicVector; + function To_StdLogicVector (ARG : NATURAL; SIZE_RES : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR (TO_UNSIGNED(ARG => ARG, + SIZE => SIZE_RES'length)); + end function To_StdLogicVector; -- Id: D.5 function To_StdULogicVector (ARG, SIZE : NATURAL) return STD_ULOGIC_VECTOR is begin @@ -1666,6 +1663,11 @@ package body NUMERIC_STD_UNSIGNED is SIZE => SIZE)); end function To_StdULogicVector; + function To_StdULogicVector (ARG : NATURAL; SIZE_RES : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is + begin + return STD_ULOGIC_VECTOR (TO_UNSIGNED(ARG => ARG, + SIZE => SIZE_RES'length)); + end function To_StdULogicVector; --============================================================================ -- function TO_01 is used to convert vectors to the @@ -2171,6 +2173,13 @@ package body NUMERIC_STD_UNSIGNED is NEW_SIZE => NEW_SIZE)); end function RESIZE; + function RESIZE (ARG, SIZE_RES : STD_LOGIC_VECTOR) + return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR ( + RESIZE (ARG => UNSIGNED(ARG), + NEW_SIZE => SIZE_RES'length)); + end function RESIZE; --============================================================================ -- Id: D.1 diff --git a/Common/sim/ieee_proposed/modelsim/standard_textio_additions_c.vhdl b/Common/sim/ieee_proposed/modelsim/standard_textio_additions_c.vhdl index 35ed5d0..ea37c66 100644 --- a/Common/sim/ieee_proposed/modelsim/standard_textio_additions_c.vhdl +++ b/Common/sim/ieee_proposed/modelsim/standard_textio_additions_c.vhdl @@ -3,8 +3,8 @@ -- "standard.textio" package. -- This package should be compiled into "ieee_proposed" and used as follows: -- use ieee_proposed.standard_textio_additions.all; --- Last Modified: $Date: 2007-03-13 14:25:58-04 $ --- RCS ID: $Id: standard_textio_additions_c.vhdl,v 1.5 2007-03-13 14:25:58-04 l435385 Exp $ +-- Last Modified: $Date: 2007/03/13 18:25:58 $ +-- RCS ID: $Id: standard_textio_additions_c.vhdl,v 1.5 2007/03/13 18:25:58 l435385 Exp $ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------ diff --git a/Common/sim/ieee_proposed/modelsim/std_logic_1164_additions.vhdl b/Common/sim/ieee_proposed/modelsim/std_logic_1164_additions.vhdl index a54200f..15f1341 100644 --- a/Common/sim/ieee_proposed/modelsim/std_logic_1164_additions.vhdl +++ b/Common/sim/ieee_proposed/modelsim/std_logic_1164_additions.vhdl @@ -4,8 +4,8 @@ -- This package should be compiled into "ieee_proposed" and used as follows: -- use ieee.std_logic_1164.all; -- use ieee_proposed.std_logic_1164_additions.all; --- Last Modified: $Date: 2007-03-13 14:27:27-04 $ --- RCS ID: $Id: std_logic_1164_additions.vhdl,v 1.6 2007-03-13 14:27:27-04 l435385 Exp $ +-- Last Modified: $Date: 2010/09/22 18:32:33 $ +-- RCS ID: $Id: std_logic_1164_additions.vhdl,v 1.13 2010/09/22 18:32:33 l435385 Exp $ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------ @@ -28,11 +28,20 @@ package std_logic_1164_additions is alias to_slv is ieee.std_logic_1164.To_StdLogicVector [STD_ULOGIC_VECTOR return STD_LOGIC_VECTOR]; alias to_std_logic_vector is ieee.std_logic_1164.To_StdLogicVector [BIT_VECTOR return STD_LOGIC_VECTOR]; alias to_std_logic_vector is ieee.std_logic_1164.To_StdLogicVector [STD_ULOGIC_VECTOR return STD_LOGIC_VECTOR]; - alias to_suv is ieee.std_logic_1164.To_StdULogicVector [BIT_VECTOR return STD_ULOGIC_VECTOR]; - alias to_suv is ieee.std_logic_1164.To_StdULogicVector [STD_LOGIC_VECTOR return STD_ULOGIC_VECTOR]; + alias to_sulv is ieee.std_logic_1164.To_StdULogicVector [BIT_VECTOR return STD_ULOGIC_VECTOR]; + alias to_sulv is ieee.std_logic_1164.To_StdULogicVector [STD_LOGIC_VECTOR return STD_ULOGIC_VECTOR]; alias to_std_ulogic_vector is ieee.std_logic_1164.To_StdULogicVector [BIT_VECTOR return STD_ULOGIC_VECTOR]; alias to_std_ulogic_vector is ieee.std_logic_1164.To_StdULogicVector [STD_LOGIC_VECTOR return STD_ULOGIC_VECTOR]; + function TO_01 (s : STD_ULOGIC_VECTOR; xmap : STD_ULOGIC := '0') + return STD_ULOGIC_VECTOR; + function TO_01 (s : STD_ULOGIC; xmap : STD_ULOGIC := '0') + return STD_ULOGIC; + function TO_01 (s : BIT_VECTOR; xmap : STD_ULOGIC := '0') + return STD_ULOGIC_VECTOR; + function TO_01 (s : BIT; xmap : STD_ULOGIC := '0') + return STD_ULOGIC; + ------------------------------------------------------------------- -- overloaded shift operators ------------------------------------------------------------------- @@ -140,6 +149,7 @@ package std_logic_1164_additions is function \??\ (S : STD_ULOGIC) return BOOLEAN; -- rtl_synthesis off +-- pragma synthesis_off function to_string (value : STD_ULOGIC) return STRING; function to_string (value : STD_ULOGIC_VECTOR) return STRING; function to_string (value : STD_LOGIC_VECTOR) return STRING; @@ -230,12 +240,13 @@ package std_logic_1164_additions is JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0); alias HEX_WRITE is HWRITE [LINE, STD_LOGIC_VECTOR, SIDE, WIDTH]; -- rtl_synthesis on -function maximum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; -function maximum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; -function maximum (l, r : STD_ULOGIC) return STD_ULOGIC; -function minimum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; -function minimum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; -function minimum (l, r : STD_ULOGIC) return STD_ULOGIC; +-- pragma synthesis_on + function maximum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; + function maximum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function maximum (l, r : STD_ULOGIC) return STD_ULOGIC; + function minimum (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR; + function minimum (l, r : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function minimum (l, r : STD_ULOGIC) return STD_ULOGIC; end package std_logic_1164_additions; package body std_logic_1164_additions is @@ -243,6 +254,64 @@ package body std_logic_1164_additions is ----------------------------------------------------------------------------- -- New/updated funcitons for VHDL-200X fast track ----------------------------------------------------------------------------- + -- to_01 + ------------------------------------------------------------------- + function TO_01 (s : STD_ULOGIC_VECTOR; xmap : STD_ULOGIC := '0') + return STD_ULOGIC_VECTOR is + variable RESULT : STD_ULOGIC_VECTOR(s'length-1 downto 0); + variable BAD_ELEMENT : BOOLEAN := false; + alias XS : STD_ULOGIC_VECTOR(s'length-1 downto 0) is s; + begin + for I in RESULT'range loop + case XS(I) is + when '0' | 'L' => RESULT(I) := '0'; + when '1' | 'H' => RESULT(I) := '1'; + when others => BAD_ELEMENT := true; + end case; + end loop; + if BAD_ELEMENT then + for I in RESULT'range loop + RESULT(I) := XMAP; -- standard fixup + end loop; + end if; + return RESULT; + end function TO_01; + ------------------------------------------------------------------- + function TO_01 (s : STD_ULOGIC; xmap : STD_ULOGIC := '0') + return STD_ULOGIC is + begin + case s is + when '0' | 'L' => RETURN '0'; + when '1' | 'H' => RETURN '1'; + when others => return xmap; + end case; + end function TO_01; + ------------------------------------------------------------------- + function TO_01 (s : BIT_VECTOR; xmap : STD_ULOGIC := '0') + return STD_ULOGIC_VECTOR is + variable RESULT : STD_ULOGIC_VECTOR(s'length-1 downto 0); + alias XS : BIT_VECTOR(s'length-1 downto 0) is s; + begin + for I in RESULT'range loop + case XS(I) is + when '0' => RESULT(I) := '0'; + when '1' => RESULT(I) := '1'; + end case; + end loop; + return RESULT; + end function TO_01; + ------------------------------------------------------------------- + function TO_01 (s : BIT; xmap : STD_ULOGIC := '0') + return STD_ULOGIC is + begin + case s is + when '0' => RETURN '0'; + when '1' => RETURN '1'; + end case; + end function TO_01; +-- end Bugzilla issue #148 + ------------------------------------------------------------------- + ------------------------------------------------------------------- -- overloaded shift operators ------------------------------------------------------------------- @@ -719,12 +788,9 @@ package body std_logic_1164_additions is end function xnor_reduce; -- %%% End "remove the following functions" - - -- The following functions are implicity in 1076-2006 - -- truth table for "?=" function - constant match_logic_table : stdlogic_table := ( + constant match_logic_table : stdlogic_table := ( ----------------------------------------------------- - -- U X 0 1 Z W L H - | | + -- U X 0 1 Z W L H - | | ----------------------------------------------------- ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '1'), -- | U | ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '1'), -- | X | @@ -737,21 +803,6 @@ package body std_logic_1164_additions is ('1', '1', '1', '1', '1', '1', '1', '1', '1') -- | - | ); - constant no_match_logic_table : stdlogic_table := ( - ----------------------------------------------------- - -- U X 0 1 Z W L H - | | - ----------------------------------------------------- - ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', '0'), -- | U | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | X | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | 0 | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | 1 | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | Z | - ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', '0'), -- | W | - ('U', 'X', '0', '1', 'X', 'X', '0', '1', '0'), -- | L | - ('U', 'X', '1', '0', 'X', 'X', '1', '0', '0'), -- | H | - ('0', '0', '0', '0', '0', '0', '0', '0', '0') -- | - | - ); - ------------------------------------------------------------------- -- ?= functions, Similar to "std_match", but returns "std_ulogic". ------------------------------------------------------------------- @@ -769,26 +820,17 @@ package body std_logic_1164_additions is variable result, result1 : STD_ULOGIC; -- result begin -- Logically identical to an "=" operator. - if ((l'length < 1) or (r'length < 1)) then - report "STD_LOGIC_1164.""?="": null detected, returning X" - severity warning; - return 'X'; - end if; - if lv'length /= rv'length then - report "STD_LOGIC_1164.""?="": L'LENGTH /= R'LENGTH, returning X" - severity warning; - return 'X'; + if ((l'length < 1) and (r'length < 1)) then + -- VHDL-2008 LRM 9.2.3 Two NULL arrays of the same type are equal + return '1'; + elsif lv'length /= rv'length then + -- Two arrays of different lengths are false + return '0'; else result := '1'; for i in lv'low to lv'high loop result1 := match_logic_table(lv(i), rv(i)); - if result1 = 'U' then - return 'U'; - elsif result1 = 'X' or result = 'X' then - result := 'X'; - else - result := result and result1; - end if; + result := result and result1; end loop; return result; end if; @@ -801,26 +843,18 @@ package body std_logic_1164_additions is alias rv : STD_ULOGIC_VECTOR(1 to r'length) is r; variable result, result1 : STD_ULOGIC; begin - if ((l'length < 1) or (r'length < 1)) then - report "STD_LOGIC_1164.""?="": null detected, returning X" - severity warning; - return 'X'; - end if; - if lv'length /= rv'length then - report "STD_LOGIC_1164.""?="": L'LENGTH /= R'LENGTH, returning X" - severity warning; - return 'X'; + -- Logically identical to an "=" operator. + if ((l'length < 1) and (r'length < 1)) then + -- VHDL-2008 LRM 9.2.3 Two NULL arrays of the same type are equal + return '1'; + elsif lv'length /= rv'length then + -- Two arrays of different lengths are false + return '0'; else result := '1'; for i in lv'low to lv'high loop result1 := match_logic_table(lv(i), rv(i)); - if result1 = 'U' then - return 'U'; - elsif result1 = 'X' or result = 'X' then - result := 'X'; - else - result := result and result1; - end if; + result := result and result1; end loop; return result; end if; @@ -829,158 +863,65 @@ package body std_logic_1164_additions is -- %%% FUNCTION "?/=" ( l, r : std_ulogic ) RETURN std_ulogic is function \?/=\ (l, r : STD_ULOGIC) return STD_ULOGIC is begin - return no_match_logic_table (l, r); + return not \?=\ (l, r); end function \?/=\; -- %%% END FUNCTION "?/="; -- %%% FUNCTION "?/=" ( l, r : std_logic_vector ) RETURN std_ulogic is function \?/=\ (l, r : STD_LOGIC_VECTOR) return STD_ULOGIC is - alias lv : STD_LOGIC_VECTOR(1 to l'length) is l; - alias rv : STD_LOGIC_VECTOR(1 to r'length) is r; - variable result, result1 : STD_ULOGIC; -- result begin - if ((l'length < 1) or (r'length < 1)) then - report "STD_LOGIC_1164.""?/="": null detected, returning X" - severity warning; - return 'X'; - end if; - if lv'length /= rv'length then - report "STD_LOGIC_1164.""?/="": L'LENGTH /= R'LENGTH, returning X" - severity warning; - return 'X'; - else - result := '0'; - for i in lv'low to lv'high loop - result1 := no_match_logic_table(lv(i), rv(i)); - if result1 = 'U' then - return 'U'; - elsif result1 = 'X' or result = 'X' then - result := 'X'; - else - result := result or result1; - end if; - end loop; - return result; - end if; + return not \?=\ (l, r); end function \?/=\; -- %%% END FUNCTION "?/="; -- %%% FUNCTION "?/=" ( l, r : std_ulogic_vector ) RETURN std_ulogic is function \?/=\ (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC is - alias lv : STD_ULOGIC_VECTOR(1 to l'length) is l; - alias rv : STD_ULOGIC_VECTOR(1 to r'length) is r; - variable result, result1 : STD_ULOGIC; begin - if ((l'length < 1) or (r'length < 1)) then - report "STD_LOGIC_1164.""?/="": null detected, returning X" - severity warning; - return 'X'; - end if; - if lv'length /= rv'length then - report "STD_LOGIC_1164.""?/="": L'LENGTH /= R'LENGTH, returning X" - severity warning; - return 'X'; - else - result := '0'; - for i in lv'low to lv'high loop - result1 := no_match_logic_table(lv(i), rv(i)); - if result1 = 'U' then - return 'U'; - elsif result1 = 'X' or result = 'X' then - result := 'X'; - else - result := result or result1; - end if; - end loop; - return result; - end if; + return not \?=\ (l, r); end function \?/=\; -- %%% END FUNCTION "?/="; + + -- Table for the ?< function (Section 9.2.3) + constant qlt : stdlogic_table := ( + ----------------------------------------------------- + -- U X 0 1 Z W L H - | | + ----------------------------------------------------- + ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'X'), -- | U | + ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | X | + ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'), -- | 0 | + ('U', 'X', '0', '0', 'X', 'X', '0', '0', 'X'), -- | 1 | + ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | Z | + ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'), -- | W | + ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'), -- | L | + ('U', 'X', '0', '0', 'X', 'X', '0', '0', 'X'), -- | H | + ('X', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X') -- | - | + ); + -- %%% FUNCTION "?>" ( l, r : std_ulogic ) RETURN std_ulogic is function \?>\ (l, r : STD_ULOGIC) return STD_ULOGIC is - variable lx, rx : STD_ULOGIC; begin - if (l = '-') or (r = '-') then - report "STD_LOGIC_1164.""?>"": '-' found in compare string" - severity error; - return 'X'; - else - lx := to_x01 (l); - rx := to_x01 (r); - if lx = 'X' or rx = 'X' then - return 'X'; - elsif lx > rx then - return '1'; - else - return '0'; - end if; - end if; + return not (qlt (l, r) or match_logic_table (l,r)); end function \?>\; -- %%% END FUNCTION "?>"; -- %%% FUNCTION "?>=" ( l, r : std_ulogic ) RETURN std_ulogic is function \?>=\ (l, r : STD_ULOGIC) return STD_ULOGIC is - variable lx, rx : STD_ULOGIC; begin - if (l = '-') or (r = '-') then - report "STD_LOGIC_1164.""?>="": '-' found in compare string" - severity error; - return 'X'; - else - lx := to_x01 (l); - rx := to_x01 (r); - if lx = 'X' or rx = 'X' then - return 'X'; - elsif lx >= rx then - return '1'; - else - return '0'; - end if; - end if; + return not qlt (l, r); end function \?>=\; - -- %%% END FUNCTION "?/>="; + -- %%% END FUNCTION "?>="; -- %%% FUNCTION "?<" ( l, r : std_ulogic ) RETURN std_ulogic is function \?<\ (l, r : STD_ULOGIC) return STD_ULOGIC is - variable lx, rx : STD_ULOGIC; begin - if (l = '-') or (r = '-') then - report "STD_LOGIC_1164.""?<"": '-' found in compare string" - severity error; - return 'X'; - else - lx := to_x01 (l); - rx := to_x01 (r); - if lx = 'X' or rx = 'X' then - return 'X'; - elsif lx < rx then - return '1'; - else - return '0'; - end if; - end if; + return qlt (l, r); end function \?<\; - -- %%% END FUNCTION "?/<"; + -- %%% END FUNCTION "?<"; -- %%% FUNCTION "?<=" ( l, r : std_ulogic ) RETURN std_ulogic is function \?<=\ (l, r : STD_ULOGIC) return STD_ULOGIC is - variable lx, rx : STD_ULOGIC; begin - if (l = '-') or (r = '-') then - report "STD_LOGIC_1164.""?<="": '-' found in compare string" - severity error; - return 'X'; - else - lx := to_x01 (l); - rx := to_x01 (r); - if lx = 'X' or rx = 'X' then - return 'X'; - elsif lx <= rx then - return '1'; - else - return '0'; - end if; - end if; + return qlt (l, r) or match_logic_table (l,r); end function \?<=\; - -- %%% END FUNCTION "?/<="; + -- %%% END FUNCTION "?<="; -- "??" operator, converts a std_ulogic to a boolean. -- %%% FUNCTION "??" @@ -991,6 +932,7 @@ package body std_logic_1164_additions is -- %%% END FUNCTION "??"; -- rtl_synthesis off +-- pragma synthesis_off ----------------------------------------------------------------------------- -- This section copied from "std_logic_textio" ----------------------------------------------------------------------------- @@ -1009,7 +951,22 @@ package body std_logic_1164_additions is 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => error); constant NBSP : CHARACTER := CHARACTER'val(160); -- space character - constant NUS : STRING(2 to 1) := (others => ' '); -- null string + constant NUS : STRING(2 to 1) := (others => ' '); -- null STRING + + -- purpose: Skips white space + procedure skip_whitespace ( + L : inout LINE) is + variable readOk : BOOLEAN; + variable c : CHARACTER; + begin + while L /= null and L.all'length /= 0 loop + if (L.all(1) = ' ' or L.all(1) = NBSP or L.all(1) = HT) then + read (l, c, readOk); + else + exit; + end if; + end loop; + end procedure skip_whitespace; procedure READ (L : inout LINE; VALUE : out STD_ULOGIC; GOOD : out BOOLEAN) is @@ -1017,10 +974,8 @@ package body std_logic_1164_additions is variable readOk : BOOLEAN; begin VALUE := 'U'; -- initialize to a "U" - loop -- skip white space - read(l, c, readOk); -- but also exit on a bad read - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; + Skip_whitespace (L); + read (l, c, readOk); if not readOk then good := false; else @@ -1037,42 +992,45 @@ package body std_logic_1164_additions is GOOD : out BOOLEAN) is variable m : STD_ULOGIC; variable c : CHARACTER; - variable s : STRING(1 to VALUE'length-1); variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1); variable readOk : BOOLEAN; + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not readOk then + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, readOk); + i := 0; good := false; - return; + while i < VALUE'length loop + if not readOk then -- Bail out if there was a bad read + return; + elsif c = '_' then + if i = 0 then -- Begins with an "_" + return; + elsif lastu then -- "__" detected + return; + else + lastu := true; + end if; + elsif (char_to_MVL9plus(c) = error) then -- Illegal character + return; + else + mv(i) := char_to_MVL9(c); + i := i + 1; + if i > mv'high then -- reading done + good := true; + VALUE := mv; + return; + end if; + lastu := false; + end if; + read(L, c, readOk); + end loop; + else + good := true; -- read into a null array end if; - if char_to_MVL9plus(c) = error then - good := false; - return; - end if; - read(L, s, readOk); - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - for i in 1 to VALUE'length-1 loop - if char_to_MVL9plus(s(i)) = error then - good := false; - return; - end if; - end loop; - mv(0) := char_to_MVL9(c); - for i in 1 to VALUE'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - VALUE := mv; - good := true; end procedure READ; procedure READ (L : inout LINE; VALUE : out STD_ULOGIC) is @@ -1080,13 +1038,11 @@ package body std_logic_1164_additions is variable readOk : BOOLEAN; begin VALUE := 'U'; -- initialize to a "U" - loop -- skip white space - read(l, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; + Skip_whitespace (L); + read (l, c, readOk); if not readOk then report "STD_LOGIC_1164.READ(STD_ULOGIC) " - & "Error end of string encountered" + & "End of string encountered" severity error; return; elsif char_to_MVL9plus(c) = error then @@ -1103,48 +1059,57 @@ package body std_logic_1164_additions is variable m : STD_ULOGIC; variable c : CHARACTER; variable readOk : BOOLEAN; - variable s : STRING(1 to VALUE'length-1); variable mv : STD_ULOGIC_VECTOR(0 to VALUE'length-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if readOk = false then -- Bail out if there was a bad read - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - elsif char_to_MVL9plus(c) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - c & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - read(L, s, readOk); - if readOk then - for i in 1 to VALUE'length-1 loop - if char_to_MVL9plus(s(i)) = error then - report - "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" & - s(i) & "' read, expected STD_ULOGIC literal." + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, readOk); + i := 0; + while i < VALUE'length loop + if readOk = false then -- Bail out if there was a bad read + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "End of string encountered" severity error; return; + elsif c = '_' then + if i = 0 then + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + elsif c = ' ' or c = NBSP or c = HT then -- reading done. + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "Short read, Space encounted in input string" + severity error; + return; + elsif char_to_MVL9plus(c) = error then + report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " + & "Error: Character '" & + c & "' read, expected STD_ULOGIC literal." + severity error; + return; + else + mv(i) := char_to_MVL9(c); + i := i + 1; + if i > mv'high then + VALUE := mv; + return; + end if; + lastu := false; end if; + read(L, c, readOk); end loop; - else - report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; end if; - mv(0) := char_to_MVL9(c); - for i in 1 to VALUE'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - VALUE := mv; end procedure READ; procedure WRITE (L : inout LINE; VALUE : in STD_ULOGIC; @@ -1168,92 +1133,17 @@ package body std_logic_1164_additions is procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN) is - variable m : STD_LOGIC; - variable c : CHARACTER; - variable s : STRING(1 to VALUE'length-1); - variable mv : STD_LOGIC_VECTOR(0 to VALUE'length-1); - variable readOk : BOOLEAN; + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - if char_to_MVL9plus(c) = error then - good := false; - return; - end if; - read(L, s, readOk); - -- Bail out if there was a bad read - if not readOk then - good := false; - return; - end if; - for i in 1 to VALUE'length-1 loop - if char_to_MVL9plus(s(i)) = error then - good := false; - return; - end if; - end loop; - mv(0) := char_to_MVL9(c); - for i in 1 to VALUE'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - VALUE := mv; - good := true; + READ (L => L, VALUE => ivalue, GOOD => GOOD); + VALUE := to_stdlogicvector (ivalue); end procedure READ; procedure READ (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is - variable m : STD_LOGIC; - variable c : CHARACTER; - variable readOk : BOOLEAN; - variable s : STRING(1 to VALUE'length-1); - variable mv : STD_LOGIC_VECTOR(0 to VALUE'length-1); + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, readOk); - exit when (readOk = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - if readOk = false then -- Bail out if there was a bad read - report "STD_LOGIC_1164.READ(STD_LOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - elsif char_to_MVL9plus(c) = error then - report - "STD_LOGIC_1164.READ(STD_LOGIC_VECTOR) Error: Character '" & - c & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - read(L, s, readOk); - if readOk then - for i in 1 to VALUE'length-1 loop - if (char_to_MVL9plus(s(i)) = error) then - report - "STD_LOGIC_1164.READ(STD_LOGIC_VECTOR) Error: Character '" & - s(i) & "' read, expected STD_ULOGIC literal." - severity error; - return; - end if; - end loop; - else - report "STD_LOGIC_1164.READ(STD_LOGIC_VECTOR) " - & "Error end of string encountered" - severity error; - return; - end if; - mv(0) := char_to_MVL9(c); - for i in 1 to VALUE'length-1 loop - mv(i) := char_to_MVL9(s(i)); - end loop; - VALUE := mv; + READ (L => L, VALUE => ivalue); + VALUE := to_stdlogicvector (ivalue); end procedure READ; procedure WRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR; @@ -1302,7 +1192,7 @@ package body std_logic_1164_additions is when others => assert not ISSUE_ERROR report - "STD_LOGIC_1164.HREAD Error: Read a '" & c & + "STD_LOGIC_1164.HREAD Read a '" & c & "', expected a Hex character (0-F)." severity error; good := false; @@ -1316,40 +1206,50 @@ package body std_logic_1164_additions is constant ne : INTEGER := (VALUE'length+3)/4; constant pad : INTEGER := ne*4 - VALUE'length; variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false); - if not ok then - good := false; - return; + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + else + Char2QuadBits(c, sv(4*i to 4*i+3), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. else - good := true; - VALUE := sv (pad to sv'high); + good := true; -- Null input string, skips whitespace end if; end procedure HREAD; @@ -1359,40 +1259,53 @@ package body std_logic_1164_additions is constant ne : INTEGER := (VALUE'length+3)/4; constant pad : INTEGER := ne*4 - VALUE'length; variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true); - if not ok then - return; + Skip_whitespace (L); + if VALUE'length > 0 then -- non Null input string + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + report "STD_LOGIC_1164.HREAD " + & "End of string encountered" + severity error; + return; + end if; + if c = '_' then + if i = 0 then + report "STD_LOGIC_1164.HREAD " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.HREAD " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + else + Char2QuadBits(c, sv(4*i to 4*i+3), ok, true); + if not ok then + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + report "STD_LOGIC_1164.HREAD Vector truncated" + severity error; + else + VALUE := sv (pad to sv'high); end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.HREAD Error: Vector truncated" - severity error; - else - VALUE := sv (pad to sv'high); end if; end procedure HREAD; @@ -1439,40 +1352,50 @@ package body std_logic_1164_additions is constant ne : INTEGER := (VALUE'length+2)/3; constant pad : INTEGER := ne*3 - VALUE'length; variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false); - if not ok then - good := false; - return; + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + good := false; + return; + elsif c = '_' then + if i = 0 then + good := false; -- Begins with an "_" + return; + elsif lastu then + good := false; -- "__" detected + return; + else + lastu := true; + end if; + else + Char2TriBits(c, sv(3*i to 3*i+2), ok, false); + if not ok then + good := false; + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + good := false; -- vector was truncated. + else + good := true; + VALUE := sv (pad to sv'high); end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. else - good := true; - VALUE := sv (pad to sv'high); + good := true; -- read into a null array end if; end procedure OREAD; @@ -1482,40 +1405,52 @@ package body std_logic_1164_additions is constant ne : INTEGER := (VALUE'length+2)/3; constant pad : INTEGER := ne*3 - VALUE'length; variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); + variable i : INTEGER; + variable lastu : BOOLEAN := false; -- last character was an "_" begin VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true); - if not ok then - return; + Skip_whitespace (L); + if VALUE'length > 0 then + read (l, c, ok); + i := 0; + while i < ne loop + -- Bail out if there was a bad read + if not ok then + report "STD_LOGIC_1164.OREAD " + & "End of string encountered" + severity error; + return; + elsif c = '_' then + if i = 0 then + report "STD_LOGIC_1164.OREAD " + & "String begins with an ""_""" severity error; + return; + elsif lastu then + report "STD_LOGIC_1164.OREAD " + & "Two underscores detected in input string ""__""" + severity error; + return; + else + lastu := true; + end if; + else + Char2TriBits(c, sv(3*i to 3*i+2), ok, true); + if not ok then + return; + end if; + i := i + 1; + lastu := false; + end if; + if i < ne then + read(L, c, ok); + end if; + end loop; + if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" + report "STD_LOGIC_1164.OREAD Vector truncated" + severity error; + else + VALUE := sv (pad to sv'high); end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.OREAD Error: Vector truncated" - severity error; - else - VALUE := sv (pad to sv'high); end if; end procedure OREAD; @@ -1529,88 +1464,17 @@ package body std_logic_1164_additions is procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+3)/4; - constant pad : INTEGER := ne*4 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - VALUE := to_stdlogicvector(sv (pad to sv'high)); - good := true; - end if; + HREAD (L => L, VALUE => ivalue, GOOD => GOOD); + VALUE := to_stdlogicvector (ivalue); end procedure HREAD; procedure HREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+3)/4; - constant pad : INTEGER := ne*4 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*4 - 1); - variable s : STRING(1 to ne-1); + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(l, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2QuadBits(c, sv(0 to 3), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.HREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true); - if not ok then - return; - end if; - end loop; - VALUE := to_stdlogicvector(sv (pad to sv'high)); - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.HREAD Error: Vector truncated" - severity error; - end if; + HREAD (L => L, VALUE => ivalue); + VALUE := to_stdlogicvector (ivalue); end procedure HREAD; procedure HWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR; @@ -1623,88 +1487,17 @@ package body std_logic_1164_additions is procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN) is - variable ok : BOOLEAN; - variable c : CHARACTER; - constant ne : INTEGER := (VALUE'length+2)/3; - constant pad : INTEGER := ne*3 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - good := false; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, false); - if not ok then - good := false; - return; - end if; - read(L, s, ok); - if not ok then - good := false; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false); - if not ok then - good := false; - return; - end if; - end loop; - VALUE := to_stdlogicvector (sv (pad to sv'high)); - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - good := false; -- vector was truncated. - else - good := true; - end if; + OREAD (L => L, VALUE => ivalue, GOOD => GOOD); + VALUE := to_stdlogicvector (ivalue); end procedure OREAD; procedure OREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is - variable c : CHARACTER; - variable ok : BOOLEAN; - constant ne : INTEGER := (VALUE'length+2)/3; - constant pad : INTEGER := ne*3 - VALUE'length; - variable sv : STD_ULOGIC_VECTOR(0 to ne*3 - 1); - variable s : STRING(1 to ne-1); + variable ivalue : STD_ULOGIC_VECTOR (VALUE'range); begin - VALUE := (VALUE'range => 'U'); -- initialize to a "U" - loop -- skip white space - read(L, c, ok); - exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT)); - end loop; - -- Bail out if there was a bad read - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed skipping white space" - severity error; - return; - end if; - Char2TriBits(c, sv(0 to 2), ok, true); - if not ok then - return; - end if; - read(L, s, ok); - if not ok then - report "STD_LOGIC_1164.OREAD Error: Failed to read the STRING" - severity error; - return; - end if; - for i in 1 to ne-1 loop - Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true); - if not ok then - return; - end if; - end loop; - VALUE := to_stdlogicvector (sv (pad to sv'high)); - if or_reduce (sv (0 to pad-1)) = '1' then -- %%% replace with "or" - report "STD_LOGIC_1164.OREAD Error: Vector truncated" - severity error; - end if; + OREAD (L => L, VALUE => ivalue); + VALUE := to_stdlogicvector (ivalue); end procedure OREAD; procedure OWRITE (L : inout LINE; VALUE : in STD_LOGIC_VECTOR; @@ -1839,6 +1632,7 @@ package body std_logic_1164_additions is end function to_ostring; -- rtl_synthesis on +-- pragma synthesis_on function maximum (L, R : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is begin -- function maximum if L > R then return L;