------------------------------------------------------------------------------- -- Title : boneyard.vhd -- Welcome to the bone yard! Here you will find code which has been debugged, -- but which we decided to leave out of the standard. Here you will find some -- of the bits and pieces you may need to create other functions. -- Never delete debugged code. -- Things like this have a way of comming back to life. -- Proposed package body for the VHDL-200x-FT XXXXXXXXX package -- This package body supplies a recommended implementation of these functions -- Last Modified: $Date$ -- RCS ID: $Id$ -- -- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) ------------------------------------------------------------------------------- library ieee; use ieee.std_logic_1164.all; use ieee.numeric_std.all; package boneyard is -- New conversion functions, these drop or add sign bits only function remove_sign (arg : SIGNED) return UNSIGNED is variable result : UNSIGNED (arg'length-1 downto 0); alias XARG : SIGNED(arg'length-1 downto 0) is ARG; variable yarg : SIGNED (XARG'range); begin if arg'length < 1 then return NAU; end if; if (to_x01(XARG(XARG'high)) = '1') then yarg := abs (xarg); else yarg := to_x01(xarg); end if; result := UNSIGNED(yarg); return result; end function remove_sign; function add_sign (arg : UNSIGNED) return SIGNED is variable result : SIGNED (arg'length downto 0); alias XARG : UNSIGNED(arg'length-1 downto 0) is ARG; begin if arg'length < 1 then return NAS; end if; result := "0" & SIGNED (to_x01(XARG)); return result; end function add_sign; -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). -- Procedure takes a carry in into the adder, and provides a carry out. procedure add_carry ( L, R : in UNSIGNED; c_in : in STD_ULOGIC; result : out UNSIGNED; c_out : out STD_ULOGIC) is constant SIZE : NATURAL := MAX(L'length, R'length); variable L01 : UNSIGNED(SIZE downto 0); variable R01 : UNSIGNED(SIZE downto 0); variable res_big : UNSIGNED (SIZE downto 0); -- one bit too big begin c_out := 'X'; -- default to X if ((L'length < 1) or (R'length < 1)) then result := NAU; return; end if; L01 := TO_01(RESIZE(L, SIZE+1), 'X'); R01 := TO_01(RESIZE(R, SIZE+1), 'X'); if (to_X01(c_in) = 'X') or (L01(L01'left) = 'X') or (R01(R01'left) = 'X') then result (SIZE-1 downto 0) := (others => 'X'); return; end if; res_big := ADD_UNSIGNED(L01, R01, c_in); c_out := res_big(SIZE); result := res_big(SIZE-1 downto 0); end procedure add_carry; -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). -- Procedure takes a carry in into the adder, and provides a carry out. procedure add_carry ( L, R : in SIGNED; c_in : in STD_ULOGIC; result : out SIGNED; c_out : out STD_ULOGIC) is constant SIZE : NATURAL := MAX(L'length, R'length); variable L01 : SIGNED(SIZE downto 0); variable R01 : SIGNED(SIZE downto 0); variable res_big : SIGNED (SIZE downto 0); begin c_out := 'X'; -- default to X if ((L'length < 1) or (R'length < 1)) then result := NAS; return; end if; L01 := TO_01(RESIZE(L, SIZE+1), 'X'); R01 := TO_01(RESIZE(R, SIZE+1), 'X'); if (to_X01(c_in) = 'X') or (L01(L01'left) = 'X') or (R01(R01'left) = 'X') then result (SIZE-1 downto 0) := (others => 'X'); return; end if; res_big := ADD_SIGNED(L01, R01, c_in); c_out := res_big(size) xor res_big(size-1); result := res_big(size-1 downto 0); end procedure add_carry; -- These reduction operators are done recursively ------------------------------------------------------------------- -- and ------------------------------------------------------------------- function and_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return and_reduce (to_StdULogicVector (arg)); end function and_reduce; ------------------------------------------------------------------- function and_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is variable Upper, Lower : STD_ULOGIC; variable Half : INTEGER; variable BUS_int : STD_ULOGIC_VECTOR (arg'length - 1 downto 0); variable Result : STD_ULOGIC := '1'; -- In the case of a NULL range begin if (arg'length >= 1) then BUS_int := to_ux01 (arg); if (BUS_int'length = 1) then Result := BUS_int (BUS_int'left); elsif (BUS_int'length = 2) then Result := and_table (BUS_int(BUS_int'right), BUS_int(BUS_int'left)); else Half := (BUS_int'length + 1) / 2 + BUS_int'right; Upper := and_reduce (BUS_int (BUS_int'left downto Half)); Lower := and_reduce (BUS_int (Half - 1 downto BUS_int'right)); Result := and_table (Upper, Lower); end if; end if; return Result; end function and_reduce; ------------------------------------------------------------------- -- nand ------------------------------------------------------------------- function nand_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return not_table(and_reduce(to_StdULogicVector(arg))); end function nand_reduce; ------------------------------------------------------------------- function nand_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not_table(and_reduce(arg)); end function nand_reduce; ------------------------------------------------------------------- -- or ------------------------------------------------------------------- function or_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return or_reduce (to_StdULogicVector (arg)); end function or_reduce; ------------------------------------------------------------------- function or_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is variable Upper, Lower : STD_ULOGIC; variable Half : INTEGER; variable BUS_int : STD_ULOGIC_VECTOR (arg'length - 1 downto 0); variable Result : STD_ULOGIC := '0'; -- In the case of a NULL range begin if (arg'length >= 1) then BUS_int := to_ux01 (arg); if (BUS_int'length = 1) then Result := BUS_int (BUS_int'left); elsif (BUS_int'length = 2) then Result := or_table (BUS_int(BUS_int'right), BUS_int(BUS_int'left)); else Half := (BUS_int'length + 1) / 2 + BUS_int'right; Upper := or_reduce (BUS_int (BUS_int'left downto Half)); Lower := or_reduce (BUS_int (Half - 1 downto BUS_int'right)); Result := or_table (Upper, Lower); end if; end if; return Result; end function or_reduce; ------------------------------------------------------------------- -- nor ------------------------------------------------------------------- function nor_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return not_table(or_reduce(To_StdULogicVector(arg))); end function nor_reduce; ------------------------------------------------------------------- function nor_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not_table(or_reduce(arg)); end function nor_reduce; ------------------------------------------------------------------- -- xor ------------------------------------------------------------------- function xor_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return xor_reduce (to_StdULogicVector (arg)); end function xor_reduce; ------------------------------------------------------------------- function xor_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is variable Upper, Lower : STD_ULOGIC; variable Half : INTEGER; variable BUS_int : STD_ULOGIC_VECTOR (arg'length - 1 downto 0); variable Result : STD_ULOGIC := '0'; -- In the case of a NULL range begin if (arg'length >= 1) then BUS_int := to_ux01 (arg); if (BUS_int'length = 1) then Result := BUS_int (BUS_int'left); elsif (BUS_int'length = 2) then Result := xor_table (BUS_int(BUS_int'right), BUS_int(BUS_int'left)); else Half := (BUS_int'length + 1) / 2 + BUS_int'right; Upper := xor_reduce (BUS_int (BUS_int'left downto Half)); Lower := xor_reduce (BUS_int (Half - 1 downto BUS_int'right)); Result := xor_table (Upper, Lower); end if; end if; return Result; end function xor_reduce; ------------------------------------------------------------------- -- xnor ------------------------------------------------------------------- function xnor_reduce (arg : STD_LOGIC_VECTOR) return STD_ULOGIC is begin return not_table(xor_reduce(To_StdULogicVector(arg))); end function xnor_reduce; ------------------------------------------------------------------- function xnor_reduce (arg : STD_ULOGIC_VECTOR) return STD_ULOGIC is begin return not_table(xor_reduce(arg)); end function xnor_reduce; -- Function from Proposal FT18 function "and" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return to_X01(L); else return '0'; end if; end function "and"; function "and" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return to_X01(R); else return '0'; end if; end function "and"; function "or" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return '1'; else return to_X01(L); end if; end function "or"; function "or" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return '1'; else return to_X01(R); end if; end function "or"; function "xor" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return not to_X01(L); else return to_X01(L); end if; end function "xor"; function "xor" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return not to_X01(R); else return to_X01(R); end if; end function "xor"; function "nand" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return not to_X01(L); else return '1'; end if; end function "nand"; function "nand" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return not to_X01(R); else return '1'; end if; end function "nand"; function "nor" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return '0'; else return not to_X01(L); end if; end function "nor"; function "nor" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return '0'; else return not to_X01(R); end if; end function "nor"; function "xnor" (L : STD_ULOGIC; R : BOOLEAN) return STD_ULOGIC is begin if R then return to_X01(L); else return not to_X01(L); end if; end function "xnor"; function "xnor" (L : BOOLEAN; R : STD_ULOGIC) return STD_ULOGIC is begin if L then return to_X01(R); else return not to_X01(R); end if; end function "xnor"; -- Some synthesis tools don't like the "test_boundary" function from -- "float_generic_pkg-body.vhdl, so do it this way -- (ignoring denormal and infinite numbers) -- function test_boundary ( -- arg : REAL; -- Input, converted to real -- constant fraction_width : NATURAL; -- length of FP output fraction -- constant exponent_width : NATURAL; -- length of FP exponent -- constant denormalize : BOOLEAN := true) -- Use IEEE extended FP -- return boundary_type is -- begin -- function test_boundary -- if arg = 0.0 then -- return zero; -- else -- return normal; -- end if; -- end function test_boundary; ----------------------------------------------------------------------------- -- Textio Functions ----------------------------------------------------------------------------- --rtl_synthesis off -- if the time is 1 ns, and the resolution is 1 ps, -- then to_string(now) = 1000.0 ps; function to_string ( VALUE : in TIME; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0; resolution : in TIME := sim_resolution ) return STRING is -- Can't use "hr", "min", etc because they are reserved. type times is (xhr, xmin, xsec, xms, xus, xns, xps, xfs); variable rtime, ttime : REAL; variable czero, i, j, k : INTEGER; -- 10 ps resolution variable L : LINE; -- pointer begin if (resolution = Sim_Resolution) then return justify(value => TIME'image(VALUE), justified => JUSTIFIED, field => FIELD); else if (resolution = 0.0 ns) then assert (false) report "to_string(time): Resolution passed is less than " & "simulator resolution" severity error; return "0 ns"; end if; deallocate (L); write (L, resolution); -- Write it into a string read (L, rtime); -- Read REAL from the string -- Assumes that resolutions in "hr", and "min" are illegal, -- and that resolutions are always a power of 10. ttime := rtime; i := 0; -- Calculate Log10 while (ttime >= 10.0) loop ttime := ttime / 10.0; i := i + 1; end loop; if (ttime /= 1.0) then report "to_string(time): Illegal resolution, not a power of 10. " & TIME'image(resolution) severity error; return "0 ns"; end if; if (rtime >= 1000.0) then -- convert the units j := 0; -- Calculate Log1000 ttime := rtime; while (ttime >= 1000.0) loop ttime := ttime / 1000.0; j := j + 1; end loop; -- figure out the current units if (L.all = " sec") then k := 2; elsif (L.all = " ms") then k := 3; elsif (L.all = " us") then k := 4; elsif (L.all = " ns") then k := 5; elsif (L.all = " ps") then k := 6; else k := 7; end if; deallocate (L); write (L, times'image(times'val(k-j))); -- Write the state type L.all(1) := ' '; -- destroy the "x" end if; czero := (VALUE / resolution) * (10**(i rem 3)); return justify(value => to_string (VALUE => czero) & L.all, justified => JUSTIFIED, field => FIELD); end if; end function to_string; function to_dstring ( value : in SIGNED; justified : in SIDE := right; field : in width := 0 ) return STRING is variable argint : INTEGER; -- integer version of value begin if value'length < 1 then return NUS; else argint := to_integer (value); return justify( value => INTEGER'image(argint), justified => justified, field => field); end if; end function to_dstring; function to_dstring ( value : in UNSIGNED; justified : in SIDE := right; field : in width := 0 ) return STRING is variable argint : NATURAL; -- integer version of value begin if value'length < 1 then return NUS; else argint := to_integer (value); return justify( value => INTEGER'image(argint), justified => justified, field => field); end if; end function to_dstring; procedure DWRITE ( L : inout LINE; -- input line VALUE : in SIGNED; -- fixed point input JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is variable ivalue : INTEGER; begin ivalue := to_integer (VALUE); WRITE (L => L, VALUE => ivalue, JUSTIFIED => JUSTIFIED, FIELD => FIELD); end procedure DWRITE; procedure DREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR; GOOD : out BOOLEAN) is variable ivalue : INTEGER; variable igood : BOOLEAN; begin READ (L => L, VALUE => ivalue, GOOD => igood); if igood and ivalue > -1 then VALUE := To_StdLogicVector (ivalue, 32); GOOD := true; else VALUE := (31 downto 0 => 'X'); GOOD := false; end if; end procedure DREAD; procedure DREAD (L : inout LINE; VALUE : out STD_LOGIC_VECTOR) is variable ivalue : INTEGER; begin READ (L => L, VALUE => ivalue); if ivalue < 0 then assert false report "NUMERIC_UNSIGNED: DREAD value less than 0 " & INTEGER'image(ivalue); VALUE := (31 downto 0 => 'X'); else VALUE := To_StdLogicVector (ivalue, 32); end if; end procedure DREAD; procedure DWRITE ( L : inout LINE; -- input line VALUE : in UNSIGNED; -- fixed point input JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is variable ivalue : NATURAL; begin ivalue := to_integer (VALUE); WRITE (L => L, VALUE => ivalue, JUSTIFIED => JUSTIFIED, FIELD => FIELD); end procedure DWRITE; procedure DREAD(L : inout LINE; VALUE : out UNSIGNED) is variable ivalue : NATURAL; begin READ (L => L, VALUE => ivalue); VALUE := to_unsigned (ivalue, value'length); end procedure DREAD; procedure DREAD(L : inout LINE; VALUE : out UNSIGNED; GOOD : out BOOLEAN) is variable ivalue : NATURAL; begin READ (L => L, VALUE => ivalue, GOOD => GOOD); VALUE := to_unsigned(ivalue, value'length); end procedure DREAD; function to_dstring ( value : ufixed; justified : in SIDE := right; field : in width := 0 ) return STRING is variable value_real : REAL; begin if value'length < 1 then return NUS; else value_real := to_real (value); return justify (value => REAL'image(value_real), justified => justified, field => field); end if; end function to_dstring; function to_dstring ( value : sfixed; justified : in SIDE := right; field : in width := 0 ) return STRING is variable value_real : REAL; begin if value'length < 1 then return NUS; else value_real := to_real (value); return justify (value => REAL'image(value_real), justified => justified, field => field); end if; end function to_dstring; procedure SREAD (L : inout LINE; VALUE : out STRING) is variable ok : BOOLEAN; variable c : CHARACTER; -- Result is padded with space characters variable result : STRING (1 to VALUE'length) := (others => ' '); begin 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 assert false report "TEXTIO.SREAD Error: Failed skipping white space"; return; end if; result (1) := c; for i in 2 to VALUE'length loop read(l, c, ok); if (ok = false) or ((c = ' ') or (c = NBSP) or (c = HT)) then exit; else result (i) := c; end if; end loop; VALUE := result; end SREAD; procedure read (L : inout LINE; VALUE : out integer_vector; GOOD : out BOOLEAN) is variable dummy : CHARACTER; variable igood : BOOLEAN := true; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), GOOD => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then good := false; return; end if; end loop; good := true; end procedure read; procedure read (L : inout LINE; VALUE : out integer_vector) is variable dummy : CHARACTER; variable igood : BOOLEAN; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), good => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then report "STANDARD.STD_TEXTIO(INTEGER_VECTOR) " & "Read error ecounted during vector read" severity error; return; end if; end loop; end procedure read; procedure write (L : inout LINE; VALUE : in integer_vector; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0) is begin for i in VALUE'range loop write (L => L, VALUE => VALUE(i), JUSTIFIED => JUSTIFIED, FIELD => FIELD); if (i /= value'right) then swrite (L, ", "); end if; end loop; end procedure write; procedure read (L : inout LINE; VALUE : out real_vector; GOOD : out BOOLEAN) is variable dummy : CHARACTER; variable igood : BOOLEAN := true; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), GOOD => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then good := false; return; end if; end loop; good := true; end procedure read; procedure read (L : inout LINE; VALUE : out real_vector) is variable dummy : CHARACTER; variable igood : BOOLEAN; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), good => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then report "STANDARD.STD_TEXTIO(REAL_VECTOR) " & "Read error ecounted during vector read" severity error; return; end if; end loop; end procedure read; procedure write (L : inout LINE; VALUE : in real_vector; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0; DIGITS : in NATURAL := 0) is begin for i in VALUE'range loop write (L => L, VALUE => VALUE(i), JUSTIFIED => JUSTIFIED, FIELD => FIELD, DIGITS => DIGITS); if (i /= value'right) then swrite (L, ", "); end if; end loop; end procedure write; procedure read (L : inout LINE; VALUE : out time_vector; GOOD : out BOOLEAN) is variable dummy : CHARACTER; variable igood : BOOLEAN := true; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), GOOD => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then good := false; return; end if; end loop; good := true; end procedure read; procedure read (L : inout LINE; VALUE : out time_vector) is variable dummy : CHARACTER; variable igood : BOOLEAN; begin for i in VALUE'range loop read (L => L, VALUE => VALUE(i), good => igood); if (igood) and (i /= value'right) then read (L => L, VALUE => dummy, -- Toss the comma or seperator good => igood); end if; if (not igood) then report "STANDARD.STD_TEXTIO(TIME_VECTOR) " & "Read error ecounted during vector read" severity error; return; end if; end loop; end procedure read; procedure write (L : inout LINE; VALUE : in time_vector; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0; UNIT : in TIME := ns) is begin for i in VALUE'range loop write (L => L, VALUE => VALUE(i), JUSTIFIED => JUSTIFIED, FIELD => FIELD, UNIT => UNIT); if (i /= value'right) then swrite (L, ", "); end if; end loop; end procedure write; function to_string ( VALUE : in INTEGER_VECTOR; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0 ) return STRING is variable L : LINE; begin deallocate (L); write (L => L, VALUE => VALUE, JUSTIFIED => JUSTIFIED, FIELD => FIELD); return L.all; end function to_string; function to_string ( VALUE : in REAL_VECTOR; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0; DIGITS : in NATURAL := 0 ) return STRING is variable L : LINE; begin deallocate (L); write (L => L, VALUE => VALUE, JUSTIFIED => JUSTIFIED, FIELD => FIELD, DIGITS => DIGITS); return L.all; end function to_string; function to_string ( VALUE : in REAL_VECTOR; format : in STRING ) return STRING is variable L : LINE; begin deallocate (L); for i in VALUE'range loop write (L => L, VALUE => to_string (VALUE => VALUE(i), format => format)); if (i /= VALUE'right) then SWRITE (L => L, VALUE => ", "); end if; end loop; return L.all; end function to_string; function to_string ( VALUE : in TIME_VECTOR; JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0; UNIT : in TIME := ns ) return STRING is variable L : LINE; begin deallocate (L); write (L => L, VALUE => VALUE, JUSTIFIED => JUSTIFIED, FIELD => FIELD, UNIT => UNIT); return L.all; end function to_string; --rtl_synthesis on end package boneyard;