Import vests testsuite

1 files changed, 647 insertions, 0 deletions

diff --git a/testsuite/vests/vhdl-93/ashenden/compliant/bv_arithmetic_body.vhd b/testsuite/vests/vhdl-93/ashenden/compliant/bv_arithmetic_body.vhd
new file mode 100644
index 000000000..41267bdc6
--- /dev/null
+++ b/testsuite/vests/vhdl-93/ashenden/compliant/bv_arithmetic_body.vhd
@@ -0,0 +1,647 @@
+
+-- Copyright (C) 1996 Morgan Kaufmann Publishers, Inc
+
+-- This file is part of VESTs (Vhdl tESTs).
+
+-- VESTs is free software; you can redistribute it and/or modify it
+-- under the terms of the GNU General Public License as published by the
+-- Free Software Foundation; either version 2 of the License, or (at
+-- your option) any later version. 
+
+-- VESTs is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+-- for more details. 
+
+-- You should have received a copy of the GNU General Public License
+-- along with VESTs; if not, write to the Free Software Foundation,
+-- Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 
+
+-- ---------------------------------------------------------------------
+--
+-- $Id: bv_arithmetic_body.vhd,v 1.3 2001-10-26 16:29:33 paw Exp $
+-- $Revision: 1.3 $
+--
+-- ---------------------------------------------------------------------
+
+package body bv_arithmetic is
+
+  ----------------------------------------------------------------
+  --  Type conversions
+  ----------------------------------------------------------------
+
+  function bv_to_natural ( bv : in bit_vector ) return natural is
+
+    variable result : natural := 0;
+
+  begin
+    for index in bv'range loop
+      result := result * 2 + bit'pos( bv(index) );
+    end loop;
+    return result;
+  end function bv_to_natural;
+
+  function natural_to_bv ( nat : in natural;
+      	      	      	   length : in natural ) return bit_vector is
+
+    variable temp : natural := nat;
+    variable result : bit_vector(length - 1 downto 0) := (others => '0');
+
+  begin
+    for index in result'reverse_range loop
+      result(index) := bit'val( temp rem 2 );
+      temp := temp / 2;
+      exit when temp = 0;
+    end loop;
+    return result;
+  end function natural_to_bv;
+
+  function bv_to_integer ( bv : in bit_vector ) return integer is
+
+    variable temp : bit_vector(bv'range);
+    variable result : integer := 0;
+
+  begin
+    if bv(bv'left) = '1' then	  -- negative number
+      temp := not bv;
+    else
+      temp := bv;
+    end if;
+    for index in bv'range loop	  -- sign bit of temp = '0'
+      result := result * 2 + bit'pos( temp(index) );
+    end loop;
+    if bv(bv'left) = '1' then
+      result := (-result) - 1;
+    end if;
+    return result;
+  end function bv_to_integer;
+
+  function integer_to_bv ( int : in integer;
+      	      	      	   length : in natural ) return bit_vector is
+
+    variable temp : integer;
+    variable result : bit_vector(length - 1 downto 0) := (others => '0');
+
+  begin
+    if int < 0 then
+      temp := - (int + 1);
+    else
+      temp := int;
+    end if;
+    for index in result'reverse_range loop
+      result(index) := bit'val( temp rem 2 );
+      temp := temp / 2;
+      exit when temp = 0;
+    end loop;
+    if int < 0 then
+      result := not result;
+      result(result'left) := '1';
+    end if;
+    return result;
+  end function integer_to_bv;
+
+  ----------------------------------------------------------------
+  --  Arithmetic operations
+  ----------------------------------------------------------------
+
+  procedure bv_add ( bv1, bv2 : in bit_vector;
+      	       	     bv_result : out bit_vector;
+		     overflow : out boolean ) is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv_result'length - 1 downto 0);
+    variable carry_in : bit;
+    variable carry_out : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_add: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        carry_in := carry_out;  -- of previous bit
+        result(index) := op1(index) xor op2(index) xor carry_in;
+        carry_out := (op1(index) and op2(index))
+                     or (carry_in and (op1(index) xor op2(index)));
+      end loop;
+      bv_result := result;
+      overflow := carry_out /= carry_in;
+    end if;
+  end procedure bv_add;
+
+  function "+" ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv1'length - 1 downto 0);
+    variable carry_in : bit;
+    variable carry_out : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length then
+      report """+"": operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        carry_in := carry_out;  -- of previous bit
+        result(index) := op1(index) xor op2(index) xor carry_in;
+        carry_out := (op1(index) and op2(index))
+                     or (carry_in and (op1(index) xor op2(index)));
+      end loop;
+    end if;
+    return result;
+  end function "+";
+
+  procedure bv_sub ( bv1, bv2 : in bit_vector;
+      	       	     bv_result : out bit_vector;
+		     overflow : out boolean ) is
+
+    -- subtraction implemented by adding ((not bv2) + 1), ie -bv2
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv_result'length - 1 downto 0);
+    variable carry_in : bit;
+    variable carry_out : bit := '1';
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_sub: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        carry_in := carry_out;  -- of previous bit
+        result(index) := op1(index) xor (not op2(index)) xor carry_in;
+        carry_out := (op1(index) and (not op2(index)))
+                     or (carry_in and (op1(index) xor (not op2(index))));
+      end loop;
+      bv_result := result;
+      overflow := carry_out /= carry_in;
+    end if;
+  end procedure bv_sub;
+
+  function "-" ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    -- subtraction implemented by adding ((not bv2) + 1), ie -bv2
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv1'length - 1 downto 0);
+    variable carry_in : bit;
+    variable carry_out : bit := '1';
+
+  begin
+    if bv1'length /= bv2'length then
+      report """-"": operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        carry_in := carry_out;  -- of previous bit
+        result(index) := op1(index) xor (not op2(index)) xor carry_in;
+        carry_out := (op1(index) and (not op2(index)))
+                     or (carry_in and (op1(index) xor (not op2(index))));
+      end loop;
+    end if;
+    return result;
+  end function "-";
+
+  procedure bv_addu ( bv1, bv2 : in bit_vector;
+      	       	      bv_result : out bit_vector;
+		      overflow : out boolean ) is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv_result'length - 1 downto 0);
+    variable carry : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_addu: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        result(index) := op1(index) xor op2(index) xor carry;
+        carry := (op1(index) and op2(index))
+                 or (carry and (op1(index) xor op2(index)));
+      end loop;
+      bv_result := result;
+      overflow := carry = '1';
+    end if;
+  end procedure bv_addu;
+
+  function bv_addu ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv1'length - 1 downto 0);
+    variable carry : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length then
+      report "bv_addu: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        result(index) := op1(index) xor op2(index) xor carry;
+        carry := (op1(index) and op2(index))
+                 or (carry and (op1(index) xor op2(index)));
+      end loop;
+    end if;
+    return result;
+  end function bv_addu;
+
+  procedure bv_subu ( bv1, bv2 : in bit_vector;
+      	       	      bv_result : out bit_vector;
+		      overflow : out boolean ) is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv_result'length - 1 downto 0);
+    variable borrow : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_subu: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        result(index) := op1(index) xor op2(index) xor borrow;
+        borrow := (not op1(index) and op2(index))
+                  or (borrow and not (op1(index) xor op2(index)));
+      end loop;
+      bv_result := result;
+      overflow := borrow = '1';
+    end if;
+  end procedure bv_subu;
+
+  function bv_subu ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    variable result : bit_vector(bv1'length - 1 downto 0);
+    variable borrow : bit := '0';
+
+  begin
+    if bv1'length /= bv2'length then
+      report "bv_subu: operands of different lengths"
+        severity failure;
+    else
+      for index in result'reverse_range loop
+        result(index) := op1(index) xor op2(index) xor borrow;
+        borrow := (not op1(index) and op2(index))
+                  or (borrow and not (op1(index) xor op2(index)));
+      end loop;
+    end if;
+    return result;
+  end function bv_subu;
+
+  procedure bv_neg ( bv : in bit_vector;
+                     bv_result : out bit_vector;
+                     overflow : out boolean ) is
+
+    constant zero : bit_vector(bv'range) := (others => '0');
+
+  begin
+    bv_sub( zero, bv, bv_result, overflow );
+  end procedure bv_neg;
+
+
+  function "-" ( bv : in bit_vector ) return bit_vector is
+
+    constant zero : bit_vector(bv'range) := (others => '0');
+
+  begin
+    return zero - bv;
+  end function "-";
+
+  procedure bv_mult ( bv1, bv2 : in bit_vector;
+      	       	      bv_result : out bit_vector;
+		      overflow : out boolean ) is
+
+    variable negative_result : boolean;
+    variable op1 : bit_vector(bv1'range) := bv1;
+    variable op2 : bit_vector(bv2'range) := bv2;
+    variable multu_result : bit_vector(bv1'range);
+    variable multu_overflow : boolean;
+    variable abs_min_int : bit_vector(bv1'range) := (others => '0');
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_mult: operands of different lengths"
+        severity failure;
+    else
+      abs_min_int(bv1'left) := '1';
+      negative_result := (op1(op1'left) = '1') xor (op2(op2'left) = '1');
+      if op1(op1'left) = '1' then
+        op1 := - bv1;
+      end if;
+      if op2(op2'left) = '1' then
+        op2 := - bv2;
+      end if;
+      bv_multu(op1, op2, multu_result, multu_overflow);
+      if negative_result then
+        overflow := multu_overflow or (multu_result > abs_min_int);
+        bv_result := - multu_result;
+      else
+        overflow := multu_overflow or (multu_result(multu_result'left) = '1');
+        bv_result := multu_result;
+      end if;
+    end if;
+  end procedure bv_mult;
+
+  function "*" ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    variable negative_result : boolean;
+    variable op1 : bit_vector(bv1'range) := bv1;
+    variable op2 : bit_vector(bv2'range) := bv2;
+    variable result : bit_vector(bv1'range);
+
+  begin
+    if bv1'length /= bv2'length then
+      report """*"": operands of different lengths"
+        severity failure;
+    else
+      negative_result := (op1(op1'left) = '1') xor (op2(op2'left) = '1');
+      if op1(op1'left) = '1' then
+        op1 := - bv1;
+      end if;
+      if op2(op2'left) = '1' then
+        op2 := - bv2;
+      end if;
+      result := bv_multu(op1, op2);
+      if negative_result then
+        result := - result;
+      end if;
+    end if;
+    return result;
+  end function "*";
+
+  procedure bv_multu ( bv1, bv2 : in bit_vector;
+      	       	       bv_result : out bit_vector;
+		       overflow : out boolean ) is
+
+    alias op1 : bit_vector(bv1'length - 1 downto 0) is bv1;
+    alias op2 : bit_vector(bv2'length - 1 downto 0) is bv2;  
+    constant len : natural := bv1'length;
+    constant accum_len : natural := len * 2;
+    variable accum : bit_vector(accum_len - 1 downto 0) := (others => '0');
+    constant zero : bit_vector(accum_len - 1 downto len):= (others => '0');
+    variable addu_overflow : boolean;
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_multu: operands of different lengths"
+        severity failure;
+    else
+      for count in 0 to len - 1 loop
+        if op2(count) = '1' then
+          bv_addu( accum(count + len - 1 downto count), op1,
+                   accum(count + len - 1 downto count), addu_overflow);
+          accum(count + len) := bit'val(boolean'pos(addu_overflow));
+        end if;
+      end loop;
+      bv_result := accum(len - 1 downto 0);
+      overflow := accum(accum_len-1 downto len) /= zero;
+    end if;
+  end procedure bv_multu;
+
+  function bv_multu ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    -- Use bv_multu with overflow detection, but ignore overflow flag
+
+    variable result : bit_vector(bv1'range);
+    variable tmp_overflow : boolean;
+
+  begin
+    bv_multu(bv1, bv2, result, tmp_overflow);
+    return result;
+  end function bv_multu;
+
+  procedure bv_div ( bv1, bv2 : in bit_vector;
+      	       	     bv_result : out bit_vector;
+		     div_by_zero : out boolean;
+                     overflow : out boolean ) is
+
+    --  Need overflow, in case divide b"10...0" (min_int) by -1
+    --  Don't use bv_to_int, in case size bigger than host machine!
+
+    variable negative_result : boolean;
+    variable op1 : bit_vector(bv1'range) := bv1;
+    variable op2 : bit_vector(bv2'range) := bv2;
+    variable divu_result : bit_vector(bv1'range);
+
+  begin
+    if bv1'length /= bv2'length or bv1'length /= bv_result'length then
+      report "bv_div: operands of different lengths"
+        severity failure;
+    else
+      negative_result := (op1(op1'left) = '1') xor (op2(op2'left) = '1');
+      if op1(op1'left) = '1' then
+        op1 := - bv1;
+      end if;
+      if op2(op2'left) = '1' then
+        op2 := - bv2;
+      end if;
+      bv_divu(op1, op2, divu_result, div_by_zero);
+      if negative_result then
+        overflow := false;
+        bv_result := - divu_result;
+      else
+        overflow := divu_result(divu_result'left) = '1';
+        bv_result := divu_result;
+      end if;
+    end if;
+  end procedure bv_div;
+
+  function "/" ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    variable negative_result : boolean;
+    variable op1 : bit_vector(bv1'range) := bv1;
+    variable op2 : bit_vector(bv2'range) := bv2;
+    variable result : bit_vector(bv1'range);
+
+  begin
+    if bv1'length /= bv2'length then
+      report """/"": operands of different lengths"
+        severity failure;
+    else
+      negative_result := (op1(op1'left) = '1') xor (op2(op2'left) = '1');
+      if op1(op1'left) = '1' then
+        op1 := - bv1;
+      end if;
+      if op2(op2'left) = '1' then
+        op2 := - bv2;
+      end if;
+      result := bv_divu(op1, op2);
+      if negative_result then
+        result := - result;
+      end if;
+    end if;
+    return result;
+  end function "/";
+
+  procedure bv_divu ( bv1, bv2 : in bit_vector;
+      	       	      bv_quotient : out bit_vector;
+		      bv_remainder : out bit_vector;
+		      div_by_zero : out boolean ) is
+
+    constant len : natural := bv1'length;
+    constant zero_divisor : bit_vector(len-1 downto 0) := (others => '0');
+    alias dividend : bit_vector(bv1'length-1 downto 0) is bv1;
+    variable divisor : bit_vector(bv2'length downto 0) := '0' & bv2;
+    variable quotient : bit_vector(len-1 downto 0);
+    variable remainder : bit_vector(len downto 0) := (others => '0');
+    variable ignore_overflow  : boolean;
+
+  begin
+    if bv1'length /= bv2'length
+      or bv1'length /= bv_quotient'length or bv1'length /= bv_remainder'length then
+      report "bv_divu: operands of different lengths"
+        severity failure;
+    else
+      --  check for zero divisor
+      if bv2 = zero_divisor then
+        div_by_zero := true;
+        return;
+      end if;
+      --  perform division
+      for iter in len-1 downto 0 loop
+        if remainder(len) = '0' then
+          remainder := remainder sll 1;
+          remainder(0) := dividend(iter);
+          bv_sub(remainder, divisor, remainder, ignore_overflow);
+        else
+          remainder := remainder sll 1;
+          remainder(0) := dividend(iter);
+          bv_add(remainder, divisor, remainder, ignore_overflow);
+        end if;
+        quotient(iter) := not remainder(len);
+      end loop;
+      if remainder(len) = '1' then
+        bv_add(remainder, divisor, remainder, ignore_overflow);
+      end if;
+      bv_quotient := quotient;
+      bv_remainder := remainder(len - 1 downto 0);
+      div_by_zero := false;
+    end if;
+  end procedure bv_divu;
+
+  procedure bv_divu ( bv1, bv2 : in bit_vector;
+      	       	      bv_quotient : out bit_vector;
+		      div_by_zero : out boolean ) is
+
+    variable ignore_remainder : bit_vector(bv_quotient'range);
+
+  begin
+    bv_divu(bv1, bv2, bv_quotient, ignore_remainder, div_by_zero);
+  end procedure bv_divu;
+
+  function bv_divu ( bv1, bv2 : in bit_vector ) return bit_vector is
+
+    variable result : bit_vector(bv1'range);
+    variable tmp_div_by_zero : boolean;
+
+  begin
+    bv_divu(bv1, bv2, result, tmp_div_by_zero);
+    return result;
+  end function bv_divu;
+
+  ----------------------------------------------------------------
+  --  Arithmetic comparison operators.
+  --  Perform comparisons on bit vector encoded signed integers.
+  --  (For unsigned integers, built in lexical comparison does
+  --  the required operation.)
+  ----------------------------------------------------------------
+
+  function bv_lt ( bv1, bv2 : in bit_vector ) return boolean is
+
+    variable tmp1 : bit_vector(bv1'range) := bv1;
+    variable tmp2 : bit_vector(bv2'range) := bv2;
+
+  begin
+    assert bv1'length = bv2'length
+      report "bv_lt: operands of different lengths"
+      severity failure;
+    tmp1(tmp1'left) := not tmp1(tmp1'left);
+    tmp2(tmp2'left) := not tmp2(tmp2'left);
+    return tmp1 < tmp2;
+  end function bv_lt;
+
+  function bv_le ( bv1, bv2 : in bit_vector ) return boolean is
+
+    variable tmp1 : bit_vector(bv1'range) := bv1;
+    variable tmp2 : bit_vector(bv2'range) := bv2;
+
+  begin
+    assert bv1'length = bv2'length
+      report "bv_le: operands of different lengths"
+      severity failure;
+    tmp1(tmp1'left) := not tmp1(tmp1'left);
+    tmp2(tmp2'left) := not tmp2(tmp2'left);
+    return tmp1 <= tmp2;
+  end function bv_le;
+
+  function bv_gt ( bv1, bv2 : in bit_vector ) return boolean is
+
+    variable tmp1 : bit_vector(bv1'range) := bv1;
+    variable tmp2 : bit_vector(bv2'range) := bv2;
+
+  begin
+    assert bv1'length = bv2'length
+      report "bv_gt: operands of different lengths"
+      severity failure;
+    tmp1(tmp1'left) := not tmp1(tmp1'left);
+    tmp2(tmp2'left) := not tmp2(tmp2'left);
+    return tmp1 > tmp2;
+  end function bv_gt;
+
+  function bv_ge ( bv1, bv2 : in bit_vector ) return boolean is
+
+    variable tmp1 : bit_vector(bv1'range) := bv1;
+    variable tmp2 : bit_vector(bv2'range) := bv2;
+
+  begin
+    assert bv1'length = bv2'length
+      report "bv_ged: operands of different lengths"
+      severity failure;
+    tmp1(tmp1'left) := not tmp1(tmp1'left);
+    tmp2(tmp2'left) := not tmp2(tmp2'left);
+    return tmp1 >= tmp2;
+  end function bv_ge;
+
+  ----------------------------------------------------------------
+  --  Extension operators - convert a bit vector to a longer one
+  ----------------------------------------------------------------
+
+  function bv_sext ( bv : in bit_vector;
+      	      	     length : in natural ) return bit_vector is
+
+    alias bv_norm : bit_vector(bv'length - 1 downto 0) is bv;
+    variable result : bit_vector(length - 1 downto 0) := (others => bv(bv'left));
+    variable src_length : natural := bv'length;
+
+  begin
+    if src_length > length then
+      src_length := length;
+    end if;
+    result(src_length - 1 downto 0) := bv_norm(src_length - 1 downto 0);
+    return result;
+  end function bv_sext;
+
+  function bv_zext ( bv : in bit_vector;
+      	      	     length : in natural ) return bit_vector is
+
+    alias bv_norm : bit_vector(bv'length - 1 downto 0) is bv;
+    variable result : bit_vector(length - 1 downto 0) := (others => '0');
+    variable src_length : natural := bv'length;
+
+  begin
+    if src_length > length then
+      src_length := length;
+    end if;
+    result(src_length - 1 downto 0) := bv_norm(src_length - 1 downto 0);
+    return result;
+  end function bv_zext;
+
+end package body bv_arithmetic;