--  This -*- vhdl -*- file was generated from numeric_std-body.proto
--  This -*- vhdl -*- file is part of GHDL.
--  IEEE 1076.3 compliant numeric std package body.
--  The implementation is based only on the specifications.
--  Copyright (C) 2015 Tristan Gingold
--
--  GHDL 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, or (at your option) any later
--  version.
--
--  GHDL 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 GCC; see the file COPYING2.  If not see
--  <http://www.gnu.org/licenses/>.

package body NUMERIC_STD is
  constant NO_WARNING : Boolean := False;

  constant null_unsigned : unsigned (0 downto 1) := (others => '0');
  constant null_signed   :   signed (0 downto 1) := (others => '0');

  subtype nat1 is natural range 0 to 1;

  type nat1_to_sl_type is array (nat1) of std_ulogic;
  constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1');

  subtype sl_01 is std_ulogic range '0' to '1';
  subtype sl_x01 is std_ulogic range 'X' to '1';

  type carry_array is array (sl_01, sl_01, sl_01) of sl_01;
  constant compute_carry : carry_array :=
    ('0' => ('0' => ('0' => '0', '1' => '0'),
             '1' => ('0' => '0', '1' => '1')),
     '1' => ('0' => ('0' => '0', '1' => '1'),
             '1' => ('0' => '1', '1' => '1')));
  constant compute_sum : carry_array :=
    ('0' => ('0' => ('0' => '0', '1' => '1'),
             '1' => ('0' => '1', '1' => '0')),
     '1' => ('0' => ('0' => '1', '1' => '0'),
             '1' => ('0' => '0', '1' => '1')));

  type sl_to_x01_array is array (std_ulogic) of sl_x01;
  constant sl_to_x01 : sl_to_x01_array :=
    ('0' | 'L' => '0', '1' | 'H' => '1', others => 'X');

  type compare_type is (compare_unknown,
                        compare_lt,
                        compare_eq,
                        compare_gt);

  --  Match.
  --  '-' matches with everything.
  --  '0'/'L' matches, '1'/'H' matches.
  type match_table_type is array (std_ulogic, std_ulogic) of boolean;
  constant match_table: match_table_type :=
    ('0' | 'L' => ('0' | 'L' | '-' => true, others => false),
     '1' | 'H' => ('1' | 'H' | '-' => true, others => false),
     '-' => (others => true),
     others => ('-' => true, others => false));

  function MAX (L, R : natural) return natural is
  begin
    if L > R then
      return L;
    else
      return R;
    end if;
  end MAX;

  function TO_INTEGER (ARG : UNSIGNED) return NATURAL
  is
    variable argn : UNSIGNED (ARG'Length -1 downto 0);
    variable res : natural := 0;
  begin
    if argn'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_INTEGER: null array detected, returning 0"
        severity warning;
      return 0;
    end if;
    argn := TO_01 (ARG, 'X');
    if argn (0) = 'X' then
      assert NO_WARNING
        report
          "NUMERIC_STD.TO_INTEGER: non logical value detected, returning 0"
        severity warning;
      return 0;
    end if;

    for i in argn'range loop
      res := res + res;
      if argn (i) = '1' then
        res := res + 1;
      end if;
    end loop;

    return res;
  end TO_INTEGER;

  function TO_INTEGER (ARG :   SIGNED) return INTEGER
  is
    variable argn : SIGNED (ARG'Length -1 downto 0);
    variable res : integer := 0;
    variable b : STD_ULOGIC;
  begin
    if argn'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_INTEGER: null array detected, returning 0"
        severity warning;
      return 0;
    end if;
    argn := TO_01 (ARG, 'X');
    if argn (0) = 'X' then
      assert NO_WARNING
        report
          "NUMERIC_STD.TO_INTEGER: non logical value detected, returning 0"
        severity warning;
      return 0;
    end if;
    if argn (argn'left) = '1' then
      --  Negative value
      b := '0';
    else
      b := '1';
    end if;

    for i in argn'range loop
      res := res + res;
      if argn (i) = b then
        res := res + 1;
      end if;
    end loop;

    if b = '0' then
      --  Avoid overflow.
      res := -res - 1;
    end if;

    return res;
  end TO_INTEGER;

  function TO_01 (S : SIGNED;   XMAP : STD_LOGIC := '0') return SIGNED
  is
    subtype res_type is SIGNED (S'Length - 1 downto 0);
    variable res : res_type;
    alias snorm: res_type is S;
  begin
    if S'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_01: null array detected"
        severity warning;
      return null_signed;
    else
      for i in res_type'range loop
        case snorm (i) is
          when '0' | 'L' => res (i) := '0';
          when '1' | 'H' => res (i) := '1';
          when others =>
            assert NO_WARNING
              report "NUMERIC_STD.TO_01: non logical value detected"
              severity warning;
            res := (others => XMAP);
            exit;
        end case;
      end loop;
    end if;
    return res;
  end TO_01;

  function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED
  is
    subtype res_type is UNSIGNED (S'Length - 1 downto 0);
    variable res : res_type;
    alias snorm: res_type is S;
  begin
    if S'length = 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_01: null array detected"
        severity warning;
      return null_unsigned;
    else
      for i in res_type'range loop
        case snorm (i) is
          when '0' | 'L' => res (i) := '0';
          when '1' | 'H' => res (i) := '1';
          when others =>
            assert NO_WARNING
              report "NUMERIC_STD.TO_01: non logical value detected"
              severity warning;
            res := (others => XMAP);
            exit;
        end case;
      end loop;
    end if;
    return res;
  end TO_01;

  function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED
  is
    variable res : UNSIGNED (SIZE - 1 downto 0);
    variable a : natural := arg;
    variable d : nat1;
  begin
    if size = 0 then
      return null_unsigned;
    end if;
    for i in res'reverse_range loop
      d := a rem 2;
      res (i) := nat1_to_01 (d);
      a := a / 2;
    end loop;
    if a /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_UNSIGNED: vector is truncated"
        severity warning;
    end if;
    return res;
  end TO_UNSIGNED;

  function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED
  is
    variable res : SIGNED (SIZE - 1 downto 0);
    variable v : integer := arg;
    variable b0, b1 : std_ulogic;
    variable d : nat1;
  begin
    if size = 0 then
      return null_signed;
    end if;
    if arg < 0 then
      --  Use one complement to avoid overflow:
      --   -v = (not v) + 1
      --   not v = -v - 1
      --   not v = -(v + 1)
      v := -(arg + 1);
      b0 := '1';
      b1 := '0';
    else
      v := arg;
      b0 := '0';
      b1 := '1';
    end if;

    for i in res'reverse_range loop
      d := v rem 2;
      v := v / 2;
      if d = 0 then
        res (i) := b0;
      else
        res (i) := b1;
      end if;
    end loop;
    if v /= 0 or res (res'left) /= b0 then
      assert NO_WARNING
        report "NUMERIC_STD.TO_SIGNED: vector is truncated"
        severity warning;
    end if;
    return res;
  end TO_SIGNED;

  function std_match (l, r : std_ulogic) return boolean is
  begin
    return match_table (l, r);
  end std_match;


  function std_match (l, r : std_ulogic_vector) return boolean
  is
     alias la : std_ulogic_vector (l'length downto 1) is l;
     alias ra : std_ulogic_vector (r'length downto 1) is r;
  begin
     if la'left = 0 or ra'left = 0 then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: null argument, returning false"
          severity warning;
        return false;
     elsif la'left /= ra'left then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: args length mismatch, returning false"
          severity warning;
        return false;
     else
        for i in la'range loop
           if not match_table (la (i), ra (i)) then
             return false;
           end if;
        end loop;
        return true;
     end if;
  end std_match;

  function std_match (l, r : std_logic_vector) return boolean
  is
     alias la : std_logic_vector (l'length downto 1) is l;
     alias ra : std_logic_vector (r'length downto 1) is r;
  begin
     if la'left = 0 or ra'left = 0 then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: null argument, returning false"
          severity warning;
        return false;
     elsif la'left /= ra'left then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: args length mismatch, returning false"
          severity warning;
        return false;
     else
        for i in la'range loop
           if not match_table (la (i), ra (i)) then
             return false;
           end if;
        end loop;
        return true;
     end if;
  end std_match;

  function std_match (l, r : UNSIGNED) return boolean
  is
     alias la : UNSIGNED (l'length downto 1) is l;
     alias ra : UNSIGNED (r'length downto 1) is r;
  begin
     if la'left = 0 or ra'left = 0 then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: null argument, returning false"
          severity warning;
        return false;
     elsif la'left /= ra'left then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: args length mismatch, returning false"
          severity warning;
        return false;
     else
        for i in la'range loop
           if not match_table (la (i), ra (i)) then
             return false;
           end if;
        end loop;
        return true;
     end if;
  end std_match;

  function std_match (l, r : SIGNED) return boolean
  is
     alias la : SIGNED (l'length downto 1) is l;
     alias ra : SIGNED (r'length downto 1) is r;
  begin
     if la'left = 0 or ra'left = 0 then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: null argument, returning false"
          severity warning;
        return false;
     elsif la'left /= ra'left then
        assert NO_WARNING
          report "NUMERIC_STD.STD_MATCH: args length mismatch, returning false"
          severity warning;
        return false;
     else
        for i in la'range loop
           if not match_table (la (i), ra (i)) then
             return false;
           end if;
        end loop;
        return true;
     end if;
  end std_match;


  function "+" (l : UNSIGNED; r : UNSIGNED) return UNSIGNED
  is
    constant lft : integer := MAX (l'length, r'length) - 1;
    subtype res_type is UNSIGNED (lft downto 0);
    alias la : UNSIGNED (l'length - 1 downto 0) is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if la'left < 0 or ra'left < 0 then
       return null_UNSIGNED;
    end if;
    carry := '0';
    for i in 0 to lft loop
       if i > la'left then
          lb := '0';
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := '0';
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
          res := (others => 'X');
          exit;
        end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    return res;
  end "+";

  function "+" (l : SIGNED; r : SIGNED) return SIGNED
  is
    constant lft : integer := MAX (l'length, r'length) - 1;
    subtype res_type is SIGNED (lft downto 0);
    alias la : SIGNED (l'length - 1 downto 0) is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if la'left < 0 or ra'left < 0 then
       return null_SIGNED;
    end if;
    carry := '0';
    for i in 0 to lft loop
       if i > la'left then
          lb := l (l'left);
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := r (r'left);
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
          res := (others => 'X');
          exit;
        end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    return res;
  end "+";

  function "+" (l : UNSIGNED; r : NATURAL) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_UNSIGNED;
    end if;
    carry := '0';
    r1 := r;
    for i in res'reverse_range loop
       lb := sl_to_x01 (la (i));

       r2 := r1 / 2;
       rd := r1 - 2 * r2;
       r1 := r2;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
        res := (others => 'X');
        r1 := 0;
        exit;
      end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if r1 /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.""+"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "+";

  function "+" (l : NATURAL; r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (r'length - 1 downto 0);
    alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_UNSIGNED;
    end if;
    carry := '0';
    l1 := l;
    for i in res'reverse_range loop
       rb := sl_to_x01 (ra (i));

       l2 := l1 / 2;
       ld := l1 - 2 * l2;
       l1 := l2;
       lb := nat1_to_01 (ld);
       if rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
        res := (others => 'X');
        l1 := 0;
        exit;
      end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if l1 /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.""+"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "+";

  function "+" (l : SIGNED; r : INTEGER) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_SIGNED;
    end if;
    carry := '0';
    r1 := r;
    for i in res'reverse_range loop
       lb := sl_to_x01 (la (i));

       r2 := r1 / 2;
       if r1 < 0 then
          rd := 2 * r2 - r1;
          r1 := r2 - rd;
        else
          rd := r1 - 2 * r2;
          r1 := r2;
        end if;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
        res := (others => 'X');
        r1 := 0;
        exit;
      end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if r1 /= -rmsb then
      assert NO_WARNING
        report "NUMERIC_STD.""+"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "+";

  function "+" (l : INTEGER; r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (r'length - 1 downto 0);
    alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_SIGNED;
    end if;
    carry := '0';
    l1 := l;
    for i in res'reverse_range loop
       rb := sl_to_x01 (ra (i));

       l2 := l1 / 2;
       if l1 < 0 then
          ld := 2 * l2 - l1;
          l1 := l2 - ld;
        else
          ld := l1 - 2 * l2;
          l1 := l2;
        end if;
       lb := nat1_to_01 (ld);
       if rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""+"": non logical value detected"
          severity warning;
        res := (others => 'X');
        l1 := 0;
        exit;
      end if;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if l1 /= -lmsb then
      assert NO_WARNING
        report "NUMERIC_STD.""+"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "+";

  function "-" (l : UNSIGNED; r : UNSIGNED) return UNSIGNED
  is
    constant lft : integer := MAX (l'length, r'length) - 1;
    subtype res_type is UNSIGNED (lft downto 0);
    alias la : UNSIGNED (l'length - 1 downto 0) is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if la'left < 0 or ra'left < 0 then
       return null_UNSIGNED;
    end if;
    carry := '1';
    for i in 0 to lft loop
       if i > la'left then
          lb := '0';
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := '0';
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
          res := (others => 'X');
          exit;
        end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    return res;
  end "-";

  function "-" (l : SIGNED; r : SIGNED) return SIGNED
  is
    constant lft : integer := MAX (l'length, r'length) - 1;
    subtype res_type is SIGNED (lft downto 0);
    alias la : SIGNED (l'length - 1 downto 0) is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if la'left < 0 or ra'left < 0 then
       return null_SIGNED;
    end if;
    carry := '1';
    for i in 0 to lft loop
       if i > la'left then
          lb := l (l'left);
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := r (r'left);
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
          res := (others => 'X');
          exit;
        end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    return res;
  end "-";

  function "-" (l : UNSIGNED; r : NATURAL) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_UNSIGNED;
    end if;
    carry := '1';
    r1 := r;
    for i in res'reverse_range loop
       lb := sl_to_x01 (la (i));

       r2 := r1 / 2;
       rd := r1 - 2 * r2;
       r1 := r2;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
        res := (others => 'X');
        r1 := 0;
        exit;
      end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if r1 /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.""-"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "-";

  function "-" (l : NATURAL; r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (r'length - 1 downto 0);
    alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_UNSIGNED;
    end if;
    carry := '1';
    l1 := l;
    for i in res'reverse_range loop
       rb := sl_to_x01 (ra (i));

       l2 := l1 / 2;
       ld := l1 - 2 * l2;
       l1 := l2;
       lb := nat1_to_01 (ld);
       if rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
        res := (others => 'X');
        l1 := 0;
        exit;
      end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if l1 /= 0 then
      assert NO_WARNING
        report "NUMERIC_STD.""-"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "-";

  function "-" (l : SIGNED; r : INTEGER) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_SIGNED;
    end if;
    carry := '1';
    r1 := r;
    for i in res'reverse_range loop
       lb := sl_to_x01 (la (i));

       r2 := r1 / 2;
       if r1 < 0 then
          rd := 2 * r2 - r1;
          r1 := r2 - rd;
        else
          rd := r1 - 2 * r2;
          r1 := r2;
        end if;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
        res := (others => 'X');
        r1 := 0;
        exit;
      end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if r1 /= -rmsb then
      assert NO_WARNING
        report "NUMERIC_STD.""-"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "-";

  function "-" (l : INTEGER; r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (r'length - 1 downto 0);
    alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
    variable res : res_type;
    variable lb, rb, carry : sl_x01;
  begin
    if res'length < 0 then
       return null_SIGNED;
    end if;
    carry := '1';
    l1 := l;
    for i in res'reverse_range loop
       rb := sl_to_x01 (ra (i));

       l2 := l1 / 2;
       if l1 < 0 then
          ld := 2 * l2 - l1;
          l1 := l2 - ld;
        else
          ld := l1 - 2 * l2;
          l1 := l2;
        end if;
       lb := nat1_to_01 (ld);
       if rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
        res := (others => 'X');
        l1 := 0;
        exit;
      end if;
      rb := not rb;
      res (i) := compute_sum (carry, rb, lb);
      carry := compute_carry (carry, rb, lb);
    end loop;
    if l1 /= -lmsb then
      assert NO_WARNING
        report "NUMERIC_STD.""-"": vector is truncated"
        severity warning;
    end if;
    return res;
  end "-";

  function "*" (L : UNSIGNED; R : UNSIGNED) return UNSIGNED
  is
     alias la : UNSIGNED (L'Length - 1 downto 0) is l;
     alias ra : UNSIGNED (R'Length - 1 downto 0) is r;
     variable res : UNSIGNED (L'length + R'Length -1 downto 0) := (others => '0');
     variable rb, lb, vb, carry : sl_x01;
  begin
     if la'length = 0 or ra'length = 0 then
        return null_UNSIGNED;
     end if;
     --  Shift and add L.
     for i in natural range 0 to ra'left loop
       rb := sl_to_x01 (ra (i));
       if rb = '1' then
          --  Compute res := res + shift_left (l, i).
          carry := '0';
          for j in la'reverse_range loop
            lb := la (j);
            vb := res (i + j);
            res (i + j) := compute_sum (carry, vb, lb);
            carry := compute_carry (carry, vb, lb);
          end loop;
          --  Propagate carry.
          for j in i + la'length to res'left loop
             exit when carry = '0';
             vb := res (j);
             res (j) := carry xor vb;
             carry := carry and vb;
          end loop;
       elsif rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""*"": non logical value detected"
          severity warning;
       end if;
     end loop;
     return res;
  end "*";

  function "*" (L : SIGNED; R : SIGNED) return SIGNED
  is
     alias la : SIGNED (L'Length - 1 downto 0) is l;
     alias ra : SIGNED (R'Length - 1 downto 0) is r;
     variable res : SIGNED (L'length + R'Length -1 downto 0) := (others => '0');
     variable rb, lb, vb, carry : sl_x01;
  begin
     if la'length = 0 or ra'length = 0 then
        return null_SIGNED;
     end if;
     --  Shift and add L.
     for i in natural range 0 to ra'left - 1 loop
       rb := sl_to_x01 (ra (i));
       if rb = '1' then
          --  Compute res := res + shift_left (l, i).
          carry := '0';
          for j in la'reverse_range loop
            lb := la (j);
            vb := res (i + j);
            res (i + j) := compute_sum (carry, vb, lb);
            carry := compute_carry (carry, vb, lb);
          end loop;
          --  Sign extend and propagate carry.
          lb := la (la'left);
          for j in i + l'length to res'left loop
             vb := res (j);
             res (j) := compute_sum (carry, vb, lb);
             carry := compute_carry (carry, vb, lb);
          end loop;
       elsif rb = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""*"": non logical value detected"
          severity warning;
       end if;
     end loop;
     if ra (ra'left) = '1' then
        --  R is a negative number.  It is considered as:
        --   -2**n + (Rn-1 Rn-2 ... R0).
        --  Compute res := res - 2**n * l.
        carry := '1';
        for i in la'reverse_range loop
          vb := res (ra'length - 1 + i);
          lb := not la (i);
          res (ra'length - 1+ i) := compute_sum (carry, vb, lb);
          carry := compute_carry (carry, vb, lb);
        end loop;
        vb := res (res'left);
        lb := not la (la'left);
        res (res'left) := compute_sum (carry, vb, lb);
     end if;
     return res;
  end "*";

  function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED
  is
     constant size : natural := l'length;
  begin
     if size = 0 then
        return null_UNSIGNED;
     end if;
     return l * to_UNSIGNED (r, size);
  end "*";

  function "*" (L : SIGNED; R : INTEGER) return SIGNED
  is
     constant size : natural := l'length;
  begin
     if size = 0 then
        return null_SIGNED;
     end if;
     return l * to_SIGNED (r, size);
  end "*";

  function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED
  is
     constant size : natural := r'length;
  begin
     if size = 0 then
        return null_UNSIGNED;
     end if;
     return r * to_UNSIGNED (l, size);
  end "*";

  function "*" (L : INTEGER; R : SIGNED) return SIGNED
  is
     constant size : natural := r'length;
  begin
     if size = 0 then
        return null_SIGNED;
     end if;
     return r * to_SIGNED (l, size);
  end "*";

  function has_0x (a : UNSIGNED) return sl_x01
  is
     variable res : sl_x01 := '0';
  begin
     for i in a'range loop
      if a (i) = 'X' then
         return 'X';
      end if;
      res := res or a (i);
    end loop;
    return res;
  end has_0x;

    --  All index range are normalized (N downto 0).
    --  NUM and QUOT have the same range.
    --  DEM and REMAIN have the same range.
    --  No 'X'.
    procedure divmod (num, dem : UNSIGNED; quot, remain : out UNSIGNED)
    is
       variable reg : unsigned (dem'left + 1 downto 0) := (others => '0');
       variable sub : unsigned (dem'range) := (others => '0');
       variable carry, d : sl_x01;
    begin
       for i in num'range loop
          --  Shift
          reg (reg'left downto 1) := reg (reg'left - 1 downto 0);
          reg (0) := num (i);
          --  Substract
          carry := '1';
          for j in dem'reverse_range loop
             d := not dem (j);
             sub (j) := compute_sum (carry, reg (j), d);
             carry := compute_carry (carry, reg (j), d);
          end loop;
          carry := compute_carry (carry, reg (reg'left), '1');
          --  Test
          if carry = '0' then
             --  Greater than
             quot (i) := '0';
          else
             quot (i) := '1';
             reg (reg'left) := '0';
             reg (sub'range) := sub;
          end if;
        end loop;
        remain := reg (dem'range);
    end divmod;
    
  function size_unsigned (n : natural) return natural
  is
     --  At least one bit (even for 0).
     variable res : natural := 1;
     variable n1 : natural := n;
  begin
     while n1 > 1 loop
        res := res + 1;
        n1 := n1 / 2;
     end loop;
     return res;
  end size_unsigned;

  function size_signed (n : integer) return natural
  is
     variable res : natural := 1;
     variable n1 : natural;
  begin
     if n >= 0 then
        n1 := n;
     else
        -- Use /N = -X -1 = -(X + 1)  (No overflow).
        n1 := -(n + 1);
     end if;
     while n1 /= 0 loop
        res := res + 1;
        n1 := n1 / 2;
     end loop;
     return res;
  end size_signed;

  function "/" (L : UNSIGNED; R : UNSIGNED) return UNSIGNED
  is
     subtype l_type is UNSIGNED (L'length - 1 downto 0);
     subtype r_type is UNSIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     variable quot : l_type;
     variable rema : r_type;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_unsigned;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""/"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""/"": division by 0"
        severity error;
     divmod (la, ra, quot, rema);
     return quot;
  end "/";

  function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED
  is
     constant r_size : natural := size_unsigned (r);
  begin
     if l'length = 0 then
        return null_unsigned;
     end if;
     return l / to_unsigned (r, r_size);
  end "/";

  function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED
  is
     constant l_size : natural := size_unsigned (l);
  begin
     if r'length = 0 then
        return null_unsigned;
     end if;
     return resize (to_unsigned (l, l_size) / r, r'length);
  end "/";

  function "rem" (L : UNSIGNED; R : UNSIGNED) return UNSIGNED
  is
     subtype l_type is UNSIGNED (L'length - 1 downto 0);
     subtype r_type is UNSIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     variable quot : l_type;
     variable rema : r_type;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_unsigned;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""/"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""rem"": division by 0"
        severity error;
     divmod (la, ra, quot, rema);
     return rema;
  end "rem";

  function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED
  is
     constant r_size : natural := size_unsigned (r);
  begin
     if l'length = 0 then
        return null_unsigned;
     end if;
     return resize (l rem to_unsigned (r, r_size), l'length);
  end "rem";

  function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED
  is
     constant l_size : natural := size_unsigned (l);
  begin
     if r'length = 0 then
        return null_unsigned;
     end if;
     return to_unsigned (l, l_size) rem r;
  end "rem";

  function "mod" (L : UNSIGNED; R : UNSIGNED) return UNSIGNED
  is
     subtype l_type is UNSIGNED (L'length - 1 downto 0);
     subtype r_type is UNSIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     variable quot : l_type;
     variable rema : r_type;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_unsigned;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""/"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""mod"": division by 0"
        severity error;
     divmod (la, ra, quot, rema);
     return rema;
  end "mod";

  function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED
  is
     constant r_size : natural := size_unsigned (r);
  begin
     if l'length = 0 then
        return null_unsigned;
     end if;
     return resize (l mod to_unsigned (r, r_size), l'length);
  end "mod";

  function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED
  is
     constant l_size : natural := size_unsigned (l);
  begin
     if r'length = 0 then
        return null_unsigned;
     end if;
     return to_unsigned (l, l_size) mod r;
  end "mod";

  function has_0x (a : SIGNED) return sl_x01
  is
     variable res : sl_x01 := '0';
  begin
     for i in a'range loop
      if a (i) = 'X' then
         return 'X';
      end if;
      res := res or a (i);
    end loop;
    return res;
  end has_0x;

  function "-" (ARG : SIGNED) return SIGNED
  is
     subtype arg_type is SIGNED (ARG'length - 1 downto 0);
     alias arga : arg_type is arg;
     variable res : arg_type;
     variable carry, a : sl_x01;
  begin
     if arga'length = 0 then
        return null_signed;
     end if;
     if has_0x (arga) = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
       return arg_type'(others => 'X');
     end if;
     carry := '1';
     for i in arga'reverse_range loop
       a := not arga (i);
       res (i) := carry xor a;
       carry := carry and a;
     end loop;
     return res;
  end "-";

  function "abs" (ARG : SIGNED) return SIGNED
  is
     subtype arg_type is SIGNED (ARG'length - 1 downto 0);
     alias arga : arg_type is arg;
     variable res : arg_type;
     variable carry, a : sl_x01;
  begin
     if arga'length = 0 then
        return null_signed;
     end if;
     if has_0x (arga) = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""-"": non logical value detected"
          severity warning;
       return arg_type'(others => 'X');
     end if;
     if arga (arga'left) = '0' then
        return arga;
     end if;
     carry := '1';
     for i in arga'reverse_range loop
       a := not arga (i);
       res (i) := carry xor a;
       carry := carry and a;
     end loop;
     return res;
  end "abs";

  function "/" (L : SIGNED; R : SIGNED) return SIGNED
  is
     subtype l_type is SIGNED (L'length - 1 downto 0);
     subtype r_type is SIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     subtype l_utype is UNSIGNED (l_type'range);
     subtype r_utype is UNSIGNED (r_type'range);
     variable lu : l_utype;
     variable ru : r_utype;
     variable quot : l_utype;
     variable rema : r_utype;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_signed;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""/"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""/"": division by 0"
        severity error;
     if la (la'left) = '1' then
        lu := unsigned (-la);
     else
        lu := unsigned (la);
     end if;
     if ra (ra'left) = '1' then
        ru := unsigned (-ra);
     else
        ru := unsigned (ra);
     end if;
     divmod (lu, ru, quot, rema);
     if (ra (ra'left) xor la (la'left)) = '1' then
       return -signed (quot);
     else
       return signed (quot);
     end if;
  end "/";

  function "/" (L : SIGNED; R : INTEGER) return SIGNED
  is
     constant r_size : natural := size_signed (r);
  begin
     if l'length = 0 then
        return null_signed;
     end if;
     return l / to_signed (r, r_size);
  end "/";

  function "/" (L : INTEGER; R : SIGNED) return SIGNED
  is
     constant l_size : natural := size_signed (l);
  begin
     if r'length = 0 then
        return null_signed;
     end if;
     return resize (to_signed (l, max (l_size, r'length)) / r, r'length);
  end "/";

  function "rem" (L : SIGNED; R : SIGNED) return SIGNED
  is
     subtype l_type is SIGNED (L'length - 1 downto 0);
     subtype r_type is SIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     subtype l_utype is UNSIGNED (l_type'range);
     subtype r_utype is UNSIGNED (r_type'range);
     variable lu : l_utype;
     variable ru : r_utype;
     variable quot : l_utype;
     variable rema : r_utype;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_signed;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""rem"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""rem"": division by 0"
        severity error;
     if la (la'left) = '1' then
        lu := unsigned (-la);
     else
        lu := unsigned (la);
     end if;
     if ra (ra'left) = '1' then
        ru := unsigned (-ra);
     else
        ru := unsigned (ra);
     end if;
     divmod (lu, ru, quot, rema);
     --  Result of rem has the sign of the dividend.
     if la (la'left) = '1' then
       return -signed (rema);
     else
       return signed (rema);
     end if;
  end "rem";

  function "rem" (L : SIGNED; R : INTEGER) return SIGNED
  is
     constant r_size : natural := size_signed (r);
  begin
     if l'length = 0 then
        return null_signed;
     end if;
     return resize (l rem to_signed (r, r_size), l'length);
  end "rem";

  function "rem" (L : INTEGER; R : SIGNED) return SIGNED
  is
     constant l_size : natural := size_signed (l);
  begin
     if r'length = 0 then
        return null_signed;
     end if;
     return to_signed (l, l_size) rem r;
  end "rem";

  function "mod" (L : SIGNED; R : SIGNED) return SIGNED
  is
     subtype l_type is SIGNED (L'length - 1 downto 0);
     subtype r_type is SIGNED (R'length - 1 downto 0);
     alias la : l_type is l;
     alias ra : r_type is r;
     subtype l_utype is UNSIGNED (l_type'range);
     subtype r_utype is UNSIGNED (r_type'range);
     variable lu : l_utype;
     variable ru : r_utype;
     variable quot : l_utype;
     variable rema : r_utype;
     variable r0 : sl_x01 := has_0x (r);
  begin
     if la'length = 0 or ra'length = 0 then
        return null_signed;
     end if;
     if has_0x (l) = 'X' or r0 = 'X' then
        assert NO_WARNING
          report "NUMERIC_STD.""mod"": non logical value detected"
          severity warning;
        return l_type'(others => 'X');
     end if;
     assert r0 /= '0'
        report "NUMERIC_STD.""mod"": division by 0"
        severity error;
     if la (la'left) = '1' then
        lu := unsigned (-la);
     else
        lu := unsigned (la);
     end if;
     if ra (ra'left) = '1' then
        ru := unsigned (-ra);
     else
        ru := unsigned (ra);
     end if;
     divmod (lu, ru, quot, rema);
     --  Result of mod has the sign of the divisor.
     if rema = r_utype'(others => '0') then
        --  If the remainder is 0, then the modulus is 0.
        return signed (rema);
     else
        if ra (ra'left) = '1' then
           if la (la'left) = '1' then
              return -signed (rema);
           else
              return ra + signed (rema);
           end if;
        else
           if la (la'left) = '1' then
              return ra - signed (rema);
           else
              return signed (rema);
           end if;
        end if;
     end if;
  end "mod";

  function "mod" (L : SIGNED; R : INTEGER) return SIGNED
  is
     constant r_size : natural := size_signed (r);
  begin
     if l'length = 0 then
        return null_signed;
     end if;
     return resize (l mod to_signed (r, r_size), l'length);
  end "mod";

  function "mod" (L : INTEGER; R : SIGNED) return SIGNED
  is
     constant l_size : natural := size_signed (l);
  begin
     if r'length = 0 then
        return null_signed;
     end if;
     return to_signed (l, l_size) mod r;
  end "mod";


  function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED
  is
     alias arg1 : UNSIGNED (ARG'length - 1 downto 0) is arg;
     variable res : UNSIGNED (new_size - 1 downto 0) := (others => '0');
  begin
     if new_size = 0 then
        return null_UNSIGNED;
     end if;
     if arg1'length = 0 then
        return res;
     end if;
     if arg1'length > new_size then
        --  Reduction.
        res := arg1 (res'range);
     else
        --  Expansion
        res (arg1'range) := arg1;
    end if;
    return res;
  end resize;

  function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED
  is
     alias arg1 : SIGNED (ARG'length - 1 downto 0) is arg;
     variable res : SIGNED (new_size - 1 downto 0) := (others => '0');
  begin
     if new_size = 0 then
        return null_SIGNED;
     end if;
     if arg1'length = 0 then
        return res;
     end if;
     if arg1'length > new_size then
        --  Reduction.
        res (res'left) := arg1 (arg1'left);
        res (res'left - 1 downto 0) := arg1 (res'left - 1 downto 0);
     else
        --  Expansion
        res (arg1'range) := arg1;
        res (res'left downto arg1'length) := (others => arg1 (arg1'left));
    end if;
    return res;
  end resize;

  function "not" (l : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    variable res : res_type;
  begin
    for I in res_type'range loop
      res (I) := not la (I);
    end loop;
    return res;
  end "not";

  function "not" (l : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    variable res : res_type;
  begin
    for I in res_type'range loop
      res (I) := not la (I);
    end loop;
    return res;
  end "not";

  function "and" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""and"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) and ra (I);
      end loop;
    end if;
    return res;
  end "and";

  function "and" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""and"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) and ra (I);
      end loop;
    end if;
    return res;
  end "and";

  function "nand" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""nand"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) nand ra (I);
      end loop;
    end if;
    return res;
  end "nand";

  function "nand" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""nand"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) nand ra (I);
      end loop;
    end if;
    return res;
  end "nand";

  function "or" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""or"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) or ra (I);
      end loop;
    end if;
    return res;
  end "or";

  function "or" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""or"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) or ra (I);
      end loop;
    end if;
    return res;
  end "or";

  function "nor" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""nor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) nor ra (I);
      end loop;
    end if;
    return res;
  end "nor";

  function "nor" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""nor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) nor ra (I);
      end loop;
    end if;
    return res;
  end "nor";

  function "xor" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""xor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) xor ra (I);
      end loop;
    end if;
    return res;
  end "xor";

  function "xor" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""xor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) xor ra (I);
      end loop;
    end if;
    return res;
  end "xor";

  function "xnor" (l, r : UNSIGNED) return UNSIGNED
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : UNSIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""xnor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) xnor ra (I);
      end loop;
    end if;
    return res;
  end "xnor";

  function "xnor" (l, r : SIGNED) return SIGNED
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
    alias ra : SIGNED (r'length - 1 downto 0) is r;
    variable res : res_type;
  begin
    if la'left /= ra'left then
      assert false
        report "NUMERIC_STD.""xnor"": arguments are not of the same length"
        severity failure;
      res := (others => 'X');
    else
      for I in res_type'range loop
        res (I) := la (I) xnor ra (I);
      end loop;
    end if;
    return res;
  end "xnor";

  function ucompare (l : UNSIGNED; r : UNSIGNED) return compare_type
  is
     constant sz : integer := MAX (l'length, r'length) - 1;
     alias la : UNSIGNED (l'length - 1 downto 0) is l;
     alias ra : UNSIGNED (r'length - 1 downto 0) is r;
     variable lb, rb : sl_x01;
     variable res : compare_type;
  begin
     res := compare_eq;
    for i in 0 to sz loop
       if i > la'left then
          lb := '0';
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := '0';
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
         return compare_unknown;
       end if;
       if lb = '1' and rb = '0' then
         res := compare_gt;
       elsif lb = '0' and rb = '1' then
         res := compare_lt;
       end if;
     end loop;

     return res;
  end ucompare;

  function scompare (l : SIGNED; r : SIGNED) return compare_type
  is
     constant sz : integer := MAX (l'length, r'length) - 1;
     alias la : SIGNED (l'length - 1 downto 0) is l;
     alias ra : SIGNED (r'length - 1 downto 0) is r;
     variable lb, rb : sl_x01;
     variable res : compare_type;
  begin
     --  Consider sign bit as S * -(2**N).
     lb := sl_to_x01 (la (la'left));
     rb := sl_to_x01 (ra (ra'left));
     if lb = '1' and rb = '0' then
        return compare_lt;
     elsif lb = '0' and rb = '1' then
        return compare_gt;
     else
        res := compare_eq;
     end if;
     for i in 0 to sz - 1 loop
       if i > la'left then
          lb := l (l'left);
       else
          lb := sl_to_x01 (la (i));
       end if;
       if i > ra'left then
          rb := r (r'left);
       else
          rb := sl_to_x01 (ra (i));
       end if;
       if lb = 'X' or rb = 'X' then
         return compare_unknown;
       end if;
       if lb = '1' and rb = '0' then
         res := compare_gt;
       elsif lb = '0' and rb = '1' then
         res := compare_lt;
       end if;
     end loop;

     return res;
  end scompare;

  function ucompare (l : UNSIGNED; r : NATURAL) return compare_type
  is
    subtype res_type is UNSIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
    variable lb, rb : sl_x01;
    variable res : compare_type;
  begin
    res := compare_eq;
    r1 := r;
    for i in la'reverse_range loop
       lb := sl_to_x01 (la (i));
       r2 := r1 / 2;
       rd := r1 - 2 * r2;
       r1 := r2;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
         return compare_unknown;
       end if;
       if lb = '1' and rb = '0' then
         res := compare_gt;
       elsif lb = '0' and rb = '1' then
         res := compare_lt;
       end if;
    end loop;
    if r1 /= 0 then
       res := compare_lt;
    end if;
    return res;
  end ucompare;

  function scompare (l : SIGNED; r : INTEGER) return compare_type
  is
    subtype res_type is SIGNED (l'length - 1 downto 0);
    alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
    variable lb, rb : sl_x01;
    variable res : compare_type;
  begin
    res := compare_eq;
    r1 := r;
    for i in la'reverse_range loop
       lb := sl_to_x01 (la (i));
       r2 := r1 / 2;
       if r1 < 0 then
          rd := 2 * r2 - r1;
          r1 := r2 - rd;
        else
          rd := r1 - 2 * r2;
          r1 := r2;
        end if;
       rb := nat1_to_01 (rd);
       if lb = 'X' then
         return compare_unknown;
       end if;
       if lb = '1' and rb = '0' then
         res := compare_gt;
       elsif lb = '0' and rb = '1' then
         res := compare_lt;
       end if;
    end loop;
    if sl_to_x01 (l (l'left)) = '1' then
      if r >= 0 then
         res := compare_lt;
      end if;
    else
      if r < 0 then
         res := compare_gt;
      end if;
    end if;
    return res;
  end scompare;

  function "=" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res = compare_eq;
  end "=";

  function "=" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res = compare_eq;
  end "=";

  function "=" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res = compare_eq;
  end "=";

  function "=" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq = res;
  end "=";

  function "=" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res = compare_eq;
  end "=";

  function "=" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq = res;
  end "=";

  function "/=" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res /= compare_eq;
  end "/=";

  function "/=" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res /= compare_eq;
  end "/=";

  function "/=" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res /= compare_eq;
  end "/=";

  function "/=" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq /= res;
  end "/=";

  function "/=" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res /= compare_eq;
  end "/=";

  function "/=" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""/="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""/="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq /= res;
  end "/=";

  function ">" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
       return false;
     end if;
     return res > compare_eq;
  end ">";

  function ">" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
       return false;
     end if;
     return res > compare_eq;
  end ">";

  function ">" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
      return false;
     end if;
     return res > compare_eq;
  end ">";

  function ">" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq > res;
  end ">";

  function ">" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
      return false;
     end if;
     return res > compare_eq;
  end ">";

  function ">" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">"": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq > res;
  end ">";

  function ">=" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res >= compare_eq;
  end ">=";

  function ">=" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res >= compare_eq;
  end ">=";

  function ">=" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res >= compare_eq;
  end ">=";

  function ">=" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq >= res;
  end ">=";

  function ">=" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res >= compare_eq;
  end ">=";

  function ">=" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD."">="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD."">="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq >= res;
  end ">=";

  function "<" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
       return false;
     end if;
     return res < compare_eq;
  end "<";

  function "<" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
       return false;
     end if;
     return res < compare_eq;
  end "<";

  function "<" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
      return false;
     end if;
     return res < compare_eq;
  end "<";

  function "<" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq < res;
  end "<";

  function "<" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
      return false;
     end if;
     return res < compare_eq;
  end "<";

  function "<" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<"": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<"": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq < res;
  end "<";

  function "<=" (l : UNSIGNED; r : UNSIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res <= compare_eq;
  end "<=";

  function "<=" (l : SIGNED; r : SIGNED) return boolean
  is
     variable res : compare_type;
  begin
     if l'length = 0 or r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
       return false;
     end if;
     return res <= compare_eq;
  end "<=";

  function "<=" (l : UNSIGNED; r : NATURAL) return boolean
  is
     subtype res_type is UNSIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : NATURAL;
     variable rd : nat1;
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res <= compare_eq;
  end "<=";

  function "<=" (l : NATURAL; r : UNSIGNED) return boolean
  is
     subtype res_type is UNSIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : NATURAL;
     variable ld : nat1;
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := ucompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq <= res;
  end "<=";

  function "<=" (l : SIGNED; r : INTEGER) return boolean
  is
     subtype res_type is SIGNED (l'length - 1 downto 0);
     alias la : res_type is l;
     variable r1, r2 : INTEGER;
     variable rd : nat1;
     constant rmsb : nat1 := boolean'pos(r < 0);
     variable res : compare_type;
  begin
     if l'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (l, r);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
      return false;
     end if;
     return res <= compare_eq;
  end "<=";

  function "<=" (l : INTEGER; r : SIGNED) return boolean
  is
     subtype res_type is SIGNED (r'length - 1 downto 0);
     alias ra : res_type is r;
     variable l1, l2 : INTEGER;
     variable ld : nat1;
     constant lmsb : nat1 := boolean'pos(l < 0);
     variable res : compare_type;
  begin
     if r'length = 0 then
        assert NO_WARNING
           report "NUMERIC_STD.""<="": null argument, returning FALSE"
           severity warning;
        return false;
     end if;

     res := scompare (r, l);
     if res = compare_unknown then
        assert NO_WARNING
          report "NUMERIC_STD.""<="": non logical value detected"
          severity warning;
      return false;
     end if;
     return compare_eq <= res;
  end "<=";

  function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED
  is
     subtype res_type is UNSIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
  begin
     if res'length = 0 then
        return null_UNSIGNED;
     end if;
     if count <= arg1'left then
       res (res'left downto count) := arg1 (arg1'left - count downto 0);
     end if;
     return res;
  end shift_left;

  function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED
  is
     subtype res_type is UNSIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
  begin
     if res'length = 0 then
        return null_UNSIGNED;
     end if;
     if count <= arg1'left then
       res (res'left - count downto 0) := arg1 (arg1'left downto count);
     end if;
     return res;
  end shift_right;

  function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED
  is
     subtype res_type is UNSIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
     variable cnt : natural;
  begin
     if res'length = 0 then
        return null_UNSIGNED;
     end if;
     cnt := count rem res'length;
     res (res'left downto cnt) := arg1 (res'left - cnt downto 0);
     res (cnt - 1 downto 0) := arg1 (res'left downto res'left - cnt + 1);
     return res;
  end rotate_left;

  function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED
  is
     subtype res_type is UNSIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
     variable cnt : natural;
  begin
     if res'length = 0 then
        return null_UNSIGNED;
     end if;
     cnt := count rem res'length;
     res (res'left - cnt downto 0) := arg1 (res'left downto cnt);
     res (res'left downto res'left - cnt + 1) := arg1 (cnt - 1 downto 0);
     return res;
  end rotate_right;

  function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED
  is
     subtype res_type is SIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
  begin
     if res'length = 0 then
        return null_SIGNED;
     end if;
     if count <= arg1'left then
       res (res'left downto count) := arg1 (arg1'left - count downto 0);
     end if;
     return res;
  end shift_left;

  function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED
  is
     subtype res_type is SIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => arg1 (arg1'left));
  begin
     if res'length = 0 then
        return null_SIGNED;
     end if;
     if count <= arg1'left then
       res (res'left - count downto 0) := arg1 (arg1'left downto count);
     end if;
     return res;
  end shift_right;

  function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED
  is
     subtype res_type is SIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
     variable cnt : natural;
  begin
     if res'length = 0 then
        return null_SIGNED;
     end if;
     cnt := count rem res'length;
     res (res'left downto cnt) := arg1 (res'left - cnt downto 0);
     res (cnt - 1 downto 0) := arg1 (res'left downto res'left - cnt + 1);
     return res;
  end rotate_left;

  function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED
  is
     subtype res_type is SIGNED (ARG'length - 1 downto 0);
     alias arg1 : res_type is arg;
     variable res : res_type := (others => '0');
     variable cnt : natural;
  begin
     if res'length = 0 then
        return null_SIGNED;
     end if;
     cnt := count rem res'length;
     res (res'left - cnt downto 0) := arg1 (res'left downto cnt);
     res (res'left downto res'left - cnt + 1) := arg1 (cnt - 1 downto 0);
     return res;
  end rotate_right;
end NUMERIC_STD;